base64编码 vba_Base64 编码/加密函数/解密函数

最新推荐文章于 2026-06-23 09:16:07 发布

原创最新推荐文章于 2026-06-23 09:16:07 发布 · 408 阅读

本内容遵循CC 4.0 BY-SA版权协议

本文提供了两个VBA函数，用于Base64的编码和解码操作。Base64Encode函数将字符串转换为Base64编码，而Base64Decode函数则完成解码过程。通过内置的错误处理和特定的字符映射，这两个函数能够有效地处理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

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)

over:

End Function

'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 '根据字符的位置取得索引值

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)

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

有帮助的多给鲜花，谢谢大家了。

标签

#base64编码 vba