How can we decrease code execution time in VBScript - vbscript

Question

I have the below code to replace NUL characters in a text file. This code is working as per my requirement for smaller files but the problem is when the file size is increasing it is taking more time. I have a file which consists of more than 200,000 lines consists of 160MB+ size. I have executed my code for this file and I waited for more than 2 hours still the code executing.
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
If (WScript.Arguments.Count > 0) Then
sInfile = WScript.Arguments(0)
Else
WScript.Echo "No filename specified."
WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
sOutfile = WScript.Arguments(1)
Else
sOutfile = sInfile
End If
'Get the text file from cmd file
sData = ""
FinalData = ""
sInfile = WScript.Arguments(1)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set re = New RegExp
re.Pattern = "\x00.*"
re.Global = True
Set f = oFSO.OpenTextFile(sInfile, 1, False, -1)
Do Until f.AtEndOfStream
sData = Replace(f.ReadLine, vbCrLf, "")
FinalData = FinalData + re.Replace(sData, "") + vbCrLf
Loop
f.Close
Set oOutfile = oFSO.OpenTextFile(sOutfile, 2, True, -1)
oOutfile.Write(FinalData)
oOutfile.Close
Set oOutfile = Nothing
Set oFS = Nothing
WScript.Quit
Is there any way to optimize the code to execute in less interval of time.
EDIT 1:
Updated Code:
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
If (WScript.Arguments.Count > 0) Then
sInfile = WScript.Arguments(0)
Else
WScript.Echo "No filename specified."
WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
sOutfile = WScript.Arguments(1)
Else
sOutfile = sInfile
End If
'Get the text file from cmd file
sData = ""
FinalData = ""
sInfile = WScript.Arguments(1)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set re = New RegExp
re.Pattern = "\x00.*"
re.Global = True
Set f = oFSO.OpenTextFile(sInfile, 1, False, -1)
Do Until f.AtEndOfStream
sData = Replace(f.ReadAll, vbCrLf, "")
FinalData = FinalData + re.Replace(sData, "") + vbCrLf
Loop
f.Close
Set oOutfile = oFSO.OpenTextFile(sOutfile, 2, True, -1)
oOutfile.Write(FinalData)
oOutfile.Close
Set oOutfile = Nothing
Set oFS = Nothing
WScript.Quit

Answer 1

Do not use ReadAll for large files. Reading large files into memory might exhaust the available RAM on your computer, so that it will come grinding to a halt because it starts swapping.
Also avoid concatenating strings in a loop, because the operation is slow.
Change this:
Set f = oFSO.OpenTextFile(sInfile, 1, False, -1)
Do Until f.AtEndOfStream
sData = Replace(f.ReadLine, vbCrLf, "")
FinalData = FinalData + re.Replace(sData, "") + vbCrLf
Loop
f.Close
Set oOutfile = oFSO.OpenTextFile(sOutfile, 2, True, -1)
oOutfile.Write(FinalData)
oOutfile.Close
to this:
Set f = oFSO.OpenTextFile(sInfile, 1, False, -1)
Set oOutfile = oFSO.OpenTextFile(sOutfile, 2, True, -1)
Do Until f.AtEndOfStream
oOutFile.WriteLine re.Replace(f.ReadLine, "")
Loop
f.Close
oOutfile.Close
Same code with string operations instead of a regular expression replacement:
Set f = oFSO.OpenTextFile(sInfile, 1, False, -1)
Set oOutfile = oFSO.OpenTextFile(sOutfile, 2, True, -1)
Do Until f.AtEndOfStream
line = f.ReadLine
pos = InStr(line, Chr(0))
If pos > 0 Then line = Left(line, pos-1)
oOutFile.WriteLine line
Loop
f.Close
oOutfile.Close

Answer 2

I know it's not up to date, but it might be useful to someone.
I tried another approach that takes about 5 seconds! :)
It seems that scripting engine (wscript) or FileSystemObject has a problem loading 160 MB at a time (by .ReadAll method).
So I tried to load all data (into the Dictionary) line by line via .ReadLine, process it and then save it to the output file at once.
Appendix:
- I added the option to create a test file - if you specify "CreateData" as the second argument:wscript util.vbs "C:\Temp\SampleData.txt" CreateData
- You do not need to remove CR + LF from a string that returns .ReadLine. They are already skipped.
- Sometimes it is good to test .AtEndOfStream before .ReadAll method, because if the file will be empty, the method will cause run-time error.
Dim mode, sInFile, sOutFile
If (WScript.Arguments.Count > 0) Then
sInfile = WScript.Arguments(0)
Else
WScript.Echo "No filename specified."
WScript.Quit
End If
If (WScript.Arguments.Count > 1) Then
If StrComp(WScript.Arguments(1), "CreateData", 1) = 0 then
mode = "CreateData"
sOutfile = sInFile
Else
mode = "processing"
sOutfile = WScript.Arguments(1)
End If
Else
mode = "processing"
sOutfile = sInfile
End If
Set oFSO = CreateObject("Scripting.FileSystemObject")
if mode = "CreateData" then
Call CreateDataFile(sInfile, 160) '160 = approx. 160 MB'
Wscript.Quit
end if
Dim dictData, i, sLine, tim
tim = Timer()
'Load data
set dictData = CreateObject("Scripting.Dictionary")
Set f = oFSO.OpenTextFile(sInfile, 1, False, -1)
do while not f.AtEndOfStream
dictData.Add dictData.Count, f.ReadLine()
loop
f.Close
'Process data
for each i in dictData
sLine = dictData(i)
dictData(i) = Replace(sLine, Chr(0), "")
next
'Save processed data
sFinalData = Join(dictData.Items, vbCrLf)
Set oOutfile = oFSO.OpenTextFile(sOutfile, 2, True, -1)
oOutFile.Write sFinalData
oOutfile.Close
'Message
WScript.Echo "Data processed (" & (Timer() - tim) & " sec)"
'-------------------------------------------------------------------------------
sub CreateDataFile(ByVal sFilePath, ByVal nSizeInMB)
'-------------------------------------------------------------------------------
Dim sLine, arrData, i, iMax, sData, tim
rem tim = Timer()
sLine = String(255, "A") & Chr(0) & String(254, "B")
iMax = CLng((nSizeInMB*1024*1024)/(Len(sLine)*2)) 'Unicode chars take 2 bytes
ReDim arrData(iMax)
for i = 0 to iMax
arrData(i) = sLine
next
sData = Join(arrData, vbCrLf)
set oFile = oFSO.CreateTextFile(sFilePath, True, True)
oFile.Write sData
oFile.Close
rem WScript.Echo "Data created (" & (Timer() - tim) & " sec)"
end sub