VB Base64编解码

模块代码( m_Base64.bas):

Option   Explicit
' 除以2的一次方是右移一位
' 乘以2的一次方是左移一位
' (bytInText(i) And &HFC)  (2 ^ 2)
' 第一个字节的内容And运算0xFC(11111100)(取左边6位)，再除以2的二次方(右移2位)
' (bytInText(i) And &H3) * (2 ^ 4) Or (bytInText(i + 1) And &HF0)  (2 ^ 4)
' 第一个字节的内容And运算0x03(00000011)(取右边2位)，再乘以2的四次方(左移4位)
' 第二个字节的内容And运算0xF0(11110000)(取左边4位)，再除以2的四次方(右移4位)
' 两个结果再Or运算
' (bytInText(i + 1) And &HF) * (2 ^ 2) + (bytInText(i + 2) And &HC0)  (2 ^ 6)
' 第二个字节的内容And运算0x0F(00001111)(取右边4位)，再乘以2的二次方(左移2位)
' 第三个字节的内容And运算0xC0(11000000)(取左边2位)，再除以2的六次方(右移6位)
' 两个结果再Or运算
' bytInText(i + 2) And &H3F
' 第三个字节的内容And运算0x3F(00111111)(取右边6位)
        
' Base64编码函数
Public   Function  Base64_Encode(bytInText()  As   Byte )  As   Byte ()
     Dim  Base64EncodeTable()  As   Byte
     Dim  lngInTextLen  As   Long , lngMod  As   Long , i  As   Long
     Dim  bytEncode()  As   Byte , lngEncodeLen  As   Long
    
    Base64_Encode  =   Chr ( 0 )   ' 初始化函数返回值
    
    Base64EncodeTable()  =   " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/= "   ' 初始化Base64编码表
    Base64EncodeTable()  =   StrConv (Base64EncodeTable(), vbFromUnicode)   ' 转换为ANSI编码
    
     If   LBound (bytInText)  <>   0   Then   Exit Function    ' bytInText数组下标不从零开始则出错返回
    
    lngInTextLen  =   UBound (bytInText)  -   LBound (bytInText)  +   1    ' 计算bytInText数组长度
    
    lngMod  =  lngInTextLen  Mod   3   ' 取模3后的余数(结果只有0、1、2三种情况)
     If  lngMod  =   0   Then
        lngEncodeLen  =  lngInTextLen  /   3   *   4    ' 求编码后的长度
        lngInTextLen  =  lngInTextLen  /   3   *   3    ' 取3的整数倍
     ElseIf  lngMod  =   1   Then
        lngEncodeLen  =  (lngInTextLen  +   2 )  /   3   *   4    ' 求编码后的长度
        lngInTextLen  =  ((lngInTextLen  +   2 )  /   3   -   1 )  *   3   ' 取3的整数倍
     ElseIf  lngMod  =   2   Then
        lngEncodeLen  =  (lngInTextLen  +   1 )  /   3   *   4    ' 求编码后的长度
        lngInTextLen  =  ((lngInTextLen  +   1 )  /   3   -   1 )  *   3   ' 取3的整数倍
     End   If
    
     ' MsgBox "编码后的长度为" & lngEncodeLen & "字节！"
     ' MsgBox "3的整数倍为" & lngInTextLen
    
     ReDim  bytEncode( 0   To  lngEncodeLen  -   1 )  ' 重新定义编码缓冲区
    lngEncodeLen  =   0    ' 初始化编码长度计数
    
     For  i  =   0   To  lngInTextLen  -   1   Step   3
        bytEncode(lngEncodeLen)  =  Base64EncodeTable((bytInText(i)  And   & HFC)   ( 2   ^   2 ))
        bytEncode(lngEncodeLen  +   1 )  =  Base64EncodeTable((bytInText(i)  And   & H3)  *  ( 2   ^   4 )  Or  (bytInText(i  +   1 )  And   & HF0)   ( 2   ^   4 ))
        bytEncode(lngEncodeLen  +   2 )  =  Base64EncodeTable((bytInText(i  +   1 )  And   & HF)  *  ( 2   ^   2 )  Or  (bytInText(i  +   2 )  And   & HC0)   ( 2   ^   6 ))
        bytEncode(lngEncodeLen  +   3 )  =  Base64EncodeTable(bytInText(i  +   2 )  And   & H3F)
        lngEncodeLen  =  lngEncodeLen  +   4
     Next
    
    i  =  lngInTextLen  -   1   +   1
     If  lngMod  =   1   Then    ' 对剩余字节进行填充
        bytEncode(lngEncodeLen)  =  Base64EncodeTable((bytInText(i)  And   & HFC)   ( 2   ^   2 ))
        bytEncode(lngEncodeLen  +   1 )  =  Base64EncodeTable((bytInText(i)  And   & H3)  *  ( 2   ^   4 ))
        bytEncode(lngEncodeLen  +   2 )  =  Base64EncodeTable( 64 )   ' 填充=
        bytEncode(lngEncodeLen  +   3 )  =  Base64EncodeTable( 64 )   ' 填充=
        lngEncodeLen  =  lngEncodeLen  +   4
     ElseIf  lngMod  =   2   Then
        bytEncode(lngEncodeLen)  =  Base64EncodeTable((bytInText(i)  And   & HFC)   ( 2   ^   2 ))
        bytEncode(lngEncodeLen  +   1 )  =  Base64EncodeTable((bytInText(i)  And   & H3)  *  ( 2   ^   4 )  Or  (bytInText(i  +   1 )  And   & HF0)   ( 2   ^   4 ))
        bytEncode(lngEncodeLen  +   2 )  =  Base64EncodeTable((bytInText(i  +   1 )  And   & HF)  *  ( 2   ^   2 ))
        bytEncode(lngEncodeLen  +   3 )  =  Base64EncodeTable( 64 )   ' 填充=
        lngEncodeLen  =  lngEncodeLen  +   4
     End   If

    Base64_Encode  =  bytEncode()
