VBspeed / String / Base64Dec
VBspeed © 2000-10, updated: 20-Oct-2002
Base64Dec
See also Base64Enc


The Definition
Function Base64Dec
Decodes data encoded with MIME Base64.
The reverse function to Base64Enc. Check there for details on Base64-encoding/decoding.
Declaration
The preferred format of the input and output data stream may vary depending on the context. Here are three possibilities:
  Function Base64Dec(Base64String As String) As String
  Sub Base64Dec(Base64String As String, abDst() As Byte)
  Sub Base64Dec(abSrc() As Byte, abDst() As Byte)
The input string must contain one or more lines of base64 encoded data, and returned is a string resp. byte array containing the resulting binary data.
Line breaks and illegal characters: "All line breaks or other characters not found in Table 1 must be ignored by decoding software. In base64 data, characters other than those in Table 1, line breaks, and other white space probably indicate a transmission error, about which a warning message or even a message rejection might be appropriate under some circumstances." (RFC 2045)
Roll your own
If you want to have a go at Base64Dec yourself, use this function (VB5/6-compatible) to verify the correctness of your code.


The Charts
Calls
  sDst = Base64Dec(sSrc) or
Call Base64Dec(sSrc, abDst()) or
Call Base64Dec(abSrc(), abDst())
Call 1 sSrc/abSrc() = Base64Enc("Vbspeed")
Call 2 sSrc/abSrc() = Base64Enc("The above means that base64 encoded data takes one-third more space than the data before the conversion.")
Call 3 sSrc/abSrc() = Base64Enc(Replicate(100, "The above means that base64 encoded data takes one-third more space than the data before the conversion."))
Call 4 sSrc/abSrc() = Base64Enc(Replicate(1000, "The above means that base64 encoded data takes one-third more space than the data before the conversion."))
Call 5 sSrc/abSrc() = Base64Enc(Replicate(10000, "The above means that base64 encoded data takes one-third more space than the data before the conversion."))
 VB5
CodeAuthorDopingNotes
Base64Dec01 Nobody  
Base64Dec02 GuidoAPI,TLB 
Base64Dec03 PaulTLB 
Call 1
320.216.337s
11.000.314s
21.930.606s
Call 2
37.358.605s
11.001.171s
21.241.448s
Call 3
32.92258s
11.0089s
21.0189s
Call 4
35.815,329s
21.07983s
11.00917s
Call 5
35.6755,507s
11.009,786s
21.2111,805s
 VB6
CodeAuthorDopingNotes
Base64Dec01 Nobody  
Base64Dec02 GuidoAPI,TLB 
Base64Dec03 PaulTLB 
Call 1
324.637.952s
11.000.323s
22.290.739s
Call 2
38.6210.040s
11.001.165s
21.441.682s
Call 3
32.70243s
11.0090s
21.14103s
Call 4
35.195,132s
11.00989s
21.061,046s
Call 5
35.6255,411s
11.009,862s
21.3212,972s
Notes & Conclusions
Mail your code! How to read all those numbers


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

top | charts


Base64Dec02
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 Sub Base64Dec02(Base64String As String, abDst() As Byte)
' by G.Beckmann, G.Beckmann@NikoCity.de, 20011204 [20001224]
    Static aB(255) As Byte
    Dim saSrc As bstrapi.SAFEARRAY1D, aSrc%()
    Dim b1%, b2%, b3%
    Dim p&, c&, n&, iL&, i&, j&
    
    If aB(0) = 0 Then
        RtlFillMemory aB(0), 256, 64
        For c = 48 To 57:   aB(c) = c + 4:  Next c
        For c = 65 To 90:   aB(c) = c - 65: Next c
        For c = 97 To 122:  aB(c) = c - 71: Next c
        aB(43) = 62: aB(47) = 63: c = 0
    End If
    
    iL = Len(Base64String)
    If iL = 0 Then Erase abDst: Exit Sub
    
    p = ArrPtr(aSrc)
    With saSrc
        .cDims = 1
        .cbElements = 2
        .pvData = StrPtr(Base64String)
        .cElements1D = iL
    End With
    RtlMoveMemory ByVal p, VarPtr(saSrc), 4
    
    Select Case 61
    Case aSrc(iL - 2):  j = 3: c = 1
    Case aSrc(iL - 1):  j = 2: c = 1
    Case Else:          j = 1
    End Select
    
    i = iL \ 4
    ReDim Preserve abDst(0 To i * 3 - j)
    i = i - c
    c = 0
    
    Do While i
        b1 = aB(aSrc(c + 1))
        b2 = aB(aSrc(c + 2))
        b3 = aB(aSrc(c + 3))
        abDst(n) = (aB(aSrc(c)) * 4) Or (b1 \ 16)
        abDst(n + 1) = (b1 And &HF) * 16 Or (b2 \ 4)
        abDst(n + 2) = (b2 And &H3) * 64 Or b3
        n = n + 3
        c = c + 4
        i = i - 1
    Loop
    
    Select Case j
    Case 3
        abDst(n) = (aB(aSrc(c)) * 4) Or (aB(aSrc(c + 1)) \ 16)
    Case 2
        b1 = aB(aSrc(c + 1))
        abDst(n) = (aB(aSrc(c)) * 4) Or (b1 \ 16)
        abDst(n + 1) = (b1 And &HF) * 16 Or (aB(aSrc(c + 2)) \ 4)
    End Select

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

