How can I encrypt/decrypt a variable

How can I encrypt a piece of text so that I can store it in the registry, retrieve it at some later date, and decrypt it back to the original value eg. a date or a user name?

Thanks in advance.
Clive BeatonAccess DeveloperAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

D PatelD Patel, Software EngineerCommented:
Encryption Code :
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

Open in new window


And Decryption Code :

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

Open in new window


Regards,
D Patel
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Clive BeatonAccess DeveloperAuthor Commented:
Perfect!  Thank you very much.
1
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.