End Function

' Base64解码函数
Public   Function  Base64_Decode(bytInText()  As   Byte )  As   Byte ()
     Dim  Base64DecodeTable( 1   To   122 )  As   Byte
     Dim  lngInTextLen  As   Long , i  As   Long
     Dim  bytDecode()  As   Byte , lngDecodeLen  As   Long
    
    Base64_Decode  =   Chr ( 0 )   ' 初始化函数返回值
    
     If   LBound (bytInText)  <>   0   Then   Exit Function    ' bytInText数组下标不从零开始则出错返回
    
    lngInTextLen  =   UBound (bytInText)  -   LBound (bytInText)  +   1    ' 计算bytInText数组长度
     If  lngInTextLen  Mod   4   <>   0   Then   Exit Function    ' 输入编码不是4的倍数则出错返回
    
     For  i  =   1   To   122    ' 初始化Base64解码表
         Select   Case  i
         Case   43    ' +
            Base64DecodeTable(i)  =   62
         Case   47    ' /
            Base64DecodeTable(i)  =   63
         Case   48   To   57    ' 0 - 9
            Base64DecodeTable(i)  =   52   +  (i  -   48 )
         Case   65   To   90    ' A - Z
            Base64DecodeTable(i)  =   0   +  (i  -   65 )
         Case   97   To   122    ' a - z
            Base64DecodeTable(i)  =   26   +  (i  -   97 )
         Case   Else
            Base64DecodeTable(i)  =   255
         End   Select
     Next
    lngDecodeLen  =  lngInTextLen  /   4   *   3    ' 求解码后的最大长度
     ReDim  bytDecode( 0   To  lngDecodeLen  -   1 )   ' 重新定义解码缓冲区
     ' MsgBox "解码后的最大长度为：" & lngDecodeLen
    
    lngDecodeLen  =   0    ' 初始化解码长度
    
     For  i  =   0   To  lngInTextLen  -   1   Step   4
        bytDecode(lngDecodeLen)  =  (Base64DecodeTable(bytInText(i))  *  ( 2   ^   2 ))  Or  ((Base64DecodeTable(bytInText(i  +   1 ))  And   & H30)   ( 2   ^   4 ))
        bytDecode(lngDecodeLen  +   1 )  =  ((Base64DecodeTable(bytInText(i  +   1 ))  And   & HF)  *  ( 2   ^   4 ))  Or  ((Base64DecodeTable(bytInText(i  +   2 ))  And   & H3C)   ( 2   ^   2 ))
        bytDecode(lngDecodeLen  +   2 )  =  ((Base64DecodeTable(bytInText(i  +   2 ))  And   & H3)  *  ( 2   ^   6 ))  Or  Base64DecodeTable(bytInText(i  +   3 ))
        lngDecodeLen  =  lngDecodeLen  +   3
     Next
    
     If  bytInText(lngInTextLen  -   1 )  =   & H3D  Then    ' 判断最后两个字节的情况,求解码后的实际长度
         If  bytInText(lngInTextLen  -   2 )  =   & H3D  Then
            lngDecodeLen  =  lngDecodeLen  -   2    ' 最后两个字节为"="
         Else
            lngDecodeLen  =  lngDecodeLen  -   1    ' 最后一个字节为"="
         End   If
        bytDecode(lngDecodeLen)  =   0    ' 在实际长度的后一个字节放个结束符
     End   If
     ' MsgBox "解码后的实际长度为：" & lngDecodeLen
    
    Base64_Decode  =  bytDecode()
End Function

调用例子(frmMain.frm)： 

Option   Explicit
Private   Sub  cmdDecode_Click()
     Dim  bytInText()  As   Byte
     Dim  bytOutText()  As   Byte
    
    bytInText()  =  Text1.Text
    bytInText()  =   StrConv (bytInText(), vbFromUnicode)
    bytOutText()  =  Base64_Decode(bytInText())
    Open  " C:Base64解码后的字符.txt "   For  Binary  As  # 1
    Put # 1 , , bytOutText()
    Close # 1
     MsgBox   " ' "   &   StrConv (bytInText(), vbUnicode)  &   " '的Base64解码是： "   &  vbCrLf  &  vbCrLf  &   StrConv (bytOutText(), vbUnicode)
    Text2.Text  =   StrConv (bytOutText(), vbUnicode)
End Sub

Private   Sub  cmdEncode_Click()
     Dim  bytInText()  As   Byte
     Dim  bytOutText()  As   Byte

    bytInText()  =  Text1.Text
    bytInText()  =   StrConv (bytInText(), vbFromUnicode)
    
    bytOutText()  =  Base64_Encode(bytInText())
    
    Open  " C:Base64编码后的字符.txt "   For  Binary  As  # 1
    Put # 1 , , bytOutText()
    Close # 1
    
     MsgBox   " ' "   &   StrConv (bytInText(), vbUnicode)  &   " '的Base64编码是： "   &  vbCrLf  &  vbCrLf  &   StrConv (bytOutText(), vbUnicode)
    Text2.Text  =   StrConv (bytOutText(), vbUnicode)
End Sub