'===========================================================================
' Subject: BASE 64 ENCODING                   Date: 05-12-96 (14:15)       
'  Author: G. Balla                           Code: VBDOS                  
'  Origin: artvil@ix.netcom.com             Packet: VB.ABC
'===========================================================================
'-------------------------------------------------------------------------
'This code has been placed in public domain.
'G Balla 
'--------------------------------------------------------------------------
Option Explicit

Dim Shared ic_ChopMask  As Integer  ' Constant 8-bit mask (Faster than using string constants)
Dim Shared ic_BitShift  As Integer  ' Constant shift mask (Faster than using string constants)
Dim Shared ic_StartMask As Integer  ' Initial mask value  (Faster than using string constants)

Dim Shared i_RollOver   As Integer  ' Decoded Roll over value
Dim Shared i_HighMask   As Integer  ' Mask high bits of each char
Dim Shared i_Shift      As Integer  ' Multiplier shift value
Dim Shared i_LowShift   As Integer  ' Mask low bits of each char

Dim Shared sz_Alphabet  As String   ' Decode/Encode Lookup Table
Dim Shared sz_Temp      As String   ' Working string

'----------------------------------------------------------------------------------------------
' Name:         DECODE_64$
' Type:         String function
' Description:  decodes a string from BASE64 to binary format
'
' Arguements:   Source string to decode (sz_Encoded)
'               Last string in file to decode flag (i_EndOfText)
' Returns:      Un-Encoded binary string.
'
' Errors:       Generates an Error via ERROR statement.
' Error code:   253 = No string to decode
'                   -----------------------------------------------
' NOTES:    Must call INIT_DECODE_64 before sending 1st string of an encoded file.
'
'           A DOEVENTS occurs near the end of the FOR/NEXT loop
'                   -----------------------------------------------
' Global variables: sz_Alphabet         ' Decode/Encode lookup table
'                   sz_Temp             ' Working string
'
'                   i_RollOver          ' Decode/Encode rollover value
'                   i_HighMask          ' High bit mask
'                   i_Shift             ' Multiplier value
'
'
' Local variables:  i_Char              ' Ascii Char value from Encoded string
'                   i_Ptr               ' Lookup table pointer
'                   i_Counter           ' FOR/NEXT counter
'
'----------------------------------------------------------------------------------------------
Function DECODE_64$ (sz_Encoded As String, i_EndOfText As Integer)

' Create variables
    Dim i_Ptr       As Integer
    Dim i_Char      As Integer
    Dim i_Counter As Integer

' Check if empty decoded string.
' If Empty, return NUL and Generate error 254
    If Len(sz_Encoded) = 0 Then
        DECODE_64$ = ""
        Error 253
        Exit Function
    End If

' Initialize working string
    sz_Temp = ""

' Begin Decoding
    For i_Counter = 1 To Len(sz_Encoded)

' Get next alphabet
        i_Char = Asc(Mid$(sz_Encoded, i_Counter, 1))

' Get Decoded value
        i_Ptr = InStr(sz_Alphabet, Chr$(i_Char)) - 1

' Check if character is valid
        If i_Ptr >= 0 Then

' Char is valid, process it
            If i_Shift = ic_BitShift Then

' 1st char in block of 4, keep high part of character
                i_RollOver = (i_Ptr * i_Shift) And ic_ChopMask

' Reset masks for next character
                i_HighMask = &H30
                i_LowShift = ic_StartMask
                i_Shift = ic_StartMask

            Else

' Start saving decoded character
                sz_Temp = sz_Temp + Chr$(i_RollOver Or ((i_Ptr And i_HighMask) / i_LowShift))

' Calculate next mask and shift values
                i_RollOver = (i_Ptr * i_Shift) And ic_ChopMask
                i_Shift = i_Shift * ic_BitShift
                i_HighMask = (i_HighMask \ ic_BitShift) Or &H30
                i_LowShift = i_LowShift / ic_BitShift

                If i_Shift > 256 Then
                    i_Shift = ic_BitShift
                    i_LowShift = 0
                    DoEvents
                End If
            End If

        End If
    Next

' Concat last character if required
    If (i_Shift > ic_BitShift And i_Shift < 256) Then

' Character remaining in    i_RollOver
        If i_EndOfText Then

' Last string to decode in file
            sz_Temp = sz_Temp + Chr$(i_RollOver)
        End If
    End If

' Exit wth decoded string
    DECODE_64$ = sz_Temp
End Function

