VBspeed / Bits / StringToBit
VBspeed © 2000-10, updated: 03-Nov-2001
StringToBit
See also StringToBitB, 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 StringToBit
Returns the bit-pattern representing an input string. 8 bits per char, Unicode is converted to ANSI/ASCII. For example:
  StringToBit("abc") --> "011000010110001001100011"
  StringToBit("€") --> "10000000"
Code
StringToBit02
Public Function StringToBit02(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
  StringToBit02 = Space$(Len(sData) * 8)
  For i = 1 To Len(sData)
    Mid$(StringToBit02, i * 8 - 7) = sByte(Asc(Mid$(sData, i)))
  Next
  
End Function
StringToBit03
Public Function StringToBit03(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 = StrConv(sData, vbFromUnicode)
  StringToBit03 = Space$(Len(sData) * 8)
  For i = 0 To Len(sData) - 1
    Mid$(StringToBit03, 1 + i * 8) = sByte(abData(i))
  Next
  
End Function
StringToBit05
Stuff you need for StringToBit05:
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 StringToBit05(ByRef sData As String) As String ' by Paul, wpsjr1@syix.com, 20011026 Dim lLen As Long Dim i As Long Dim bTemp As Byte Static b() As Byte Static cOut() As Currency Static lInit As Long Static lLastLen As Long lLen = Len(sData) If lLen Then If lInit Then Else lInit = 1 InitLookupTable End If If lLastLen <> lLen Then ReDim b(lLen) ReDim cOut(lLen * 2) End If lLastLen = lLen FastString.WideCharToMultiByte 0&, 0&, sData, lLen, b(0), lLen, 0&, 0& For i = 0 To lLen - 1 bTemp = b(i) cOut(i * 2) = lookup(bTemp \ &H10) cOut((i * 2) + 1) = lookup(bTemp And &HF) Next i StringToBit05 = FastString.SysAllocStringLen(cOut(0), lLen * 8) 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
StringToBit06
Stuff you need for StringToBit06:
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 StringToBit06(ByRef sData As String) As String ' by Paul, wpsjr1@syix.com, 20011029 Dim lLen As Long Dim i As Long Dim lTemp As Long Static lOutArrayPointer As Long Static b() As Byte Static cOut() As Currency Static lInit As Long Static lLastLen As Long Static lpsaOut As Long Static saOut As SAFEARRAYHEADER lLen = Len(sData) If lLen Then If lInit Then Else lInit = 1 InitLookupTable lOutArrayPointer = VarPtrArray(cOut) With saOut .DataSize = 8 ' currency array .dimensions = 1 End With lpsaOut = VarPtr(saOut) End If If lLastLen <> lLen Then ReDim b(lLen) lLastLen = lLen FastString.WideCharToMultiByte 0&, 0&, sData, lLen, b(0), lLen, 0&, 0& StringToBit06 = FastString.SysAllocStringLen(ByVal 0&, lLen * 8) With saOut .dataPointer = StrPtr(StringToBit06) .sab(0).cElements = lLen * 2 End With RtlMoveMemory ByVal lOutArrayPointer, lpsaOut, 4 Do lLen = lLen - 1 lTemp = b(lLen) cOut((lLen * 2) + 1) = lookup(lTemp And &HF) cOut(lLen * 2) = lookup(lTemp \ &H10) Loop While lLen RtlMoveMemory ByVal lOutArrayPointer, 0&, 4 End If 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
StringToBit08
Stuff you need for StringToBit08:
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 StringToBit08(ByRef sData As String) As String ' by Paul, wpsjr1@syix.com 20011120 ' doping FastString typelib Dim lLen As Long Dim lTemp As Long Static lOutArrayPointer As Long Static b() As Byte Static cOut() As Currency Static lInit As Long Static lLastLen As Long Static lpsaOut As Long Static saOut As SAFEARRAYHEADER lLen = Len(sData) If lLen Then If lInit Then Else ReDim b(7) For lInit = 0 To 15 ' generate LUT lTemp = lInit b(6) = 48 + (lTemp And 1) lTemp = lTemp \ 2 b(4) = 48 + (lTemp And 1) lTemp = lTemp \ 2 b(2) = 48 + (lTemp And 1) lTemp = lTemp \ 2 b(0) = 48 + (lTemp And 1) RtlMoveMemory lookup(lInit), b(0), 8 Next lInit For lInit = 16 To 255 lookup(lInit) = lookup((lInit And &HF0) \ &H10) Next lInit lOutArrayPointer = VarPtrArray(cOut) With saOut .DataSize = 8 ' currency array .dimensions = 1 .sab(0).cElements = &H7FFFFFFF End With lpsaOut = VarPtr(saOut) End If If lLastLen <> lLen Then ReDim b(lLen) lLastLen = lLen FastString.WideCharToMultiByte 0&, 0&, sData, lLen, b(0), lLen, 0&, 0& StringToBit08 = FastString.SysAllocStringLen(ByVal 0&, lLen * 8) saOut.dataPointer = StrPtr(StringToBit08) FastString.RtlMoveMemory ByVal lOutArrayPointer, lpsaOut lLen = lLen * 2 Do lLen = lLen - 2 lTemp = b(lLen \ 2) cOut(lLen + 1) = lookup(lTemp And &HF) cOut(lLen) = lookup(lTemp \ &H10) Loop While lLen FastString.RtlMoveMemory ByVal lOutArrayPointer, 0& End If End Function
Calls
1sRet = StringToBit("x") [1 char] --> "01111000"
2sRet = StringToBit("xxx...xxx") [10 chars] --> "01111000 .... 01111000"
3sRet = StringToBit("xxx...xxx") [100 chars] --> "01111000 .... 01111000"
4sRet = StringToBit("xxx...xxx") [10000 chars] --> "01111000 .... 01111000"
Charts
 VB5 Charts
CodeAuthorDopingNotes
StringToBit02 Donald  
StringToBit03 Donald  
StringToBit05 PaulTLB 
StringToBit06 PaulAPI,TLB 
StringToBit08 PaulAPI,TLB 
Call 1
41.723.430µs
56.1312.250µs
11.002.000µs
31.252.508µs
21.192.381µs
Call 2
56.1322.237µs
44.9818.041µs
31.093.939µs
21.073.897µs
11.003.626µs
Call 3
513.74230µs
44.4274µs
31.2321µs
21.0417µs
11.0017µs
Call 4
5194.51470,931µs
43.027,301µs
31.403,387µs
21.022,459µs
11.002,421µs
 VB6 Charts
CodeAuthorDopingNotes
StringToBit02 Donald  
StringToBit03 Donald  
StringToBit05 PaulTLB 
StringToBit06 PaulAPI,TLB 
StringToBit08 PaulAPI,TLB 
Call 1
41.703.095µs
58.9716.296µs
11.001.817µs
31.462.662µs
21.242.253µs
Call 2
55.8321.012µs
45.7220.630µs
21.043.766µs
31.124.050µs
11.003.606µs
Call 3
512.82215µs
43.2555µs
31.2721µs
21.0418µs
11.0017µs
Call 4
5196.17479,163µs
42.014,904µs
31.323,216µs
21.012,455µs
11.002,443µs
Conclusions
Note that VB6 is doing much better than VB5 on StringToBit03. A rare thing to see.
StringToBit05 ff. method: Access string data as an array of integers via the safearray hack.
Got comments? How to read all those numbers

top




VBspeed © 2000-10 by Donald Lessau