模块代码( m_Base64.bas):
Option Explicit
’’除以2的一次方是右移一位
’’乘以2的一次方是左移一位
’’(btyInText(i) And &HFC) (2 ^ 2)
’’第一个字节的内容And运算0xFC(11111100)(取左边6位)，再除以2的二次方(右移2位)
’’(btyInText(i) And &H3) * (2 ^ 4) Or (btyInText(i + 1) And &HF0) (2 ^ 4)
’’第一个字节的内容And运算0x03(00000011)(取右边2位)，再乘以2的四次方(左移4位)
’’第二个字节的内容And运算0xF0(11110000)(取左边4位)，再除以2的四次方(右移4位)
’’两个结果再Or运算
’’(btyInText(i + 1) And &HF) * (2 ^ 2) + (btyInText(i + 2) And &HC0) (2 ^ 6)
’’第二个字节的内容And运算0x0F(00001111)(取右边4位)，再乘以2的二次方(左移2位)
’’第三个字节的内容And运算0xC0(11000000)(取左边2位)，再除以2的六次方(右移6位)
’’两个结果再Or运算
’’btyInText(i + 2) And &H3F
’’第三个字节的内容And运算0x3F(00111111)(取右边6位)
’’Base64编码函数
Public Function Base64_Encode(btyInText() As Byte) As Byte()
Dim Base64EncodeTable() As Byte
Dim lngInTextLen As Long, lngMod As Long, i As Long
Dim btyEncode() As Byte, lngEncodeLen As Long
Base64_Encode = Chr(0) ’’初始化函数返回值
Base64EncodeTable() = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" ’’初始化Base64编码表
Base64EncodeTable() = StrConv(Base64EncodeTable(), vbFromUnicode) ’’转换为ANSI编码
If LBound(btyInText) <> 0 Then Exit Function ’’btyInText数组下标不从零开始则出错返回
lngInTextLen = UBound(btyInText) - LBound(btyInText) + 1 ’’计算btyInText数组长度
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 btyEncode(0 To lngEncodeLen - 1) ’’重新定义编码缓冲区
lngEncodeLen = 0 ’’初始化编码长度计数
For i = 0 To lngInTextLen - 1 Step 3
btyEncode(lngEncodeLen) = Base64EncodeTable((btyInText(i) And &HFC) (2 ^ 2))
btyEncode(lngEncodeLen + 1) = Base64EncodeTable((btyInText(i) And &H3) * (2 ^ 4) Or (btyInText(i + 1) And &HF0) (2 ^ 4))
btyEncode(lngEncodeLen + 2) = Base64EncodeTable((btyInText(i + 1) And &HF) * (2 ^ 2) Or (btyInText(i + 2) And &HC0) (2 ^ 6))
btyEncode(lngEncodeLen + 3) = Base64EncodeTable(btyInText(i + 2) And &H3F)
lngEncodeLen = lngEncodeLen + 4
Next
i = lngInTextLen - 1 + 1
If lngMod = 1 Then ’’对剩余字节进行填充
btyEncode(lngEncodeLen) = Base64EncodeTable((btyInText(i) And &HFC) (2 ^ 2))
btyEncode(lngEncodeLen + 1) = Base64EncodeTable((btyInText(i) And &H3) * (2 ^ 4))
btyEncode(lngEncodeLen + 2) = Base64EncodeTable(64) ’’填充=
btyEncode(lngEncodeLen + 3) = Base64EncodeTable(64) ’’填充=
lngEncodeLen = lngEncodeLen + 4
ElseIf lngMod = 2 Then
btyEncode(lngEncodeLen) = Base64EncodeTable((btyInText(i) And &HFC) (2 ^ 2))
btyEncode(lngEncodeLen + 1) = Base64EncodeTable((btyInText(i) And &H3) * (2 ^ 4) Or (btyInText(i + 1) And &HF0) (2 ^ 4))
btyEncode(lngEncodeLen + 2) = Base64EncodeTable((btyInText(i + 1) And &HF) * (2 ^ 2))
btyEncode(lngEncodeLen + 3) = Base64EncodeTable(64) ’’填充=
lngEncodeLen = lngEncodeLen + 4
End If
Base64_Encode = btyEncode()
End Function
’’Base64解码函数
Public Function Base64_Decode(btyInText() As Byte) As Byte()
Dim Base64DecodeTable(1 To 122) As Byte
Dim lngInTextLen As Long, i As Long
Dim btyDecode() As Byte, lngDecodeLen As Long
Base64_Decode = Chr(0) ’’初始化函数返回值
责任编辑：小草
