Script Center >
Scripting Forums
>
The Official Scripting Guys Forum!
>
Encrypt a file in HTA using XOR operation taking too long.
Encrypt a file in HTA using XOR operation taking too long.
- Hi,
I don't know if this is right place to ask this question as i have tried other forums as well and looking for help ...
Issue is that my HTA application reads a file from text and populate listbox 'on the fly from the information of that text file .
I don't want users to read the text file on the disk and using XOR operation (simple encryption) before writing the file to disk.
While decrypting the file usign the same key, it is taking too long (almost 15+ sec ) for 200+ KB file.
Is there a way i can do XOR efficiently or use any other scripting technique so that user can not open the file and mess around with that.
Here is my code
Function Cipher(Text, Key)
For i = 1 To Len(strText)
strChar1 = Mid(strText,i,1)
strTemp = strTemp & Chr( Asc(strChar1) Xor Asc("*&"))
Next
Cipher = strTem
End Function
I am actually reading the encrypted file into memory and then doing xor on saved text bu no luck...same time lag!!!
Please kindly help as this has become a major issue in going forth with HTA implementation.
Thanks and kind regards,
Aray
Answers
- Well, I have a little egg on my face. I finally found the problem. I just realized it was there in my original testing, but I failed to notice its effect. I was using a long file and the error only shows up in the last segment encrypted, so I missed it at the end of the file.
The problem is that the temporary array aString was not being zeroed between passes through the do loop. Here is a corrected version of the Cipher routine.
Function Cipher(strText, sKey)
Dim sT1, sT2, strTemp, i, j
Dim aString(), aKey()
nBuf = 1024
Redim aKey(len(sKey)),aString(nBuf)
sT1 = strText
nKeyLen = len(sKey)
For j = 1 to nKeyLen
aKey(j) = ASC(Mid(sKey, j, 1))
next
Do while sT1 <> ""
sT2 = Mid(sT1,1, nBuf)
j = 0
For i = 1 To len(sT2)
j = j + 1
if j > nKeyLen then j = 1
aString(i) = Chr(Asc(Mid(sT2,i,1)) Xor akey(j))
Next
strTemp = strTemp & Join(aString, "")
Redim aString(nBuf) ' Zeros out contents of array
sT1 = Mid(sT1, nBuf + 1)
Loop
Cipher = strTemp
End Function
There is just one added line near the end of the loop to fix the problem ...
Redim aString(nBuf) ' Zeros out contents of array
However, I did adjust the routine to allow the size of the 'chunk' to be adjusted, but that is unrelated to the problem. I used it to set the buffer to a small value to speed troubleshooting.
Hopefully that's all you'll need.
Tom Lavedas- Edited byTom Lavedas Thursday, November 05, 2009 6:23 PMfix a typo
- Marked As Answer byarayanz Wednesday, November 11, 2009 2:14 PM
All Replies
- Concatenating strings is very slow, especially as the string gets long (like 200kb). One workaround for this is to break the job up into bite sized junks using an array and the Join() function to do the concatenation of each chunk. The Join is faster than the scripted concatenation. An array could be used to collect the chunks as well, with a final Join to add the chunks together, but I don't think that complexity is really necessary (though I didn't try a large scale test).
Here is a modified routine that uses 1KB chunks ...
sMask = "TEST"
sEncrypted = Cipher("This is a test", sMask)
sOut = Cipher(sEncrypted, sMask)
wsh.echo len(sEncrypted), sOut
Function Cipher(strText, sKey)
Dim sT1, sT2, strTemp, i, j
Dim aString(1024), aKey()
Redim aKey(len(sKey))
sT1 = strText
nKeyLen = len(sKey)
For j = 1 to nKeyLen
aKey(j) = ASC(Mid(sKey, j, 1))
next
Do while sT1 <> ""
sT2 = Mid(sT1,1,1024)
j = 0
For i = 1 To len(sT2)
j = j + 1
if j > nKeyLen then j = 1
aString(i) = Chr(Asc(Mid(sT2,i,1)) Xor akey(j))
Next
strTemp = strTemp & Join(aString, "")
sT1 = Mid(sT1, 1025)
Loop
Cipher = strTemp
End Function
The output of the little test program, above, should be the original input test. This is intended for a small scale demonstration. Note that I broke up the multi-character encryption string and found it's ASCII code just once in the routine. This should also speed things a little more.
Tom Lavedas - Hi,
Thanks so much for the reply.
I tested it and I think we are close :), Program compiled but unable to decrypt. I get following from the code above " t5' " instead of original string.
Quick observations:
1. array declaration in vbscript start with index 0 and above we are starting with akey(j) with J = 1. Now I also tried with akey(j-1) but same result
2. why we need to make the string key into array? Can we use the string directly instead of converting to array
nKeyLen = len(sKey)
For j = 1 to nKeyLen
aKey(j) = ASC(Mid(sKey, j, 1))
next
3. With my program using string key directly, I noticed that with Input string just larger than 1024, the strText length jumps to 2048. This is causing issues as how to terminate the DO loop. For example, my HTA prompts user to add an item for the text box which it saves encrypted in text file on disk. If you keep adding starting from A to Z , about at 'U' the length exceeds around 1024 and jumps to 2048. At this point, the Do loop readds again the content sfrom A to U casing duplicate entries.
How to terminate the loop or find end of string.
Function Cipher(strText, sKey)
Dim sT1, sT2, strTemp, i, j
Dim aString(1024), aKey()
sT1 = strText
Do While sT1 <> ""
sT2 = Mid(sT1,1,1024)
For i = 1 To len(sT2)
aString(i) = Chr(Asc(Mid(sT2,i,1)) Xor Asc(sKey)) ' Just using sKey directly-For each character in the sT2 do the XOR operation
Next
strTemp = strTemp & Join(aString, "")
sT1 = Mid(sT1,1025) ' Take the 1025th to end of the sT1
Loop
Cipher = strTemp
End Function
I apologize if I am aksing too many questions. Actually trying to solve this problem so trying to clear as much as possible from my side.
Thanks so much for your cooperation.
Looking forward to hear from you
Thank again man.
Aray - See my comments interspersed below ...Hi,
Thanks so much for the reply.
I tested it and I think we are close :), Program compiled but unable to decrypt. I get following from the code above " t5' " instead of original string.
TL: You received that output when you used the code exactly as I posted it? That is not the result I got.
Quick observations:
1. array declaration in vbscript start with index 0 and above we are starting with akey(j) with J = 1. Now I also tried with akey(j-1) but same result
TL: Yes, arrays have an origin of zero. However, to save a subtraction and therefore some time, my code ignores that fact. The way it is designed, the empty first cell has no impact on the result. Re-indexing it to zero saves one cell in the array, but adds a subtraction operation to ever iteration of the loop.
2. why we need to make the string key into array? Can we use the string directly instead of converting to array
nKeyLen = len(sKey)
For j = 1 to nKeyLen
aKey(j) = ASC(Mid(sKey, j, 1))
next'
TL: I used a multi-character mask string. When you substitute the key directly, only the very first character is used. If that's what you want, that's OK, but my way is a tiny bit more robust. It uses all of the characters in order to encrypt the data. That way, the entire word must be known to decrypt the file. Your way requires knowing just the first character in the password. That would mean it would take a maximum of just 254 passes to find the correct character. My approach would need more sophisticated algorithms and more passes to determin the correct password. For your purposes, it might be overkill, but it is easy to do.
3. With my program using string key directly, I noticed that with Input string just larger than 1024, the strText length jumps to 2048. This is causing issues as how to terminate the DO loop. For example, my HTA prompts user to add an item for the text box which it saves encrypted in text file on disk. If you keep adding starting from A to Z , about at 'U' the length exceeds around 1024 and jumps to 2048. At this point, the Do loop reads again the contents from A to U causing duplicate entries.
How to terminate the loop or find end of string.
Function Cipher(strText, sKey)
Dim sT1, sT2, strTemp, i, j
Dim aString(1024), aKey()
sT1 = strText
Do While sT1 <> ""
sT2 = Mid(sT1,1,1024)
For i = 1 To len(sT2)
aString(i) = Chr(Asc(Mid(sT2,i,1)) Xor Asc(sKey)) ' Just using sKey directly-For each character in the sT2 do the XOR operation
Next
strTemp = strTemp & Join(aString, "")
sT1 = Mid(sT1,1025) ' Take the 1025th to end of the sT1
Loop
Cipher = strTemp
End Function
TL: I don't see this in testing my code on longer files, so I am confused. The variable strText is an input to the routine which is not affected by the operation of it. Therefore, I don't see how it can have the effect you cite. Therefore, I must suspect it is caused by the way you are trying to use it. Sorry, I can't help with that without seeing the exact code you are using.
I apologize if I am asking too many questions. Actually trying to solve this problem so trying to clear as much as possible from my side.
TL: No problem.
Thanks so much for your cooperation.
Looking forward to hear from you
Thank again man.
Aray
TL: You're welcome.
Tom Lavedas
Tom,
Thanks for your answers. I tested your program again (copy pastes) by putting the data on text area and it is working there. I try to see the encrypted output with TextArea.Value = TextArea.Value & sEncrypted <---but this showed nothing. Not a primary concern until the problem following is associated:)
With your every reply, i learn something new ... I going to use multi string encoded going forth from now now ... promise :-)
here is my code. I am using the Cipher function above (from you) without any changes
------------------------------------------------------------
Sub Encode(LogEncode)
logFile = "abc-encoded"
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(logFile) Then
Set objFileOut = objFSO.OpenTextFile(logFile, ForWriting,False,False)
FinalWrite = Cipher(LogEncode,"Aray")
objFileOut.Write(FinalWrite)
objFileOut.Close
Set objFSO = Nothing
Else
Set objFileOut = objFSO.CreateTextFile(logFile)
objFileOut.Close
Set objFileOut = Nothing
Set objFileOut1 = objFSO.OpenTextFile(logFile, ForWriting,True,False)
FinalWrite = Cipher(LogEncode,"Aray")
objFileOut1.Write(FinalWrite)
objFileOut1.Close
Set objFileOut = Nothing
Set objFSO = Nothing
End If
End Sub
------------------------------------------------------------
Sub Decode
logFile = "abc-encoded.txt"
Const ForReading = 1
Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO1.OpenTextFile(logFile, ForReading,False,False)
LOGMEM1 = ""
LOGMEM = ""
Do Until objFile.AtEndOfStream
LOGMEM1 = objFile.ReadAll
Loop
LOGMEM = Cipher(LOGMEM1,"Aray")
objFile.Close
Set objFSO1 = Nothing
End Sub
------------------------------------------------------------
Let me explain a little bit about HTA. This HTA when loads ask user for name /department and put this in file to just show as div on the body.
Then a user can add item in the listbox via window prompt and once they do, it is added in listbox and also written to the file likefollowing template:
-----Option-:---"Name of that option"
Now for each item in listbox, they can save text in the textarea which also write to the file like following
----Start: "Name of Option"
bla bla bla
bla bla bla
bla bla bla
----End "Name of Option"
I am trying to encrypt the file on disk so that user can not change the file causing program to break.
With the above code as soon as you try to add more than two items in the list box with the text, it fails to decode it when you re-fresh the application. On_Load_window is actually decodeing the file and populating the listbox by searching line by line in the decoded text in memory.
I checked the encrypted file after every change and it seems that data is writting to the file but somehow it is failing to decode. I am suspecting that after sometime the data crosses the 1024 byte, it is not decoding properly.
When it failes to decode, I can still see the lines in the text file but just encrypted.
To help troubleshoting, i added TextArea.Value = LOGMEM in decode function and included decode in the encode function (in end) to see how the program is behaving
Following is the iterations:
1. Person enter their name and depart and text file is created, following four lines are written:
Start
Name:
Department:
End
2. After adding first listbox entry "A"
Start
Name:
Department:
End
----Option-:---A
3. After adding text for option A
Start
Name:
Department:
End
----Start-Option-:---A---:
----Start: A
1
1
1
----End A
Till this point everything is working fine...Program save the information and retireves correclty.
4. Now adding the next Option - B
I get following
Start
NaStayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayArayption-:---B
Any thoughts?
this program works pefectly fine without the encode and decode. Also works if I decode this character by character but it is painfuly slow
Btw, you been very helpful and I am really greatful for your time and help.
Looking forward to hear from you...
Aray- OK, it was not obvious, but I see the problem, now. I was not actually writing the encrypted text out to a file and then reading it back. I was just applying the routine twice; once to the original text stream and then passing the resultant string back through the routine. That worked.
However, when I wrote it out to a file, the problem became evident. The encrypted string is no longer a vanilla ASCII string. It can contain a number of 'control' characters and other troublesome bytes. On cursory examination, they seem to be written to the file OK, but they definitely are not being read back in using the FSO approach.
The solution I found was to use the ADO Stream object to execute the file manipulations. In this case, it produces the correct result (I think). At least, it did for the file I tested with.
Here is a sample that worked for me ...
sMask = "TEST"
sText = GetBinFile("..\ChooseFile.txt")
sEncrypted = Cipher(sText, sMask)
PutBinFile sEncrypted, "..\ChooseFileEncrypt.txt"
sText = GetBinFile("..\ChooseFileEncrypt.txt")
sOut = Cipher(sText, sMask)
wsh.echo len(sEncrypted), len(sText), sOut
Function Cipher(strText, sKey)
Dim sT1, sT2, strTemp, i, j
Dim aString(1024), aKey()
Redim aKey(len(sKey))
sT1 = strText
nKeyLen = len(sKey)
For j = 1 to nKeyLen
aKey(j) = ASC(Mid(sKey, j, 1))
next
Do while sT1 <> ""
sT2 = Mid(sT1,1,1024)
j = 0
For i = 1 To len(sT2)
j = j + 1
if j > nKeyLen then j = 1
aString(i) = Chr(Asc(Mid(sT2,i,1)) Xor akey(j))
Next
strTemp = strTemp & Join(aString, "")
sT1 = Mid(sT1, 1025)
Loop
Cipher = strTemp
End Function
Function GetBinFile(sFileSpec)
const adTypeText = 2
const adModeReadWrite = 3
With CreateObject("ADODB.Stream")
.type = adTypeText
.mode = adModeReadWrite
.Charset = "ascii"
.open
.LoadFromFile sFileSpec
wsh.echo .size
GetBinFile = .readText(.size)
end with
end function
Function PutBinFile(sText, sFileSpec)
const adTypeText = 2
const adModeReadWrite = 3
const adSaveCreateOverwrite = 2
With CreateObject("ADODB.Stream")
.type = adTypeText
.mode = adModeReadWrite
.Charset = "ascii"
.open
.writetext sText
.SaveToFile sFileSpec, adSaveCreateOverwrite
end with
end function
One other thing. I noted that using a simple alpha string as the key results in a very weak encryption. This is due to spaces in the clear text stream that are uniformly encoded as the opposite case of the same letter in the encrypted stream as in the original. Therefore, a file with a lot of spaces contain many instances of the password, but with its case reversed. That's just too obvious. The workaround is to not use words and to include a significant number of non-alpha symbols. Then there are no obvious features that stick out, like repeated, readable words. Another way might be to encrypt the password with a fixed string to obscure the password before using it to encrypt the data stream.
HTH
Tom Lavedas - Hi,Thanks for the helping. I tested the program and no issues to read/write with encrypted data on disk.However back to same problem with strings growing more than 1024 and jumping to 2048. I did same iteration test by adding the options in listbox one by one and as you can see in following, at about "U" the string surpass 1024 mark and reads the contents from A to T again. I don't understand the reason for this as in Cipher program, we are taking the next data : sT1 = Mid(sT1, 1025)StartName== ArayDept== ITEndsT1: 84 strText: 84----OPTION---A---:sT1: 130 strText: 130----OPTION---B---:sT1: 176 strText: 176----OPTION---C---:sT1: 222 strText: 222----OPTION---D---:sT1: 268 strText: 268----OPTION---E---:sT1: 314 strText: 314----OPTION---F---:sT1: 360 strText: 360----OPTION---G---:sT1: 406 strText: 406----OPTION---H---:sT1: 452 strText: 452----OPTION---I---:sT1: 498 strText: 498----OPTION---J---:sT1: 544 strText: 544----OPTION---K---:sT1: 590 strText: 590----OPTION---L---:sT1: 636 strText: 636----OPTION---M---:sT1: 682 strText: 682----OPTION---N---:sT1: 728 strText: 728----OPTION---O---:sT1: 774 strText: 774----OPTION---P---:sT1: 820 strText: 820----OPTION---Q---:sT1: 866 strText: 866----OPTION---R---:sT1: 912 strText: 912----OPTION---S---:sT1: 958 strText: 958----OPTION---T---:sT1: 1004 strText: 1004 <-------------Till this far, if I close the program and restart it , everything is read/decrypted perfectly.----OPTION---U---: <------------As soon as I add next option "U" , the list is re-added== ArayDEPT == ITEnd----OPTION---A---:----OPTION---B---:----OPTION---C---:----OPTION---D---:----OPTION---E---:----OPTION---F---:----OPTION---G---:----OPTION---H---:----OPTION---I---:----OPTION---J---:----OPTION---K---:----OPTION---L---:----OPTION---M---:----OPTION---N---:----OPTION---O---:----OPTION---P---:----OPTION---Q---:----OPTION---R---:----OPTION---S---:----OPTION---T---:----OPTION sT1: 1024 strText: 2048Any thoughts on this?Thanks so much for helping.Aray
- Without seeing your code, I have no idea what is going on from the data you have posted.
Concerning the attempts to show the encrypted text stream in a text box, it will not work because of the codes that are likely to be included in that stream. For example, some of the bytes can be zero and many will be over 128. In addition, line ends have also been encoded and will not display as expected. That is the same problem I had with writing out the encrypted data and reading it back in to the test script. The output file can be viewed in a binary aware application, like Wordpad, though it will look very peculiar. However, I'm pretty sure it is a waste of time to try to show it in a text window.
Tom Lavedas - tom,
here is my code. I omitted the three functions which are basically same as above.
I took a lot of stuff which is part of regular house keeping and kept the basic function which still having the same issue.
With this code, on 47th iteration ( I will suggest to add multiple character to get the issue early), you will see that after you pass 1024, you will get the part of the list re-added again.
--------------------------------------------------------------------------------------------------------------------------------------
<script language="VBScript">
Dim LOGMEM,NAME,DEPT
Sub Window_Onload
Dim fso, logfile,objFSO,objFile,bUnicode
Const ForReading = 1
Const ForAppending = 8
logFile = "myfile.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(logFile) Then
Set objFile8 = objFSO.GetFile("myfile.txt")
If objFile8.Size = 0 Then
NAME = window.prompt("Please enter name.")
DEPT = window.prompt("Please enter DEPT .")
LOGMEM = "Start" & vbCrLf & "NAME= " & NAME & vbCrLf & "DEPT= " & DEPT & vbCrLf & "End" & vbCrLf
Set objFSO = Nothing
Set objFile8 = Nothing
Encode(LOGMEM)
Else
Decode
arrLines = Split(LOGMEM, VbCRLF)
For Each strLine In arrLines
If InStr(strLine,"NAME") <> 0 Then
NAME = Mid(strLine,6)& " "
End If
If InStr(strLine,"DEPT") <> 0 Then
DEPT = Mid(strLine,6)
End If
i=1
If InStr(strLine,"---OPTION") <> 0 Then
Set objOption = Document.createElement("OPTION")
objOption.Text = Replace(Mid(strLine,InStr(strLine,"---OPTION:---")+13),"---:","")
objOption.Value = i+1
CustomOptions.Add(objOption)
End If
i = i + 1
Next
Set objFSO = Nothing
Set objFile8 = Nothing
End If
Else
NAME = window.prompt("Please enter name.")
DEPT = window.prompt("Please enter DEPT .")
LOGMEM = "Start" & vbCrLf & "NAME= " & NAME & vbCrLf & "DEPT= " & DEPT & vbCrLf & "End" & vbCrLf
Set objFSO = Nothing
Set objFile8 = Nothing
Encode(LOGMEM)
End if
End Sub
'-----------------------------------------------
Sub AddCustomCat
Name = window.prompt("Please enter options")
Set objOption = Document.createElement("OPTION")
objOption.Text = Name
objOption.Value = i
CustomOptions.Add(objOption)
LOGMEM = LOGMEM & vbCrLf & "---OPTION:---"&Name & "---:" & vbCrLf
Encode(LOGMEM)
End Sub
'-----------------------------------------------
Sub Encode(LogEncode)
logFile = "myfile.txt"
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(logFile) Then
Set objFSO = Nothing
sEncrypted = Cipher(LogEncode,"Aray")
PutBinFile sEncrypted, logFile
Else
Set objFileOut = objFSO.CreateTextFile(logFile)
objFileOut.Close
Set objFileOut = Nothing
Set objFSO = Nothing
sEncrypted = Cipher(LogEncode,"Aray")
PutBinFile sEncrypted,logFile
End If
End Sub
'-----------------------------------------------
Sub Decode
logFile = "myfile.txt"
sText = GetBinFile(logFile)
LOGMEM = Cipher(sText,"Aray")
End Sub
'-----------------------------------------------
-------------------------------------------------------------------------------------------------------------------------------------
<body>
<p align = "center">
<input type="button" value="AddCustomCAT" OnClick ="AddCustomCat" >
<select size="5" style="width:160px;" name="CustomOptions">
<p>
</body>
As you see it is simple program but dont know why the list gets added again? I believe it has to do with Do loop in the cipher function but I can be wrong!!!
Any thoughts?
Thanks so much for helping...
Looking forward to hear from you.
Aray
- Well, I have a little egg on my face. I finally found the problem. I just realized it was there in my original testing, but I failed to notice its effect. I was using a long file and the error only shows up in the last segment encrypted, so I missed it at the end of the file.
The problem is that the temporary array aString was not being zeroed between passes through the do loop. Here is a corrected version of the Cipher routine.
Function Cipher(strText, sKey)
Dim sT1, sT2, strTemp, i, j
Dim aString(), aKey()
nBuf = 1024
Redim aKey(len(sKey)),aString(nBuf)
sT1 = strText
nKeyLen = len(sKey)
For j = 1 to nKeyLen
aKey(j) = ASC(Mid(sKey, j, 1))
next
Do while sT1 <> ""
sT2 = Mid(sT1,1, nBuf)
j = 0
For i = 1 To len(sT2)
j = j + 1
if j > nKeyLen then j = 1
aString(i) = Chr(Asc(Mid(sT2,i,1)) Xor akey(j))
Next
strTemp = strTemp & Join(aString, "")
Redim aString(nBuf) ' Zeros out contents of array
sT1 = Mid(sT1, nBuf + 1)
Loop
Cipher = strTemp
End Function
There is just one added line near the end of the loop to fix the problem ...
Redim aString(nBuf) ' Zeros out contents of array
However, I did adjust the routine to allow the size of the 'chunk' to be adjusted, but that is unrelated to the problem. I used it to set the buffer to a small value to speed troubleshooting.
Hopefully that's all you'll need.
Tom Lavedas- Edited byTom Lavedas Thursday, November 05, 2009 6:23 PMfix a typo
- Marked As Answer byarayanz Wednesday, November 11, 2009 2:14 PM
- Hi,I have tested the program with new changes. Since I can not dictate the file of the size on disk, i tested it with little more data to see if everything goes fine or not.So here is the error I got when the file size reaches to around 4MB. I know this size will be reached eventually and OK with the delay but found this new problem which is infact related with cipher program.I get following
"STOP running this scriptA script on this page is causing internet explorer to run slowly. If it continues to run, your computer might become unrepsonsive""I know that this is because of mutliple iterations in the HTA.I also put MSGBOX on start or end of different phases to see which module is actually taking alot of time.Program starts and on_window_load reads the file from the disk , decode the file to text, does some string manipulations (add/subtract content) in memory and then encode it and write it back to the file.Here is the breakdown of time taken by different module for 4MB file1. File read from the file ---- 10 sec2. As soon as the Cipher starts to work , I get the above error. If I keep saying "NO" to that error in about 20 sec I get the cipher complete. I get error message about three times.3. Then for string search to populate the listbox takes less than 1-2 secs and program is loaded.If a user tries to save the some new contents1. Data manipulation in the memory that includes searching for the file in memory and add/subtract takes less than 1-2 secs2. Cipher again takes around 20-25 secs <---I get the error about your computer going unresponsive three times and need to say "NO" to proceed further3. Writing the file to he disk takes 2-3 secsI am not worried a lot about initial delay (loading file) as user will eventually realize that file size is contributing to the delay and also the cipher function but this error asking to abort the script is like a show stopper. From the Cipher function , I learned that Join function is quite fast and instead of concatenating each character in array to final arraystring = string & array(i) , I do followingand string = join(array,""). That is how the string manipulations in the memory are so fast. :)Is it possible to change the Cipher function on same lines?I tried to make the buffer size in the Cipher function to 4096 from 1024 but no change. Is this OK thing to do if anticipating large file size?I ran this on two different PC with different hardware configuration. This error shows up on both and only different is the frequency of the error.Is there a way to avoid this error?Thanks so much for your help....Aray - Please help as this seems to be the major outstanding issue?Is this windows restriction or something that can be avoided by tweaking the VB script?Looking forward to hear ...Thanks for your help....Aray
- I have tried a couple of other techniques to speed the process, but have not succeeded, yet. The technique previously posted is the fastest I have found, so far.
Having said that, the problem you are having is not the result of an error, but is rather the artifact of IE trying to detect infinite loops in client-side scripts. I found an MS Knowledge Base article that address it and suggests a work around: http://support.microsoft.com/default.aspx/kb/175500.
Applying the suggested registry change might help. It won't make things run faster, but it should suppress the dialog.
Tom Lavedas Have you tried:
nBuf = len(strText)
But if you do this, there wouldn't be much need for st1, st2, and strTemp.- In my limited testing the optimum time seems to be achieved with about nBuf = 512, but I only tried a few hundred KB, not 4 MB. I suspect the Join part becomes inefficient if there are too many items in the array being joined. The original 1024 seemed to increase the time just slightly. At 8192, the time had increased significantly. Come to think of it, one of my alternate approaches did try using a full array for the multi KB sized file and nearly quadrupled the time. So, I don't think the full array approach will work too well. It's just seems to be the limitation of a scripted approach that manipulates every single byte as it concatenates the string.
Tom Lavedas - Hi,
I tested the program for different values of file sizes and nbuf in cipher program over weekend and here are my findings:File read from the disk:File Size 442Kb-----1102Kb----- 2202Kb----- 3083Kb----- 4183KbRead Time <1sec----- 1sec---------5sec---------7sec---------13secBnuf512 3 sec----- 9-------------50------------68------------1201024 2 sec------6-------------25------------35------------602048 1 sec------4-------------13------------20------------354096 1 sec------3-------------12------------15------------258192 1 sec------3-------------11------------12------------2016384 1 sec------3-------------10------------11------------1532768 1 sec------3-------------8-------------10-------------1465536 1 sec------3-------------7-------------10-------------13I tired multiple times for some values to be sure and with difference of +/-1 sec i found almost the same results.Just wondering that if we put some kind of status update in the Cipher function which can server two purposes1. User will not think that program has hung and will wait for the progress bar or status bar to complete2. Not sure yet but may be the issue related to following error will also go away"STOP running this script. A script on this page is causing internet explorer to run slowly. If it continues to run, your computer might become unrepsonsive"Please let meknow what your thoughts are?I looked through the net for progress bar and will greatly appreciate if you have any pointers.Thanks for your help ...You guys have been great help... I could not have come so far without your help...Looking forward to hear from you.Aray- Edited byarayanz Monday, November 16, 2009 2:53 PMformating
- Hi,I have looked through google to find an alternative and seems like this is the only post with most information. I accept that we can not dodge the delay but is it possible to get away with that error by putting some kind of progress bar which will cause IE not interrupt with warning message.If you think that is the way , i think we can conclude this thread and will streamline efforts to go to that part with new thread...Thanks again for all the help... Looking forward to hear from you guys... Please help!!!Aray
- Did you read the knowledgebase article I posted? Did it not help?
One other thing I can think of, but do not have time to pursue is to break up the parsing into separate threads, run asynchronous to your HTA.
Another alternative is that considering that there is absolutely no way to look at MBs of textual data all at the same time, maybe the script can parse and decode the file's information on an ad hoc basis. That is, decode and display the first 100 KB (or the last 100 KB) in the file and update the display when the top or the bottom items are selected in the selection window. It would take a lot of more programming, but there would be a minimal delay between segments.
Tom Lavedas - Knowledgebase article is good but I am not sure if the user has access to the registry on particular PC on which they are using this HTA or comfortable to change it. I changed it and although no error messages, you do not know if the program is hung or still loading. that is why question of progress bar came to mind.By asynchronous to HTA , do you mean de-ciphering the file in pieces at same time? I did not know that if that is possible? I will search in this direction too to see how to get this working with my script and what is the impact.I guess if I go with progress bar then user will know that program is loading and will not try to stop or terminate the process.As per article the IE will give warning if a script runs for unusually long time. If there is a progress bar (via calling another Sub) , will that interrupt the Cipher routine so IE does not complain with error message?Aray
- Since the user is using your HTA it has access to the registry. That is, you could write code to alter the registry to suppress the message (and restore it when the page unloads).
As far as parallel processing (asynchronous) - yes, the idea would be to parse the file into pieces to be run in parallel. Because the system reserves 'idle' time to try to keep any one program from 'locking up' the system, such an approach might run a bit faster by fooling the System Idle process into releasing more time to your script. However, it would be very complicated and might no make too big a difference. The communications between the pieces is not simple. I mentioned it, but was not really advocating it as a viable solution.
As for the progress bar, here is an example that I built a while back to illustrate one approach ...
<html>
<head>
<TITLE>Modeless Window Test</TITLE>
<HTA:APPLICATION ID="oApp"
APPLICATIONNAME="ModelessWdw"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
>
</head>
<SCRIPT Language = "VBScript">
Dim g_sGrnHTML, g_MsgArea ' global variables
Sub RunIt
DataArea.InnerHTML = "<font face='Arial' size='4'><b>" _
& "Running</b></font>"
nLeft = screenleft : nTop = screentop
' Create modeless window
set g_MsgArea = window.showModelessDialog("about:blank", null, _
"dialogLeft:" & nLeft & "px;dialogTop:" & ntop _
& "px;dialogHeight:100px;dialogWidth:400px;" _
& "center:no;scroll:no;status:no;resizable:no")
' Write document to modeless window
with g_MsgArea.document
.open
.writeln "<html><head><title>Working - patience please"
.writeln "</title></head><SCRIPT Language='VBScript'>"
.writeln "Dim g_bBlank, g_sRed, g_interval"
.writeln "sub startit"
.writeln "g_sRed=""<br><font color=red face=Arial size=4>" _
& "<center><b>Processing ...</b></center></font>"""
' Delay to allow modeless window page to repaint
.writeln "g_interval = setInterval(""Blink"", 250, ""vbscript"")"
'
.writeln "end sub"
.writeln "Sub Blink"
.writeln " if g_bBlank then"
.writeln " MsgArea.InnerHTML=g_sRed"
.writeln " else"
.writeln " MsgArea.InnerHTML="""""
.writeln " end if"
.writeln " g_bBlank=not g_bBlank"
.writeln "end sub"
' *DO NOT* remove the 'unnecessary' concatenation from next line
' of code. It is needed for correct parsing & execution
.writeln "</" & "script><body onload='startit'>"
.writeln "<span id=MsgArea></span></body></html>"
.close
Do Until .ReadyState = "complete" : Loop
End with
g_sGrnHTML = "<font color='green' face='Arial' size='4'><b>" & _
"Completed!! Total Count: nTotals</b></font>"
' Allow page to repaint
setTimeout "CountEvents", 50, "vbscript"
end sub
Sub CountEvents ' an example routine - doesn't do anything important
Dim n, i
Set oWMI = GetObject("winmgmts:\\.\root\cimv2")
Set cEvents = oWMI.ExecQuery("Select * From Win32_NTLogEvent")
'
' This loop is just here to slow things down as an example of a
' long running process
'
for i = 1 to 100*cEvents.count
n = n + 1
next
'
DataArea.InnerHTML = Replace(g_sGrnHTML, "nTotals", cEvents.count)
' Clear window timer and display completed message
with g_MsgArea.document
locInterval = .parentWindow.g_interval
.parentWindow.clearInterval locinterval
.all.MsgArea.InnerHTML = "<br><font color=lightgreen face=Arial size=4>" _
& "<center><b>Complete</b></center></font>"
end with
' Wait one second before closing progress window
setTimeout "g_MsgArea.close", 1000, "vbscript"
end sub
</SCRIPT>
<body onload=RunIt>
<input type="button" value=" Do it again " onclick="RunIt">
<p><hr><p>
<span id=DataArea></span>
</body>
</html>
It's complicated, but that's what I have handy.
Tom Lavedas
