Encript a string

Experts,

I need a function or procedure that will encrypt an alpha numeric string.  Nothing complex, just a mapping (or something) that changes the string to something you couldn't make sense of and then back again.  I am not fussed about security of access, just security of interpretation.  Something like a mapping where A =Code1 and B=code2 C= code3.

I figure, someone would have done this before.

Code snippets or links are all I need.
Carl SudholzManaging DirectorAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
GrahamSkanConnect With a Mentor RetiredCommented:
Or you could use XOR.

Sub Encode_1()
Dim strNewText As String
Dim i As Integer

Const strSample = "Hello World"

For i = 1 To Len(strSample)
    strNewText = strNewText & Chr$(Asc(Mid(strSample, i, 1)) Xor 170)
Next i
MsgBox strNewText
MsgBox Decode_1(strNewText)
End Sub

Function Decode_1(strEncoded As String)
    Dim strDecoded As String
    Dim i As Integer
    
    For i = 1 To Len(strEncoded)
        strDecoded = strDecoded & Chr$(Asc(Mid(strEncoded, i, 1)) Xor 170)
    Next i
    Decode_1 = strDecoded
End Function

Open in new window

0
 
GrahamSkanConnect With a Mentor RetiredCommented:
You could simply shift the ASCII code by one
Sub Encode()
Dim strNewText As String
Dim i As Integer

Const strSample = "Hello World"

For i = 1 To Len(strSample)
    strNewText = strNewText & Chr$(Asc(Mid(strSample, i, 1)) + 1)
Next i
MsgBox strNewText
MsgBox Decode(strNewText)
End Sub

Function Decode(strEncoded As String)
    Dim strDecoded As String
    Dim i As Integer
    
    For i = 1 To Len(strEncoded)
        strDecoded = strDecoded & Chr$(Asc(Mid(strEncoded, i, 1)) - 1)
    Next i
    Decode = strDecoded
End Function

Open in new window

0
 
devlab2012Connect With a Mentor Commented:
Create a new module with the following code:

Option Compare Database
Option Explicit

Public Function Encrypt(str As String) As String
    Encrypt = ""
    Dim s1 As String
    s1 = ""
    Dim i As Integer
    i = 0
    For i = 1 To Len(str)
        s1 = Mid(str, i, 1)
        s1 = Right("000" & CStr(Asc(s1)), 3)
        Encrypt = Encrypt & s1
    Next
End Function

Public Function Decrypt(str As String) As String
    Decrypt = ""
    Dim s1 As String
    Dim code As Integer
    s1 = ""
    Dim i As Integer
    i = 0
    For i = 1 To Len(str) Step 3
        code = CInt(Mid(str, i, 3))
        s1 = Chr(code)
        Decrypt = Decrypt & s1
    Next
End Function


Run the following queries to test it:

select Encrypt('devlab2012')
select Decrypt('100101118108097098050048049050')
select Decrypt(Encrypt('devlab2012'))
0
 
Carl SudholzManaging DirectorAuthor Commented:
Absolutely perfect!

I love experts exchange
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.