Skip to content

Commit a6e17b0

Browse files
dievdiev
committed
Все малоактуальное вынесено в папку BClient
1 parent c3ebd9a commit a6e17b0

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

79 files changed

+2728
-171
lines changed

‎ABOUT.FRM ‎BClient/About.frm

File renamed without changes.

‎BClient/Base36.bas

+70
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
Attribute VB_Name = "Base36"
2+
Option Explicit
3+
Option Compare Text
4+
Option Base 1
5+
DefLng A-Z
6+
7+
Public Function To36(Value As Variant) As String
8+
Dim n As Long, v As Long
9+
10+
On Error GoTo ErrHandler
11+
If Value < 10 Then '0..9
12+
To36 = Chr(48 + Value) '"0"+x
13+
ElseIf Value < 36 Then 'A..Z
14+
To36 = Chr(55 + Value) '"A"-10+x
15+
Else 'If Value < 2147483648# Then
16+
To36 = vbNullString
17+
n = CCur(Value)
18+
Do While n > 0
19+
v = n Mod 36
20+
If v < 10 Then v = v + 48 Else v = v + 55
21+
To36 = Chr(v) & To36
22+
n = n \ 36
23+
Loop
24+
End If
25+
Exit Function
26+
27+
ErrHandler:
28+
To36 = "-1" 'Overflow!
29+
End Function
30+
31+
Public Function Ot36(Value As String) As Long
32+
Dim i, n, v, b() As Byte
33+
34+
'On Error GoTo ErrHandler
35+
n = Len(Value)
36+
If n = 1 Then '1 digit only
37+
Ot36 = Asc(Value)
38+
Select Case Ot36
39+
Case 48 To 57 '0..9
40+
Ot36 = Ot36 - 48
41+
Case 65 To 90 'A..Z
42+
Ot36 = Ot36 - 55
43+
Case 97 To 122 'a..z
44+
Ot36 = Ot36 - 87
45+
Case Else
46+
GoTo ErrHandler
47+
End Select
48+
Else
49+
StrToBytes b, Value
50+
Ot36 = 0
51+
For i = 1 To n
52+
v = b(i)
53+
Select Case v
54+
Case 48 To 57 '0..9
55+
v = v - 48
56+
Case 65 To 90 'A..Z
57+
v = v - 55
58+
Case 97 To 122 'a..z
59+
v = v - 87
60+
Case Else
61+
GoTo ErrHandler
62+
End Select
63+
Ot36 = Ot36 + v * (36 ^ (n - i))
64+
Next
65+
End If
66+
Exit Function
67+
68+
ErrHandler:
69+
Ot36 = -1 'Overflow!
70+
End Function

‎BNKFORMS.BAS ‎BClient/BnkForms.bas

File renamed without changes.

‎BClient/Bytes.bas

