Task: Base64 encode data


C++: #include <iostream>
#include <fstream>
#include <vector>

typedef unsigned char byte;
using namespace std;

const unsigned m1 = 63 << 18, m2 = 63 << 12, m3 = 63 << 6;

class base64
{
public:
    base64() { char_set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; }
    string encode( vector<byte> v )
    {
	string res;
	unsigned d, a = 0, l = static_cast<unsigned>( v.size() );
	while( l > 2 )
	{
	    d = v[a++] << 16 | v[a++] << 8 | v[a++];	
	    res.append( 1, char_set.at( ( d & m1 ) >> 18 ) );	
	    res.append( 1, char_set.at( ( d & m2 ) >> 12 ) );	
	    res.append( 1, char_set.at( ( d & m3 ) >>  6 ) );
	    res.append( 1, char_set.at( d & 63 ) );
	    l -= 3;
	}
	if( l == 2 )
	{
	    d = v[a++] << 16 | v[a++] << 8;
	    res.append( 1, char_set.at( ( d & m1 ) >> 18 ) );	
	    res.append( 1, char_set.at( ( d & m2 ) >> 12 ) );	
	    res.append( 1, char_set.at( ( d & m3 ) >>  6 ) );
	    res.append( 1, '=' );
	}
	else if( l == 1 )
	{
	    d = v[a++] << 16;
	    res.append( 1, char_set.at( ( d & m1 ) >> 18 ) );	
	    res.append( 1, char_set.at( ( d & m2 ) >> 12 ) );	
	    res.append( "==", 2 );
	}
	return res;
    }

private:
    string char_set;
};

int main( int argc, char* argv[] )
{
    base64 b;
    basic_ifstream<byte> f( "favicon.ico", ios::binary );
    string r = b.encode( vector<byte>( ( istreambuf_iterator<byte>( f ) ), istreambuf_iterator<byte>() ) );
    copy( r.begin(), r.end(), ostream_iterator<char>( cout ) );
    return 0;
}







VB: Option Explicit
Public Function Decode(s As String) As String
    Dim i As Integer, j As Integer, r As Byte
    Dim FirstByte As Byte, SecndByte As Byte, ThirdByte As Byte
    Dim SixBitArray() As Byte, ResultString As String, Token As String
    Dim Counter As Integer, InputLength As Integer
    InputLength = Len(s)
    ReDim SixBitArray(InputLength + 1)
    j = 1 
    For i = 1 To InputLength 
        Token = Mid(s, i, 1)
        Select Case Token
            Case "A" To "Z"
                SixBitArray(j) = Asc(Token) - Asc("A")
                j = j + 1
            Case "a" To "z"
                SixBitArray(j) = Asc(Token) - Asc("a") + 26
                j = j + 1
            Case "0" To "9"
                SixBitArray(j) = Asc(Token) - Asc("0") + 52
                j = j + 1
            Case "+"
                SixBitArray(j) = 62
                j = j + 1
            Case "/"
                SixBitArray(j) = 63
                j = j + 1
            Case "="
                
            Case Else
                
        End Select
    Next i
    r = (j - 1) Mod 4
    Counter = 1
    For i = 1 To (j - 1) \ 4 
        FirstByte = SixBitArray(Counter) * 4 + SixBitArray(Counter + 1) \ 16
        SecndByte = (SixBitArray(Counter + 1) Mod 16) * 16 + SixBitArray(Counter + 2) \ 4
        ThirdByte = (SixBitArray(Counter + 2) Mod 4) * 64 + SixBitArray(Counter + 3)
        ResultString = ResultString & Chr(FirstByte) & Chr(SecndByte) & Chr(ThirdByte)
        Counter = Counter + 4
    Next i
    Select Case r
        Case 3
            FirstByte = SixBitArray(Counter) * 4 + SixBitArray(Counter + 1) \ 16
            SecndByte = (SixBitArray(Counter + 1) Mod 16) * 16 + SixBitArray(Counter + 2) \ 4
            ResultString = ResultString & Chr(FirstByte) & Chr(SecndByte)
        Case 2
            FirstByte = SixBitArray(Counter) * 4 + SixBitArray(Counter + 1) \ 16
            ResultString = ResultString & Chr(FirstByte)
    End Select
    Decode = ResultString
End Function
Public Function Encode(s As String) As String
    Dim InputLength As Integer, FirstByte As Byte, SecndByte As Byte, ThirdByte As Byte, r As Byte
    Dim LineNumber As Integer, z As Integer, q() As String, ResultString As String
    Dim FullLines As Integer, LastLineLength As Integer, Counter As Integer
    q = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,a,b,c,d,e,f,g,h,i,j," & _
        "k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,0,1,2,3,4,5,6,7,8,9,+,/", ",", -1, vbTextCompare)
    InputLength = Len(s)
    r = InputLength Mod 3
    FullLines = ((InputLength - r) / 3) \ 20 + 1: LastLineLength = (InputLength - r) / 3 Mod 20 - 1
    Counter = 1
    For LineNumber = 1 To FullLines
        For z = 0 To IIf(LineNumber < FullLines, 19, LastLineLength) 
            FirstByte = Asc(Mid(s, Counter, 1))
            SecndByte = Asc(Mid(s, Counter + 1, 1))
            ThirdByte = Asc(Mid(s, Counter + 2, 1))
            Counter = Counter + 3
            ResultString = ResultString & q(FirstByte \ 4) & q((FirstByte Mod 4) * 16 + _
                (SecndByte \ 16)) & q((SecndByte Mod 16) * 4 + (ThirdByte \ 64)) & q(ThirdByte Mod 64)
        Next z
        If LineNumber < FullLines Then ResultString = ResultString & vbCrLf
    Next LineNumber
    Select Case r
        Case 2
            FirstByte = Asc(Mid(s, Counter, 1))
            SecndByte = Asc(Mid(s, Counter + 1, 1))
            ResultString = ResultString & q(FirstByte \ 4) & q((FirstByte Mod 4) * 16 + _
                (SecndByte \ 16)) & q((SecndByte Mod 16) * 4) & "="
        Case 1
            FirstByte = Asc(Mid(s, Counter, 1))
            ResultString = ResultString & q(FirstByte \ 4) & q((FirstByte Mod 4) * 16) & "=="
    End Select
    Encode = ResultString
End Function
Private Function ReadWebFile(ByVal vWebFile As String) As String
    
    Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    oXMLHTTP.Open "GET", vWebFile, False
    oXMLHTTP.send
    Do While oXMLHTTP.readyState <> 4: DoEvents: Loop
    oResp = oXMLHTTP.responseBody 
    ReadWebFile = StrConv(oResp, vbUnicode)
    Set oXMLHTTP = Nothing
End Function
Public Sub Task()
    Dim In_ As String, Out As String, bIn As String
    Dim filelength As Integer
    Dim i As Integer
    In_ = ReadWebFile("http://rosettacode.org/favicon.ico")
    Out = Encode(In_)
    bIn = Decode(Out)
    Debug.Print "The first eighty and last eighty characters after encoding:"
    Debug.Print Left(Out, 82) & "..." & vbCrLf & Join(Split(Right(Out, 82), vbCrLf), "")
    Debug.Print "Result of string comparison of input and decoded output: " & StrComp(In_, bIn, vbBinaryCompare)
    Debug.Print "A zero indicates both strings are equal."
End Sub