MS Access VBA 替换密码加密/解密

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/8537419/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 14:43:40  来源:igfitidea点击:

MS Access VBA Substitution Cipher Encrypt/Decrypt

ms-accessvbaencryptionaccess-vba

提问by Matt Donnan

Could anyone suggest please how I can achieve a substitution cipher style; encrypt and decrypt function in VBA. I appreciate hashing is considered the better way but I need reversible encryption. Many Thanks.

谁能建议我如何实现替换密码风格;VBA中的加密和解密功能。我很欣赏散列被认为是更好的方法,但我需要可逆加密。非常感谢。

采纳答案by Matt Donnan

Many thanks for all the answers provided in reference to my question, it's good to see there are different approaches, this is one I coded yesterday morning. It allows a different cipher keyword/phrase to be used for both Upper & Lowercase letters, I have used 'Zebras' in this example, it also runs a second pass with the ROT13 cipher. Encryption method:

非常感谢针对我的问题提供的所有答案,很高兴看到有不同的方法,这是我昨天早上编码的方法。它允许对大写和小写字母使用不同的密码关键字/短语,我在这个例子中使用了“斑马”,它还使用 ROT13 密码运行第二遍。加密方式:

Public Function Encrypt(strvalue As String) As String

Const LowerAlpha    As String = "abcdefghijklmnopqrstuvwxyz"
Const LowerSub      As String = "zebrascdfghijklmnopqtuvwxy" 'zebras
Const UpperAlpha    As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const UpperSub      As String = "ZEBRASCDFGHIJKLMNOPQTUVWXY" 'ZEBRAS

Dim lngi            As Long
Dim lngE            As Long
Dim strEncrypt      As String
Dim strLetter       As String

If strvalue & "" = "" Then Exit Function

For lngi = 1 To Len(strvalue)

    strLetter = Mid(strvalue, lngi, 1)

    Select Case Asc(strLetter)

        Case 65 To 90 'Uppercase
            'Find position in alpha string
            For lngE = 1 To Len(UpperAlpha)
                If Mid(UpperAlpha, lngE, 1) = strLetter Then GoTo USub
            Next
USub:
            strEncrypt = strEncrypt & Mid(UpperSub, lngE, 1)

        Case 97 To 122 'Lowercase
            'Find position in alpha string
            For lngE = 1 To Len(LowerAlpha)
                If Mid(LowerAlpha, lngE, 1) = strLetter Then GoTo LSub
            Next
LSub:
            strEncrypt = strEncrypt & Mid(LowerSub, lngE, 1)

        Case Else 'Do not substitute

            strEncrypt = strEncrypt & strLetter

    End Select

Next

'Now pass this string through ROT13 for another tier of security

For lngi = 1 To Len(strEncrypt)
    Encrypt = Encrypt & Chr(Asc(Mid(strEncrypt, lngi, 1)) + 13)
Next

End Function

And this is the Decryption that goes with it:

这是随之而来的解密:

Public Function Decrypt(strvalue As String) As String

Const LowerAlpha    As String = "abcdefghijklmnopqrstuvwxyz"
Const LowerSub      As String = "zebrascdfghijklmnopqtuvwxy" 'zebras
Const UpperAlpha    As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const UpperSub      As String = "ZEBRASCDFGHIJKLMNOPQTUVWXY" 'ZEBRAS

Dim lngi            As Long
Dim lngE            As Long
Dim strDecrypt      As String
Dim strLetter       As String

If strvalue & "" = "" Then Exit Function

'Reverse the ROT13 cipher

For lngi = 1 To Len(strvalue)
    strDecrypt = strDecrypt & Chr(Asc(Mid(strvalue, lngi, 1)) - 13)
Next

'Now reverse the encryption

For lngi = 1 To Len(strDecrypt)

    strLetter = Mid(strDecrypt, lngi, 1)

    Select Case Asc(strLetter)

        Case 65 To 90 'Uppercase
            'Find position in sub string
            For lngE = 1 To Len(UpperSub)
                If Mid(UpperSub, lngE, 1) = strLetter Then GoTo USub
            Next
USub:
            Decrypt = Decrypt & Mid(UpperAlpha, lngE, 1)

        Case 97 To 122 'Lowercase
            'Find position in sub string
            For lngE = 1 To Len(LowerSub)
                If Mid(LowerSub, lngE, 1) = strLetter Then GoTo LSub
            Next
LSub:
            Decrypt = Decrypt & Mid(LowerAlpha, lngE, 1)

        Case Else 'Do not substitute

            Decrypt = Decrypt & strLetter

    End Select

Next

End Function

I hope the coding is very simple to follow for those who do not have vast experience with VBA coding and it can be lifted straight from the page; but again thanks for all the other answers.

我希望编码对于那些没有丰富 VBA 编码经验的人来说非常简单,并且可以直接从页面中提取;但再次感谢所有其他答案。

回答by Robert Harvey

You can use Blowfish. There's a Visual Basic 6 version that will work in Access, available here:

您可以使用河豚。有一个可以在 Access 中使用的 Visual Basic 6 版本,可在此处获得:

http://www.di-mgt.com.au/cryptoBlowfishVer6.html

http://www.di-mgt.com.au/cryptoBlowfishVer6.html

You can also try TwoFish.

您也可以尝试TwoFish。

回答by Stephen Turner

There is a simple example hereor you can use the even simpler ROT13cipher.

这里有一个简单的例子或者您可以使用更简单的ROT13密码。

These are useful for obscuring a little text, but I'd not use them for anything that actually needs to be kept secure.

这些对于隐藏一些文本很有用,但我不会将它们用于任何实际需要保持安全的东西。