Encrypting info in registry

[Tomexx]

Hi,
I'm thinking about encrypting program info in the registry such as expiry date, days run etc. I know how to read/write to and from the registry.
Can anyone help me with the ENCRYPTION part?

Thanks.

[zuperman]

Option Explicit
'you will need to write a little errHandler for this
'as if you try to delete what isn't there you will get
'an error.
'to encrypt a string

Public Function Encrypt(Text As String, Password As String)

On Error Resume Next

Dim X As Long
Dim Y As Long
Dim CurChar As Byte
Dim CurChar1 As Byte
Dim CurChar2 As Byte
Dim EncText As String
Dim UnEncText As String
Dim CodeLoop As Integer
Dim Code As Byte
Dim LoopVar As Byte
Dim FirstLetter As Byte

UnEncText = Text & Password

LoopVar = 1
Do While LoopVar <> Len(Password) + 1
CodeLoop = CodeLoop + Asc(Mid(Password, LoopVar, 1))
LoopVar = LoopVar + 1
Loop
Code = Int((CodeLoop / LoopVar / 2)) - 1
FirstLetter = Int(Asc(Mid(Password, 1, 1)) / 2) - 1
X = 0
Y = Len(UnEncText)
Do While X < Y
X = X + 1
CurChar = Asc(Mid(UnEncText, X, 1))
CurChar1 = Int(CurChar / 2) + FirstLetter
CurChar2 = Int(CurChar / 2) + Code

If CurChar1 - FirstLetter + CurChar2 - Code <> CurChar Then CurChar2 = CurChar2 + 1
EncText = Chr(CurChar1) & Chr(CurChar2) & EncText
Loop
Encrypt = EncText
End Function

Public Function Decrypt(Text As String, Password As String)
On Error Resume Next
Dim X As Long
Dim Y As Long
Dim CurChar As Byte
Dim EncText As String
Dim CodeLoop As Integer
Dim Code As Byte
Dim LoopVar As Byte
Dim FirstLetter As Byte
LoopVar = 1

Do While LoopVar <> Len(Password) + 1
CodeLoop = CodeLoop + Asc(Mid(Password, LoopVar, 1))
LoopVar = LoopVar + 1
Loop

Code = Int((CodeLoop / LoopVar / 2)) - 1
FirstLetter = Int(Asc(Mid(Password, 1, 1)) / 2) - 1
X = 0
Y = Len(Text)

Do While X < Y
X = X + 2
CurChar = Asc(Mid(Text, X - 1, 1)) + Asc(Mid(Text, X, 1)) - Code - FirstLetter
EncText = Chr(CurChar) & EncText
Loop

If Len(EncText) = 0 Then
Decrypt = ""
Else
If Len(Password) > Len(EncText) Then
Decrypt = "Wrong password."
Else
If Password = Mid(EncText, Len(EncText) - Len(Password) + 1) Then
Decrypt = Mid(EncText, 1, Len(EncText) - Len(Password))
Else
Decrypt = "Wrong password."
End If
End If
End If
End Function

Private Sub Command2_Click()
'this will delete it from the register if you are finished
'with playing with it
DeleteSetting "project1", "TextboxValue"

End Sub

Private Sub Form_Load()
'this will load it into the register
Text1.Text = GetSetting("project1", "TextboxValue", "Value", 0)
'if you want to decode it you do this right behind it
Text1.Text = Decrypt(Text1.Text, "*.%jl;")
End Sub


Private Sub Form_Unload(Cancel As Integer)
'this will save it into the register when you quit
SaveSetting "project1", "TextboxValue", "Value", Text1.Text
End Sub


Private Sub Command1_Click()
'encrypt whatever text is in text1
Text1.Text = Encrypt(Text1.Text, "*.%jl;")
End Sub

[PsyVision]

On planet-source-code.com the other day i saw a nice encryption that turned the text to numbers and encrypted it. very nice.

[howkensea]

Although I am somewhat new to VB, I have written a program
that will encrypt values to the registry under the current user. It has a start key, so you will need to store that as
well so that when it is decrypted, it will be correct.
One of the good things about this code, is that I discovered
that there were occaisions where it would create a null value for one of the characters and that was bad!! So this code goes through and if any of the values are null, it increments the key by a value that you can set yourself, and then starts over to encrypt. You can adapt it to fit what you need. If you are interested, I can post the code.

Basically, all you need to do is encrypt text using some encryption method (as PsyVision mentioned, you can find them at http://www.planet-source-code.com) and then save them to the registry like you normally would.