Bootstrap

base64编码 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 解码/解密函数:

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

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

;