Remove parts of a string and copy the rest back to a file with vbscript - vbscript

I would like to remove the unwanted text from each string in a file.
the input string looks like this
username^time stamp^don't need this printed on printer name more useless info pages printed:some number
I want to remove everything else but keep the username,time stamp,printer name and some number.Then write each line to a file so the output looks like this
username timestamp printername some number
This is the code I'm working with
Set fs = CreateObject("Scripting.FileSystemObject")
sf = "C:\test.txt"
Set f = fs.OpenTextFile(sf, 1) ''1=for reading
s = f.ReadAll
segments = Split(s,"^",-1)
s= segments(1,)
f.Close
Set f = fs.OpenTextFile(sf, 2) ''2=ForWriting
f.Write s
f.Close

There's always a moment that somebody asks "Why not use a regular expression?". This is that moment.
Try this:
Dim re, s, match, matches
s = "Chuck Norris^12-12-2012^don't need this printed on HAL9000 more useless info pages printed:42 "
Set re = new regexp
re.pattern = "(.*)\^(.*)\^.*printed on (\w+).*pages printed:(\d+).*"
re.Global = True
Set matches = re.Execute(s)
Set match = matches(0)
msgbox "username=" & match.submatches(0)
msgbox "time stamp=" & match.submatches(1)
msgbox "printer=" & match.submatches(2)
msgbox "pages printed=" & match.submatches(3)
Neat huh? And I bet you'll figure out how to implement it in your existing code.

Code:
Const csSep = "^"
'username^time^(other arbitrary junk)^printer name^(other arbitrary junk)^page count
Dim sJunk : sJunk = "kurt^01:02:03^some junk^nec p7^nix^123"
WScript.Echo sJunk
Dim aParts : aParts = Split(sJunk, csSep)
Dim sNetto : sNetto = Join(Array(aParts(0),aParts(1),aParts(3),aParts(5)), csSep)
WScript.Echo sNetto
output:
kurt^01:02:03^some junk^nec p7^nix^123
kurt^01:02:03^nec p7^123

Related

remove nul characters from text file using vbs

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

Vbs script to add space if it finds a string like abc11adv to abc11 adv

Hi I am novice in vbs script. I have one text file every line has statements like
minis1in use by bla bla
rit34in use by someone
atp34in use by someone2
I want a vbs script to convert this text file to
minis1 in use by bla bla
rit34 in use by someone
atp34 in use by someone2
I found one vbs script but it replaces string at particular position in every line. But I want to search for a number only in first string in every line and number may be one digit or two digit or three digit after that number it should give space. Without replacing character with a space.
StrFileName = "C:\Users\Desktop\Scheduled\output.txt"
Const ForReading = 1
Const ForWriting = 2
Dim objFSO
Dim objTF
Dim objRexex
Dim StrFileName
Dim strTxt
StrFileName = "C:\Users\Desktop\Scheduled\output.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile(StrFileName, ForReading)
Set objregex = CreateObject("vbscript.regexp")
strTxt = objTF.ReadAll
objTF.Close
With objregex
.Global = True
.MultiLine = True
.Pattern = "^(.{6})[^-](.*)$"
strTxt = .Replace(strTxt, "$1" & " " & "$2")
End With
Set objTF = objFSO.OpenTextFile(StrFileName, ForWriting)
objTF.Write strTxt
objTF.Close
Maybe the pattern "^(\w+)(\d+)(\w+)" used non-globally will do what you want:
Option Explicit
Dim r : Set r = New RegExp
r.Global = False ' just the first
r.Pattern = "^(\w+)(\d+)(\w+)"
Dim s
For Each s In Split("minis1in use by+rit34adv use+atp34in use not34in use+not here1in use", "+")
WScript.Echo s
WScript.Echo r.Replace(s, "$1$2 $3")
WScript.Echo
Next
output:
cscript 25228592.vbs
minis1in use by
minis1 in use by
rit34adv use
rit34 adv use
atp34in use not34in use
atp34 in use not34in use
not here1in use
not here1in use
If "every line has statements like" what you've shown, and you're sure of that, make it easy on yourself:
strTxt = Replace(strTxt, "in use by ", " in use by ")

Search and divide numeric strings

