Decryption function gives wrong result with special characters - vbscript

Question

I'm building an encryption/decryption function in VBScript / Classic ASP.
It all works as long as the string to be encrypted/decrypted does not contain special characters.
' str = "Bayern München"
' key = "ab34ehyd67hy6752daskjh"
Function EncryptString(val, key)
valLen = Len(val)
keyLen = Len(key)
keyPos = 1
newVal = ""
revVal = val
For x = 1 To valLen
calc = AscW(Mid(revVal, x, 1)) + AscW(Mid(key, keyPos, 1))
'Response.Write ":" & AscW(Mid(revVal, x, 1)) & " + " & AscW(Mid(key, keyPos, 1)) & " = " & calc & "<br />"
newVal = newVal & Hex(calc)
keyPos = keyPos + 1
If keyPos > keyLen Then keyPos = 1
Next
EncryptString = newVal
End Function
Function DecryptString(val, key)
' The workaround - start
For i = 160 To 255
val = Replace(val, Chr(i), "&#" & i & ";")
Next
' The workaround - end
valLen = Len(val)
keyLen = Len(key)
keyPos = 1
newVal = ""
revVal = val
chrVal = ""
' I suspect this to be the error
For y = 1 To valLen Step 2
chrVal = chrVal & ChrW("&h" & Mid(revVal, y, 2))
Next
For x = 1 To Len(chrVal)
calc = AscW(Mid(chrVal, x, 1)) - AscW(Mid(key, keyPos, 1))
'Response.Write "::" & AscW(Mid(chrVal, x, 1)) & " - " & AscW(Mid(key, keyPos, 1)) & " = " & calc & "<br />"
newVal = newVal & ChrW(calc)
keyPos = keyPos + 1
If keyPos > keyLen Then keyPos = 1
Next
DecryptString = newVal
End Function
If I do an encryption of the string "Bayern München" and afterwards call the DecryptString function on the encrypted string, it returns Bayern M?À?vU?.
If I output the data (the Response.Write's in the example), the decryption function returns a negative number for the character ü, so I'm doing something wrong - but what?
The system encoding is Windows-1252.
UPDATE:
I did this workaround in the DecryptString function. I'm not sure if it covers all possible problems, but from my testing so far it does:
For i = 160 To 255
val = Replace(val, Chr(i), "&#" & i & ";")
Next

Answer 1

Don't know if you still need to fix it, but all above is because hex() returns a string longer than 2 for any decimal over 255:
(255)10 = (FF)16
(256)10 = (100)16
i.e. when original string + salt is over 255(10)
("ü" 252) + ("6" 54) = 252+54 = 306(10)=132(16) (3 characters long)
then "For y=1 To valLen Step 2" will take only "13" of "132" which will result to improper decryption.
Depends on the need, it can be "fixed", for example, by checking if encrypted code is over 255 and when true, do not add salt:
Function EncryptString(val, key)
...
'newVal = newVal & Hex(calc) <-- replace this by following code
if calc > 255 then
newVal = newVal & "01" & Hex(Asc(Mid(revVal, x, 1))) ' no salt
else
newVal = newVal & Hex(calc)
end if
where "01" is just a "signal" character that tells that the next char will be without salt.
Respectively,
Function DecryptString(val, key)
...
'calc = Asc(Mid(chrVal, x, 1)) - Asc(Mid(key, keyPos, 1))
if Asc(Mid(chrVal, x, 1))=1 then 'determine "signal"
ignorenext = true 'flag that next char has no salt
else
if ignorenext then
calc = Asc(Mid(chrVal, x, 1)) 'no salt
ignorenext = false
else
calc = Asc(Mid(chrVal, x, 1)) - Asc(Mid(key, keyPos, 1))
end if
newVal = newVal & Chr(calc)
keyPos = keyPos + 1
If keyPos > keyLen Then keyPos = 1
end if
Note, for Windows-1252 no need to use AscW()/ChrW() which are unicode specific.
Another approach will be to replace hexadecimal by something more "stable" i.e. base32. Taking sample code from Classic ASP/VBScript implementation of Crockford's Base32 Encoding your code can look like
Function EncryptString(val, key)
valLen = Len(val)
keyLen = Len(key)
keyPos = 1
newVal = ""
revVal = val
For x = 1 To valLen
calc = Asc(Mid(revVal, x, 1)) + Asc(Mid(key, keyPos, 1))
newVal = newVal & ToBase32(calc)
keyPos = keyPos + 1
If keyPos > keyLen Then keyPos = 1
Next
EncryptString = ucase(newVal)
End Function
Function DecryptString(val, key)
valLen = Len(val)
keyLen = Len(key)
keyPos = 1
newVal = ""
revVal = val
chrVal = ""
For y = 1 To valLen Step 2
chrVal = chrVal & fromBase32(Mid(revVal, y, 2))
calc = fromBase32(Mid(revVal, y, 2)) - Asc(Mid(key, keyPos, 1))
newVal = newVal & Chr(calc)
keyPos = keyPos + 1
If keyPos > keyLen Then keyPos = 1
Next
DecryptString = newVal
End Function