Mime (Base64) Speed Challenge

[Rikk]

Ok... I'm back with another speed challenge. This time, it's converting strings and files to/from base64.

A friend and I have developed code that is lightning fast and I’m wondering if ANYONE here can beat our times. (It WONT be easy!!)

Simple code for conversion to (and from) Base64 can be found here:

http://www.vbsquare.com/internet/sen...dmail.bas.html

Our times follow, good luck beating them!! If you do, I’d love to see your code, if you can’t, I’ll show you ours. (Times were generated on: AMD T-Bird 750Mhz, 256MB PC133)

String, 1000000 bytes
Total Successes : 10
Total Failures : 0
Average Line Count : 1000000
Average Encode Time : 0.3703 sec
Average Decode Time : 0.975 sec
Average Total Time : 1.3453 sec

File VMM32.VXD, 1,032,956 bytes
Total Successes : 10
Total Failures : 0
Average Line Count : 0
Average Encode Time : 0.2703 sec
Average Decode Time : 1.0742 sec
Average Total Time : 1.3445 sec

[Rikk]

well?

[Rikk]

bump

[Alphanos]

When you say converting it to base 64, what kind of system are you talking about? 4 characters for each one, or crunching more than that into each character?

[Alphanos]

BTW, would you consider testing my encryption program on that file you tested your blowfish code on and see if mine is slower or not? That'll tell me if there's more optimization to be done, because theoretically it should run faster than blowfish.

Thanks in advance if you do.

[DiGiTaIErRoR]

I'm guessing base64 would work like hex?

A-Z ....a-z .....0-9 ....+ ..\
0-25 26-51 52 - 61 62 63

?

then in two character units like hex also?

XY where x * 64 + y?

[nishantp]

And may i ask what purpose base-64 would have over decimal or hex?

[Alphanos]

The reason that I'm asking is that strings are in essence base 256 numbers. One character is one digit of base 256 (0-255*256^0). So does he mean to separate it into four ascii codes, where the last 2 bits are unused? Or to use 6 bits of one character for the first 64^0, and another 2 of the next character for 64^1(since you'd only ever need 64*3 with ascii codes)? Or to pack 2 characters into two characters using a different method so that its in base 64? I'm sorry if I'm being stupid, but what Rikk's saying seems unclear.

[DiGiTaIErRoR]

Yeah.. if you where gonna do a large base why not do base 256 and use the ASCii char set?

That would seem easier.

XY x * 256 + y

so at max for two characters you could yeild 65535

cuz hex works like XYZ where x*256+y*16+z*1

so base 256 with XYZ would be:
x*65536+y*256+z*1

so at max for 3 char would be 16777215
4:4,294,967,040
5:1,099,511,562,240
6:281,474,959,933,440
...
16:340,282,346,638,528,859,811,704,183,484,516,925,440

wow...

but really bases are based on the Nth place to the power of the base.

so base64 would be
64^3*q+64^2*x+64^1*y+64^0*z

but still why!

[DiGiTaIErRoR]

I remember back in the day when all we had was base2!!!

You lucky youngin's!

[Alphanos]

When you get right down to it, one digit of base 256 is 8 bits, so you actually are working in binary. Just in a simpler form; 4 characters instead of 32 bits. A hexit represents 4 bits, an octet 3, but a digit of base 256 represents 8 bits.

I've thought about this for a while now, and a 4-character string is a good way to represent a long value, because they're the same amount of data. So in an OOP project I'm working on I'm having classes generate and read their records based on dynamic field lengths based on fixed-length index numbers. There's always a 4-character long value, followed by that many characters for the field, followed by another 4-character long value, etc. In that form, the idea is expanded to write the class records in a text database system using binary-access files.

[Tygur]

Originally posted by Rikk
Ok... I'm back with another speed challenge. This time, it's converting strings and files to/from base64.

If you're still offering that challenge, I'd like to take it up. I just need to know exactly what this code is supposed to do. I'm guessing it's supposed to be an encode and decode function that takes and returns strings. Exactly what is a Base64 decoder doing?

By the way, I unserstand the purpose. The puropse is so that files with funky characters can be sent in email without problems. The characters would be encoded.

[Rikk]

Originally posted by Tygur

If you're still offering that challenge, I'd like to take it up. I just need to know exactly what this code is supposed to do. I'm guessing it's supposed to be an encode and decode function that takes and returns strings. Exactly what is a Base64 decoder doing?

By the way, I unserstand the purpose. The puropse is so that files with funky characters can be sent in email without problems. The characters would be encoded.

Here is a web site about Base64 (MIME)
Link to RFC: 1341 (MIME -- Multipurpose Internet Mail Extensions)

Below is sample code for encoding and decoding to/from Base64. The code is NOT fast but does work.

Function Base64Encode(inData)
  'rfc1521
  '2001 Antonin Foller, PSTRUH Software, http://pstruh.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim cOut, sOut, I
  
  'For each group of 3 bytes
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut, sGroup
    
    'Create one long from this 3 bytes.
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
    
    'Oct splits the long to 8 groups with 3 bits
    nGroup = Oct(nGroup)
    
    'Add leading zeros
    nGroup = String(8 - Len(nGroup), "0") & nGroup
    
    'Convert to base64
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
    
    'Add the part to output string
    sOut = sOut + pOut
    
    'Add a new line for each 76 chars in dest (76*3/4 = 57)
    If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
  Next
  Select Case Len(inData) Mod 3
    Case 1: '8 bit final
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  Base64Encode = sOut
End Function

Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function

