clsb64.cls

快速Base64编码_解码引擎全部源程序

' | of encode table and vice versa for decode table.  |
' | Note that byte array is used instead of string.   |
' | Refer to the RFC on the codec table.              |
' +---------------------------------------------------+

Public Sub Init()

Dim Index As Integer

' Initialize Codec Table

' A-Z
For Index = 65 To 90
    B64EncTable(Index - 65) = Index
    B64DecTable(Index) = Index - 65
Next

' a-z
For Index = 97 To 122
    B64EncTable(Index - 71) = Index
    B64DecTable(Index) = Index - 71
Next

' 0-9
For Index = 48 To 57
    B64EncTable(Index + 4) = Index
    B64DecTable(Index) = Index + 4
Next

' + and /
B64EncTable(62) = 43: B64DecTable(43) = 62
B64EncTable(63) = 47: B64DecTable(47) = 63

End Sub

' +-------------------------------------------------------------+
' | Loads a file into byte array                                |
' +-------------------------------------------------------------+
' | Parameter   :                                               |
' | strPathName - Path and File name that points to input file  |
' | aryOut      - a byte array (will be redimension afterwards) |
' |                                                             |
' | Description :                                               |
' | Fetch the file 1 kilo byte each time until EOF. Each time   |
' | 1kb is fetched, it will be converted from string to byte    |
' | array, and store into the output byte array                 |
' +-------------------------------------------------------------+

Public Sub Load(ByVal strPathName As String, ByRef aryOut() As Byte)

Dim fIndex As Integer           ' free file index
Dim wIndex As Integer           ' temporary array pointer
Dim fSize  As Long              ' file size
Dim fPointer As Long            ' output array pointer
Dim fBuffer As String * 1024    ' fetch buffer (string)
Dim fTemp() As Byte             ' fetch buffer (array)

fIndex = FreeFile                               ' Get free file index
fSize = FileLen(strPathName)                    ' Get file size

ReDim aryOut(fSize - 1)                         ' Redimension Output array (zero-based)

Open strPathName For Binary As fIndex           ' Open file in binary mode

Do While Not EOF(fIndex)                        ' Continue until end of file (EOF)
    
    Get fIndex, , fBuffer                       ' Fetch 1024 bytes (1kb) from file
    
    fTemp = StrConv(fBuffer, vbFromUnicode)     ' Convert and store to temporary byte array
        
    For wIndex = LBound(fTemp) To UBound(fTemp) ' Store from temporary byte array
        aryOut(fPointer) = fTemp(wIndex)        ' into the output array
        fPointer = fPointer + 1                 ' Increment the array pointer
        If fPointer = fSize Then Exit Do        ' Exit when pointer equal to file size (array pointer is zero-based)
    Next                                        ' Next temporary byte array location
    
Loop                                            ' Next 1024 bytes to be fetch

Close fIndex                                    ' Close file

End Sub

' +-------------------------------------------------------------+
' | Store byte array into file                                  |
' +-------------------------------------------------------------+
' | Parameter   :                                               |
' | aryIn       - byte array that contain the data to be stored |
' | strPathName - path and file that points to the output file  |
' |              (automatically overwrite file if file exists)  |
' |                                                             |
' | Description :                                               |
' | Convert byte array into string and puts the whole string    |
' | into file.                                                  |
' +--------------------------------------------------------------

Public Sub Save(ByRef aryIn() As Byte, ByVal strPathName As String)

Dim fIndex As Integer       ' Free file index
Dim fBuffer As String       ' Temporary buffer

fIndex = FreeFile                       ' Get free file index

Open strPathName For Binary As fIndex   ' Open file in binary mode
fBuffer = StrConv(aryIn, vbUnicode)     ' Convert from byte array to string
Put fIndex, , fBuffer                   ' Store into file
Close fIndex                            ' Close file

End Sub

' +------------------------------------------------------+
' | String to byte array conversion                      |
' +------------------------------------------------------+
' | Parameter   :                                        |
' | strIn  - input string                                |
' | aryOut - output array                                |
' |                                                      |
' | Description :                                        |
' | Note that output array does not have be to dimension |
' | instead is automatically done by StrConv             |
' +------------------------------------------------------+

Public Sub StrToAry(ByVal strIn As String, ByRef aryOut() As Byte)

aryOut = StrConv(strIn, vbFromUnicode)  ' Convert string to byte array

End Sub

' +----------------------------+
' | Array to string conversion |
' +----------------------------+
' | Parameter   :              |
' | aryIn  - input array       |
' | strOut - output string     |
' |                            |
' | Description :              |
' | None                       |
' +----------------------------+

Public Sub AryToStr(ByRef aryIn() As Byte, ByRef strOut As String)

strOut = StrConv(aryIn, vbUnicode)      ' Convert byte array to string

End Sub

