VB - Fast Base64 Encoding and Decoding

[Comintern]

Here's some code for encoding and decoding MIME Base64 (and fast). On my machine it'll do around 2MB a second encoding and 1MB a second decoding. The zip file contains both a class version (a little slower because of the overhead) and a module version. Enjoy! (yEnc encoder/decode to follow shortly).

EDIT: Orig. zip removed, use the one below.

[Agilaz]

nice code, but....

Private Sub Command1_Click()
    Dim lCnt As Long
    
    For lCnt = 1 To 255
        IntegrityTest lCnt
    Next lCnt
    
End Sub
 
Private Sub IntegrityTest(lLen As Long)
    Dim lCnt1 As Long, lCnt2 As Long
    Dim sOriginal As String, sEncoded As String, sDecoded As String
    Dim bytArr() As Byte
    
    ReDim bytArr(lLen) As Byte
    
    'create a binary string for testing
    
    Do
        bytArr(lCnt1) = lCnt2
        lCnt1 = lCnt1 + 1
        lCnt2 = lCnt2 + 1
        If lCnt2 = 256 Then lCnt2 = 0
    Loop Until lCnt1 > UBound(bytArr)
       
    sOriginal = StrConv(bytArr, vbUnicode)
    
    
    sEncoded = Encode64(sOriginal)
    
    sDecoded = Decode64(sEncoded)
    
    If sOriginal = sDecoded Then
        Debug.Print "Data integrity test passed!"; lLen
    Else
        Debug.Print "Data integrity test failed!"; lLen
    End If
    
End Sub

well, try that code and see yourself

[Comintern]

Your test for equity will always fail if the length of the input string isn't divisible by 3. Reason being, the string is passed to the encoder ByRef and is padded with nulls so that it's length is divisible by 3. That means that the string that is actually encoded correctly, but when you look for equity later in the test code you aren't comparing against what was actually encoded. You can verify this by explicitly passing the strings to the encoding functions ByVal or passing it a copy of the string.

I would like to thank you for making me take a look at this again--there was an error that my testing didn't catch dealing with how the end padding key is placed when the encoded data ends with a CrLf. That just needed a little one-line fix.

Here's my test code, 10000 random length strings between 1 and 1000 characters.

Private Sub IntegrityBas()
 
    Dim sOrig As String, sTest As String, sEnc As String, sDec As String, lRep As Long
    
    Randomize
    
    For lRep = 1 To 10000
        sOrig = TestString(Int(1000 * Rnd + 1))
        sTest = sOrig
        sEnc = Encode64(sTest)
        sDec = Decode64(sEnc)
        If sDec <> sOrig Then
            Debug.Print "Data integrity test failed!"
            Exit Sub
        End If
    Next lRep
    
    Debug.Print "Data integrity test passed!"
    
End Sub
 
Private Sub IntegrityCls()
 
    Dim sOrig As String, sTest As String, sEnc As String, sDec As String, lRep As Long, oEnc As Base64
    
    Randomize
    Set oEnc = New Base64
    
    For lRep = 1 To 10000
        sOrig = TestString(Int(1000 * Rnd + 1))
        sTest = sOrig
        sEnc = oEnc.Encode(sTest)
        sDec = oEnc.Decode(sEnc)
        If sDec <> sOrig Then
            Debug.Print "Data integrity test failed!"
            Set oEnc = Nothing
            Exit Sub
        End If
    Next lRep
    
    Set oEnc = Nothing
    Debug.Print "Data integrity test passed!"
    
End Sub
 
Private Function TestString(lLen As Long) As String
 
    Dim bTemp() As Byte, lPos As Long
    
    ReDim bTemp(lLen)
    For lPos = LBound(bTemp) To UBound(bTemp)
        bTemp(lPos) = Int((255 + 1) * Rnd)
    Next lPos
 
    TestString = StrConv(bTemp, vbUnicode)
 
End Function

[devincci1969]

I tried the code using another language....Chinese to be precise. It doesn't work.

