The VBScript Network and Systems Administrator's Cafe

Dec 2 2008   12:55AM GMT

Very simple encryption example with VBScript

Jerry Lees Jerry Lees Profile: Jerry Lees

I previously mentioned a routine that I wrote to encrypt a string. Now, before the security folks look at the code… understand this:

This is intended only to obscure a string from a casual prying eye. It is NOT intended to be a replacement for true encryption like 3DES and RSA encryption. Please do NOT assume this routine is in any way secure or uncrackable. It is intended to only be an exercise in working with strings and is only as secure as the price you have paid for it. Nothing. 😉 Furthermore, it is provided as-is without warranties and by using it you agree that all risk from it’s use is transferred to you.

….Now that we’ve gotten the unpleasant legal disclaimer out of the way… Lets discuss the code!

Essentially, The code uses a variable length key to obscure the original string by iterating through the string you want obscured and adding the ASCII value of the character at each position of the original string with the ASCII value of a rotating “key character” in the key provided to generate a new ASCII value. This new ASCII value is then converted to a character and added to the newly encrypted string. The obscured string is further obscured by the fact that the original string is reversed prior to being changed. 

This key position changes after each character in the original string is obscured. The result is the key is iterated through sequentially as the original string is encrypted and when the end of the key string is encountered the iteration through the key string is started again from the beginning of the key string until the original string is completely encrypted.

This process works because the ASCII values in the typical string and the typical key string when added together do not exceed 255. (The highest possible ASCII character) Essentially, Strings and Keys with ASCII values higher than 126 should not be used or the result could be unpredictable– or worse yet, an unencryptable string.

Now that I’ve explained a bit about the premise… Lets look at the code!

Option Explicit

Dim temp, key

temp = “Now is the time for all good men To come To the aid of their fellow countrymen.”
key = “huasHIYhkasdho1”

temp = Encrypt(temp,key)
WScript.Echo temp
temp = Decrypt(temp,key)
WScript.Echo temp

Function encrypt(Str, key)
 Dim lenKey, KeyPos, LenStr, x, Newstr
 Newstr = “”
 lenKey = Len(key)
 KeyPos = 1
 LenStr = Len(Str)
 str = StrReverse(str)
 For x = 1 To LenStr
      Newstr = Newstr & chr(asc(Mid(str,x,1)) + Asc(Mid(key,KeyPos,1)))
      KeyPos = keypos+1
      If KeyPos > lenKey Then KeyPos = 1
 encrypt = Newstr
End Function

Function Decrypt(str,key)
 Dim lenKey, KeyPos, LenStr, x, Newstr
 Newstr = “”
 lenKey = Len(key)
 KeyPos = 1
 LenStr = Len(Str)
 For x = LenStr To 1 Step -1
      Newstr = Newstr & chr(asc(Mid(str,x,1)) – Asc(Mid(key,KeyPos,1)))
      KeyPos = KeyPos+1
      If KeyPos > lenKey Then KeyPos = 1
      Decrypt = Newstr
End Function

5  Comments on this Post

There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when other members comment.
  • TonyLongson
    Nice work Jerry. You can change the script to cope with characters up to ASCII 255 by a slight change incorporating modular arithmetic: [CODE] Function encrypt(Str, key) Dim lenKey, KeyPos, LenStr, x, Newstr, EncCharNum Newstr = “” lenKey = Len(key) KeyPos = 1 LenStr = Len(Str) str = StrReverse(str) For x = 1 To LenStr EncCharNum = Asc (Mid (str, x, 1)) + Asc (Mid (key, KeyPos, 1)) Newstr = Newstr & chr(EncCharNum Mod 256) KeyPos = keypos+1 If KeyPos > lenKey Then KeyPos = 1 Next encrypt = Newstr End Function Function Decrypt(str,key) Dim lenKey, KeyPos, LenStr, x, Newstr, DecCharNum Newstr = “” lenKey = Len(key) KeyPos = 1 LenStr = Len(Str) str=StrReverse(str) For x = LenStr To 1 Step -1 DecCharNum = Asc (Mid (str, x, 1)) - Asc (Mid (key,KeyPos, 1)) + 256 Newstr = Newstr & chr(DecCharNum Mod 256) KeyPos = KeyPos+1 If KeyPos > lenKey Then KeyPos = 1 Next Newstr=StrReverse(Newstr) Decrypt = Newstr End Function [/CODE] This basically "wraps around" the value to always generate a code between 0 and 255. The only issue then is that you may get control characters in the encrypted string, so you probably couldn't store an encrypted value within the script itself unless you encoded it with vb constants or Chr calls, e.g. [CODE] EncData = "Abc" + vbNull + "%£" & Chr (19) & "xyz" [/CODE]
    0 pointsBadges:
  • Rahulji
    Hi, Very good work. Can you please give me a similar script wich uses any 128 bit encryption algorithm? this will really help me with my work. thanks in Advance Rahul
    0 pointsBadges:
  • PapaFett
    Hi, Jerry, thanks for this excellent post. I'm currently trying to use this in a VBScript ASP page on IIS6 but I get an error every time (even just attempting to run the example above), the error is: Invalid procedure call or argument: 'chr' And is being caused by this line: Newstr = Newstr & chr(asc(Mid(str,x,1)) - Asc(Mid(key,KeyPos,1))) Interestingly enough, I also tried Tony's versions of the functions he posted here and while I don't get an error, it just doesn't work (depending on the input, the decrypt just returns nothing). Thanks in advance for any help or pointers, much appreciated! Bob
    0 pointsBadges:
  • Prakash1234


    Could you please give me the script encryption in VB Script with base64 encoded?

    10 pointsBadges:
  • stealzy
    Function Crypt(key, str, escapeQuotes)
      ' str, key - strings, containing char from 32 to 126 ASCII code table
      ' return encrypt/decrypt string, on input error return empty string
      Dim minLen, remainderStr, x, diffStr, diffCharNum, keyCharNum, strCharNum, diffSum
      If Len(str) > Len(key) Then
        minLen = Len(key)
        remainderStr = Right(str, Len(str) - minLen)
        minLen = Len(str)
        remainderStr = Right(key, Len(key) - minLen)
      End If
      For x = 1 To minLen
        keyCharNum = Asc( Mid(key, x, 1))
        strCharNum = Asc( Mid(str, x, 1))
        If (keyCharNum > 126 Or keyCharNum < 32 Or strCharNum > 126 Or strCharNum < 32) Then
          diffStr = ""
          remainderStr = ""
          Exit For
        End If
        diffCharNum = keyCharNum - strCharNum
        If (diffCharNum < 0) Then diffCharNum = diffCharNum + 126 - 32 + 1
        diffCharNum = diffCharNum + 32
        diffSum = chr(diffCharNum)
        If (escapeQuotes And diffSum = """") Then diffSum = """"""
        diffStr = diffStr & diffSum
      Crypt = diffStr & remainderStr
    End Function
    20 pointsBadges:

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

Share this item with your network: