Code |
StringToBitB02 |
Public Function StringToBitB02(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
StringToBitB02 = Space$(Len(sData) * 8)
For i = 1 To Len(sData)
Mid$(StringToBitB02, i * 8 - 7) = sByte(AscB(Mid$(sData, i))) '€ => 172
Next
End Function
|
|
StringToBitB03 |
Public Function StringToBitB03(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
StringToBitB03 = Space$(Len(sData) * 8)
For i = 0 To Len(sData) - 1
Mid$(StringToBitB03, 1 + i * 8) = sByte(abData(i * 2))
Next
End Function
|
|
StringToBitB04 |
Stuff you need for StringToBitB04:
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 StringToBitB04(sData As String) As String
' by G.Beckmann, G.Beckmann@NikoCity.de, 20011025
' based on StringToBit01 by Paul
Static saSrc As bstrapi.SAFEARRAY1D, pSrc&
Static saDst As bstrapi.SAFEARRAY1D, pDst&
Static init&, aNibbles#(15)
Dim c&, d&, 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)
StringToBitB04 = bstrapi.SysAllocStringLen(vbNullString, c * 8)
saSrc.pvData = StrPtr(sData)
saSrc.cElements1D = c
saDst.pvData = StrPtr(StringToBitB04)
saDst.cElements1D = c * 2
RtlMoveMemory ByVal ArrPtr(aSrc), pSrc, 4
RtlMoveMemory ByVal ArrPtr(aDst), pDst, 4
c = c - 1
Do Until c < 0
d = aSrc(c)
aDst(c * 2) = aNibbles((d \ &H10) And &HF)
aDst(c * 2 + 1) = aNibbles(d And &HF)
c = c - 1
Loop
RtlZeroMemory ByVal ArrPtr(aSrc), 4
RtlZeroMemory ByVal ArrPtr(aDst), 4
End Function
|
|
StringToBitB05 |
Stuff you need for StringToBitB05:
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 StringToBitB05(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 * 2) ' one extra, but don't bother subtracting
lLastLen = lLen
For i = 0 To lLen - 1
iTemp = iData(i)
cOut(i * 2) = lookup((iTemp And &HF0) \ &H10)
cOut((i * 2) + 1) = lookup(iTemp And &HF)
Next i
StringToBitB05 = FastString.SysAllocStringLen(cOut(0), lLen * 8)
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
|
|
StringToBitB06 |
Stuff you need for StringToBitB06:
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 StringToBitB06(ByRef sData As String) As String
' by Paul, wpsjr1@syix.com, 20011029
Dim lLen As Long
Dim iTemp As Integer
Dim lCounter As Long
Static lpsaIn As Long
Static lpsaOut As Long
Static cOut() As Currency
Static iData() As Integer ' array shell used to contain string data
Static saIn As SAFEARRAYHEADER
Static saOut As SAFEARRAYHEADER
Static lInit As Long
Static lInArrayPointer As Long
Static lOutArrayPointer As Long
lLen = Len(sData)
If lInit Then
Else
lInit = 1
InitLookupTable
lInArrayPointer = VarPtrArray(iData)
lOutArrayPointer = VarPtrArray(cOut)
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
StringToBitB06 = FastString.SysAllocStringLen(ByVal 0&, lLen * 8)
With saOut
.dataPointer = StrPtr(StringToBitB06)
.sab(0).cElements = lLen * 2
End With
RtlMoveMemory ByVal lOutArrayPointer, lpsaOut, 4
If lLen Then ' not zero length
Do
lLen = lLen - 1
iTemp = iData(lLen)
cOut((lLen * 2) + 1) = lookup(iTemp And &HF)
cOut(lLen * 2) = lookup(iTemp And &HF0)
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
|
|
StringToBitB07 |
Stuff you need for StringToBitB07:
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 StringToBitB07(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() As Byte
Static aDst#()
Static pSrc&, psaSrc&
Static pDst&, psaDst&
Dim c&, d&, ai%()
If init = 0 Then
ReDim Preserve ai%(0 To 3)
For init = 0 To 15
d = 1: c = 3
Do Until c < 0
If init And d Then ai(c) = 49 Else ai(c) = 48
d = d * 2: c = c - 1
Loop
RtlMoveMemory aLoNibbles(init), ai(0), 8
Next init
For c = 0 To 255
aLoNibbles(c) = aLoNibbles(c Mod 16)
aHiNibbles(c) = aLoNibbles(c \ 16)
Next c
saSrc.cDims = 1
saSrc.cbElements = 1
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)
StringToBitB07 = bstrapi.SysAllocStringLenPtr(ByVal 0, c * 4)
saSrc.pvData = StrPtr(sData)
saDst.pvData = StrPtr(StringToBitB07)
RtlMoveMemory ByVal psaSrc, pSrc, 4
RtlMoveMemory ByVal psaDst, pDst, 4
Do Until c <= 0
c = c - 2
d = aSrc(c)
aDst(c + 0) = aHiNibbles(d)
aDst(c + 1) = aLoNibbles(d)
Loop
RtlZeroMemory ByVal psaSrc, 4
RtlZeroMemory ByVal psaDst, 4
End Function
|
|
StringToBitB08 |
Stuff you need for StringToBitB08:
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 StringToBitB08(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 lpsaIn As Long
Static lpsaOut As Long
Static cOut() As Currency
Static bData() As Byte ' array shell used to contain string data
Static saIn As SAFEARRAYHEADER
Static saOut As SAFEARRAYHEADER
Static lInit As Long
Static lInArrayPointer As Long
Static lOutArrayPointer As Long
lLen = LenB(sData)
If lInit Then
Else
ReDim bData(7)
For lInit = 0 To 15 ' generate LUT
lTemp = lInit
bData(6) = 48 + (lTemp And 1)
lTemp = lTemp \ 2
bData(4) = 48 + (lTemp And 1)
lTemp = lTemp \ 2
bData(2) = 48 + (lTemp And 1)
lTemp = lTemp \ 2
bData(0) = 48 + (lTemp And 1)
RtlMoveMemory lookup(lInit), bData(0), 8
Next lInit
For lInit = 16 To 255
lookup(lInit) = lookup((lInit And &HF0) \ &H10)
Next lInit
Erase bData
lInArrayPointer = VarPtrArray(bData)
lOutArrayPointer = VarPtrArray(cOut)
With saIn
.DataSize = 1 ' byte 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)
FastString.RtlMoveMemory ByVal lInArrayPointer, lpsaIn
StringToBitB08 = FastString.SysAllocStringLen(ByVal 0&, lLen * 4)
saOut.dataPointer = StrPtr(StringToBitB08)
FastString.RtlMoveMemory ByVal lOutArrayPointer, lpsaOut
If lLen Then ' not zero length
lLen = lLen - 2
lCounter = 0
Do
lTemp = bData(lCounter)
cOut(lCounter) = lookup(lTemp And &HF0)
cOut(lCounter + 1) = lookup(lTemp And &HF)
lCounter = lCounter + 2
Loop While lCounter <= lLen
End If
FastString.RtlMoveMemory ByVal lInArrayPointer, 0&
FastString.RtlMoveMemory ByVal lOutArrayPointer, 0&
End Function
|
Calls |
1 | sRet = StringToBitB("x") [1 char] --> "01111000"
|
2 | sRet = StringToBitB("xxx...xxx") [10 chars] --> "01111000 .... 01111000"
|
3 | sRet = StringToBitB("xxx...xxx") [100 chars] --> "01111000 .... 01111000"
|
4 | sRet = StringToBitB("xxx...xxx") [10000 chars] --> "01111000 .... 01111000"
|
Charts |
|