banner
李大仁博客

李大仁博客

天地虽大,但有一念向善,心存良知,虽凡夫俗子,皆可为圣贤。

[VBA]Base64编码和Base64解码

VBA 实现 Base64 编码和 Base64 解码,用于处理加密的 URL 非常方便。

VBA Base64 编码 / 加密函数:

'VBA Base64 编码 / 加密函数:
Function Base64Encode (StrA As String) As String 'Base64 编码
On Error GoTo over ' 排错
Dim buf() As Byte, length As Long, mods As Long
Dim Str() As Byte
Dim i, kk As Integer
kk = Len(StrA) - 1
ReDim Str(kk)
For i = 0 To kk
Str(i) = Asc(Mid(StrA, i + 1, 1))
Next i
Const B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
mods = (UBound (Str) + 1) Mod 3 ' 除以 3 的余数
length = UBound(Str) + 1 - mods
ReDim buf(length / 3 * 4 + IIf(mods <> 0, 4, 0) - 1)
For i = 0 To length - 1 Step 3
buf(i / 3 * 4) = (Str(i) And &HFC) / &H4
buf(i / 3 * 4 + 1) = (Str(i) And &H3) * &H10 + (Str(i + 1) And &HF0) / &H10
buf(i / 3 * 4 + 2) = (Str(i + 1) And &HF) * &H4 + (Str(i + 2) And &HC0) / &H40
buf(i / 3 * 4 + 3) = Str(i + 2) And &H3F
Next
If mods = 1 Then
buf(length / 3 * 4) = (Str(length) And &HFC) / &H4
buf(length / 3 * 4 + 1) = (Str(length) And &H3) * &H10
buf(length / 3 * 4 + 2) = 64
buf(length / 3 * 4 + 3) = 64
ElseIf mods = 2 Then
buf(length / 3 * 4) = (Str(length) And &HFC) / &H4
buf(length / 3 * 4 + 1) = (Str(length) And &H3) * &H10 + (Str(length + 1) And &HF0) / &H10
buf(length / 3 * 4 + 2) = (Str(length + 1) And &HF) * &H4
buf(length / 3 * 4 + 3) = 64
End If
For i = 0 To UBound(buf)
Base64Encode = Base64Encode + Mid(B64_CHAR_DICT, buf(i) + 1, 1)
Next
over:
End Function

VBA Base64 解码 / 解密函数:

'VBA Base64 解码 / 解密函数:
Function Base64Decode (B64 As String) As String '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 kk, length As Long, mods As Long
mods = Len(B64) Mod 4
length = Len(B64) - mods
ReDim OutStr(length / 4 * 3 - 1 + Switch(mods = 0, 0, 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
For i = 0 To UBound(OutStr)
Base64Decode = Base64Decode & Chr(OutStr(i))
Next i ' 读取解码结果
over:
End Function

参考:http://club.excelhome.net/forum.php?mod=viewthread&tid=1239744&ordertype=1

加载中...
此文章数据所有权由区块链加密技术和智能合约保障仅归创作者所有。