VB Base64 解码/解密函数:
Function Base64Uncode(B64 As String) As Byte() 'Base64 解码
On Error GoTo over '排错
Dim OutStr() As Byte, i As Long, j As Long
Const B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
If InStr(1, B64, "=") <> 0 Then B64 = Left(B64, InStr(1, B64, "=") - 1) '判断Base64真实长度,除去补位
Dim length As Long, mods As Long
mods = Len(B64) Mod 4
length = Len(B64) - mods
ReDim OutStr(length / 4 * 3 - 1 + Switch(mods = 2, 1, mods = 3, 2))
For i = 1 To length Step 4
Dim buf(3) As Byte
For j = 0 To 3
buf(j) = InStr(1, B64_CHAR_DICT, Mid(B64, i + j, 1)) - 1
Next
OutStr((i - 1) / 4 * 3) = buf(0) * &H4 + (buf(1) And &H30) / &H10
OutStr((i - 1) / 4 * 3 + 1) = (buf(1) And &HF) * &H10 + (buf(2) And &H3C) / &H4
OutStr((i - 1) / 4 * 3 + 2) = (buf(2) And &H3) * &H40 + buf(3)
Next
If mods = 2 Then
OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16
ElseIf mods = 3 Then
OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16
OutStr(length / 4 * 3 + 1) = ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &HF) * &H10 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 3, 1)) - 1) And &H3C) / &H4
End If
Base64Uncode = OutStr '读取解码结果
over:
End Function |