I need to insert a strText to line 14 in a template.txt file. Line 14 will always be blank before writing (sort of like appending I guess).
What I really need is to copy line 21 to line 14. Not sure what is the easier method to achieve this?
Here is what I have so far but not working. Below code is the template.txt.
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
DIM Infile : Infile = "C:\template.txt"
Set tempFile = objFSO.OpenTextFile (Infile)
strText = tempFile.ReadAll
tempFile.Close
strNewText = Replace(strText, "","Channel_LandWaterMask = 3.0")
Set tempFile = objFSO.OpenTextFile (Infile, 2)
tempfile.Writeline 14, strNewText ‘(How would I write this???)
tempFile.Close
Here is the template.txt:
; Resample INF script for
; Section_YY XX_ZZZZ
[Source]
Type = MultiSource
NumberOfSources = 2
[Source1]
Type = GeoTIFF
Layer = Imagery
SourceDir = "S:\XX\Section_YY\Images"
SourceFile = "XX_ZZZZ_CC.tif"
Variation = DAY
[Source2]
Type = GeoTIFF
Layer = Imagery
SourceDir = "S:\XX\Section_YY\Images"
SourceFile = "XX_ZZZZ_LM.tif"
Variation = Night
Channel_LandWaterMask = 3.0
[Source3]
Type = GeoTIFF
Layer = None
SourceDir = "S:\XX\Section_YY\Images"
SourceFile = "XX_ZZZZ_WM.tif"
SamplingMethod = Gaussian
[Destination]
DestDir = "S:\2_Output\Section_YY"
DestBaseFileName = "XX_ZZZZ"
DestFileType = BGL
LOD = Auto
UseSourceDimensions = 1
CompressionQuality = 85
Take a look at the below example:
sContent = ReadTextFile("C:\template.txt", 0)
aContent = Split(sContent, vbCrLf)
aContent(13) = aContent(20) & vbCrLf & aContent(13)
sContent = Join(aContent, vbCrLf)
WriteTextFile sContent, "C:\template.txt", 0
Function ReadTextFile(sPath, lFormat)
' lFormat -2 - System default, -1 - Unicode, 0 - ASCII
With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, lFormat)
ReadTextFile = ""
If Not .AtEndOfStream Then ReadTextFile = .ReadAll
.Close
End With
End Function
Sub WriteTextFile(sContent, sPath, lFormat)
' lFormat -2 - System default, -1 - Unicode, 0 - ASCII
With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 2, True, lFormat)
.Write sContent
.Close
End With
End Sub
Note that it inserts the content of the line 21 before the line 14, thus preserving newline, since the content of the line 14 are newline chars. If you want just replace, then use aContent(13) = aContent(20) instead of aContent(13) = aContent(20) & vbCrLf & aContent(13).
Do Until Inp.AtEndOfStream
Count=Count + 1
Line=Inp.readline
If Count = 14 then
outp.writeline "My line 14"
Else
outp.writeline Line
End If
Loop
Is the pattern for your type of problem. Read a line, make a decision, write something.
Related
I'm developing a script that encrypts a users Tacacs-password, and writes this string into another script. My script opens, reads & writes the Tacacs-password into my other script but it doensn't overwrite it.
First run:
strTacacs = "Test1234"
Second run:
strTacacs = "Test1234"strTacacs = "Test1234"
My current script:
'***********Write to auto-logon script************
Const ForReading = 1
Const ForWriting = 2
newline = "strTacacs = " & chr(34) & Tacacs & chr(34)
line = 30
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim lineCount : lineCount = 0
Dim firstContent : firstContent = ""
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If LCase(objFSO.GetExtensionName(objFile)) = "vbs" Then
lineCount = 0
firstContent = ""
FileName = objStartFolder & objFile.Name
Set objStream = objFSO.OpenTextFile(strFile, ForReading)
Do Until objStream.AtEndOfStream
lineCount = lineCount + 1
firstContent = firstContent & objStream.ReadLine & vbCrLf
'msgbox(firstContent)
if lineCount = 30 Then
firstContent = firstContent & newline
msgbox(firstContent)
End if
Loop
Set objStream = objFSO.OpenTextFile(FileName, ForWriting)
objStream.WriteLine firstContent
objStream.Close
End If
Next
.
Does anybody know what I'm doing wrong?
I'm new in the world of scripting so your help is greatly appreciated!
Thx!
It looks like you are writing both the original line and the new line when you get to line 30. You should only write newline when lineCount is 30 and write the original line otherwise:
Do Until objStream.AtEndOfStream
lineCount = lineCount + 1
If lineCount = 30 Then
' Replace line with newline
firstContent = firstContent & newline & vbCrLf
Else
' Write original line
firstContent = firstContent & objStream.ReadLine & vbCrLf
End If
Loop
If you know the password in the original file, you could read the whole file content in one shot using ReadAll method:
Set objStream = objFSO.OpenTextFile(strFile, ForReading)
firstContent = objStream.ReadAll
then use Replace to replace the password, and finally write the content back.
You current line-by-line approach is easier if you don't know the password and simply replace a specific line. You could also check if line starts with strTacacs = which gets you away from hardcoding the line number:
Dim sLine
Dim sPasswordLine
sPasswordLine = "strTacas ="
Do Until objStream.AtEndOfStream
' Read line
sLine = objStream.ReadLine
If Left(sLine, Len(sPasswordLine)) = sPasswordLine Then
' Replace line with newline
firstContent = firstContent & newline & vbCrLf
Else
' Write original line
firstContent = firstContent & sLine & vbCrLf
End If
Loop
I need to remove some text from lines:
strdir = "C:\texto.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = fso.OpenTextFile(strdir)
Dim arrTxt()
k = 0
Do Until objFile.AtEndOfStream
z = (k+1)
ReDim Preserve arrTxt(z)
line = objFile.ReadLine
arrTxt(k) = line
k = z
Loop
print Join(arrTxt, ",")
print (UBound(arrTxt) + 1)
My text file texto.txt:
name=test
correo=test#test.tst
I want remove "name=" and "correo=".
#Cid showcased how you can use the power of Split/Join to achieve what you want. I am going to demonstrate how you can harness the power of RegEx to achieve similar result without having to read one line at a time.
Assuming your text file looks like this
strdir = "C:\texto.txt"
Set objFSO = CreateObject("Scripting.filesystemobject")
Set objFile = objFSO.OpenTextFile(strdir)
strContent = objFile.ReadAll
objFile.Close
msgbox RemoveLines(strContent)
Function RemoveLines(str)
Dim objRegEx
Set objRegEx = New RegExp
With objRegEx
.Global = True
.Pattern = "^name=.*\n|^correo=.*\n"
.Multiline = True
End With
RemoveLines = objRegEx.Replace(str, "")
End Function
Output
I'd split each lines using = as delimiter and then, I'd check if the first element is name or correo.
strdir = "C:\texto.txt"
Set fso = createobject("Scripting.filesystemobject")
Set objFile = fso.OpenTextFile(strdir)
Dim arrTxt()
k = 0
Do until objFile.AtEndOfStream
z = (k+1)
ReDim preserve arrTxt(z)
line = objFile.ReadLine
myArray = Split(line, "=")
If (Not ((UBound(myArray) > 0) AND (myArray(0) = "name" OR myArray(0) = "correo"))) Then
arrTxt(k) = line
k = z
End If
loop
print Join(arrTxt,",")
print (Ubound(arrTxt) + 1)
With vba - The initial idea is to make the code understandable for a human - the code has the following 3 tasks:
Read from a file and save the input as a string;
Manipulate the string (e.g. replace the name= and correo=;
Write the manipulated string to a new file;
All these actions are noticeable in the TestMe():
Sub TestMe()
Dim readTxt As String
Dim filePath As String: filePath = "C:\text.txt"
readTxt = ReadFromFile(filePath)
readTxt = Replace(readTxt, "name=", "")
readTxt = Replace(readTxt, "correo=", "")
WriteToFile filePath, readTxt
End Sub
Once the bone above is ready, the two functions ReadFromFile and WriteToFile are quite handy:
Public Function ReadFromFile(path As String) As String
Dim fileNo As Long
fileNo = FreeFile
Open path For Input As #fileNo
Do While Not EOF(fileNo)
Dim textRowInput As String
Line Input #fileNo, textRowInput
ReadFromFile = ReadFromFile & textRowInput
If Not EOF(fileNo) Then
ReadFromFile = ReadFromFile & vbCrLf
End If
Loop
Close #fileNo
End Function
Sub WriteToFile(filePath As String, text As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile(filePath)
oFile.Write text
oFile.Close
End Sub
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
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
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
I would like to check a txt file for a string.
If the string doesn't exist, it takes a number from key.txt and write it in another file. That part works fine.
But when the string is found, I would like to read the first five characters into a variable and take this variable to creating xml. When I run my script and the string is found.... the xml element Key is empty...
Anyone can help me? Thanks
Dim FSSys, Reference, corp, Account, intCorp, strPK, FS
Set FSSys = Wscript.CreateObject("Scripting.FileSystemObject")
Set Reference = FSSys.OpenTextFile("C:\corpreferenz.txt")
intCorp = Reference.ReadAll
Reference.Close
intCorp = intCorp + 1
Set corp = FSSys.CreateTextFile("C:\corpreferenz.txt")
corp.Write intCorp
corp.Close
Const FORREADING = 1
Const FORWRITING = 2
Const FORAPPENDING = 8
Dim sToSearch: sToSearch = "Test"
Dim sFileName: sFileName = "C:\Account.txt"
Dim sContent, Found, TxtFile
If Not FSSys.FileExists(sFileName) Then
MsgBox "File Not Found"
WScript.Quit 0
End If
Set TxtFile = FSSys.OpenTextFile(sFileName,FORREADING)
sContent = TxtFile.ReadAll
If InStr(sContent,sToSearch) Then
Found = True
while not TxtFile.AtEndOfStream
sTemp = TxtFile.ReadLine
If Instr(1,sTemp,sToSearch)>0 then
strPK = strPK + sTemp
FS = Left(strPK, 5)
End If
Wend
End If
Set TxtFile = Nothing
If Not Found Then
Set PKNumber = FSSys.OpenTextFile("C:\Key.txt")
intPKNumber = PKNumber.ReadAll
PKNumber.Close
intPKNumber = intPKNumber + 1
Set PKNum = FSSys.CreateTextFile("C:\Key.txt")
PKNum.Write intPKNumber
PKNum.Close
FS = intPKNumber
Set TxtFile = FSSys.OpenTextFile(sFileName,FORAPPENDING)
TxtFile.WriteLine intPKNumber & " " & sToSearch
End If
'Create XML
set xml = CreateObject("Microsoft.XMLDOM")
set encoding = xml.createProcessingInstruction("xml", "version='1.0'")
xml.insertBefore encoding, xml.childNodes.Item(0)
set foo = xml.createElement("XML")
set bar = xml.createElement("Table")
set corp = xml.createElement("Corp")
set cdata = xml.createCDATASection(intCorp)
set konto = xml.createElement("Key")
set cdata1 = xml.createCDATASection(FS)
corp.appendChild cdata
bar.appendChild corp
konto.appendChild cdata1
bar.appendChild konto
foo.appendChild bar
xml.appendChild(foo)
xmlSave xml, "C:BUP.xml"
'Function for XML
function xmlSave(xml, filename)
set rdr = CreateObject("MSXML2.SAXXMLReader")
set wrt = CreateObject("MSXML2.MXXMLWriter")
Set oStream = CreateObject("ADODB.STREAM")
oStream.Open
oStream.Charset = "ISO-8859-1"
wrt.indent = True
wrt.encoding = "ISO-8859-1"
wrt.output = oStream
Set rdr.contentHandler = wrt
Set rdr.errorHandler = wrt
rdr.Parse xml
wrt.flush
oStream.SaveToFile filename, 2
end function
After
sContent = TxtFile.ReadAll
you (the read pointer) are at the end of the file; TxtFile.AtEndOfStream is True and TxtFile.ReadLine won't be called/would fail. Evidence:
>> Set f = CreateObject("Scripting.FileSystemObject").OpenTextFile(WScript.ScriptFullName)
>> WScript.Echo 0, CStr(f.AtEndOfStream)
>> s = f.ReadAll()
>> WScript.Echo 1, CStr(f.AtEndOfStream)
>>
0 Falsch (False)
1 Wahr (True)
You could loop over the lines of the file (Split() sContent on vbCrLf), or - better - use a RegExp on sContent to extract the data needed.
I have text files that are approximately 6MB in size. There are some lines that contain the NULL (Chr(0))character that I would like to remove.
I have two methods to do this: using Asc()=0 but this takes approximately 50s to complete, the other method uses InStr (line, Chr(0)) =0 (fast ~ 4sec)but the results remove vital info from the lines which contain the NULL characters.
First line of text file as example:
##MMCIBN.000NULL7NULL076059NULL7653NULL1375686349NULL2528NULL780608NULL10700NULL\NULL_NC_ACT.DIR\CFG_RESET.INI
First method (works but VERY slow)
function normalise (textFile )
Set fso = CreateObject("Scripting.FileSystemObject")
writeTo = fso.BuildPath(tempFolder, saveTo & ("\Output.arc"))
Set objOutFile = fso.CreateTextFile(writeTo)
Set objFile = fso.OpenTextFile(textFile,1)
Do Until objFile.AtEndOfStream
strCharacters = objFile.Read(1)
If Asc(strCharacters) = 0 Then
objOutFile.Write ""
nul = true
Else
if nul = true then
objOutFile.Write(VbLf & strCharacters)
else
objOutFile.Write(strCharacters)
end if
nul = false
End If
Loop
objOutFile.close
end function
The output looks like this:
##MMCIBN.000
7
076059
7653
1375686349
2528
780608
10700
\
_NC_ACT.DIR\CFG_RESET.INI
Second method code:
filename = WScript.Arguments(0)
Set fso = CreateObject("Scripting.FileSystemObject")
sDate = Year(Now()) & Right("0" & Month(now()), 2) & Right("00" & Day(Now()), 2)
file = fso.BuildPath(fso.GetFile(filename).ParentFolder.Path, saveTo & "Output " & sDate & ".arc")
Set objOutFile = fso.CreateTextFile(file)
Set f = fso.OpenTextFile(filename)
Do Until f.AtEndOfStream
line = f.ReadLine
If (InStr(line, Chr(0)) > 0) Then
line = Left(line, InStr(line, Chr(0)) - 1) & Right(line, InStr(line, Chr(0)) + 1)
end if
objOutFile.WriteLine line
Loop
f.Close
but then the output is:
##MMCIBN.000\CFG_RESET.INI
Can someone please guide me how to remove the NULLS quickly without losing information. I have thought to try and use the second method to scan for which line numbers need updating and then feed this to the first method to try and speed things up, but quite honestly I have no idea where to even start doing this!
Thanks in advance...
It looks like the first method is just replacing each NULL with a newline. If that's all you need, you can just do this:
Updated:
OK, sounds like you need to replace each set of NULLs with a newline. Let's try this instead:
strText = fso.OpenTextFile(textFile, 1).ReadAll()
With New RegExp
.Pattern = "\x00+"
.Global = True
strText = .Replace(strText, vbCrLf)
End With
objOutFile.Write strText
Update 2:
I think the Read/ReadAll methods of the TextStream class are having trouble dealing with the mix of text and binary data. Let's use an ADO Stream object to read the data instead.
' Read the "text" file using a Stream object...
Const adTypeText = 2
With CreateObject("ADODB.Stream")
.Type = adTypeText
.Open
.LoadFromFile textFile
.Charset = "us-ascii"
strText = .ReadText()
End With
' Now do our regex replacement...
With New RegExp
.Pattern = "\x00+"
.Global = True
strText = .Replace(strText, vbCrLf)
End With
' Now write using a standard TextStream...
With fso.CreateTextFile(file)
.Write strText
.Close
End With
I tried this method (update2) for reading a MS-Access lock file (Null characters terminated strings in 64 byte records) and the ADODB.Stream didn't want to open an already in use file. So I changed that part to :
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(Lfile)
z = f.Size
set ts = f.OpenAsTextStream(ForReading, 0) 'TristateFalse
strLog = ts.Read(z)
ts.Close
set f = nothing
' replace 00 with spaces
With New RegExp
.Pattern = "\x00+"
.Global = True
strLog = .Replace(strLog, " ")
End With
' read MS-Access computername and username
for r = 1 to len(strLog) step 64
fnd = trim(mid(strLog,r, 32)) & ", " & trim(mid(strLog,r+32, 32)) & vbCrLf
strRpt = strRpt & fnd
next