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.430s
56.1312.250s
11.002.000s
31.252.508s
21.192.381s
Call 2
56.1322.237s
44.9818.041s
31.093.939s
21.073.897s
11.003.626s
Call 3
513.74230s
44.4274s
31.2321s
21.0417s
11.0017s
Call 4
5194.51470,931s
43.027,301s
31.403,387s
21.022,459s
11.002,421s
 VB6 Charts
CodeAuthorDopingNotes
StringToBit02 Donald  
StringToBit03 Donald  
StringToBit05 PaulTLB 
StringToBit06 PaulAPI,TLB 
StringToBit08 PaulAPI,TLB 
Call 1
41.703.095s
58.9716.296s
11.001.817s
31.462.662s
21.242.253s
Call 2
55.8321.012s
45.7220.630s
21.043.766s
31.124.050s
11.003.606s
Call 3
512.82215s
43.2555s
31.2721s
21.0418s
11.0017s
Call 4
5196.17479,163s
42.014,904s
31.323,216s
21.012,455s
11.002,443s
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