1

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?

4 Answers 4

2

(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
Sign up to request clarification or add additional context in comments.

1 Comment

I understand it much better now, thank you Ekkehard. I was getting issues with decrypting the same string (values beyond the array size), for the very reasons you illustrate in your points. I have rewritten my code, I will post it here (with great trepidation as to the manner of criticism it may attract) after I have checked it.
1

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

1 Comment

Contains errors and bad practices (see stackoverflow.com/a/28798878/603855)
1

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
'*****************************************************************

1 Comment

Does not address the question.
0

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")

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.