的MS Access VBA代换密码加密/解密 [英] MS Access VBA Substitution Cipher Encrypt/Decrypt

问题描述

任何人都可以提出请我如何能实现替代密码的风格;加密和解密功能的VBA。我AP preciate散列被认为是更好的办法，但我需要可逆加密。非常感谢。

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.

推荐答案

非常感谢所有给我的问题提供了参考答案，这是很好的看到有不同的做法，这是一个我codeD昨天上午。它允许同时用于上和安培一个不同的密码关键字/短语;小写字母，我已经在这个实施例中使用斑马，它也运行一个第二遍用ROT13密码。加密方式：

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:

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

我希望编码是非常简单的遵循这些谁没有丰富的经验与VBA代码，它可以直接从该页面被取消;但再次感谢所有的答案。

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.

这篇关于的MS Access VBA代换密码加密/解密的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！