This function is based off the other encryption I wrote on this forum, but with a lot of differences. It doesn't use any random (and because of this is much faster) and uses a password instead of a "seed". The main difference however is the output, it's very cheeky because it doesn't even bother to obscure it!
It only changes three groups of characters 0-9, a-z and A-Z and these are wrapped locally too (so numbers stay as numbers, no loss of capitalisation etc) and everything else is untouched, which is ideal for encrypting script or text with line-breaks. This may seem very risky and unsecure, but it works really well....almost like it encodes your text to another language, in a way. This makes it hard for any brute force attempt as the output errors can sometimes have "cadence" (if you are scanning for real words) For example:-
"cool" encoded with the password "3129" outputs "crap" (it really does too)
"crap" decoded with the password "3129" outputs "cool", however..
"crap" encoded with the password "3129" outputs erm.... nearly something else *coughs*
And who's to say which one I was using?
Anyway, like the previous version this one can also encrypt words like "aaaaaaaa" and its output looks like any other encoded word.
Here's the compact VBS version:-
Function GoadEncode (strText, strPassword, intEncDec)
Dim bytASC, intPassAdd, intTextPos, intPassPos
If Len(strPassword) < 2 Then GoadEncode = "Password too short!" : Exit Function
intPassPos = Int(Len(strPassword)/2)
For intTextPos = 1 To Len(strText)
bytASC = Asc(Mid(strText, intTextPos))
intPassAdd = Asc(Mid(strPassword, intPassPos)) + intTextPos + intPassPos
Select Case True
Case bytASC > 47 And bytASC < 58
bytASC = bytASC + (intPassAdd Mod 10) * intEncDec
If bytASC > 57 Then
bytASC = 48 + (bytASC - 58)
ElseIf bytASC < 48 Then
bytASC = 57 - (47 - bytASC)
End If
Case bytASC > 64 And bytASC < 91
bytASC = bytASC + (intPassAdd Mod 26) * intEncDec
If bytASC > 90 Then
bytASC = 65 + (bytASC - 91)
ElseIf bytASC < 65 Then
bytASC = 90 - (64 - bytASC)
End If
Case bytASC > 96 And bytASC < 123
bytASC = bytASC + (intPassAdd Mod 26) * intEncDec
If bytASC > 122 Then
bytASC = 97 + (bytASC - 123)
ElseIf bytASC < 97 Then
bytASC = 122 - (96 - bytASC)
End If
End Select
GoadEncode = GoadEncode & Chr(bytASC)
intPassPos = intPassPos + 1
If intPassPos > Len(strPassword) Then intPassPos = 1
Next
End Function
And here's the HTA I used to write it with full comments. You can slightly alter the password and click decode to see the "error" output:-
<HTML><HEAD><TITLE>!</TITLE>
<HTA:APPLICATION MAXIMIZEBUTTON="No" MINIMIZEBUTTON="No" INNERBORDER="No" BORDER="Thin"
SCROLL="No" ICON="Notepad.exe"/>
<STYLE TYPE="text/css">
.styText {Font-Family:Lucida Console;Font-Size:15; Width:710;}
</STYLE>
</HEAD>
<BODY SCROLL="No" STYLE="Margin:3;BackGround-Color:ButtonFace;Font-Family:Arial;Font-Size:12;">
Password<br>
<INPUT ID="txtPassword" TYPE="TEXT" VALUE="Open" /><br><HR>
Text to encode<br>
<INPUT ID="txtToEncode" TYPE="TEXT" class="styText"/>
<INPUT TYPE="button" ID="cmdEncode" VALUE="Encode" /><br>
Encoded text<br>
<INPUT ID="txtEncoded" TYPE="TEXT" class="styText"/>
<INPUT TYPE="button" ID="cmdDecode" VALUE="Decode" /><br>
Decoded text<br>
<INPUT ID="txtDecodedEncode" TYPE="TEXT" class="styText" STYLE="BackGround-Color:ButtonFace"
READONLY=1/><br>
<SCRIPT LANGUAGE="VBScript">
Option Explicit
'------------------------------ HTA demo -------------------------------
Self.ResizeTo 800,210
'---- Title is encoded with password "Open"
Document.Title = GoadEncode("RqnjTttywo - Px Bddj Xvnm 3845", "Open", -1)
'---- Debug, show only changeable chars
'txtToEncode.Value = "0123456789 ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
'---- Encode button click
Sub cmdEncode_OnClick()
txtEncoded.value = GoadEncode(txtToEncode.Value, txtPassword.Value, 1)
txtDecodedEncode.value = ""
End Sub
'---- Decode button click
Sub cmdDecode_OnClick()
txtDecodedEncode.value = GoadEncode(txtEncoded.Value, txtPassword.Value, -1)
End Sub
'-------------------------------- VBS function ---------------------------------
'strText = Text you want to encode\decode
'strPassword = The password, can use any character and be any size (but has to be bigger than 1 char)
'intEncDec = 1 to encode or -1 to decode
Function GoadEncode (strText, strPassword, intEncDec)
Dim bytASC, intPassAdd, intTextPos, intPassPos
If Len(strPassword) < 2 Then GoadEncode = "Password too short!" : Exit Function
'---- Start password scan in the middle.
intPassPos = Int(Len(strPassword)/2)
'---- Scan text
For intTextPos = 1 To Len(strText)
'---- Get ASCII of text char
bytASC = Asc(Mid(strText, intTextPos))
'---- Get ASCII of password char (add both indexes for an offset)
intPassAdd = Asc(Mid(strPassword, intPassPos)) + intTextPos + intPassPos
'---- Now shift 3 groups of chars up or down using intPassAdd, but stay within
'their limited boundaries (10,26,26)
Select Case True
'---- Char 0-9
Case bytASC > 47 And bytASC < 58
'---- Add intPassAdd, but shortened to 0-9 range. (and times by intEncDec to encode\decode)
bytASC = bytASC + (intPassAdd Mod 10) * intEncDec
'---- Wrap character with carry
If bytASC > 57 Then
bytASC = 48 + (bytASC - 58)
ElseIf bytASC < 48 Then
bytASC = 57 - (47 - bytASC)
End If
'---- Char A-Z (same as above but with different boundaries)
Case bytASC > 64 And bytASC < 91
bytASC = bytASC + (intPassAdd Mod 26) * intEncDec
If bytASC > 90 Then
bytASC = 65 + (bytASC - 91)
ElseIf bytASC < 65 Then
bytASC = 90 - (64 - bytASC)
End If
'---- Char a-z
Case bytASC > 96 And bytASC < 123
bytASC = bytASC + (intPassAdd Mod 26) * intEncDec
If bytASC > 122 Then
bytASC = 97 + (bytASC - 123)
ElseIf bytASC < 97 Then
bytASC = 122 - (96 - bytASC)
End If
End Select
'---- Build output string
GoadEncode = GoadEncode & Chr(bytASC)
'---- Next position in password with wrap around
intPassPos = intPassPos + 1
If intPassPos > Len(strPassword) Then intPassPos = 1
Next
End Function
</SCRIPT>
</BODY>
</HTML> Have fun!