基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：813200300

本次赞助数额为： 2 元　

支付宝支付

微信支付

   源码介绍

---

本实例提供了Excel VBA 加密解密函数

'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