VBspeed / String / Base64Enc
VBspeed © 2000-10, updated: 08-Jan-2003
Base64Enc
See also Base64Dec


The Definition
Function Base64Enc
Encodes data with MIME Base64. Base64 encoding is designed to make binary data survive transport through transport layers that are not 8-bit clean, such as mail bodies.
Base64 processes data as 24-bit groups, mapping this data to four encoded characters. Base64 encoding is sometimes referred to as 3-to-4 encoding. Each 6 bits of the 24-bit group is used as an index into a mapping table (the base64 alphabet) to obtain a character for the encoded data. Padding at the end of the data is performed using the additional "=" character. The encoded data are consistently only about 33 percent larger than the unencoded data.
The encoding scheme is first defined in RFC 1341, obsoleted later by RFC 1521 and RFC 2045. The section 6.8 of RFC 2045, 'Base64 Content-Transfer-Encoding', is reproduced here.
Declaration
The preferred format of the input and output data stream may vary depending on the context. Here are three possibilities:
  Function Base64Enc(Expression As String) As String
  Function Base64Enc(abSrc() As Byte) As String
  Sub Base64Dec(abSrc() As Byte, abDst() As Byte)
The input string resp. byte array can contain arbitrary binary data, and the function returns a string containing one or more lines (see below) of base64 encoded data.
Line breaks: RFC 2045 demands: "The encoded output stream must be represented in lines of no more than 76 characters each." Note that VBspeed's Base64Enc definition does not conform to this.
Unicode: Care has to be taken when a source string contains UNICODE characters that cannot be losslessly mapped to the ANSI charset (and only very few can). For example, take the Cyrillic character Я (dec 1071, hex 04 2F): in Base64Enc01, which can handle ANSI only, this character is mapped to the default character "?", and consequently the encoding is wrong.
  Base64Enc01("Я") --> "Pw=="; Base64Dec01("Pw==") --> "?" (WRONG)
  Base64Enc02("Я") --> "LwQ="; Base64Dec02("LwQ=") --> "Я" (correct)
Functions that take byte arrays as source data (as e.g. Base64Enc02 - shown above as if taking a string for demonstration purposes), do not have any unicode problems, resp. they export those problems to the place where unicode strings are converted to byte arrays.
Examples
ANSI, 1 byte/char:
  Base64Enc("VBspee")   --> "VkJzcGVl"        'in: 6, out:  8, padding: 0
  Base64Enc("VBspeed")  --> "VkJzcGVlZA=="    'in: 7, out: 12, padding: 2
  Base64Enc("VBspeedo") --> "VkJzcGVlZG8="    'in: 8, out: 12, padding: 1
  Base64Enc("VBspeedos")--> "VkJzcGVlZG9z"    'in: 9, out: 12, padding: 0
  
UNICODE, 2 bytes/char:
  Base64Enc("VBspee")   --> "VgBCAHMAcABlAGUA"          'in: 12, out: 16, padding: 0
  Base64Enc("VBspeed")  --> "VgBCAHMAcABlAGUAZAA="      'in: 14, out: 20, padding: 1
  Base64Enc("VBspeedo") --> "VgBCAHMAcABlAGUAZABvAA=="  'in: 16, out: 24, padding: 2
  Base64Enc("VBspeedos")--> "VgBCAHMAcABlAGUAZABvAHMA"  'in: 18, out: 24, padding: 0
Roll your own
If you want to have a go at Base64Enc yourself, use this function (VB5/6-compatible) to verify the correctness of your code.


The Charts
Calls
  sDst = Base64Enc(sSrc) or
sDst = Base64Enc(abSrc()) or
Call Base64Enc(abSrc(), abDst())
Call 1 sSrc/abSrc() = "Vbspeed"
Call 2 sSrc/abSrc() = "The above means that base64 encoded data takes one-third more space than the data before the conversion."
Call 3 sSrc/abSrc() = Replicate(100, "The above means that base64 encoded data takes one-third more space than the data before the conversion.")
Call 4 sSrc/abSrc() = Replicate(1000, "The above means that base64 encoded data takes one-third more space than the data before the conversion.")
Call 5 sSrc/abSrc() = Replicate(10000, "The above means that base64 encoded data takes one-third more space than the data before the conversion.")
 VB5
