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