If LBound(btyInText) <> 0 Then Exit Function ’’btyInText数组下标不从零开始则出错返回
lngInTextLen = UBound(btyInText) - LBound(btyInText) + 1 ’’计算btyInText数组长度
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 btyDecode(0 To lngDecodeLen - 1) ’’重新定义解码缓冲区
’’MsgBox "解码后的最大长度为：" & lngDecodeLen
lngDecodeLen = 0 ’’初始化解码长度
For i = 0 To lngInTextLen - 1 Step 4
btyDecode(lngDecodeLen) = (Base64DecodeTable(btyInText(i)) * (2 ^ 2)) Or ((Base64DecodeTable(btyInText(i + 1)) And &H30) (2 ^ 4))
btyDecode(lngDecodeLen + 1) = ((Base64DecodeTable(btyInText(i + 1)) And &HF) * (2 ^ 4)) Or ((Base64DecodeTable(btyInText(i + 2)) And &H3C) (2 ^ 2))
btyDecode(lngDecodeLen + 2) = ((Base64DecodeTable(btyInText(i + 2)) And &H3) * (2 ^ 6)) Or Base64DecodeTable(btyInText(i + 3))
lngDecodeLen = lngDecodeLen + 3
Next
If btyInText(lngInTextLen - 1) = &H3D Then ’’判断最后两个字节的情况,求解码后的实际长度
If btyInText(lngInTextLen - 2) = &H3D Then
lngDecodeLen = lngDecodeLen - 2 ’’最后两个字节为"="
Else
lngDecodeLen = lngDecodeLen - 1 ’’最后一个字节为"="
End If
btyDecode(lngDecodeLen) = 0 ’’在实际长度的后一个字节放个结束符
End If
’’MsgBox "解码后的实际长度为：" & lngDecodeLen
Base64_Decode = btyDecode()
End Function
调用例子(frmMain.frm)：
Option Explicit
Private Sub cmdDecode_Click() ’’解码按钮
Dim btyInText() As Byte
Dim btyOutText() As Byte
btyInText() = Text1.Text ’’输入文本框
btyInText() = StrConv(btyInText(), vbFromUnicode)
btyOutText() = Base64_Decode(btyInText())
Open "C:Base64解码后的字符.txt" For Binary As #1
Put #1, , btyOutText()
Close #1
MsgBox "’’" & StrConv(btyInText(), vbUnicode) & "’’的Base64解码是：" & vbCrLf & vbCrLf & StrConv(btyOutText(), vbUnicode)
Text2.Text = StrConv(btyOutText(), vbUnicode) ’’输出文本框
End Sub
Private Sub cmdEncode_Click() ’’编码按钮
Dim btyInText() As Byte
Dim btyOutText() As Byte
btyInText() = Text1.Text ’’输入文本框
btyInText() = StrConv(btyInText(), vbFromUnicode)
btyOutText() = Base64_Encode(btyInText())
Open "C:Base64编码后的字符.txt" For Binary As #1
Put #1, , btyOutText()
Close #1
MsgBox "’’" & StrConv(btyInText(), vbUnicode) & "’’的Base64编码是：" & vbCrLf & vbCrLf & StrConv(btyOutText(), vbUnicode)
Text2.Text = StrConv(btyOutText(), vbUnicode) ’’输出文本框
End Sub
上一页 [1] [2]
责任编辑：小草
