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