I have an output.txt file which has following content:
Windows 6543765432
Linux 4534653463
MacOS 3564325
Ubuntu 8235646255
I want to create a VBScript which searches for all numeric values in output.txt and divide them by 1024 so that memory in KB can be changed into MB.
I have tried in batch here, but due to 2 GB limitation it's not working in above case.
Your top-level task is to modify a small file of structured text. The 'design pattern' for such a task is:
Get a FileSystemObject
Specify the full file path
Read the content
Modify the content
Write the modified content back
Your sub-task of modification involves computations on non-constant /varying parts; then a 'RegExp.Replace with Function' strategy should be used:
Define a RegExp (global, identify the parts to change)
.Replace(input, GetRef("function to do the computations on the parts"))
In your case, that function should convert the (string) parts to numbers, divide then, and return the result converted to strings.
In code:
Option Explicit
Const FSPEC = "..\testdata\txt\19556079.txt"
Dim oFS : Set oFS = CreateObject( "Scripting.FileSystemObject" )
Dim sAll : sAll = Modify(oFS.OpenTextFile(FSPEC).ReadAll())
oFS.CreateTextFile(FSPEC).Write sAll
WScript.Echo oFS.OpenTextFile(FSPEC).ReadAll()
Function Modify(s)
Dim re : Set re = New RegExp
re.Global = True
re.Pattern = "\d+"
Modify = re.Replace(s, GetRef("FiMoReFunc"))
End Function
Function FiMoReFunc(sM, sP, sS)
FiMoReFunc = CStr(CDbl(sM) / 1024)
End Function
For a more fancy output:
FiMoReFunc = Right(Space(20) & FormatNumber(CDbl(sM) / 1024, 1, True) & " Unit", 20)
output:
Windows 6,390,395.9 Unit
Linux 4,428,372.5 Unit
MacOS 3,480.8 Unit
Ubuntu 8,042,623.3 Unit
Try this
Option Explicit
Const FILE = "output.txt"
Dim fso
Dim ts,line
Dim match,matches
Dim os,mem
Set fso = CreateObject("Scripting.FilesystemObject")
Set ts = fso.OpenTextFile(FILE)
With New RegExp
.IgnoreCase = True
While Not ts.AtEndOfStream
line = ts.ReadLine
.Pattern = "[a-z]+"
Set matches = .Execute(line)
For Each match In matches
os = match.Value
Next
.Pattern = "\d+"
Set matches = .Execute(line)
For Each match In matches
mem = (CDbl(match.Value) / 1024)
Next
WScript.Echo os & vbTab & mem
Wend
End With
Set ts = Nothing
Set fso = Nothing
WScript.Quit

subscript out of range error in vbscript

Can someone look at the below script and tell me why it's throwing this error subscript out of range error in vbscript ..In the text file there are two entries it writes to the file correctly but then it throws an error while exiting the loop so it never calls the other function..I think it's trying to run 3 times but there are just 2 entries in the text file
The text file is in this format
Format.css Shared
Design.css Shared
Dim strInputPath1
Dim txsInput1,txsOutput
Dim FSO
Dim Filename
Set FSO = CreateObject("Scripting.FileSystemObject")
strOutputPath = "C:\txt3.txt"
Set txsOutput = FSO.CreateTextFile(strOutputPath)
Set re = New RegExp
re.Pattern = "\s+"
re.Global = True
Set f = FSO.OpenTextFile("C:\Users\spadmin\Desktop\Main\combination.txt")
Do Until f.AtEndOfStream
tokens = Split(Trim(re.Replace(f.ReadLine, " ")))
extension = Split(tokens(0),".")
strInputPath1 = "C:\inetpub\wwwroot\Test\files\" & tokens(1) & "\" & extension(1) & "\" & tokens(0)
Set txsInput1 = FSO.OpenTextFile(strInputPath1, 1)
WScript.Echo strInputPath1
txsOutput.Writeline txsInput1.ReadAll
Loop
WScript.Echo "Calling"
txsInput1.Close
txsOutput.Close
f.Close
Call CreateCSSFile()
''''''''''''''''''''''''''''''''''''
' Merge Css Files
''''''''''''''''''''''''''''''''''''
Sub CreateCSSFile()
WScript.Echo "Called"
Dim FilenameCSS
Dim strInputPathCSS
Dim txsInputCSS,txsOutputCSS
Dim FSOCSS
Set FSOCSS = CreateObject("Scripting.FileSystemObject")
strOutputPathCSS = "C:\txt4.txt"
Set txsOutputCSS = FSOCSS.CreateTextFile(strOutputPath)
Set re = New RegExp
re.Pattern = "\s+"
re.Global = True
Set fCSS = FSOCSS.OpenTextFile("C:\Users\spadmin\Desktop\TestingTheWebService\combination.txt")
Do Until fCSS.AtEndOfStream
tokensCSS = Split(Trim(re.Replace(fCSS.ReadLine, " ")))
extensionCSS = Split(tokensCSS(0),".")
strInputPathCSS = "C:\inetpub\wwwroot\EpsShared\c\" & tokensCSS(1) & "\" & extensionCSS(1) & "\" & tokensCSS(0)
Set txsInputCSS = FSOCSS.OpenTextFile(strInputPathCSS, 1)
txsOutputCSS.Writeline txsInputCSS.ReadAll
Loop
fCSS.Close
txsInputCSS.Close
txsOutputCSS.Close
Set FSOCSS = Nothing
End Sub
If your file contains trailing blank lines, applying Split() may return arrays with less than 2 elements. In that case token(1) should throw a 'subscript out of range' error.
You should always check, if Split() workes as expected:
tokens = Split(Trim(re.Replace(f.ReadLine, " ")))
If 1 = UBound(tokens) Then
extension = Split(tokens(0),".")
If 1 = UBound(extension) Then
strInputPath1 = "..." & tokens(1) & "..."
Else
... parse error ...
End If
Else
... parse error or just trailing blank lines? ...
End If

Break down sections in a text file using vbscript

I have a file which is in this format
name.css value
name.js value
I want to break this down and create strings which will be in this format
string1 = "c:\" + value + name + extension(css or js)
can someone please tell me how to do this in vbscript.
So far I am looking to break this into dictionary and then loop through and creating new dim objects which loops through the whole file and creates values but not getting it right.Any help is very much appreciated.
Thanks
Simple solution:
Set fso = CreateObject("Scripting.FileSystemObject")
Set re = New RegExp
re.Pattern = "\s+"
re.Global = True
Set f = fso.OpenTextFile("C:\your\input.txt")
Do Until f.AtEndOfStream
tokens = Split(Trim(re.Replace(f.ReadLine, " ")))
WScript.Echo "C:\" & tokens(1) & tokens(0)
Loop
f.Close

Resources