VBspeed / Bits / StringToBitB
VBspeed © 2000-10, updated: 19-Nov-2001
StringToBitB
See also StringToBit, StringToBitW


StringToBit, StringToBitB, StringToBitW
StringToBit generally returns the bit-pattern (or bit-stream) representing a given input string.
We gotta deal with the ANSI/ASCII vs Unicode issue here, and this is how we do it:

StringToBit has *3 sub-disciplines* in analogy with the Asc-function:
  1. StringToBit:    8 bits per char, Unicode is converted to ANSI/ASCII
  2. StringToBitB:   8 bits per char, first Unicode byte (the upper unicode byte is ignored)
  3. StringToBitW:  16 bits per char, both Unicode bytes

For example: the Euro-sign "" = Unicode 8364 (&H20AC), ANSI/ASCII-code 128
  StringToBit("")  --> "10000000"          '=  128 =   &H80 =  Asc("")
  StringToBitB("") --> "10101100"          '=  172 =   &HAC = AscB("")
  StringToBitW("") --> "0010000010101100"  '= 8364 = &H20AC = AscW("")
Use this function (VB5/6-compatible) to verify the correctness of your StringToBit, StringToBitB, StringToBitW code.


Function StringToBitB
Returns the bit-pattern representing an input string. 8 bits per char, first Unicode byte (the upper unicode byte is ignored). For example:
  StringToBitB("abc") --> "011000010110001001100011"
  StringToBitB("") --> "10101100"
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
1sRet = StringToBitB("x") [1 char] --> "01111000"
2sRet = StringToBitB("xxx...xxx") [10 chars] --> "01111000 .... 01111000"
3sRet = StringToBitB("xxx...xxx") [100 chars] --> "01111000 .... 01111000"
4sRet = StringToBitB("xxx...xxx") [10000 chars] --> "01111000 .... 01111000"
Charts
 VB5 Charts
CodeAuthorDopingNotes
StringToBitB02 Donald  
StringToBitB03 Donald  
StringToBitB04 GuidoAPI,TLB 
StringToBitB05 PaulAPI,TLB 
StringToBitB06 PaulAPI,TLB 
StringToBitB07 GuidoAPI,TLB 
StringToBitB08 PaulAPI,TLB 
Call 1
41.182.838s
72.776.683s
61.323.195s
11.002.413s
31.152.780s
51.283.083s
21.022.470s
Call 2
75.1617.100s
63.5511.774s
51.224.027s
31.103.650s
21.073.554s
41.153.804s
11.003.312s
Call 3
716.49178s
65.4759s
41.0812s
51.2213s
21.0211s
11.0011s
31.0511s
Call 4
7278.37472,438s
63.806,442s
21.051,777s
51.412,391s
31.051,785s
11.001,697s
41.061,805s
 VB6 Charts
CodeAuthorDopingNotes
StringToBitB02 Donald  
StringToBitB03 Donald  
StringToBitB04 GuidoAPI,TLB 
StringToBitB05 PaulAPI,TLB 
StringToBitB06 PaulAPI,TLB 
StringToBitB07 GuidoAPI,TLB 
StringToBitB08 PaulAPI,TLB 
Call 1
21.152.746s
73.197.634s
61.563.748s
31.152.765s
41.172.802s
51.363.246s
11.002.396s
Call 2
75.1616.687s
63.3310.759s
51.404.538s
31.233.983s
21.113.599s
41.244.007s
11.003.232s
Call 3
716.27175s
63.5939s
41.1312s
51.3715s
21.0211s
11.0011s
31.0411s
Call 4
7268.79459,308s
62.554,356s
41.061,808s
51.402,398s
21.051,794s
11.001,709s
31.061,803s
Conclusions
Please, stop fighting! The tables get too long!
Got comments? How to read all those numbers

top




VBspeed © 2000-10 by Donald Lessau