CodeAuthorDopingNotes
Base64Enc01 Nobody  
Base64Enc02 GuidoAPI,TLB 
Base64Enc03 PaulTLB 
Base64Enc04 PaulTLB 
Call 1
416.955.058µs
21.130.336µs
11.000.298µs
32.010.600µs
Call 2
48.137.457µs
31.541.411µs
11.000.917µs
21.351.238µs
Call 3
44.97317µs
31.82116µs
11.0064µs
21.0466µs
Call 4
46.984,854µs
31.971,373µs
21.36950µs
11.00696µs
Call 5
45.4656,488µs
31.4114,574µs
21.0711,107µs
11.0010,340µs
 VB6
CodeAuthorDopingNotes
Base64Enc01 Nobody  
Base64Enc02 GuidoAPI,TLB 
Base64Enc03 PaulTLB 
Base64Enc04 PaulTLB 
Call 1
419.425.710µs
21.260.371µs
11.000.294µs
32.050.604µs
Call 2
49.298.282µs
31.581.408µs
11.000.892µs
21.391.240µs
Call 3
44.32294µs
31.65113µs
11.0068µs
21.0269µs
Call 4
46.974,967µs
31.971,400µs
21.451,034µs
11.00712µs
Call 5
45.4156,934µs
31.3514,203µs
21.0511,106µs
11.0010,530µs
Notes & Conclusions
Mail your code! How to read all those numbers


The Code
Base64Enc01
submitted 29-Sep-2002 by Nobody  
Doping: none
Public Function Base64Enc01(s$) As String
' by Nobody, 20011204
  Static Enc() As Byte
  Dim b() As Byte, Out() As Byte, i&, j&, L&
  If (Not Val(Not Enc)) = 0 Then 'Null-Ptr = not initialized
    Enc = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
  End If
  L = Len(s): b = StrConv(s, vbFromUnicode)
  ReDim Preserve b(0 To (UBound(b) \ 3) * 3 + 2)
  ReDim Preserve Out(0 To (UBound(b) \ 3) * 4 + 3)
  For i = 0 To UBound(b) - 1 Step 3
    Out(j) = Enc(b(i) \ 4): j = j + 1
    Out(j) = Enc((b(i + 1) \ 16) Or (b(i) And 3) * 16): j = j + 1
    Out(j) = Enc((b(i + 2) \ 64) Or (b(i + 1) And 15) * 4): j = j + 1
    Out(j) = Enc(b(i + 2) And 63): j = j + 1
  Next i
  For i = 1 To i - L: Out(UBound(Out) - i + 1) = 61: Next i
  Base64Enc01 = StrConv(Out, vbUnicode)
End Function
Author's comments:
Donald's comments:

top | charts


Base64Enc02
submitted 29-Sep-2002 by Guido Beckmann  
Doping: API, and reference to typelib BStrAPI.tlb (by G.Beckmann) - Download BStrAPI.tlb (2KB zipped, VB5-compatible).
Public Function Base64Enc02(aB() As Byte) As String
' by G.Beckmann, G.Beckmann@NikoCity.de, 20011204 [20001224]
    Static aChr%(63)
    Dim saDst As bstrapi.SAFEARRAY1D, aDst%()
    Dim b0&, b1&, b2&
    Dim p&, c&, n&, iHi&, iL&
    
    If aChr(0) = 0 Then
        For c = 0 To 25:    aChr(c) = c + 65:    Next c
        For c = 26 To 51:   aChr(c) = c + 71:    Next c
        For c = 52 To 61:   aChr(c) = c - 4:     Next c
        aChr(62) = 43:      aChr(63) = 47
        c = 0
    End If
    
    iHi = UBound(aB())
    iL = ((iHi + 3) \ 3) * 4
    p = ArrPtr(aDst)
    
    Base64Enc02 = bstrapi.SysAllocStringLenPtr(ByVal 0&, iL)
    With saDst
        .cDims = 1
        .cbElements = 2
        .pvData = StrPtr(Base64Enc02)
        .cElements1D = iL
    End With

    RtlMoveMemory ByVal p, VarPtr(saDst), 4
    
    iL = iHi - 2
    Do Until c > iL
        b0 = aB(c): b1 = aB(c + 1): b2 = aB(c + 2)
        aDst(n) = aChr(b0 \ 4&)
        aDst(n + 1) = aChr(((b0 And 3&) * 16&) Or (b1 \ 16&))
        aDst(n + 2) = aChr(((b1 And 15&) * 4&) Or (b2 \ 64&))
        aDst(n + 3) = aChr(b2 And 63&)
        n = n + 4
        c = c + 3
    Loop
    
    Select Case iHi - c
    Case 0
        b0 = aB(c)
        aDst(n) = aChr(b0 \ 4&)
        aDst(n + 1) = aChr((b0 And 3&) * 16)
        aDst(n + 2) = 61
        aDst(n + 3) = 61
    Case 1
        b0 = aB(c)
        b1 = aB(c + 1)
        aDst(n) = aChr(b0 \ 4&)
        aDst(n + 1) = aChr(((b0 And 3&) * 16&) Or (b1 \ 16&))
        aDst(n + 2) = aChr((b1 And 15&) * 4&)
        aDst(n + 3) = 61
    End Select

    RtlZeroMemory ByVal p, 4