Function Base64Decode(ByVal base64String)
  'rfc1521
  '1999 Antonin Foller, PSTRUH Software, http://pstruh.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim dataLength, sOut, groupBegin
  
  'remove white spaces, if any
  base64String = Replace(base64String, vbCrLf, "")
  base64String = Replace(base64String, vbTab, "")
  base64String = Replace(base64String, " ", "")
  
  'The source must consists from groups with len of 4 chars
  dataLength = Len(base64String)
  If dataLength Mod 4 <> 0 Then
    Err.Raise 1, "Base64Decode", "Bad Base64 string."
    Exit Function
  End If

  
  ' Now decode each group:
  For groupBegin = 1 To dataLength Step 4
    Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
    ' Each data group encodes up To 3 actual bytes.
    numDataBytes = 3
    nGroup = 0

    For CharCounter = 0 To 3
      ' Convert each character into 6 bits of data, And add it To
      ' an integer For temporary storage.  If a character is a '=', there
      ' is one fewer data byte.  (There can only be a maximum of 2 '=' In
      ' the whole string.)

      thisChar = Mid(base64String, groupBegin + CharCounter, 1)

      If thisChar = "=" Then
        numDataBytes = numDataBytes - 1
        thisData = 0
      Else
        thisData = InStr(Base64, thisChar) - 1
      End If
      If thisData = -1 Then
        Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
        Exit Function
      End If

      nGroup = 64 * nGroup + thisData
    Next
    
    'Hex splits the long to 6 groups with 4 bits
    nGroup = Hex(nGroup)
    
    'Add leading zeros
    nGroup = String(6 - Len(nGroup), "0") & nGroup
    
    'Convert the 3 byte hex integer (6 chars) to 3 characters
    pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 5, 2)))
    
    'add numDataBytes characters to out string
    sOut = sOut & Left(pOut, numDataBytes)
  Next

  Base64Decode = sOut
End Function

Now see the time it took to encode and decode 100000 bytes. (NOTE: this is a string 10 times smaller than the one in the original post)

String, 100000 bytes
Total Successes : 10
Total Failures : 0
Average Line Count : 100000
Average Encode Time : 28.28906 sec
Average Decode Time : 14.39063 sec
Average Total Time : 42.67969 sec

I got the code from here:


http://www.pstruh.cz/tips/detpg_Base64.htm

Good luck!!!

[Bloodeye]

Here try this one out. I just whipped it up....
j/k...actually I got it from here: http://www.vbip.com/winsock/winsock_http_04_01.asp