' +-------------------------------------------------------------------------------+
' | Encode an byte array                                                          |
' +-------------------------------------------------------------------------------+
' | Parameter                                                                     |
' | aryIn  - Input array                                                          |
' | aryOut - Output array (will be redimensioned)                                 |
' |                                                                               |
' | Description :                                                                 |
' | Size of output is always 1/3 larger (3 bytes becomes 4) due to the algorythm. |
' | Take note that the output size should ALWAYS be dividable by 4 perfectly.     |
' | If the input size is not dividable by 3 perfectly, the next empty byte is     |
' | filled with 0 (null) to round the last group of bits into 6. If input byte is |
' | 1 then output will be 2 encoded bytes followed with 2 "=", if 2 bytes is      |
' | input then output should be 3 encoded bytes with 1 "="                        |
' +-------------------------------------------------------------------------------+

Public Sub Encode(ByRef aryIn() As Byte, ByRef aryOut() As Byte)

Dim SizeIn As Long      ' Size of input array
Dim SizeOut As Long     ' Size of output array (to be calculate)
Dim SizeMod As Integer  ' Remainder of input (due to base64 encode algorythm)
Dim Buffer(2) As Byte   ' Temporary buffer to store 3 bytes of data to be encode
Dim Index As Long       ' Encode index
Dim oIndex As Long      ' Output Index

SizeIn = UBound(aryIn) + 1                  ' size of input
SizeMod = SizeIn Mod 3                      ' remaining input bytes
SizeOut = (SizeIn - SizeMod) / 3 * 4        ' size of output (dividable by 3)
If SizeMod > 0 Then SizeOut = SizeOut + 4   ' if there is remaining bytes, add another group of 4 byte

ReDim aryOut(SizeOut - 1)                   ' redimension output array

If SizeIn >= 3 Then                         ' Input has more than 1 group of 3 bytes

    For Index = 0 To SizeIn - SizeMod - 1 Step 3    ' Start from 1st element in input byte array
    
        Buffer(0) = aryIn(Index)            ' Fetch next 3 bytes
        Buffer(1) = aryIn(Index + 1)        ' into temporary array
        Buffer(2) = aryIn(Index + 2)        ' (arrays are faster)

        ' Encode 3 bytes to 4
        ' by concatenating 3 x 8 bits into 24 bits
        ' then divide into 4 x 6 bit group
        ' then encode using the encode the table
        
        aryOut(oIndex) = B64EncTable((Buffer(0) And &HFC) \ 4)
        aryOut(oIndex + 1) = B64EncTable((Buffer(0) And &H3) * 16 Or (Buffer(1) And &HF0) \ 16)
        aryOut(oIndex + 2) = B64EncTable((Buffer(1) And &HF) * 4 Or (Buffer(2) And &HC0) \ 64)
        aryOut(oIndex + 3) = B64EncTable((Buffer(2) And &H3F))
        
        oIndex = oIndex + 4                 ' Increment output array index

    Next

End If

If SizeMod = 1 Then                         ' 1 byte remaining in input buffer
    
    Buffer(0) = aryIn(SizeIn - 1)           ' Get the remaining 1 byte
    Buffer(1) = 0                           ' Fill the 2nd buffer with null (to round the 2nd byte into 6 bits)
    
    ' Output 2 bytes with 2 "="
    aryOut(oIndex) = B64EncTable((Buffer(0) And &HFC) \ 4)
    aryOut(oIndex + 1) = B64EncTable((Buffer(0) And &H3) * 16 Or (Buffer(1) And &HF0) \ 16)
    aryOut(oIndex + 2) = 61                 ' Neccessary to assign "==" to round output into 1 group of 4 bytes
    aryOut(oIndex + 3) = 61                 ' according to Base64 Encode Standard

ElseIf SizeMod = 2 Then                     ' 2 bytes remaining in input buffer

    Buffer(0) = aryIn(SizeIn - 2)           ' Get the remaining 2 bytes
    Buffer(1) = aryIn(SizeIn - 1)
    Buffer(2) = 0                           ' Fill the 3rd buffer with null (to round the 3rd byte into 6 bits)
    
    ' Output 3 bytes with 1 "="
    aryOut(oIndex) = B64EncTable((Buffer(0) And &HFC) \ 4)
    aryOut(oIndex + 1) = B64EncTable((Buffer(0) And &H3) * 16 Or (Buffer(1) And &HF0) \ 16)
    aryOut(oIndex + 2) = B64EncTable((Buffer(1) And &HF) * 4 Or (Buffer(2) And &HC0) \ 64)
    aryOut(oIndex + 3) = 61                 ' Necessary to assign "=" to round output into 1 group of 4 bytes
    
End If

End Sub

' +-----------------------------------------------------------------------------+
' | Decode a byte array                                                         |
' +-----------------------------------------------------------------------------+
' | Parameter   :                                                               |