ACCESS 混淆加密解密

2024-08-25更新

' 引用 Microsoft XML, v6.0 库
' 在 VBA 编辑器中，选择 工具 -> 引用 -> 勾选 Microsoft XML, v6.0

' 加密函数：将密码明文编码为 Base64 格式
Function EncodeBase64(plainText As String) As String
    Dim xml As Object
    Dim byteArray() As Byte
    Dim base64String As String

    ' 创建 XML 对象
    Set xml = CreateObject("MSXML2.DOMDocument.6.0")

    ' 将明文转换为字节数组
    byteArray = StrConv(plainText, vbFromUnicode)

    ' 使用 XML 对象的 Base64 编码功能
    xml.LoadXML "<root />"
    xml.DocumentElement.DataType = "bin.base64"
    xml.DocumentElement.NodeTypedValue = byteArray
    base64String = xml.DocumentElement.text

    ' 清理对象
    Set xml = Nothing

    ' 返回 Base64 编码后的字符串
    EncodeBase64 = base64String
End Function

' 解密函数：将 Base64 格式的密码解码为明文
Function DecodeBase64(base64String As String) As String
    Dim xml As Object
    Dim byteArray() As Byte
    Dim plainText As String

    ' 创建 XML 对象
    Set xml = CreateObject("MSXML2.DOMDocument.6.0")

    ' 使用 XML 对象的 Base64 解码功能
    xml.LoadXML "<root />"
    xml.DocumentElement.DataType = "bin.base64"
    xml.DocumentElement.text = base64String
    byteArray = xml.DocumentElement.NodeTypedValue

    ' 将字节数组转换回明文
    plainText = StrConv(byteArray, vbUnicode)

    ' 清理对象
    Set xml = Nothing

    ' 返回解码后的明文
    DecodeBase64 = plainText
End Function

'混淆PW与KEY,这里混淆的效果,你可以想象成十指交叉.这里你可以写自己想要的效果.Key的意义只在于混淆,至于怎么混淆,混淆到什么程序,全凭你想象与能力
Function ObfuscatedCode(PW As String, KEY As String) As String
    Dim result As String
    Dim i As Integer
    Dim keyLength As Integer
    Dim pwLength As Integer
    Dim insertPos As Integer
    
    ' 获取 KEY 的长度
    keyLength = Len(KEY)
    
    ' 获取 PW 的长度
    pwLength = Len(PW)
    
    ' 如果 KEY 的长度是偶数，从 PW 的第二位后面开始交叉
    ' 如果 KEY 的长度是奇数，从 PW 的第一位后面开始交叉
    If keyLength Mod 2 = 0 Then
        insertPos = 2
    Else
        insertPos = 1
    End If
    
    ' 初始化结果字符串
    result = PW
    
    ' 遍历 KEY 中的每个字符
    For i = 1 To keyLength
        ' 插入 KEY 的字符到指定位置
        result = Left(result, insertPos) & Mid(KEY, i, 1) & Mid(result, insertPos + 1)
        ' 更新插入位置
        insertPos = insertPos + 2
        ' 确保插入位置不会超过当前结果字符串的长度
        If insertPos > Len(result) + 1 Then
            insertPos = Len(result) + 1
        End If
    Next i
    
    ' 返回最终的结果
    ObfuscatedCode = result
End Function

'最终调用的加密函数
'加密
Function Encode(ByVal PW As String, KEY As String) As String
    Dim M As String
    For i = 0 To 7
        PW = EncodeBase64(PW)
        Debug.Print "第一轮 " & i & " > " & PW
    Next
    M = ObfuscatedCode(PW, KEY)
    Debug.Print "+key > " & M
    For i = 0 To 4
        M = EncodeBase64(M)
        Debug.Print "第二轮 " & i & " > " & M
    Next
    Encode = M
End Function

效果:

 

-------------------------解密部分---------------------------------------------------

 

'分离出PW
Function ExtractPW(CombinedStr As String, Key As String) As String
    Dim PW As String
    Dim i As Integer
    Dim KeyLength As Integer
    Dim insertPos As Integer
    CombinedStr = Replace(CombinedStr, vbNewLine, "")
    ' 获取 KEY 的长度
    KeyLength = Len(Key)
    
    ' 根据 KEY 的长度确定插入位置
    If KeyLength Mod 2 = 0 Then
        insertPos = 2
    Else
        insertPos = 1
    End If
    
    ' 只需提取PW
    PW = Left(CombinedStr, insertPos)
    For i = 1 To KeyLength - 1
        insertPos = insertPos + 2
        PW = PW & Mid(CombinedStr, insertPos, 1)
    Next i
    PW = PW & Mid(CombinedStr, insertPos + 2)
    ' 返回PW
    ExtractPW = PW
End Function

最后调用的函数为:

'解密
Function Decode(ByVal PW As String, Key As String) As String
    Dim M As String
    For i = 0 To 4
        PW = DecodeBase64(PW)
    Next
    M = ExtractPW(PW, Key)
    For i = 0 To 7
        M = DecodeBase64(M)
    Next
    Decode = M
End Function