VBScript - Pass for loop iterations into dynamic a

Question

I have this code which outputs each for loop iteration result into a message box:

dim str

str = inputbox("Please enter character string for encryption","Encryption")

for i=1 to len(str)
wscript.echo asc(mid(str,i,1)) - (i-1)  
next

I would like to store each iteration result into an array, and then display the full array content in a message box as a string.

I'm trying something like this:

dim str, arr()

str = inputbox("Please enter character string for encryption","Encryption")

for i=1 to len(str)
redim preserve arr(ubound(arr)+1)
arr(ubound(arr)) = asc(mid(str,i,1)) - (i-1)    
next

wscript.echo arr

but get Line 6: Error: subscript out of range 'ubound'. Should I be calling the iteration through a function, before mapping it to an array?

Answer 1

(1) UBound() does not fail on an empty array, it it returns -1 (one less as for an array with just one element):

>> Dim a : a = Array()
>> WScript.Echo TypeName(a), UBound(a)
>> ReDim a(UBound(a)+1)
>> a(Ubound(a)) = "one and only"
>> WScript.Echo TypeName(a), UBound(a), a(0)
>>
Variant() -1
Variant() 0 one and only

(2) UBound() fails for a(), because a() is not an empty array but an abomination - a fixed array with no size - that the compiler/interpreter is too stupid to catch. You can't do anything with a(), except overwriting/replacing the variable with something - hopefully - usefull.

(3) UBound() never returns undefined (there is no undefined in VBScript), but a number.

(4) Using the loop counter for string positions (1...) and array indices (0...) is misguided; your arrays will contain empty elements at the head.

(5) The decent way to store computations of string elements into a corresponding array is to use the knowledge about the string's length to avoid the costly ReDim Preserve:

>> s = "abc"
>> ReDim a(Len(s) - 1)
>> For p = 1 To Len(s) : a(p - 1) = Chr(Asc(Mid(s, p, 1)) - 32) : Next
>> WScript.Echo Join(a), Join(a, "")
>>
A B C ABC

Answer 2

Your code is incorrect because UBound fails on empty arrays, it returns undefined.

Why don't you use "i" as the index like this (I tested it):

for i=1 to len(str)
    redim preserve arr(i+1)
    arr(i) = asc(mid(str,i,1)) - (i-1)    
next

Also your syntax is wrong for printing out the array, use something like this:

for j=1 to i
    WScript.Echo arr(j)
next

Answer 3

This is my revised, fully functional code, thanks for the help...

dim str, arr, arr2, result, ls, i, encstr, decstr

do while len(str)=0
str = inputbox("Please enter character string for encryption","Cipher")
if isempty(str) then
wscript.quit()
end if
loop

ls=(len(str))
redim arr(ls -1)
for i=1 to ls
arr(i-1) = chr(asc(mid(str,i,1)) - (i-1))
next
encstr = join(arr,"")
rem wscript.echo encstr

ls=len(encstr)
redim arr2(ls-1)
for i=1 to ls
arr2(i-1) = chr(asc(mid(encstr,i,1)) + (i-1))
next
decstr=join(arr2,"")
rem wscript.echo decstr

result=msgbox("Encrypted string: " & encstr & vbcrlf & "Decrypted string: " & decstr,0,"Cipher")

Answer 4

If you like another Encryption method using XOR Operator :

Option Explicit
'Déclaration des variables globales
Dim Titre,MaChaine,fso,ws,LogFile,ChaineCrypt
'Titre du Script
Titre = "Cryptage d'une chaîne de caractères by Hackoo"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("Wscript.Shell")
'Nom du fichier qui va stocker le résultat
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "txt"
if fso.FileExists(LogFile) Then 'Si le fichier LogFile existe 
    fso.DeleteFile LogFile 'alors on le supprime
end If
'La boîte de saisie de la chaîne de caractères
MaChaine = InputBox("Taper votre chaîne ou bien une phrase pour la crypter",Titre,"www.stackoverflow.com")
'Si la Chaîne est vide ou bien on ne tape rien dans l'inputbox,alors on quitte le script
If MaChaine = "" Then Wscript.Quit 
ChaineCrypt = Crypt(MaChaine,"2015")
MsgBox DblQuote(MaChaine) &" est transformée en "& VbCrlF & VbCrlF & DblQuote(ChaineCrypt),Vbinformation,Titre
Call WriteLog(ChaineCrypt,LogFile)
ws.run LogFile
'************************************************************************
Function Crypt(text,key) 
Dim i,a
For i = 1 to len(text)
      a = i mod len(key)
      if a = 0 then a = len(key)
      Crypt = Crypt & chr(asc(mid(key,a,1)) XOR asc(mid(text,i,1)))
Next
End Function
'*****************************************************************
'Fonction pour ajouter des guillemets dans une variable
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************************
'Fonction pour écrire le résultat dans un fichier texte
Sub WriteLog(strText,LogFile)
    Dim fs,ts 
    Const ForAppending = 8
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(LogFile,ForAppending,True)
    ts.WriteLine strText
    ts.Close
End Sub
'*****************************************************************