I got some script to convert string to base64 and write encoded data to text file that's all goes fine and result stored in encoded.txt but I need each line to be double quoted at the start and '& _' with double quotes at the end so how to make this script do that automatically for each line? here is my script
Option Explicit
Const fsDoOverwrite = true
Const fsAsASCII = false
Const adTypeBinary = 1
Dim objFSO
Dim objFileOut
Dim objXML
Dim objDocElem
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open()
objStream.LoadFromFile(Wscript.scriptfullname)
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
objDocElem.dataType = "bin.base64"
objDocElem.nodeTypedValue = objStream.Read()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFileOut = objFSO.CreateTextFile("encoded.txt", fsDoOverwrite, fsAsASCII)
objFileOut.Write objDocElem.text
objFileOut.Close()
Set objFSO = Nothing
Set objFileOut = Nothing
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing
Sub encodeFileBase64( inputFile, outputFile )
Const fsDoOverwrite = True
Const fsAsASCII = False
Const adTypeBinary = 1
Dim stream, strBuffer
Set stream = WScript.CreateObject("ADODB.Stream")
With stream
.Type = adTypeBinary
.Open
.LoadFromFile inputFile
End With
With WScript.CreateObject("MSXML2.DOMDocument").CreateElement("Base64Data")
.dataType = "bin.base64"
.nodeTypedValue = stream.Read()
strBuffer = .Text
End With
stream.Close
With New RegExp
.Multiline = True
.Global = True
.IgnoreCase = False
.Pattern = "[\r\n]+(?=[0-9A-Za-z])"
strBuffer = Chr(34) & .Replace(strBuffer, Chr(34) & " & _" & vbCrLf & Chr(34) ) & Chr(34)
End With
WScript.CreateObject("Scripting.FileSystemObject").CreateTextFile( outputFile, fsDoOverwrite, fsAsASCII ).Write strBuffer
End Sub
encodeFileBase64 WScript.ScriptFullName, WScript.ScriptFullName & ".b64"
This will use a regular expression object to replace all intermediate line endings with the adecuated line termination/start and two aditional quotes, one at the start and one at the end.
Split the text by a line break, then loop through and put it all back together while you add the quotes. (not tested, but probably close, code follows; there is a strong chance you'll need to find the right type of line feed for your situation - I picked vbCr as an example):
allTextArray = SPLIT(originalText, vbCr)
For i=0 to UBound(allTextArray)
allTextWithQuotes = allTextWithQuotes & """" & allTextArray(i) & """"
Next
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
The below .TXT file is read into a VBS FileSystemObject. I am trying to search for all dates that match otherwise I need to put them in a "error.txt" file. However, when I run my code below it is always placing the matches in the error.txt file and not skipping the matching dates.
Why are the dates not matching?
INPUT:
"LIRRR 1M",.412900,02/08/2016
"LIRRR 3M",.222700,02/08/2016
"LIRRR 6M",.333200,02/08/2016
"LIRRR12M",1.1333300,02/08/2016
"FEDFRRRR",.333000,02/08/2016
"CCC 1YR",.550330,02/08/2016
"5YRCMT",1.2503300,02/08/2016
"10YRCMT",1.860000,02/08/2016
Here is the code that I have written:
On error resume next
Const ForReading = 1
Dim strSearchFor
Dim MyDate, MyWeekDay
MyDate = Date ' Assign a date.
MyWeekDay = Weekday(MyDate)
If MyWeekDay = 2 then
strSearchFor =Right("0" & DatePart("m",Date), 2)&"/"&Right("0" & DatePart("d",Date-3), 2)&"/"&DatePart("yyyy",Date)
Else
strSearchFor =Right("0" & DatePart("m",Date), 2)&"/"&Right("0" & DatePart("d",Date-1), 2)&"/"&DatePart("yyyy",Date)
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("C:\Users\Desktop\index.txt", ForReading)
do until objTextFile.AtEndOfStream
strLine = objTextFile.ReadLine()
If InStr(strLine, strSearchFor) <> 0 then
Set objFile = objFSO.CreateTextFile("C:\Users\Desktop\pass.txt")
objFile.Write "date is match"& vbCrLf
Else
Set objFile = objFSO.CreateTextFile("C:\Users\Desktop\error.txt")
objFile.Write "date is not match"& vbCrLf
End If
loop
objTextFile.Close
Why not use RegEx to get the portion of the string that appears to be the date and use the IsDate Function to validate it?
Option Explicit
Dim arrLines,i
arrLines = ReadFile("./input.txt","byline")
For i=LBound(arrLines) to UBound(arrLines)
wscript.echo FormatOutput(arrLines(i))
Next
'*********************************************
Function FormatOutput(s)
Dim re, match
Set re = New RegExp
re.Pattern = "[\d]+[\/-][\d]+[\/-][\d]+"
re.Global = True
For Each match In re.Execute(s)
if IsDate(match.value) then
FormatOutput = CDate(match.value)
Exit For
end if
Next
Set re = Nothing
End Function
'*********************************************
Function ReadFile(path,mode)
Const ForReading = 1
Dim objFSO,objFile,i,strLine
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(path,ForReading)
If mode = "byline" then
Dim arrFileLines()
i = 0
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(i)
strLine = objFile.ReadLine
strLine = Trim(strLine)
If Len(strLine) > 0 Then
arrFileLines(i) = strLine
i = i + 1
ReadFile = arrFileLines
End If
Loop
objFile.Close
End If
If mode = "all" then
ReadFile = objFile.ReadAll
objFile.Close
End If
End Function
'*****************************************************************
Please advice how changes the current single incoming log file to search multiple files.
Dim strTextToFind, strInputFile, strOutputFile, boolMatchCaseSensitive
Dim objFSO, objInputFile, strFoundText, strLine, objOutputFile
strTextToFind = Inputbox("Enter the text you would like to search for.")
strInputFile = "C:\Users\mmmanima\Desktop\mani\Day_16.txt"
iF YOU CAN NOTICED, IM ONLY ACCESS THE day_16 FILE
strOutputFile = "C:\Users\mmmanima\Desktop\texting As\result.txt"
Set objFSO = CreateObject("Scripting.FilesystemObject")
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine
If InStr(strLine,strTextToFind) > 0 Then
strFoundText = strLine
If strFoundText <> "" Then
Set objOutputFile = objFSO.OpenTextFile(strOutputFile,intForAppending, True)
objOutputFile.WriteLine strFoundText
objOutputFile.Close
Set objOutputFile = Nothing
End If
End If
loop
objInputFile.Close
Set objInputFile = Nothing
WScript.Quit
VBScript required to search userinput string into the share folder and there is 60 files.
As I believe you want to search through the all files in a particular folder. Then I suggest you to loop you action while all files are read
to do that it's easier to maintain sub or function
pseudo:
var inputFolder = ".\myfolder"
foreach file in the inputFolder
{
inputFile = file
searchIn(inputFile)
}
sub searchIn(inputFile)
{
'do your current works here
}
code:
This part will give you the all file names
Set fso = CreateObject("Scripting.FileSystemObject")
inputFldr = Replace(wscript.scriptfullname,wscript.scriptname,".\")
Set fldr = fso.getFolder(inputFldr)
For Each file In fldr.Files
'call to your function
Next
----------plese aware of typos------
Dim strTextToFind, strInputFile, strOutputFile, boolMatchCaseSensitive
Dim objFSO, objInputFile, strFoundText, strLine, objOutputFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
inputFldr = Replace(wscript.scriptfullname,wscript.scriptname,".\")
Set fldr = objFSO.getFolder(inputFldr)
strTextToFind = Inputbox("Enter the text you would like to search for.")
For Each file In fldr.Files
yourFunctionName(file )
Next
sub yourFunctionName(inputFile)
strInputFile = inputFile
strOutputFile = ".\result.txt"
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine
If InStr(strLine,strTextToFind) > 0 Then
strFoundText = strLine
If strFoundText <> "" Then
Set objOutputFile = objFSO.OpenTextFile(strOutputFile,intForAppending, True)
objOutputFile.WriteLine strFoundText
objOutputFile.Close
Set objOutputFile = Nothing
End If
End If
loop
objInputFile.Close
Set objInputFile = Nothing
end sub
WScript.echo "done"
WScript.Quit
You can try this vbscript, i added a function BrowseForFolder()
Option Explicit
Dim strTextToFind,inputFldr,strInputFile,strOutputFile,path,fldr
Dim objFSO, objInputFile,strFoundText,strLine,objOutputFile,file,ws
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("wscript.Shell")
path = objFSO.GetParentFolderName(wscript.ScriptFullName)
strOutputFile = path & "\result.txt"
If objFSO.FileExists(strOutputFile) Then
objFSO.DeleteFile(strOutputFile)
End if
inputFldr = BrowseForFolder()
Set fldr = objFSO.getFolder(inputFldr)
strTextToFind = Inputbox("Enter the text you would like to search for it !","Enter the text you would like to search for it !","wscript")
For Each file In fldr.Files
Call Search(file,strTextToFind)
Next
ws.run strOutputFile
'***************************************************************************************************************
Sub Search(inputFile,strTextToFind)
strInputFile = inputFile
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
Set objInputFile = objFSO.OpenTextFile(strInputFile,intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine
If InStr(strLine,strTextToFind) > 0 Then
strFoundText = strLine
If strFoundText <> "" Then
Set objOutputFile = objFSO.OpenTextFile(strOutputFile,intForAppending, True)
objOutputFile.WriteLine "The Path of file ===> "& DblQuote(strInputFile) & VbCRLF &_
"String found "& DblQuote(strTextToFind) & " ===> "& DblQuote(strFoundText) & VbCRLF & String(100,"*")
objOutputFile.Close
Set objOutputFile = Nothing
End If
End If
loop
objInputFile.Close
Set objInputFile = Nothing
End sub
'***************************************************************************************************************
Function BrowseForFolder()
Dim ws,objFolder,Copyright
Set ws = CreateObject("Shell.Application")
Set objFolder = ws.BrowseForFolder(0,"Choose the folder to search on it ",1,"c:\Programs")
If objFolder Is Nothing Then
Wscript.Quit
End If
BrowseForFolder = objFolder.self.path
end Function
'****************************************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************
A bit late in the day after such a long time gap to address Mara Raj's problem with Hackoo's script but here it is for any others who may be interested. On starting the script it automatically deletes any existing result.txt file. Should the script subsequently go on to find "no match" it fails to generate a results.txt file as it would normally do if there were a match. The simplest way to correct this is to insert:
If objFSO.FileExists(strOutputFile) Then
else
wscript.echo "No Matches Found"
wscript.Quit
end if
between "next" and "ws.run strOutputFile"
I need a script to be able to move files with like names once there are 4 like files.
Example:
Cust-12345.txt
Addr-12345.txt
Ship-12345.txt
Price-12345.txt
The files will always start with those for names, the numbers after the "-" will always be different. I need to be able to search a folder and when all 4 files are there move them into a completed folder.
option explicit
dim objFS : dim strShareDirectory : dim strDumpStorageDir : dim objFolder : dim colFiles : dim re : dim objFile
dim dictResults ' dictionary of [filename] -> [matching substring]
dim dictResultsCount ' dictionary of [matching substring] -> [count]
dim dictResultsFinal ' only the valid entries from dictResults
dim keyItem
dim strMatch
dim message
message = "Yes"
set dictResultsFinal = CreateObject("Scripting.Dictionary")
set dictResults = CreateObject("Scripting.Dictionary")
set dictResultsCount = CreateObject("Scripting.Dictionary")
Set objFS = CreateObject("Scripting.FileSystemObject")
strShareDirectory = "c:\Test"
strDumpStorageDir = "c\Test\Out"
Set objFolder = objFS.GetFolder(strShareDirectory)
Set colFiles = objFolder.Files
Set re = New RegExp
re.Global = True
re.IgnoreCase = False
re.Pattern = "-\d"
Dim curFile, matchValue
Dim i: i = 0
For Each objFile in colFiles
' test if the filename matches the pattern
if re.test(objFile.Name) then
' for now, collect all matches without further checks
strMatch = re.execute(objFile.Name)(0)
dictResults(objFile.Name) = strMatch
' and count
if not dictResultsCount.Exists(strMatch) then
dictResultsCount(strMatch) = 1
else
dictResultsCount(strMatch) = dictResultsCount(strMatch) +1
end if
end if
next
' for testing: output all filenames that match the pattern
msgbox join(dictResults.keys(), vblf)
' now copy only the valid entries into a new dictionary
for each keyItem in dictResults.keys()
if dictResultsCount.Exists( dictResults(keyItem) ) then
if dictResultsCount( dictResults(keyItem) ) = 4 then
dictResultsFinal(keyItem) = 1
end if
end if
next
I had an answer here that involved using an array but, come to think of it, I don't think you even need an array. Just iterate each file and check for the existence of the others.
Set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.Pattern = "\\(Cust|Addr|Ship|Price)-(\d+)\.txt"
For Each File In objFS.GetFolder(strShareDirectory).Files
' Test to make sure the file matches our pattern...
If re.Test(File.Path) Then
' It's a match. Get the number...
strNumber = re.Execute(File.Path)(0).SubMatches(1)
' If all four exist, move them...
If AllFourExist(strNumber) Then
For Each strPrefix In Array("Cust-", "Addr-", "Ship-", "Price-")
objFS.MoveFile strShareDirectory & "\" & strPrefix & strNumber & ".txt", _
strDumpStorageDir & "\" & strPrefix & strNumber & ".txt"
Next
End If
End If
Next
And here's the AllFourExist function (I'm assuming objFS is global):
Function AllFourExist(strNumber)
For Each strPrefix In Array("Cust-", "Addr-", "Ship-", "Price-")
If Not objFS.FileExists(strShareDirectory & "\" & strPrefix & strNumber & ".txt") Then Exit Function
Next
AllFourExist = True
End Function
I'm not sure how the FSO will handle the fact that you're moving files out of a folder that you're currently iterating. If it complains, you may need to resort to an array after all. Something to keep in mind.