This single function will encrypt and decrypt a string using a key. It uses seeded random so there's 2147483647 combinations for the key value (pretty low level). However you can encrypt an already encrypted string multiple times making it even stronger and impossible to crack unless you know the seed number sequence.
I also made it skip quotes in the input and output so you can paste encrypted strings into scripts. This was a bit of a pain as space is char 32 (and is needed) but quotes are char 34. To get around this I swap it with the tilde (char 126), which you can't use in your string, sorry!
As for the output, try scrambling a string like:- aaaaaaaaaaaaa (looks like any other encrypted word)
'------------------------------- Scramble -------------------------------'
' strText = String to encrypt\decrypt '
' lngSeed = Long number for the random seed (key) '
' Returns a string '
' To Encrypt:- Send the plain text with a positive seed number (1-2147483647)'
' To Decrypt:- Send the encrypted text with the same number but negative '
Function Scramble (strText, lngSeed)
Dim L,intRand,bytASC
Rnd(-1) : Randomize ABS(lngSeed)
For L = 1 To Len(strText)
bytASC=Asc(Mid(strText, L))
If bytASC=126 then bytASC=34
intRand = bytASC + ((Int(Rnd(1) * 160) - 80) * SGN(lngSeed))
If intRand <= 31 Then
intRand = 125 - (31 - intRand)
ElseIf intRand >= 126 Then
intRand = 32 + (intRand - 126)
End If
If intRand=34 then intRand=126
Scramble = Scramble & Chr(intRand)
Next
End Function
Here's the test app I used to write it (with comments).....Just save it as "Whatever.HTA"
<HTML><HEAD><HTA:APPLICATION /></HEAD>
<BODY SCROLL="no" STYLE="font-size:16;margin:0px" BGCOLOR="buttonface">
Seed (1 to 2147483647)<br><INPUT ID="Text4" TYPE="TEXT" SIZE=16 VALUE="1"/><br>
Text to encrypt<br><INPUT ID="Text1" TYPE="TEXT" SIZE="88" STYLE="Font-Family:Courier new" />
<INPUT TYPE="button" ID="Button1" VALUE="Encode" /><br>
Encrypted text<br><INPUT ID="Text2" TYPE="TEXT" SIZE="88" STYLE="Font-Family:Courier new"/>
<INPUT TYPE="button" ID="Button2" VALUE="Decode" /><br>
Decrypted text<br><INPUT ID="Text3" TYPE="TEXT" SIZE="88" STYLE="Font-Family:Courier new"/><br>
</BODY>
<SCRIPT LANGUAGE="VBScript">
Self.ResizeTo 800,220
Text3.ReadOnly = true
'---- Encrypted HTA title ----'
Document.Title = Scramble ("pO25|YBG.C7]Sz~gO% ZwyHeIZne|ayWTM~b9IsG",-2010)
'---- Test encrypt button ----'
Sub Button1_OnClick()
Text2.value = Scramble (Text1.value, Text4.value)
Text3.value = ""
End Sub
'---- Test decrypt button ----'
Sub Button2_OnClick()
Text3.value = Scramble (Text2.value, -Text4.value)
End Sub
'---- Scramble ----'
Function Scramble (strText, lngSeed)
Dim L,intRand,bytASC
'---- Force seeded random mode
Rnd(-1)
'---- Set (positive) seed
Randomize ABS(lngSeed)
'---- Scan through string
For L = 1 To Len(strText)
'---- Get ASC of char
bytASC=Asc(Mid(strText, L))
'---- Fix for quotes (tilde to quote)
If bytASC=126 then bytASC=34
'---- Add a random value from -80 to 80, encode\decode is decided by the seed's sign
intRand = bytASC + ((Int(Rnd(1) * 160) - 80) * SGN(lngSeed))
'---- Cycle char between 32 and 125 (with carry)
If intRand <= 31 Then
intRand = 125 - (31 - intRand)
ElseIf intRand >= 126 Then
intRand = 32 + (intRand - 126)
End If
'---- Fix for quotes (quote to tilde)
If intRand=34 then intRand=126
'---- Output string
Scramble = Scramble & Chr(intRand)
Next
End Function
</SCRIPT>
</HTML>