Solved

How can I encrypt/decrypt a variable

Posted on 2016-09-28
2
47 Views
Last Modified: 2016-09-28
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.
0
Comment
Question by:CRB1609
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 7

Accepted Solution

by:
D Patel earned 500 total points
ID: 41821143
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
 

Author Closing Comment

by:CRB1609
ID: 41821174
Perfect!  Thank you very much.
1

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

635 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question