+166
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,166 @@
1+
Attribute VB_Name = "Bytes"
2+
Option Explicit
3+
Option Base 0 'Binary bytes like the C language!!!
4+
DefLng A-Z
5+
6+
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
7+
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
8+
9+
Sub StrToBytes(ab() As Byte, s As String)
10+
If IsArrayEmpty(ab) Then If Len(s) > 0 Then ReDim ab(0 To Len(s) - 1) Else ReDim ab(0)
11+
Dim cab ' As SysInt
12+
' Copy to existing array, padding or truncating if needed
13+
cab = UBound(ab) - LBound(ab) + 1
14+
If Len(s) < cab Then s = s & String(cab - Len(s), 0)
15+
CopyMemory ab(LBound(ab)), ByVal s, cab
16+
17+
'If IsArrayEmpty(ab) Then
18+
' ' Just assign to empty array
19+
' ab = StrConv(s, vbFromUnicode)
20+
'Else
21+
' Dim cab ' As SysInt
22+
' ' Copy to existing array, padding or truncating if needed
23+
' cab = UBound(ab) - LBound(ab) + 1
24+
' If Len(s) < cab Then s = s & String(cab - Len(s), 0)
25+
' CopyMemory ab(LBound(ab)), ByVal s, cab
26+
'End If
27+
End Sub
28+
29+
Function BytesToStr(ab() As Byte) As String
30+
'BytesToStr = StrConv(ab(), vbUnicode)
31+
BytesToStr = String(LenBytes(ab), 0)
32+
CopyMemory ByVal BytesToStr, ab(LBound(ab)), LenBytes(ab)
33+
End Function
34+
35+
' Read string with length in first byte
36+
Function BytesToPStr(ab() As Byte, Optional iOffset As Long = 0) As String
37+
BytesToPStr = MidBytes(ab, iOffset + 1, ab(iOffset))
38+
End Function
39+
40+
Function BytesToWord(abBuf() As Byte, Optional iOffset As Long = 0) As Integer
41+
Dim w As Integer
42+
CopyMemory w, abBuf(iOffset), 2
43+
BytesToWord = w
44+
End Function
45+
46+
Function BytesToDWord(abBuf() As Byte, Optional iOffset As Long = 0) As Long
47+
Dim dw As Long
48+
CopyMemory dw, abBuf(iOffset), 4
49+
BytesToDWord = dw
50+
End Function
51+
52+
Sub BytesFromWord(w As Long, abBuf() As Byte, Optional iOffset As Long = 0)
53+
CopyMemory abBuf(iOffset), w, 2
54+
End Sub
55+
56+
Sub BytesFromDWord(dw As Long, abBuf() As Byte, Optional iOffset As Long = 0)
57+
CopyMemory abBuf(iOffset), dw, 4
58+
End Sub
59+
60+
'' Emulate relevant Basic string functions for arrays of bytes:
61+
'' Len$ LenBytes
62+
'' Mid$ function MidBytes
63+
'' Mid$ statement InsBytes sub
64+
'' Left$ LeftBytes
65+
'' Right$ RightBytes
66+
67+
' LenBytes - Emulates Len for array of bytes
68+
Function LenBytes(ab() As Byte) As Long
69+
LenBytes = UBound(ab) - LBound(ab) + 1
70+
End Function
71+
72+
' MidBytes - emulates Mid$ function for array of bytes
73+
' (Note that MidBytes does not emulate Mid$ exactly--string fields
74+
' in byte arrays are often null-padded, and MidBytes can extract
75+
' non-null portion.)
76+
Function MidBytes(ab() As Byte, iOffset, Optional vLen As Variant, _
77+
Optional vToNull As Variant) As String
78+
Dim s As String, fToNull As Boolean, cab ' As SysInt
79+
If Not IsMissing(vToNull) Then fToNull = vToNull
80+
' Calculate length
81+
If IsMissing(vLen) Then
82+
cab = LenBytes(ab) - iOffset
83+
Else
84+
cab = vLen
85+
End If
86+
' Assign and return string
87+
s = String$(cab, 0)
88+
CopyMemory ByVal s, ab(iOffset), cab
89+
If fToNull Then
90+
cab = InStr(s & vbNullChar, vbNullChar)
91+
MidBytes = Left$(s, cab - 1)
92+
Else
93+
MidBytes = s
94+
End If
95+
End Function
96+
97+
' InsBytes - Emulates Mid$ statement for array of bytes
98+
' (Note that InsBytes does not emulate Mid$ exactly--it inserts
99+
' a null-padded string into a fixed-size field in order to work
100+
' better with common use of byte arrays.)
101+
Sub InsBytes(sIns As String, ab() As Byte, iOffset, _
102+
Optional vLen As Variant, Optional sPad As Byte = 0)
103+
Dim cab ' As SysInt
104+
' Calculate length
105+
If IsMissing(vLen) Then
106+
cab = Len(sIns)
107+
Else
108+
cab = vLen
109+
' Null-pad insertion string if too short
110+
If (Len(sIns) < cab) Then
111+
sIns = sIns & String$(cab - Len(sIns), sPad)
112+
End If
113+
End If
114+
' Insert string
115+
CopyMemory ab(iOffset), ByVal sIns, cab
116+
End Sub
117+
118+
' LeftBytes - Emulates Left$ function for array of bytes
119+
Function LeftBytes(ab() As Byte, iLen) As String
120+
Dim s As String
121+
s = String$(iLen, 0)
122+
CopyMemory ByVal s, ab(LBound(ab)), iLen
123+
LeftBytes = s
124+
End Function
125+
126+
' RightBytes - Emulates Right$ function for array of bytes
127+
Function RightBytes(ab() As Byte, iLen) As String
128+
Dim s As String
129+
s = String$(iLen, 0)
130+
CopyMemory ByVal s, ab(UBound(ab) - iLen + 1), iLen
131+
RightBytes = s
132+
End Function
133+
134+
' FillBytes - Fills field in array of bytes with given byte
135+
Sub FillBytes(ab() As Byte, Optional b As Byte = 0, Optional iOffset As Long = 0, Optional iLen As Long)
136+
Dim i ' As SysInt
137+
If IsArrayEmpty(ab) Then ReDim ab(iLen)
138+
If IsMissing(iLen) Then iLen = UBound(ab) - iOffset + 1
139+
For i = iOffset To iOffset + iLen - 1
140+
ab(i) = b
141+
Next
142+
End Sub
143+
144+
' InStrBytes is not implemented because a simple version would
145+
' simply be equivalent to InStr(ab(), s). This creates a temporary
146+
' string for ab() on every call. An efficient version that works
147+
' directly on arrays of bytes could be written in C.
148+
149+
'However here is my release
150+
Function InStrBytes(ab() As Byte, b As Byte, Optional iOffset As Long = 0) As Long
151+
Dim i ' As SysInt
152+
For i = iOffset To UBound(ab)
153+
If ab(i) = b Then
154+
InStrBytes = i
155+
Exit Function
156+
End If
157+
Next
158+
InStrBytes = -1 'Not found
159+
End Function
160+
161+
Function IsArrayEmpty(ab() As Byte) As Boolean
162+
Dim v As Variant
163+
On Error Resume Next
164+
v = ab(LBound(ab))
165+
IsArrayEmpty = (Err <> 0)
166+
End Function

0 commit comments

Comments
 (0)