| Code |
| StringToBitW02 |
Public Function StringToBitW02(sData As String) As String
' by Donald, donald@xbeat.net, 20011027
' init byte-bits
Static b As Long
Static sByte(0 To 255) As String
If b = 0 Then
For b = 0 To 255
sByte(b) = "00000000"
If b And &H1& Then MidB$(sByte(b), 15&) = "1"
If b And &H2& Then MidB$(sByte(b), 13&) = "1"
If b And &H4& Then MidB$(sByte(b), 11&) = "1"
If b And &H8& Then MidB$(sByte(b), 9&) = "1"
If b And &H10& Then MidB$(sByte(b), 7&) = "1"
If b And &H20& Then MidB$(sByte(b), 5&) = "1"
If b And &H40& Then MidB$(sByte(b), 3&) = "1"
If b And &H80& Then MidB$(sByte(b), 1&) = "1"
Next
End If
' string to bit
Dim i As Long
StringToBitW02 = Space$(LenB(sData) * 8)
For i = 1 To LenB(sData) Step 2
Mid$(StringToBitW02, i * 8 - 7) = sByte(AscB(MidB$(sData, i + 1)))
Mid$(StringToBitW02, i * 8 + 1) = sByte(AscB(MidB$(sData, i)))
Next
End Function
|
|
| StringToBitW03 |
Public Function StringToBitW03(sData As String) As String
' by Donald, donald@xbeat.net, 20011027
' init byte-bits
Static b As Long
Static sByte(0 To 255) As String
If b = 0 Then
For b = 0 To 255
sByte(b) = "00000000"
If b And &H1& Then MidB$(sByte(b), 15&) = "1"
If b And &H2& Then MidB$(sByte(b), 13&) = "1"
If b And &H4& Then MidB$(sByte(b), 11&) = "1"
If b And &H8& Then MidB$(sByte(b), 9&) = "1"
If b And &H10& Then MidB$(sByte(b), 7&) = "1"
If b And &H20& Then MidB$(sByte(b), 5&) = "1"
If b And &H40& Then MidB$(sByte(b), 3&) = "1"
If b And &H80& Then MidB$(sByte(b), 1&) = "1"
Next
End If
' string to bit
Dim i As Long
Dim abData() As Byte
abData = sData
StringToBitW03 = Space$(LenB(sData) * 8)
For i = 0 To LenB(sData) - 1 Step 2
Mid$(StringToBitW03, i * 8 + 1) = sByte(abData(i + 1))
Mid$(StringToBitW03, i * 8 + 9) = sByte(abData(i))
Next
End Function
|
|
| StringToBitW04 |
Stuff you need for StringToBitW04:
1. Typelib BStrAPI (2KB, VB5-compatible, by G.Beckmann)
Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any)
Private Declare Sub RtlZeroMemory Lib "kernel32" (dst As Any, ByVal nBytes&)
Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&)
Private Declare Sub RtlFillMemory Lib "kernel32" (dst As Any, ByVal nBytes&, ByVal bFill As Byte)
Public Function StringToBitW04(sData As String) As String
' by G.Beckmann, G.Beckmann@NikoCity.de, 20011025
' returns unicode string
Static saSrc As bstrapi.SAFEARRAY1D, pSrc&
Static saDst As bstrapi.SAFEARRAY1D, pDst&
Static init&, aNibbles#(15)
Dim c&, d&, e&, aSrc%(), aDst#()
If init = 0 Then
ReDim Preserve aSrc(3)
For init = 0 To 15
d = 1: c = 3
Do Until c < 0
If init And d Then aSrc(c) = 49 Else aSrc(c) = 48
d = d * 2: c = c - 1
Loop
RtlMoveMemory aNibbles(init), aSrc(0), 8
Next init
Erase aSrc()
saSrc.cDims = 1
saSrc.cbElements = 2
pSrc = VarPtr(saSrc)
saDst.cDims = 1
saDst.cbElements = 8
pDst = VarPtr(saDst)
End If
c = Len(sData)
StringToBitW04 = bstrapi.SysAllocStringLen(vbNullString, c * 16)
saSrc.pvData = StrPtr(sData)
saSrc.cElements1D = c
saDst.pvData = StrPtr(StringToBitW04)
saDst.cElements1D = c * 4
RtlMoveMemory ByVal ArrPtr(aSrc), pSrc, 4
RtlMoveMemory ByVal ArrPtr(aDst), pDst, 4
c = c - 1
Do Until c < 0
d = aSrc(c) And &HFFFF& '1 unicode-character -> 4 nibbles
aDst(c * 4 + 3) = aNibbles(d And &HF) 'LoLo
aDst(c * 4 + 2) = aNibbles((d \ &H10) And &HF) 'LoHi
aDst(c * 4 + 1) = aNibbles((d \ &H100) And &HF) 'HiLo
aDst(c * 4 + 0) = aNibbles(d \ &H1000) 'HiHi
c = c - 1
Loop
RtlZeroMemory ByVal ArrPtr(aSrc), 4
RtlZeroMemory ByVal ArrPtr(aDst), 4
End Function
|
|
| StringToBitW05 |
Stuff you need for StringToBitW05:
1. Module modSafeArray_Paul.bas (2KB zipped, VB5-compatible).
2. Module modStringToBit05 (1KB zipped, VB5-compatible), portions shown below.
3. Typelib FastString (1KB, VB5-compatible, by Paul)
Private lookup(0 To 15) As Currency
Public Function StringToBitW05(ByRef sData As String) As String
' by Paul, wpsjr1@syix.com, 20011027
Dim lInArrayPointer As Long
Static cOut() As Currency
Dim lLen As Long
Dim i As Long
Static iData() As Integer ' array shell used to contain string data
Dim saIn As SAFEARRAYHEADER
Static lInit As Long
Static lLastLen As Long
Dim iTemp As Integer
lLen = Len(sData)
If lLen Then ' not zero length
lInArrayPointer = VarPtrArray(iData)
If RedimArray(integerArray, lLen, saIn, StrPtr(sData), lInArrayPointer) Then
If lInit Then
Else
lInit = 1
InitLookupTable
End If
If lLastLen <> lLen Then ReDim cOut(lLen * 4) ' one extra, but don't bother subtracting
lLastLen = lLen
For i = 0 To lLen - 1
iTemp = iData(i)
cOut(i * 4) = lookup((iTemp And &HF000&) \ &H1000)
cOut((i * 4) + 1) = lookup((iTemp And &HF00&) \ &H100)
cOut((i * 4) + 2) = lookup((iTemp And &HF0) \ &H10)
cOut((i * 4) + 3) = lookup(iTemp And &HF)
Next i
StringToBitW05 = FastString.SysAllocStringLen(cOut(0), lLen * 16)
DestroyArray lInArrayPointer
End If
End If
End Function
Private Sub InitLookupTable()
lookup(0) = 1351100504368.7472@ ' magic numbers, magical mystery tour :P
lookup(1) = 1379248002039.8128@
lookup(2) = 1351100933865.4768@
lookup(3) = 1379248431536.5424@
lookup(4) = 1351100504375.3008@
lookup(5) = 1379248002046.3664@
lookup(6) = 1351100933872.0304@
lookup(7) = 1379248431543.096@
lookup(8) = 1351100504368.7473@
lookup(9) = 1379248002039.8129@
lookup(10) = 1351100933865.4769@
lookup(11) = 1379248431536.5425@
lookup(12) = 1351100504375.3009@
lookup(13) = 1379248002046.3665@
lookup(14) = 1351100933872.0305@
lookup(15) = 1379248431543.0961@
End Sub
|
|
| StringToBitW06 |
Stuff you need for StringToBitW06:
1. Module modSafeArray_Paul.bas (2KB zipped, VB5-compatible).
2. Module modStringToBit06 (1KB zipped, VB5-compatible), portions shown below.
3. Typelib FastString (1KB zipped, VB5-compatible, by Paul)
Private lookup(0 To 255) As Currency
Public Function StringToBitW06(ByRef sData As String) As String
' by Paul, wpsjr1@syix.com, 20011029
Dim lLen As Long
Dim lTemp As Long
Static saIn As SAFEARRAYHEADER
Static saOut As SAFEARRAYHEADER
Static iData() As Integer ' array shell used to contain string data
Static cOut() As Currency
Static lInit As Long
Static lpsaIn As Long
Static lpsaOut As Long
Static lInArrayPointer As Long
Static lOutArrayPointer As Long
lLen = Len(sData)
If lInit Then
Else
lInit = 1
lInArrayPointer = VarPtrArray(iData)
lOutArrayPointer = VarPtrArray(cOut)
InitLookupTable
With saIn
.DataSize = 2 ' integer array
.dimensions = 1
End With
With saOut
.DataSize = 8 ' currency array
.dimensions = 1
End With
lpsaIn = VarPtr(saIn)
lpsaOut = VarPtr(saOut)
End If
With saIn
.dataPointer = StrPtr(sData)
.sab(0).cElements = lLen
End With
RtlMoveMemory ByVal lInArrayPointer, lpsaIn, 4
StringToBitW06 = FastString.SysAllocStringLen(ByVal 0&, lLen * 16)
With saOut
.dataPointer = StrPtr(StringToBitW06)
.sab(0).cElements = lLen * 4
End With
RtlMoveMemory ByVal lOutArrayPointer, lpsaOut, 4
If lLen Then
Do
lLen = lLen - 1
lTemp = iData(lLen)
cOut((lLen * 4) + 3) = lookup(lTemp And &HF)
cOut((lLen * 4) + 2) = lookup(lTemp And &HF0)
cOut((lLen * 4) + 1) = lookup(lTemp \ &H100 And &HF)
cOut(lLen * 4) = lookup(lTemp \ &H1000 And &HF)
Loop While lLen
End If
RtlMoveMemory ByVal lInArrayPointer, 0&, 4
RtlMoveMemory ByVal lOutArrayPointer, 0&, 4
End Function
Private Sub InitLookupTable()
Dim i As Long
lookup(0) = 1351100504368.7472@ ' magic numbers, magical mystery tour :P
lookup(1) = 1379248002039.8128@
lookup(2) = 1351100933865.4768@
lookup(3) = 1379248431536.5424@
lookup(4) = 1351100504375.3008@
lookup(5) = 1379248002046.3664@
lookup(6) = 1351100933872.0304@
lookup(7) = 1379248431543.096@
lookup(8) = 1351100504368.7473@
lookup(9) = 1379248002039.8129@
lookup(10) = 1351100933865.4769@
lookup(11) = 1379248431536.5425@
lookup(12) = 1351100504375.3009@
lookup(13) = 1379248002046.3665@
lookup(14) = 1351100933872.0305@
lookup(15) = 1379248431543.0961@
For i = 16 To 255
lookup(i) = lookup((i And &HF0) \ &H10)
Next i
End Sub
|
|
| StringToBitW07 |
Stuff you need for StringToBitW07:
1. Typelib BStrAPI (2KB, VB5-compatible, by G.Beckmann)
Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any)
Private Declare Sub RtlZeroMemory Lib "kernel32" (dst As Any, ByVal nBytes&)
Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&)
Private Declare Sub RtlFillMemory Lib "kernel32" (dst As Any, ByVal nBytes&, ByVal bFill As Byte)
Public Function StringToBitW07(ByRef sData As String) As String
' by G.Beckmann, G.Beckmann@NikoCity.de, 20011119
Static saSrc As bstrapi.SafeArray1D
Static saDst As bstrapi.SafeArray1D
Static init&
Static aLoNibbles#(0 To 255)
Static aHiNibbles#(0 To 255)
Static aSrc%()
Static aDst#()
Static pSrc&, psaSrc&
Static pDst&, psaDst&
Dim c&, d&
If init = 0 Then
ReDim Preserve aSrc(0 To 3)
For init = 0 To 15
d = 1: c = 3
Do Until c < 0
If init And d Then aSrc(c) = 49 Else aSrc(c) = 48
d = d * 2: c = c - 1
Loop
RtlMoveMemory aLoNibbles(init), aSrc(0), 8
Next init
Erase aSrc()
For c = 0 To 255
aLoNibbles(c) = aLoNibbles(c Mod 16)
aHiNibbles(c) = aLoNibbles(c \ 16)
Next c
saSrc.cDims = 1
saSrc.cbElements = 2
saSrc.cElements1D = &H7FFFFFFF
saDst.cDims = 1
saDst.cbElements = 8
saDst.cElements1D = &H7FFFFFFF
pSrc = VarPtr(saSrc)
pDst = VarPtr(saDst)
psaSrc = ArrPtr(aSrc)
psaDst = ArrPtr(aDst)
End If
c = LenB(sData) * 2
StringToBitW07 = bstrapi.SysAllocStringLenPtr(0, c * 4)
saSrc.pvData = StrPtr(sData)
saDst.pvData = StrPtr(StringToBitW07)
RtlMoveMemory ByVal psaSrc, pSrc, 4
RtlMoveMemory ByVal psaDst, pDst, 4
Do Until c <= 0
c = c - 4
d = aSrc(c \ 4) And &HFFFF&
aDst(c + 0) = aHiNibbles(d \ &H100)
aDst(c + 1) = aLoNibbles(d \ &H100)
aDst(c + 2) = aHiNibbles(d And &HFF)
aDst(c + 3) = aLoNibbles(d And &HFF)
Loop
RtlZeroMemory ByVal psaSrc, 4
RtlZeroMemory ByVal psaDst, 4
End Function
|
|
| StringToBitW08 |
Stuff you need for StringToBitW08:
1. Module modSafeArray_Paul.bas (2KB zipped, VB5-compatible).
2. Typelib FastString (1KB, VB5-compatible, by Paul)
Private lookup(0 To 255) As Currency
Public Function StringToBitW08(ByRef sData As String) As String
' by Paul, wpsjr1@syix.com 20011120
' doping FastString typelib
Dim lLen As Long
Dim lTemp As Long
Dim lCounter As Long
Static saIn As SAFEARRAYHEADER
Static saOut As SAFEARRAYHEADER
Static iData() As Integer ' array shell used to contain string data
Static cOut() As Currency
Static lInit As Long
Static lpsaIn As Long
Static lpsaOut As Long
Static lInArrayPointer As Long
Static lOutArrayPointer As Long
lLen = LenB(sData)
If lInit Then
Else
'lInit = 1
ReDim iData(3)
For lInit = 0 To 15 ' generate LUT
lTemp = lInit
iData(3) = 48 + (lTemp And 1)
lTemp = lTemp \ 2
iData(2) = 48 + (lTemp And 1)
lTemp = lTemp \ 2
iData(1) = 48 + (lTemp And 1)
lTemp = lTemp \ 2
iData(0) = 48 + (lTemp And 1)
RtlMoveMemory lookup(lInit), iData(0), 8
Next lInit
For lInit = 16 To 255
lookup(lInit) = lookup((lInit And &HF0) \ &H10)
Next lInit
Erase iData
lInArrayPointer = VarPtrArray(iData)
lOutArrayPointer = VarPtrArray(cOut)
With saIn
.DataSize = 2 ' integer array
.dimensions = 1
.sab(0).cElements = &H7FFFFFFF
End With
With saOut
.DataSize = 8 ' currency array
.dimensions = 1
.sab(0).cElements = &H7FFFFFFF
End With
lpsaIn = VarPtr(saIn)
lpsaOut = VarPtr(saOut)
End If
saIn.dataPointer = StrPtr(sData)
RtlMoveMemory ByVal lInArrayPointer, lpsaIn, 4
StringToBitW08 = FastString.SysAllocStringLen(ByVal 0&, lLen * 8)
saOut.dataPointer = StrPtr(StringToBitW08)
RtlMoveMemory ByVal lOutArrayPointer, lpsaOut, 4
lLen = lLen * 2
If lLen Then
lLen = lLen - 1
lCounter = 0
Do
lTemp = iData(lCounter \ 4)
cOut(lCounter) = lookup(lTemp \ &H1000 And &HF)
cOut(lCounter + 1) = lookup(lTemp \ &H100 And &HF)
cOut(lCounter + 2) = lookup(lTemp And &HF0)
cOut(lCounter + 3) = lookup(lTemp And &HF)
lCounter = lCounter + 4
Loop While lCounter <= lLen
End If
FastString.RtlMoveMemory ByVal lInArrayPointer, 0&
FastString.RtlMoveMemory ByVal lOutArrayPointer, 0&
End Function
|
| Calls |
|
1 | sRet = StringToBitW("x") [1 char] --> "01111000"
|
|
2 | sRet = StringToBitW("xxx...xxx") [10 chars] --> "01111000 .... 01111000"
|
|
3 | sRet = StringToBitW("xxx...xxx") [100 chars] --> "01111000 .... 01111000"
|
|
4 | sRet = StringToBitW("xxx...xxx") [10000 chars] --> "01111000 .... 01111000"
|
| Charts |
|