End Function
Author's comments :
Donald's comments :

top | charts


Base64Enc03
submitted 20-Oct-2002 by Paul  
Doping: TLB UPDATE 13-Oct-2002 (cf. Dope'n'Declarations)
Public Function Base64Enc03(ByRef bIn() As Byte) As String
' by Paul, wpsjr1@syix.com, 20021020
' doping: string.tlb
  Static bTemp()        As Byte
  Static LUT(4095)      As Long ' 16K LUT
  Static lArrayPointer  As Long
  Dim i                 As Long
  Dim SA                As FastString.SafeArrayHeader
  Dim lOut()            As Long
  Dim j                 As Long
  Dim lNumTrips         As Long
  Dim lElements         As Long
  Dim lPartial          As Long
  Dim lNumBytes         As Long
  Dim lOne              As Long
  Dim lTwo              As Long
  Dim lThree            As Long
  
  If lArrayPointer = 0 Then  ' Initialize Lookup Table
    bTemp = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
    
    For i = 0 To 63
      For j = 0 To 63
        LUT((i * 64) + j) = (bTemp(j) * 65536) Or bTemp(i)
      Next j
    Next i
    
    i = 0
  End If
  
  j = LBound(bIn)
  lElements = UBound(bIn) - j + 1
  lNumTrips = lElements \ 3
  lPartial = lElements - (lNumTrips * 3)
  lNumBytes = lNumTrips * 4
  If lPartial Then lNumBytes = lNumBytes + 4

  lArrayPointer = FastString.VB5.VarPtrLongArray(lOut)
  Base64Enc03 = FastString.SysAllocStringLen(ByVal 0&, lNumBytes)
  
  lNumBytes = lNumBytes \ 2

  With SA
    .cDims = 1
    .cbElements = 4 ' long array
    .pvData = StrPtr(Base64Enc03)
    .cElements = lNumBytes
  End With

  FastString.RtlMoveMemory ByVal lArrayPointer, VarPtr(SA)

  If lNumTrips Then
    lNumBytes = lNumBytes - j - lPartial - 1
    
    Do
      lOne = bIn(j)         ' its as easy as...
      lTwo = bIn(j + 1)
      lThree = bIn(j + 2)
  
      ' 12 bit lut, unique method?
      lOne = (lOne * 16) Or ((lTwo And &HF0) \ 16)  ' 111111112222
      lThree = lThree Or ((lTwo And &HF) * 256)     ' 222233333333
      
      lOut(i) = LUT(lOne)
      lOut(i + 1) = LUT(lThree)
      j = j + 3
      i = i + 2
    Loop While i < lNumBytes
  End If
  
  If lPartial Then
    If lPartial = 2 Then
      lOne = bIn(j)
      lTwo = bIn(j + 1)
      lOut(i) = (bTemp(((lOne And 3) * 16) Or (lTwo \ 16))) * &H10000
      lOut(i) = lOut(i) Or bTemp(lOne \ 4)
      lOut(i + 1) = 61 * &H10000
      lOut(i + 1) = lOut(i + 1) Or bTemp((lTwo And &HF) * 4)
    Else ' lpartial = 1
      lOne = bIn(j)
      lOut(i) = bTemp((lOne And 3) * 16) * &H10000
      lOut(i) = lOut(i) Or bTemp(lOne \ 4)
      lOut(i + 1) = (61 * &H10000) Or 61
    End If
  End If
  
  FastString.RtlMoveMemory ByVal lArrayPointer, 0&
