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.838µs
72.776.683µs
61.323.195µs
11.002.413µs
31.152.780µs
51.283.083µs
21.022.470µs
Call 2
75.1617.100µs
63.5511.774µs
51.224.027µs
31.103.650µs
21.073.554µs
41.153.804µs
11.003.312µs
Call 3
716.49178µs
65.4759µs
41.0812µs
51.2213µs
21.0211µs
11.0011µs
31.0511µs
Call 4
7278.37472,438µs
63.806,442µs
21.051,777µs
51.412,391µs
31.051,785µs
11.001,697µs
41.061,805µs
 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.746µs
73.197.634µs
61.563.748µs
31.152.765µs
41.172.802µs
51.363.246µs
11.002.396µs
Call 2
75.1616.687µs
63.3310.759µs
51.404.538µs
31.233.983µs
21.113.599µs
41.244.007µs
11.003.232µs
Call 3
716.27175µs
63.5939µs
41.1312µs
51.3715µs
21.0211µs
11.0011µs
31.0411µs
Call 4
7268.79459,308µs
62.554,356µs
41.061,808µs
51.402,398µs
21.051,794µs
11.001,709µs
31.061,803µs
Conclusions
Please, stop fighting! The tables get too long!
Got comments? How to read all those numbers

top




VBspeed © 2000-10 by Donald Lessau