'----------------------------------------------------------------------------------------------
' Name:         ENCODE_64$
' Type:         String function
' Description:  Encodes a string into a BASE64 coded string
'
' Arguement:    Source string to encode (sz_UnEncoded)
' Returns:      Encoded BASE64 string.
'
' Errors:       Generates an Error via ERROR statement.
' Error code:   254 = No string to encode
'                       returns NUL string
'                   -----------------------------------------------
' NOTES:    If sending more than 1 string per file, ensure that each source string
'               is a multiple of 3 bytes or premature padded characters are added.
'               The last string of a file is exempt from this rule.
'
'           Each string can be 16383 bytes in length to satisfy VB's string capacity limitation.
'
'           Encoded blocks should be written as sub block lengths of about 76 characters and
'               added CR/LF added to each sub-block.
'               This is what WINCODE does and should satisfy most UUE browsers.
'
'           A DOEVENT occurs near the end of the FOR/NEXT loop
'
'                   -----------------------------------------------
' Global variables: sz_Alphabet     ' Encoding/Decoding lookup table
'                   sz_Temp         ' Working string
'                   ic_ChopMask     ' Constant 8-bit mask for speed
'                   ic_BitShift     ' Constant shift mask for speed
'
'                   i_RollOver      ' Decode/Encode rollover value
'                   i_HighMask      ' High bit mask
'                   i_Shift         ' Multiplier value
'
' Local variables:  ic_LowFill      ' Constant Low 2-bit fill value for speed
'
'                   i_LowMask       ' Low bits mask
'                   i_Char          ' Ascii char value from Un coded string
'                   i_Ptr           ' Lookup table pointer
'
'                   i_Counter       ' For/Next loop counter
'----------------------------------------------------------------------------------------------
Function ENCODE_64$ (sz_UnEncoded As String)

' Create variables
    Dim ic_LowFill  As Integer

    Dim i_Char      As Integer
    Dim i_LowMask   As Integer
    Dim i_Ptr       As Integer

    Dim i_Counter As Integer


' Check if empty decoded string.
' If Empty, return NUL and Generate error 254
    If Len(sz_UnEncoded) = 0 Then
        ENCODE_64$ = ""
        Error 254
        Exit Function
    End If

' Initialize lookup dictionary and constants
    sz_Alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

    ic_BitShift = 4
    ic_ChopMask = 255
    ic_LowFill = 3


' Initialize Masks
    sz_Temp = ""

    i_HighMask = &HFC
    i_LowMask = &H3
    i_Shift = &H10
    i_RollOver = 0


' Begin Encoding process
    For i_Counter = 1 To Len(sz_UnEncoded)

' Fetch ascii character in decoded string
        i_Char = Asc(Mid$(sz_UnEncoded, i_Counter, 1))

' Calculate Alphabet lookup pointer
        i_Ptr = ((i_Char And i_HighMask) \ (i_LowMask + 1)) Or i_RollOver

' Roll bit patterns
        i_RollOver = (i_Char And i_LowMask) * i_Shift

' Concatenate encoded character to working encoded string
        sz_Temp = sz_Temp + Mid$(sz_Alphabet, i_Ptr + 1, 1)

' Adjust masks
        i_HighMask = (i_HighMask * ic_BitShift) And ic_ChopMask
        i_LowMask = i_LowMask * ic_BitShift + ic_LowFill
        i_Shift = i_Shift \ ic_BitShift

' If last character in block, concat last RollOver and
'   reset masks
        If i_HighMask = 0 Then
            sz_Temp = sz_Temp + Mid$(sz_Alphabet, i_RollOver + 1, 1)
            i_RollOver = 0
            i_HighMask = &HFC
            i_LowMask = &H3
            i_Shift = &H10
            DoEvents
        End If

    Next i_Counter

' If RollOver remains, concat it to the working string
    If i_Shift < &H10 Then
        sz_Temp = sz_Temp + Mid$(sz_Alphabet, i_RollOver + 1, 1)
    End If

' Pad encoded string with required '=' pad characters
    i_Ptr = (Len(sz_Temp) Mod 4)
    If i_Ptr Then sz_Temp = sz_Temp + String$(4 - i_Ptr, "=")

' Return encoded string
    ENCODE_64$ = sz_Temp
End Function

'----------------------------------------------------------------------------------------------
' Name:         INIT_DECODE_64
' Type:         Sub procedure
' Description:  Initializes local shared variables for DECODE_64$
'                   Required because many encoded files cannot be decoded in a single string
'
' Used:         Before decoding a BASE64 file.  (DECODE_64$)
' Arguements:   None
' Returns:      Nothing
'
' Errors:       None
'
' Global Variables used:
'               sz_Alphabet             Encode/Decode Table lookup
'
'               ic_ChopMask             Constant value in variable to speed process
'               ic_BitShift             Constant value in variable to speed process
'               ic_StartMask            Constant value in variable to speed process
'
'               i_Shift                 Multiplier shift value
'               i_LowShift              Mask Low bits of each char
'               i_RollOver              Decoded Roll over value from prev char in string
'               i_HighMask              Mask high bits of each char
'----------------------------------------------------------------------------------------------
Sub INIT_DECODE_64 ()

' Initialize 2nd encoding pass lookup dictionary
    sz_Alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

' Initialize Constants
    ic_ChopMask = 255
    ic_BitShift = 4
    ic_StartMask = &H10

' Initialize Masks
    i_Shift = ic_BitShift
    i_LowShift = 0
    i_RollOver = 0
    i_HighMask = -1
End Sub