End Function
Author's comments:
Donald's comments:

top | charts


Base64Enc04
submitted 20-Oct-2002 by Paul  
Doping: TLB UPDATE 13-Oct-2002 (cf. Dope'n'Declarations)
Public Sub Base64Enc04(ByRef bIn() As Byte, ByRef bOut() As Byte)
' by Paul, wpsjr1@syix.com, 20021020
' doping: string.tlb
  ' performs better than Base64Enc03 on P1, maybe p2
  Static bTemp()        As Byte
  Static LUT(4095)      As Integer ' 8K LUT
  Static lArrayPointer  As Long
  Dim bTempOut()        As Integer
  Dim i                 As Long
  Dim SA                As FastString.SafeArrayHeader
  Dim j                 As Long
  Dim lNumTrips         As Long
  Dim lElements         As Long
  Dim lPartial          As Long
  Dim lNumBytes         As Long
  Dim lOne              As Long
  Dim lTwo              As Long
  Dim lThree            As Long
  
  If lArrayPointer = 0 Then  ' Initialize Lookup Table
    bTemp = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
    
    For i = 0 To 63
      For j = 0 To 63
        LUT((i * 64) + j) = (bTemp(j) * 256) Or bTemp(i)
      Next j
    Next i
    
    i = 0
  End If
  
  j = LBound(bIn)
  lElements = UBound(bIn) - j + 1
  lNumTrips = lElements \ 3
  lPartial = lElements - (lNumTrips * 3)
  lNumBytes = lNumTrips * 4
  If lPartial Then lNumBytes = lNumBytes + 4

  ReDim bOut(lNumBytes - 1)
  lArrayPointer = FastString.VB5.VarPtrIntegerArray(bTempOut)
  lNumBytes = lNumBytes \ 2
  
  With SA
    SA.cDims = 1
    SA.cbElements = 2 ' integer array
    SA.pvData = VarPtr(bOut(0)) ' point ot the byte arrays data
    SA.cElements = lNumBytes
  End With

  FastString.RtlMoveMemory ByVal lArrayPointer, VarPtr(SA)

  If lNumTrips Then
    lNumBytes = lNumBytes - lPartial - 1
    'j = 0
    
    Do
      lOne = bIn(j)         ' its as easy as...
      lTwo = bIn(j + 1)
      lThree = bIn(j + 2)
  
      ' 12 bit lut, unique method?
      lOne = (lOne * 16) Or ((lTwo And &HF0) \ 16)  ' 111111112222
      lThree = lThree Or ((lTwo And &HF) * 256)     ' 222233333333
      
      bTempOut(i) = LUT(lOne)
      bTempOut(i + 1) = LUT(lThree)
      j = j + 3
      i = i + 2
    Loop While i < lNumBytes
  End If
  
  If lPartial Then
    If lPartial = 2 Then
      lOne = bIn(j)
      lTwo = bIn(j + 1)
      bTempOut(i) = (bTemp(((lOne And 3) * 16) Or (lTwo \ 16))) * &H100
      bTempOut(i) = bTempOut(i) Or bTemp(lOne \ 4)
      bTempOut(i + 1) = 61 * &H100
      bTempOut(i + 1) = bTempOut(i + 1) Or bTemp((lTwo And &HF) * 4)
    Else ' lpartial = 1
      lOne = bIn(j)
      bTempOut(i) = bTemp((lOne And 3) * 16) * &H100
      bTempOut(i) = bTempOut(i) Or bTemp(lOne \ 4)
      bTempOut(i + 1) = (61 * &H100) Or 61
    End If
  End If
  
  FastString.RtlMoveMemory ByVal lArrayPointer, 0&
End Sub
Author's comments:
Donald's comments:

top | charts




VBspeed © 2000-10 by Donald Lessau