top | charts


Base64Dec03
submitted 20-Oct-2002 by Paul  
Doping: TLB UPDATE 13-Oct-2002 (cf. Dope'n'Declarations)
Sub Base64Dec03(ByRef abBase64() As Byte, ByRef abResult() As Byte)
' by Paul, wpsjr1@syix.com, 20021020
' doping: string.tlb
  Static lArrayPointer  As Long
  Static LUT(32767)     As Integer ' 64K LUT (very little is really used)
  Static bTemp()        As Byte
  Static Decode(255)    As Byte
  Dim lIn()             As Integer
  Dim lTemp             As Long
  Dim i                 As Long
  Dim j                 As Long
  Dim lNumQuads         As Long
  Dim lPartial          As Long
  Dim lUbound           As Long
  Dim lNumChars         As Long
  Dim bHi               As Byte
  Dim bMid              As Byte
  Dim bLo               As Byte

  Dim SA As FastString.SafeArrayHeader

  If lArrayPointer = 0 Then
    bTemp = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" & String$(192, "@"), vbFromUnicode)
    
    For i = 0 To 63
      Decode(bTemp(i)) = i
    Next i
    
    For i = 0 To 255
      For j = 0 To 127
        LUT((j * 256) + i) = (Decode(i) * 64) Or Decode(j)
      Next j
    Next i
    
    i = 0
  End If
  
  j = LBound(abBase64)
  lUbound = UBound(abBase64)
  lNumChars = lUbound - j + 1
  lNumQuads = lNumChars \ 4
  If (lNumChars And 3) Then Exit Sub ' encoded strings should always be even multiples of four
  
  If abBase64(lUbound) = 61 Then ' check for one terminating "="
    lPartial = 1
    If abBase64(lUbound - 1) = 61 Then ' or two?
      lPartial = 2
    End If
  End If

  ReDim abResult((lNumQuads * 3) - lPartial - 1)
  lArrayPointer = FastString.VB5.VarPtrIntegerArray(lIn)
  lNumQuads = lNumQuads * 2

  With SA
    .cDims = 1
    .cbElements = 2 ' integer array
    .pvData = VarPtr(abBase64(j))
    .cElements = lNumQuads
  End With

  FastString.RtlMoveMemory ByVal lArrayPointer, VarPtr(SA)
  j = 0
    
  If lPartial Then lNumQuads = lNumQuads - 2
    
  If lNumQuads Then
    Do
      lTemp = lIn(i) ' 111111112222
      lTemp = LUT(lTemp) ' Lookup table anyone?
      bMid = (lTemp And &HF) * &H10
      bHi = (lTemp \ &H10) And &HFF
    
      lTemp = lIn(i + 1) ' 222233333333
      lTemp = LUT(lTemp)
      bMid = bMid Or ((lTemp And &HF00) \ &H100)
      bLo = lTemp And &HFF
    
      abResult(j) = bHi
      abResult(j + 1) = bMid
      abResult(j + 2) = bLo
    
      j = j + 3
      i = i + 2
    Loop While i < lNumQuads
  End If
  
  If lPartial Then
    If lPartial = 1 Then
      lTemp = LUT(lIn(i))
      abResult(j) = (lTemp \ &H10) And &HFF
      abResult(j + 1) = ((lTemp And &HF) * &H10) Or (Decode(abBase64(lUbound - 1)) \ 4)
    
    Else ' lPartial = 2
      lTemp = LUT(lIn(i))
      abResult(j) = (lTemp \ &H10) And &HFF
    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