Private Function Base64_Encode(strSource) As String
 
    Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    
    Dim strTempLine As String
    Dim j As Integer
    
    For j = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3
    
       strTempLine = strTempLine + Mid(BASE64_TABLE, _
                     (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
    
       strTempLine = strTempLine + Mid(BASE64_TABLE, _
                     ((Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                     + Asc(Mid(strSource, j + 1, 1)) \ 16) + 1, 1)
    
       strTempLine = strTempLine + Mid(BASE64_TABLE, _
                     ((Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 _
                     + Asc(Mid(strSource, j + 2, 1)) \ 64) + 1, 1)
    
       strTempLine = strTempLine + Mid(BASE64_TABLE, _
                     (Asc(Mid(strSource, j + 2, 1)) Mod 64) + 1, 1)
    
    Next j
    
    If Not (Len(strSource) Mod 3) = 0 Then
    
          If (Len(strSource) Mod 3) = 2 Then
    
             strTempLine = strTempLine + Mid(BASE64_TABLE, _
                           (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
    
             strTempLine = strTempLine + Mid(BASE64_TABLE, _
                           (Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                            + Asc(Mid(strSource, j + 1, 1)) \ 16 + 1, 1)
    
             strTempLine = strTempLine + Mid(BASE64_TABLE, _
                           (Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 + 1, 1)
    
             strTempLine = strTempLine & "="
    
          ElseIf (Len(strSource) Mod 3) = 1 Then
    
             strTempLine = strTempLine + Mid(BASE64_TABLE, _
                           Asc(Mid(strSource, j, 1)) \ 4 + 1, 1)
    
             strTempLine = strTempLine + Mid(BASE64_TABLE, _
                           (Asc(Mid(strSource, j, 1)) Mod 4) * 16 + 1, 1)
    
             strTempLine = strTempLine & "=="
    
          End If
    
       End If
    
    Base64_Encode = strTempLine
 
End Function

[Rikk]

Bloodeye,

Your Encode function gave the following times. (Since you didn't provide a decode, I used another one.) BTW, this was compiled.

String, 100000 bytes
Total Successes : 10
Total Failures : 0
Average Line Count : 100000
Average Encode Time : 91.23828 sec
Average Decode Time : 14.39063 sec
Average Total Time : 105.62891 sec

Thanks! Bloodeye, try again? Anyone else want to try?

[Rikk]

bump

[Alphanos]

I wrote one up, and its decent, but it doesn't even come close to the kind of times you're getting. I'm interested in how you're doing it, because on mine the decode is a LOT faster than the encode.

[Alphanos]

Here's the code I used if you're interested. Don't even bother testing the speed though, its a lot slower than yours.

Init has to be called before you can run either of the two main subs.

Option Explicit
    Private Encode1(0 To 63) As Byte
    Private Encode2(0 To 192) As Byte
    Private Decode1(48 To 51) As Byte
    Private Decode2(48 To 122) As Byte
Public Sub ShutDown()
    Erase Encode1
    Erase Encode2
    Erase Decode1
    Erase Decode2
    
    Dim TempForm As Form
    For Each TempForm In Forms
        Unload TempForm
        Set TempForm = Nothing
    Next TempForm
    
    End
End Sub
Public Sub EncodeTo64(ByRef TextString As String)
    Dim i As Long
    Dim i2 As Long
    Dim TextLen As Long
    Dim ByteArray() As Byte
    Dim TextBytes() As Byte
    
    TextLen = Len(TextString)
    
    ReDim ByteArray(TextLen * 2) As Byte
    TextLen = TextLen - 1
    TextBytes() = StrConv(TextString, vbFromUnicode)
    i = -1
    Do
        i = i + 1
        ByteArray(i2) = Encode2(TextBytes(i) And 192)
        i2 = i2 + 1
        ByteArray(i2) = Encode1(TextBytes(i) And 63)
        i2 = i2 + 1
    Loop Until i = TextLen
    
    TextString = StrConv(ByteArray(), vbUnicode)
    Erase ByteArray
    Erase TextBytes
End Sub
Public Sub DecodeFrom64(ByRef TextString As String)
    Dim i As Long
    Dim i2 As Long
    Dim TextLen As Long
    Dim ByteArray() As Byte
    Dim TextBytes() As Byte
    
    TextLen = Len(TextString)
    
    ReDim ByteArray(TextLen * 0.5) As Byte
    
    TextBytes() = StrConv(TextString, vbFromUnicode)
    
    Do
        ByteArray(i2) = Decode1(TextBytes(i)) Or (Decode2(TextBytes(i + 1)))
        i = i + 2
        i2 = i2 + 1
    Loop Until i = TextLen
    
    TextString = StrConv(ByteArray(), vbUnicode)
    Erase ByteArray
    Erase TextBytes
 
End Sub
Public Sub Init()
    Encode2(0) = 48
    Encode2(64) = 49
    Encode2(128) = 50
    Encode2(192) = 51
    Decode1(48) = 0
    Decode1(49) = 64
    Decode1(50) = 128
    Decode1(51) = 192
    
    Dim i As Long
    Dim i2 As Long
    
    i = 0
    i2 = 48
    Do
        Encode1(i) = i2
        Decode2(i2) = i
        i = i + 1
        i2 = i2 + 1
    Loop Until i2 = 58
    
    i2 = 65
    Do
        Encode1(i) = i2
        Decode2(i2) = i
        i = i + 1
        i2 = i2 + 1
    Loop Until i2 = 93
    
    i2 = 97
    Do
        Encode1(i) = i2
        Decode2(i2) = i
        i = i + 1
        i2 = i2 + 1
    Loop Until i2 = 123
End Sub

[Rikk]

Originally posted by Alphanos
I wrote one up, and its decent, but it doesn't even come close to the kind of times you're getting. I'm interested in how you're doing it, because on mine the decode is a LOT faster than the encode.

In ours (I say that because myself and a friend worked on this for two weeks) we use what I call direct Base64/Base265 conversion for a big-time speed increase. It took an hour at the white-board to figure this method out. See code below...

ENCODE

Public Function Encode(strToEncode As String, Optional srcIsFile As Boolean, Optional writeFile As Boolean, Optional outFileName) As String
Dim a As Long, b As Integer, c As Byte, d As Byte, decVal As Byte, z As Long, y As Long 'counters
Dim fso, ff As Integer, newFileName As String 'file vars
Dim padCount As Byte 'determines count of equal signs at the end of file
Dim charInput() As Byte 'holds input data
Dim mimeArray(111111) As Byte 'holds the mime equiv from index(binary) to value(ascii)
Dim addArray(11) As Long 'holds values from 100000 - 1 in binary
Dim dblConvArray(255, 2, 3) As Double 'holds every character and the possible positions 1,2,3
Dim charOutput() As Byte 'final output
'We have to make sure people use common sense!
    If Not Len(strToEncode) > 0 Then Exit Function
    If srcIsFile = False And writeFile And IsMissing(outFileName) Then
        Err.Raise 10001, "Encoder DLL - Encode", "You must include the output file name when the source is not a file!"
        Exit Function
    End If
    If srcIsFile Then
        Set fso = CreateObject("Scripting.FileSystemObject")
        If Not fso.FileExists(strToEncode) Then
            Err.Raise 10002, "Encoder.DLL - Encode", "The path specified is invalid!"
            Exit Function
        End If
    End If
'Make the mime array
    mimeArray(0) = 65: mimeArray(1) = 66: mimeArray(10) = 67:
    mimeArray(11) = 68: mimeArray(100) = 69: mimeArray(101) = 70:
    mimeArray(110) = 71: mimeArray(111) = 72: mimeArray(1000) = 73:
    mimeArray(1001) = 74: mimeArray(1010) = 75: mimeArray(1011) = 76:
    mimeArray(1100) = 77: mimeArray(1101) = 78: mimeArray(1110) = 79:
    mimeArray(1111) = 80: mimeArray(10000) = 81: mimeArray(10001) = 82:
    mimeArray(10010) = 83: mimeArray(10011) = 84: mimeArray(10100) = 85:
    mimeArray(10101) = 86: mimeArray(10110) = 87: mimeArray(10111) = 88:
    mimeArray(11000) = 89: mimeArray(11001) = 90: mimeArray(11010) = 97:
    mimeArray(11011) = 98: mimeArray(11100) = 99: mimeArray(11101) = 100:
    mimeArray(11110) = 101: mimeArray(11111) = 102: mimeArray(100000) = 103:
    mimeArray(100001) = 104: mimeArray(100010) = 105: mimeArray(100011) = 106:
    mimeArray(100100) = 107: mimeArray(100101) = 108: mimeArray(100110) = 109:
    mimeArray(100111) = 110: mimeArray(101000) = 111: mimeArray(101001) = 112:
    mimeArray(101010) = 113: mimeArray(101011) = 114: mimeArray(101100) = 115:
    mimeArray(101101) = 116: mimeArray(101110) = 117: mimeArray(101111) = 118:
    mimeArray(110000) = 119: mimeArray(110001) = 120: mimeArray(110010) = 121:
    mimeArray(110011) = 122: mimeArray(110100) = 48: mimeArray(110101) = 49:
    mimeArray(110110) = 50: mimeArray(110111) = 51: mimeArray(111000) = 52:
    mimeArray(111001) = 53: mimeArray(111010) = 54: mimeArray(111011) = 55:
    mimeArray(111100) = 56: mimeArray(111101) = 57: mimeArray(111110) = 43:
    mimeArray(111111) = 47:
'determine input type
    If srcIsFile Then
'File Manipulation
        ff = FreeFile
        Open strToEncode For Binary As #ff
        ReDim charInput(FileLen(strToEncode) - 1)
        Get #ff, , charInput
        Close #ff
    Else
'Store the string into ascii/byte array
        charInput = StrConv(strToEncode, vbFromUnicode)
    End If
'build array to help build main array
    addArray(0) = 100000: addArray(1) = 10000: addArray(2) = 1000: addArray(3) = 100: addArray(4) = 10: addArray(5) = 1
    addArray(6) = 100000: addArray(7) = 10000: addArray(8) = 1000: addArray(9) = 100: addArray(10) = 10: addArray(11) = 1
'build array to to hold the possibilities of each character
    For b = 0 To 255
        decVal = b
        For c = 0 To 2
            For d = 0 To 7
                If (2 ^ (7 - d)) <= decVal Then
                    If c = 0 And d < 6 Then dblConvArray(b, 0, 0) = dblConvArray(b, 0, 0) + addArray(d)
                    If c = 0 And d > 5 Then dblConvArray(b, 0, 1) = dblConvArray(b, 0, 1) + addArray(d)
                    If c = 1 And d < 4 Then dblConvArray(b, 1, 1) = dblConvArray(b, 1, 1) + addArray(d + 2)
                    If c = 1 And d > 3 Then dblConvArray(b, 1, 2) = dblConvArray(b, 1, 2) + addArray(d + 2)
                    If c = 2 And d < 2 Then dblConvArray(b, 2, 2) = dblConvArray(b, 2, 2) + addArray(d + 4)
                    If c = 2 And d > 1 Then dblConvArray(b, 2, 3) = dblConvArray(b, 2, 3) + addArray(d + 4)
                    decVal = decVal - (2 ^ (7 - d))
                End If
            Next d
            decVal = b
        Next c
    Next b
'destroy array
    Erase addArray
'redim the output array to the calculated size
    ReDim charOutput(((Int(UBound(charInput) / 3) * 4) + (UBound(charInput) Mod 3) + 1))
'now run a loop to check for line breaks and padding
    If UBound(charOutput) + 1 > 72 Then
'resize the array to hold the total number of cr's and lf's
        If ((UBound(charOutput) + 1) / 72) <> Int((UBound(charOutput) + 1) / 72) Then
            ReDim Preserve charOutput((Int((UBound(charOutput) + 1) / 72) * 2) + UBound(charOutput))
        Else
            ReDim Preserve charOutput(((Int((UBound(charOutput) + 1) / 72) * 2) + UBound(charOutput)) - 2)
        End If
're-pad the array
        For z = 0 To padCount - 1
            charOutput(UBound(charOutput) - z) = 61
        Next z
    Else
'the array isn't big enough to cr so just take care of padding
        While (UBound(charOutput) + 1) / 4 <> Int((UBound(charOutput) + 1) / 4)
            padCount = padCount + 1
            ReDim Preserve charOutput(UBound(charOutput) + 1)
            charOutput(UBound(charOutput)) = 61
        Wend
    End If
'clear y
    y = 0
'start the main loop
    For z = 0 To UBound(charInput) Step 3
'here we are actually inserting the cr and lf. We just accounted for them before. Padding was taken care of though
        If z / 54 = Fix(z / 54) And z <> 0 Then
            charOutput(y) = 13
            charOutput(y + 1) = 10
            y = y + 2
        End If
'from here down...its greek...but basically we are adding the bits to get the 4 (6bit) chars from 3 (8bit) chars
        charOutput(y) = mimeArray(dblConvArray(charInput(z), 0, 0))
        If z + 1 > UBound(charInput) Then
            charOutput(y + 1) = mimeArray(dblConvArray(charInput(z), 0, 1))
            Exit For
        End If
        charOutput(y + 1) = mimeArray(dblConvArray(charInput(z), 0, 1) + dblConvArray(charInput(z + 1), 1, 1))
        If z + 2 > UBound(charInput) Then
            charOutput(y + 2) = mimeArray(dblConvArray(charInput(z + 1), 1, 2))
            Exit For
        End If
        charOutput(y + 2) = mimeArray(dblConvArray(charInput(z + 1), 1, 2) + dblConvArray(charInput(z + 2), 2, 2))
        charOutput(y + 3) = mimeArray(dblConvArray(charInput(z + 2), 2, 3))
        y = y + 4
    Next z
'destroy all arrays
    Erase mimeArray
    Erase dblConvArray
    Erase charInput
'convert the byte array to string and return it
    If writeFile Then
        ff = FreeFile
        If IsMissing(outFileName) Then
            newFileName = strToEncode & ".encode"
        Else
            newFileName = outFileName
        End If
        Open newFileName For Output As #ff
        Print #ff, "s"
        Close #ff
        Open newFileName For Binary As #ff
        Put #ff, , charOutput
        Close #ff
    Else
'create a string for output
        Encode = Left$(StrConv(charOutput, vbUnicode), UBound(charOutput) + 1)
    End If
'destroy final array
    Erase charOutput
End Function

[Rikk]

DECODE

Public Function Decode(strToDecode As String, Optional srcIsFile As Boolean, Optional writeFile As Boolean, Optional outFileName) As String
Dim a As Long, b As Long, z As Integer 'counter vars
Dim fso, ff As Integer, newFileName As String, strClean As String 'file vars
Dim charInput() As Byte 'holds input data as bytes
Dim lngMimeArray(255) As Long 'holds the long equiv to mime chars
Dim bConvArray(255, 3, 2) As Byte 'Array for conversion from 6bit binary to 8bit binary
Dim charOutput() As Byte 'holds output characters after conversion
'We have to make sure people use common sense!
    If srcIsFile = False And writeFile And IsMissing(outFileName) Then
        Err.Raise 10001, "Encoder DLL - Decode", "You must include the output file name when the source is not a file!"
        Exit Function
    End If
    If srcIsFile Then
        Set fso = CreateObject("Scripting.FileSystemObject")
        If Not fso.FileExists(strToDecode) Then
            Err.Raise 10002, "Encoder.DLL - Decode", "The path specified is invalid!"
            Exit Function
        End If
    End If
'determine input type
    If srcIsFile Then
        ff = FreeFile
        Open strToDecode For Binary As #ff
        ReDim Preserve charInput(FileLen(strToDecode) - 1)
        Get #ff, , charInput
        Close #ff
'revert this to a string for cleaning
        strClean = Left$(StrConv(charInput, vbUnicode), UBound(charInput) + 1)
'destroy the array
        Erase charInput
'clean the special chars
        strClean = Replace(strClean, Chr(13), "")
        strClean = Replace(strClean, Chr(10), "")
        strClean = Replace(strClean, Chr(61), "")
'revert back to an array
        charInput = StrConv(strClean, vbFromUnicode)
    Else
        strToDecode = Replace(strToDecode, Chr(13), "")
        strToDecode = Replace(strToDecode, Chr(10), "")
        strToDecode = Replace(strToDecode, Chr(61), "")
        charInput = StrConv(strToDecode, vbFromUnicode)
    End If
'build the mime array, byte to long conversion
    lngMimeArray(65) = 0: lngMimeArray(66) = 1: lngMimeArray(67) = 10: lngMimeArray(68) = 11
    lngMimeArray(69) = 100: lngMimeArray(70) = 101: lngMimeArray(71) = 110: lngMimeArray(72) = 111
    lngMimeArray(73) = 1000: lngMimeArray(74) = 1001: lngMimeArray(75) = 1010: lngMimeArray(76) = 1011
    lngMimeArray(77) = 1100: lngMimeArray(78) = 1101: lngMimeArray(80) = 1111: lngMimeArray(81) = 10000
    lngMimeArray(82) = 10001: lngMimeArray(83) = 10010: lngMimeArray(84) = 10011: lngMimeArray(85) = 10100
    lngMimeArray(86) = 10101: lngMimeArray(87) = 10110: lngMimeArray(88) = 10111: lngMimeArray(89) = 11000
    lngMimeArray(90) = 11001: lngMimeArray(97) = 11010: lngMimeArray(98) = 11011: lngMimeArray(99) = 11100
    lngMimeArray(100) = 11101: lngMimeArray(101) = 11110: lngMimeArray(102) = 11111: lngMimeArray(103) = 100000
    lngMimeArray(104) = 100001: lngMimeArray(105) = 100010: lngMimeArray(106) = 100011: lngMimeArray(107) = 100100
    lngMimeArray(108) = 100101: lngMimeArray(109) = 100110: lngMimeArray(110) = 100111: lngMimeArray(111) = 101000
    lngMimeArray(112) = 101001: lngMimeArray(113) = 101010: lngMimeArray(114) = 101011: lngMimeArray(115) = 101100
    lngMimeArray(116) = 101101: lngMimeArray(117) = 101110: lngMimeArray(118) = 101111: lngMimeArray(119) = 110000
    lngMimeArray(120) = 110001: lngMimeArray(121) = 110010: lngMimeArray(122) = 110011: lngMimeArray(48) = 110100
    lngMimeArray(49) = 110101: lngMimeArray(50) = 110110: lngMimeArray(51) = 110111: lngMimeArray(52) = 111000
    lngMimeArray(53) = 111001: lngMimeArray(54) = 111010: lngMimeArray(55) = 111011: lngMimeArray(56) = 111100
    lngMimeArray(57) = 111101: lngMimeArray(43) = 111110: lngMimeArray(47) = 111111: lngMimeArray(79) = 1110
'build the byte conversion array
    For z = 0 To 255
        bConvArray(z, 0, 0) = getcharVal(lngMimeArray(z) * 100)
        bConvArray(z, 1, 0) = getcharVal(Int(lngMimeArray(z) / 10000))
        bConvArray(z, 1, 1) = getcharVal((lngMimeArray(z) Mod 10000) * 10000)
        bConvArray(z, 2, 1) = getcharVal(Int(lngMimeArray(z) / 100))
        bConvArray(z, 2, 2) = getcharVal((lngMimeArray(z) Mod 100) * 1000000)
        bConvArray(z, 3, 2) = getcharVal(lngMimeArray(z))
    Next z
'Destroy the mime array
    Erase lngMimeArray
'redim the output array to the calculated size
    ReDim charOutput(Int(UBound(charInput) / 4) * 3)
'add space for padding
    If Int(((UBound(charInput) / 4) - Int(UBound(charInput) / 4)) * 10) = 5 Then ReDim charOutput(UBound(charOutput) + 1)
    If Int(((UBound(charInput) / 4) - Int(UBound(charInput) / 4)) * 10) = 7 Then ReDim charOutput(UBound(charOutput) + 2)
'Start the main loop of conversion
    For a = 0 To UBound(charInput) Step 4
        b = (a / 4) * 3
        If a = UBound(charInput) Then
'last character
            charOutput(b) = bConvArray(charInput(a), 0, 0)
            Exit For
        End If
'first in series of 3
        charOutput(b) = bConvArray(charInput(a), 0, 0) + bConvArray(charInput(a + 1), 1, 0)
        If a + 2 > UBound(charInput) Then
            If Not b + 1 > UBound(charOutput) Then
'if there is no third one write the second
                charOutput(b + 1) = bConvArray(charInput(a + 1), 1, 1)
            End If
        Else
'otherwise use the second and third to make the second
            charOutput(b + 1) = bConvArray(charInput(a + 1), 1, 1) + bConvArray(charInput(a + 2), 2, 1)
        End If
        If a + 3 > UBound(charInput) Then
            If Not b + 2 > UBound(charOutput) Then
                charOutput(b + 2) = bConvArray(charInput(a + 2), 2, 2)
            End If
        Else
            charOutput(b + 2) = bConvArray(charInput(a + 2), 2, 2) + bConvArray(charInput(a + 3), 3, 2)
        End If
    Next a
'destroy input array
    Erase charInput
    Erase bConvArray
'determine output type
    If writeFile Then
        ff = FreeFile
        If IsMissing(outFileName) Then
            newFileName = strToDecode & ".decode"
        Else
            newFileName = outFileName
        End If
        Open newFileName For Output As #ff
        Print #ff, "s"
        Close #ff
        Open newFileName For Binary As #ff
        Put #ff, , charOutput
        Close #ff
    Else
        Decode = Left$(StrConv(charOutput, vbUnicode), UBound(charOutput) + 1)
    End If
    Erase charOutput
End Function
Private Function getcharVal(ByVal tmpLng As Long) As Byte
Dim char As Byte
'this returns the ascii value from binary
    If tmpLng > 9999999 Then tmpLng = tmpLng - 10000000: char = 128
    If tmpLng > 999999 Then tmpLng = tmpLng - 1000000: char = char + 64
    If tmpLng > 99999 Then tmpLng = tmpLng - 100000: char = char + 32
    If tmpLng > 9999 Then tmpLng = tmpLng - 10000: char = char + 16
    If tmpLng > 999 Then tmpLng = tmpLng - 1000: char = char + 8
    If tmpLng > 99 Then tmpLng = tmpLng - 100: char = char + 4
    If tmpLng > 9 Then tmpLng = tmpLng - 10: char = char + 2
    If tmpLng > 0 Then char = char + 1
'return the value
    getcharVal = char
End Function

If you see ways to make this faster, please let me know...

[Rikk]

bump

[Alphanos]

I tried reading it, but I need to read it again some other time when my brain is working better.

[Rikk]

thanks

[Rikk]

bump

[David.Poundall]

This code needs to go in the codebank somewhere. It is blindingly fast and you need something like this for encoding and decoding E-mail attachments.

[Merri]

Too bad they never actually released the code; just saying your code is fast and showing some results doesn't tell a whole lot. Atleast I didn't see the code being submitted anywhere.

Anyways, I might be able to do a late challenge, just not sure if I bother. Are there more than one person here who needs a fast Base64?

[David.Poundall]

Yes they did - threads 19 and 20.

[Merri]

Ah, missread the nick there. Humm... it does look like it could be beaten.

[asmdev]

this is a nice tutorial about base64 conversion
http://www.cpp-home.com/tutorial.php?102_1

[batserra]

a question ,i write a code program to encrypt/decrypt ,i want to save files in Base64(more small size) ,but the Rikk code is for strings. How i have to modify to also send bytes??

dim buffer() as byte ,FileO as integer,key as string
FileO = FreeFile
Buffer() = EncryptArray(Which, Buffer(), Key)
Open OutFile For Binary As #FileO
Put #FileO, , Encode(Buffer) ????????
End If
Close #FileO

And what to decode???

Thanks for your help

[Comintern]

Hey, thanks for resurrecting this thread! I decided to see if I could do better than Rikk's code expecting to come close, but I ended up smoking it . I used a simple bit-masking and bit-shifting to calculate individual characters in both the encode and decode functions, with a couple of lookup tables (mainly for avoiding repeated multiplications). At first, I tried manipulating the strings with the CopyMemory API, but it turned out that indexing into a byte array was a lot faster so I ended up going with that. My functions only take strings as inputs, so in the interest of fairness I commented out all of Rikk's code that dealt with the file functions (saves a couple of If tests). For testing, I used an input of a 1,000,000 character randomly generated string. This is the test code:

Private Sub SpeedCompare()
 
    Dim lStart As Long, lEnd As Long, lTotal As Long, sTemp As String, sDoc As String, iCount As Integer
 
    sDoc = TestString(1000000)  'Generate a random 1000000 char string.
    
    For iCount = 1 To 10
        lStart = GetTickCount
        sTemp = MyEncode(sDoc)
        lEnd = GetTickCount
        lTotal = lTotal + (lEnd - lStart)
    Next iCount
    Debug.Print ("My Average Encode: " & lTotal / 10000 & " seconds.")
    
    For iCount = 1 To 10
        lStart = GetTickCount
        sDoc = MyDecode(sTemp)
        lEnd = GetTickCount
        lTotal = lTotal + (lEnd - lStart)
    Next iCount
    Debug.Print ("My Average Decode: " & lTotal / 10000 & " seconds.")
    
    For iCount = 1 To 10
        lStart = GetTickCount
        sTemp = Encode(sDoc)
        lEnd = GetTickCount
        lTotal = lTotal + (lEnd - lStart)
    Next iCount
    Debug.Print ("His Average Encode: " & lTotal / 10000 & " seconds.")
    
    For iCount = 1 To 10
        lStart = GetTickCount
        sDoc = Decode(sTemp)
        lEnd = GetTickCount
        lTotal = lTotal + (lEnd - lStart)
    Next iCount
    Debug.Print ("His Average Decode: " & lTotal / 10000 & " seconds.")
    
End Sub
 
Private Function TestString(lLen As Long) As String
 
    Dim lCount As Long, bOut() As Byte
    
    Randomize
    ReDim bOut(lLen - 1)
    For lCount = 0 To UBound(bOut)
        bOut(lCount) = Int(Rnd * 255)
    Next lCount
    
    TestString = StrConv(bOut, vbUnicode)
 
End Function

And here are my encode and decode functions (a little easier to read I might add):

Option Explicit
 
Private Const clOneMask = 16515072          '000000 111111 111111 111111
Private Const clTwoMask = 258048            '111111 000000 111111 111111
Private Const clThreeMask = 4032            '111111 111111 000000 111111
Private Const clFourMask = 63               '111111 111111 111111 000000
 
Private Const clHighMask = 16711680         '11111111 00000000 00000000
Private Const clMidMask = 65280             '00000000 11111111 00000000
Private Const clLowMask = 255               '00000000 00000000 11111111
 
Private Const cl2Exp18 = 262144             '2 to the 18th power
Private Const cl2Exp12 = 4096               '2 to the 12th
Private Const cl2Exp6 = 64                  '2 to the 6th
Private Const cl2Exp8 = 256                 '2 to the 8th
Private Const cl2Exp16 = 65536              '2 to the 16th
 
Public Function MyEncode(sString As String) As String
 
    Dim bTrans(63) As Byte, lPowers8(255) As Long, lPowers16(255) As Long, bOut() As Byte, bIn() As Byte
    Dim lChar As Long, lTrip As Long, iPad As Integer, lLen As Long, lTemp As Long, lPos As Long
    
    For lTemp = 0 To 63                     'Fill the translation table.
        Select Case lTemp
            Case 0 To 25
                bTrans(lTemp) = 65 + lTemp  'A - Z
            Case 26 To 51
                bTrans(lTemp) = 71 + lTemp  'a - z
            Case 52 To 61
                bTrans(lTemp) = lTemp - 4   '1 - 0
            Case 62
                bTrans(lTemp) = 43          'Chr(43) = "+"
            Case 63
                bTrans(lTemp) = 47          'Chr(47) = "/"
        End Select
    Next lTemp
 
    For lTemp = 0 To 255                    'Fill the 2^8 and 2^16 lookup tables.
        lPowers8(lTemp) = lTemp * cl2Exp8
        lPowers16(lTemp) = lTemp * cl2Exp16
    Next lTemp
 
    iPad = Len(sString) Mod 3               'See if the length is divisible by 3
    If iPad Then                            'If not, figure out the end pad and resize the input.
        iPad = 3 - iPad
        sString = sString & String(iPad, Chr(0))
    End If
    
    bIn = StrConv(sString, vbFromUnicode)   'Load the input string.
    lLen = ((UBound(bIn) + 1) / 3) * 4      'Length of resulting string.
    lTemp = lLen \ 72                       'Added space for vbCrLfs.
    ReDim bOut(((lTemp * 2) + lLen) - 1)    'Make the output buffer.
    
    lLen = 0                                'Reusing this one, so reset it.
    
    For lChar = LBound(bIn) To UBound(bIn) Step 3
        lTrip = lPowers16(bIn(lChar)) + lPowers8(bIn(lChar + 1)) + bIn(lChar + 2)    'Combine the 3 bytes
        lTemp = lTrip And clOneMask                 'Mask for the first 6 bits
        bOut(lPos) = bTrans(lTemp \ cl2Exp18)       'Shift it down to the low 6 bits and get the value
        lTemp = lTrip And clTwoMask                 'Mask for the second set.
        bOut(lPos + 1) = bTrans(lTemp \ cl2Exp12)   'Shift it down and translate.
        lTemp = lTrip And clThreeMask               'Mask for the third set.
        bOut(lPos + 2) = bTrans(lTemp \ cl2Exp6)    'Shift it down and translate.
        bOut(lPos + 3) = bTrans(lTrip And clFourMask) 'Mask for the low set.
        If lLen = 68 Then                           'Ready for a newline
            bOut(lPos + 4) = 13                     'Chr(13) = vbCr
            bOut(lPos + 5) = 10                     'Chr(10) = vbLf
            lLen = 0                                'Reset the counter
            lPos = lPos + 6
        Else
            lLen = lLen + 4
            lPos = lPos + 4
        End If
    Next lChar
    
    If iPad = 1 Then                                'Add the padding chars if any.
        bOut(UBound(bOut)) = 61                     'Chr(61) = "="
    ElseIf iPad = 2 Then
        bOut(UBound(bOut)) = 61
        bOut(UBound(bOut) - 1) = 61
    End If
    
    MyEncode = StrConv(bOut, vbUnicode)             'Convert back to a string and return it.
    
End Function
 
Public Function MyDecode(sString As String) As String
 
    Dim bOut() As Byte, bIn() As Byte, bTrans(255) As Byte, lPowers6(63) As Long, lPowers12(63) As Long
    Dim lPowers18(63) As Long, lQuad As Long, iPad As Integer, lChar As Long, lPos As Long, sOut As String
    Dim lTemp As Long
 
    sString = Replace(sString, vbCr, vbNullString)      'Get rid of the vbCrLfs.  These could be in...
    sString = Replace(sString, vbLf, vbNullString)      'either order.
 
    lTemp = Len(sString) Mod 4              'Test for valid input.
    If lTemp Then
        Call Err.Raise(vbObjectError, "MyDecode", "Input string is not valid Base64.")
    End If
    
    If InStrRev(sString, "==") Then         'InStrRev is faster when you know its at the end.
        iPad = 2                            'Note:  These translate to 0, so you can leave them...
    ElseIf InStrRev(sString, "=") Then      'in the string and just resize the output.
        iPad = 1
    End If
     
    For lTemp = 0 To 255                    'Fill the translation table.
        Select Case lTemp
            Case 65 To 90
                bTrans(lTemp) = lTemp - 65  'A - Z
            Case 97 To 122
                bTrans(lTemp) = lTemp - 71  'a - z
            Case 48 To 57
                bTrans(lTemp) = lTemp + 4   '1 - 0
            Case 43
                bTrans(lTemp) = 62          'Chr(43) = "+"
            Case 47
                bTrans(lTemp) = 63          'Chr(47) = "/"
        End Select
    Next lTemp
 
    For lTemp = 0 To 63                     'Fill the 2^6, 2^12, and 2^18 lookup tables.
        lPowers6(lTemp) = lTemp * cl2Exp6
        lPowers12(lTemp) = lTemp * cl2Exp12
        lPowers18(lTemp) = lTemp * cl2Exp18
    Next lTemp
 
    bIn = StrConv(sString, vbFromUnicode)           'Load the input byte array.
    ReDim bOut((((UBound(bIn) + 1) \ 4) * 3) - 1)   'Prepare the output buffer.
    
    For lChar = 0 To UBound(bIn) Step 4
        lQuad = lPowers18(bTrans(bIn(lChar))) + lPowers12(bTrans(bIn(lChar + 1))) + _
                lPowers6(bTrans(bIn(lChar + 2))) + bTrans(bIn(lChar + 3))           'Rebuild the bits.
        lTemp = lQuad And clHighMask                'Mask for the first byte
        bOut(lPos) = lTemp \ cl2Exp16               'Shift it down
        lTemp = lQuad And clMidMask                 'Mask for the second byte
        bOut(lPos + 1) = lTemp \ cl2Exp8            'Shift it down
        bOut(lPos + 2) = lQuad And clLowMask        'Mask for the third byte
        lPos = lPos + 3
    Next lChar
 
    sOut = StrConv(bOut, vbUnicode)                     'Convert back to a string.
    If iPad Then sOut = Left$(sOut, Len(sOut) - iPad)   'Chop off any extra bytes.
    MyDecode = sOut
 
End Function

Finally, the results on my machine. Sometimes the simpler solutions are better.

My Average Encode: 0.4422 seconds.
My Average Decode: 0.9156 seconds.
His Average Encode: 1.6359 seconds.
His Average Decode: 2.3 seconds.

Anyone else want to take a stab?

[Merri]

See this thread for a tip on how to avoid using StrConv and see how to use a Integer array instead (which is faster to access and you don't need StrConv at all). Though you'd still have to figure out how to reserve space quickly for the output string, but that's why there are VBspeed solutions for that.

I don't have the time to do a faster code myself. Mathwise I don't see many problems in your code, though I'd replace this:

lLen = ((UBound(bIn) + 1) / 3) * 4

with this:

lLen = ((UBound(bIn) + 1) * 4) \ 3

[Comintern]

See this thread for a tip on how to avoid using StrConv and see how to use a Integer array instead (which is faster to access and you don't need StrConv at all). Though you'd still have to figure out how to reserve space quickly for the output string, but that's why there are VBspeed solutions for that.

Very interesting thread. It never really occured to me to use an integer instead of a byte to represent Unicode, even though it seems so obvious now that you mention it .

I don't have the time to do a faster code myself. Mathwise I don't see many problems in your code, though I'd replace this:

lLen = ((UBound(bIn) + 1) / 3) * 4

with this:

lLen = ((UBound(bIn) + 1) * 4) \ 3

Nice catch. I'll chalk this one up to a typo on my part -- I thought I'd used all intdivides. One thing that surprised me was how fast the intdivides by powers of 2 process. I'd be curious to find out how those instructions get compiled, because I'd always assumed that any divide instruction was expensive, float or not. I know that bit shifts are blindingly fast by comparison. Might have to compile it and look at the resulting assembly. BTW, I did the divide before the multiply to minimize the chance of overflowing the long. Is there a performance issue in the order of the multiply and divide operations?

One other area that I see room for improvement in is the 2 Replace() calls at the start of the decode function, but I have no clue how to get around that. As far as a performance breakdown in comparision to Rikk's code, I think the main things I cut out were the conditional tests and repeated calls to UBound inside the en/decoding loops. I'm not sure if the size of the lookup arrays are relevent, but I always tend to think that the more compact the table the better.

[Merri]

Humm... I didn't take a careful look. I'd remove InStrRev (it is awfully slow) and Replace completely. Just skip the line changes. It might be wise to check if there are any line changes (using InStr) so the code could determine a mode to work in.

The current maximum file size that it can handle is 512 MB thanks to the * 4 \ 3 line, so it should be enough for about any use. I'm pretty sure nobody does a Base64 encoding/decoding for a file bigger than that.

Afaik \ is not a real divider, but I've already forgotten how it was supposed to work. Anyways, the main advantage with \ is that it doesn't require a coercion in memory: if you do a floating point division (and floating point is much slower than integer), you also make a behind-the-scenes datatype coercion (as this is VB we're talking about).

The tables could be an array defined outside the function and it could be made only once; then just store a static boolean value to know if it has been filled or not.

As for encoding, I'd swap If lLen = 68 Then to If lLen <> 68 Then because the first If occurs first and doing Else is slower. At the moment the Else gets called far more often. Humm, there is also String used to add empty stuff at the end. A big no-no, I'm sure it could be done using another faster method. All string based handling is slow, so we really want to get rid of all string handling besides the quick and efficient string allocation (for which one can find code at VBspeed I linked). InStr might be the only "worthwhile to use" string function thanks to its good speed with one and two character keywords.