[Comintern]

What problem are you running into? This should encode any binary file, so the language of the file shouldn't be relevent. If it is used to encode unicode strings, you will need to compensate for the implicit unicode conversions that VB6 performs. Can you post a sample file for me to test with?

[kbertone]

ComIntern! Your code looks good, but I am having trouble using it to encode data from a binary file in VB6. Have tried bunch of different ways to get the data out of the file and into a string to give to your encoder function, but the base64 comes back wrong. Could you post some VB6 example code as to how to do this?

I have tried stuff like InputB from the file into a string, reading the file into a Byte (byte by byte) and concatenating them into a string, etc, but nothing seems to work.

Thanks!

[kbertone]

Here is an example of some code that doesn't seem to return the right base64:


iFile = FreeFile()
Open txtAttachmentFile.Text For Binary Access Read Lock Write As #iFile
strAttachment = InputB(LOF(iFile), iFile)
Close #iFile

' convert attachment to base64
Set mybase64 = New Base64
strAttachment = mybase64.Encode(strAttachment)

[Comintern]

You're reading the file as ANSI into a Unicode string. Use the Get function instead:

    iFile = FreeFile()
    Open txtAttachmentFile.Text For Binary Access Read Lock Write As #iFile
    strAttachment = String$(LOF(iFile), Chr$(0))
    Get #iFile, , strAttachment
    Close #iFile

[kbertone]

Thanks, O Great ComIntern. Works like a charm!

[JHart]

Thank you very much for the code -- just what I was looking for!

- Joe

[bearboss_85]

This one help a lot in my project :

You're reading the file as ANSI into a Unicode string. Use the Get function instead:

    iFile = FreeFile()
    Open txtAttachmentFile.Text For Binary Access Read Lock Write As #iFile
    strAttachment = String$(LOF(iFile), Chr$(0))
    Get #iFile, , strAttachment
    Close #iFile

But how to make it back to a single file when we want to decode it... I know that I need to convert it to binary first so that it can be converted into one single actual file. But I've got no idea in doing that plus I'm a beginner in VB6. Thanks....

[Comintern]

This one help a lot in my project :



But how to make it back to a single file when we want to decode it... I know that I need to convert it to binary first so that it can be converted into one single actual file. But I've got no idea in doing that plus I'm a beginner in VB6. Thanks....

Try:

    iFile = FreeFile()
    Open file.bin For Binary As #iFile              'replace with the destination file name.
    Put #iFile, , sBinary
    Close #iFile

file.bin would be replaced with the output filename, sBinary would be the decoded string.

[bearboss_85]

I've got this originally from here :

http://www.vbforums.com/showthread.php?t=514815

It's my thread.. LaVolpe is helping a lot.. Since it's your code, I figure out that I might want to asked your opinion as well... Here's the code:

Private Sub cmdDecode_Click()
Dim sBase64 As String
Dim sJPG As String
Dim iFile As Integer
Dim myClass As Class1

    cdSave.Filter = "Joint Photo Group (*.jpg)|*.jpg|Joint Photo Expert Group (*.jpeg)|*.jpeg"
    cdSave.ShowSave
    If Err Then
        ' This code runs if the dialog was cancelled
        MsgBox "Dialog Cancelled"
    Else
        Set myClass = New Class1
        iFile = FreeFile()
        Open Text2.Text For Binary Access Read Lock Write As #iFile
        sJPG = String$(LOF(iFile), 0)
        Get #iFile, , sJPG
        Close #iFile
    
        sBase64 = myClass.Decode(sJPG)
        iFile = FreeFile()
        Open cdSave.FileName For Binary As #iFile
        Put #iFile, , sBase64
        Close #iFile
    End If

End Sub

I've got this kind of error :

Run-time error '53'

File not found

[Pteranodon]

I am getting a "garbage at end of zipfile" message when trying to open a .zip file created with the decoded contents of a string using this decode code. Different .zip programs, like Enzip and ZipCentral, give slightly different versions of the same message.