ACCESS 混淆加密解密

发布时间 2023-10-15 21:45:32作者: 一曲轻扬

考虑到这样一个场景,程序只给用户使用到一定期限,如果用户没有新的KEY,将不能再使用程序.所以才有了下面这个想法.考虑不到位的地方,希望大家指正

一.数据表内有两个字段,A存储着过期日期,B字段存储着用户登陆日期,这里要重点说一下,如果用户打开程序时,电脑上的日期大于B字段的日期,则更新B字段;如果小于B字段的值,则不更新,这主要是防止用户把日期调到公元前.

二.如果程序启动时没有检测到这两个值,则直接关闭程序.

三.禁止shift键启动.这个我之前有写过 ACCESS 禁止用户使用SHIFT启动数据库 - 一曲轻扬 - 博客园 (cnblogs.com)

四.混淆AB两个字段的值,这节只讲这个主题,我给个简单的算法,大家可以再开发

混淆日期:

Public Function EncryptDate(ByVal dateStr As String) As String
    Dim result As String
    Dim key As String
    Dim i As Integer
    
    ' 定义密钥,自己定义,还原时,还要用到这个key
    key = "MySecretKey"
    
    ' 遍历日期字符串的每个字符,对其进行异或操作
    For i = 1 To Len(dateStr)
        result = result & Chr(Asc(Mid(dateStr, i, 1)) Xor Asc(Mid(key, (i Mod Len(key)) + 1, 1)))
    Next i
    
    ' 返回混淆后的字符串
    EncryptDate = RandomizeDigits(result)
End Function
Public Function RandomizeDigits(ByVal inputStr As String) As String
    Dim result As String
    Dim i As Integer
    
    ' 定义数字字符集
    Dim digits As String
    digits = "0123456789"
    
    ' 混淆字符串,将随机数字插入到每个字符之间
    For i = 1 To Len(inputStr)
        result = result & Mid(inputStr, i, 1) & Mid(digits, Int((Len(digits) * Rnd) + 1), 1)
    Next i
    
    ' 如果结果的长度小于32,则继续添加随机数字,直到达到32位长度
    Do While Len(result) < 32
        result = result & Mid(digits, Int((Len(digits) * Rnd) + 1), 1)
    Loop
    
    ' 返回长度为32的结果字符串
    RandomizeDigits = Left(result, 32)
End Function

上面的EncryptDate 函数,把一个字符串的日期,混淆成下面这个样子,可以看出来,还是很容易被人看出破绽的:

?EncryptDate("2023-10-15")
KcWP_TDfTL

所以我们还要再用 RandomizeDigits 函数包装一下,加入随机数字,结果大概是这个样子:

?EncryptDate("2023-10-15")
K7c5W5P2_3T7D0f7T8L7048739809357

以上就是加密混淆的过程,知道了方法,还原起来就会变得很简单了:

Public Function DecryptDate(ByVal encryptedStr As String) As String
    Dim result As String
    Dim key As String
    Dim i As Integer
    encryptedStr = RemoveDigitsRegex(encryptedStr)
    ' 定义密钥,自己定义吧
    key = "MySecretKey"
    
    ' 遍历混淆后的字符串的每个字符,对其进行异或操作,这里可以是其他算法
    For i = 1 To Len(encryptedStr)
        result = result & Chr(Asc(Mid(encryptedStr, i, 1)) Xor Asc(Mid(key, (i Mod Len(key)) + 1, 1)))
    Next i
    
    ' 返回还原后的日期字符串
    DecryptDate = result
End Function
Public Function RemoveDigitsRegex(ByVal inputStr As String) As String
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    
    regex.Pattern = "\d+" ' 匹配数字
    regex.Global = True     '全部替换
    RemoveDigitsRegex = regex.Replace(inputStr, "")
End Function
在运行 DecryptDate 时,要先把参数中的数字全部清除掉,剩下的就是真正的密文了,按照来时的路,很快就能解出正确的日期
?EncryptDate("2023-10-15")
K7c5W5P2_3T7D0f7T8L7048739809357
?DecryptDate("K7c5W5P2_3T7D0f7T8L7048739809357")
2023-10-15

五.当用户的KEY到期后,会弹出一个输入框,只有正确的KEY才能被存储到数据库,然后等待下一个周期.(略)

以上就是本节的所有内容.