模块代码( 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
' 除以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
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