I have VBScript that launches TestNG tests. Before calling tests it should download .jar files of application under test. Here is the main part of the code:
'Variables - input args
Dim objArgs
Set objArgs = wscript.Arguments
finalHour = CInt(objArgs(1))
Set oShell = WScript.CreateObject("WSCript.shell")
Set UAC = CreateObject("Shell.Application")
'save script stating date
startDay = Day(Now)
startHour = Hour(Now)
downloadLink = "http://....ru:.../.../"
savePath = "C:\monitoring\build-under-test\"
WScript.Echo "Download jar files from '" & downloadLink & "...'"
'DownloadFile downloadLink & "some.jar", savePath & "some.jar"
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = CreateObject("ADODB.Stream")
xHttp.Open "GET", downloadLink & "account.jar", False
xHttp.Send
With bStrm
.Type = 1 '//binary
.Open
.Write xHttp.ResponseBody
.SaveToFile savePath & "account.jar", 1 '//overwrite
.Close
End With
xHttp = Nothing
bStrm = Nothing
Do
WScript.Echo "Executing: run-suite.bat " & objArgs(0) & " - at " & Now
WScript.Echo " finalHour = " & finalHour
'With waiting of last command execution
oShell.Run "run-suite.bat " & objArgs(0) & " " & objArgs(1) & " false true > C:\monitoring\results\logfiles\" & logBatName, 1, True
currentHour = Hour(Now)
WScript.Echo " checking: currentHour < finalHour :: " & currentHour & " < " & finalHour
Loop While currentHour < finalHour
The problem is that when I executed this file:
cscript.exe "run-monitoring.vbs" "test-suite\monitoring-all-tests.xml" 21
This file deleted itself. Then after I recreated the file, it deleted itself again without run command. So I started to recreate it and comment lines to find the line which forces deletion of the file. It was:
.SaveToFile savePath & "account.jar", 1 '//overwrite
When I remove comment, file deletes itself. Even after PC restart.
Why is it so? Why is file reexecuted even when I do not run it?
There are two lines of code that work with the same resources (.jar files)
.SaveToFile savePath & "account.jar", 1 '//overwrite
and (java tests that use this lib):
oShell.Run "run-suite.bat " & objArgs(0) & " " & objArgs(1) & " false true > C:\monitoring\results\logfiles\" & logBatName, 1, True
Commenting any of these lines fixes self-deleting. So solution I used is quite simple: move .jar file saving operation to another vbscript file download-jar.vbs and call it in the script:
oShell.run "cscript.exe download-jar.vbs " & downloadJarsLink, 1, True
Maybe there is another way (release resources after saving) but I need fast and steady solution, and here it is.
Related
This question already has answers here:
Download a file with VBS
(6 answers)
Closed last year.
I've been trying to download a dancing banana Png lately (just to learn how) and have just not been having any luck. Whenever I try something out it gives me an error that says Write to File failed and gives me 800A0BBC as the code. What am I doing wrong? Thanks in advance!
Code:
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "https://wallpapercave.com/wp/wp5042624.png", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "c:\temp\wp5042624.png", 2 '//overwrite
end with
I don't know if you have in your code that you tried before an extra quote or your code is not well formatted; anyway , give a try for this code that save your image in a folder named Images_PNG created on your desktop just for testing !
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("WScript.Shell")
strDirectory = "Images_PNG"
strDirectory = objFSO.BuildPath(Ws.SpecialFolders("Desktop"), strDirectory)
If not objFSO.FolderExists(strDirectory) Then objFSO.CreateFolder(strDirectory)
URL = "https://wallpapercave.com/wp/wp5042624.png"
Save2File = strDirectory & "\wp5042624.png"
Call Download(URL,Save2File)
MsgBox "Terminted !",vbInformation,"Download PNG File"
'--------------------------------------------------------------------------------------------
Sub Download(URL,Save2File)
Dim File,Line,BS,ws
On Error Resume Next
Set File = CreateObject("Microsoft.XMLHTTP")
File.Open "GET",URL, False
File.Send()
If err.number <> 0 then
Line = Line & vbcrlf & "Error Getting File"
Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & vbcrlf &_
err.description
Line = Line & vbcrlf & "Source " & err.source
MsgBox Line,vbCritical,"Error getting file"
Err.clear
wscript.quit
End If
If File.Status = 200 Then ' File exists and it is ready to be downloaded
Set BS = CreateObject("ADODB.Stream")
Set ws = CreateObject("wscript.Shell")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile Save2File, 2
ElseIf File.Status = 404 Then
MsgBox "File Not found : " & File.Status,vbCritical,"Error File Not Found"
Else
MsgBox "Unknown Error : " & File.Status,vbCritical,"Error getting file"
End If
End Sub
'-------------------------------------------------------------------------
I have a vbscript that checks for all users and checks for its last login time.
i open a file to write inside the file. However , i seem to have an issue where the it is writing only the last name it checks instead of all the names.
Result in the text should be :
user1
user2
user3
user4
However , this is my current result :
user4
How do i go about this?
I do apologize as i am mainly in C# and VBS is very new to me.
Option Explicit
Dim strComputer, objComputer, objUser, FSO, File
Const ForWriting = 2
strComputer = "."
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.Filter = Array("user")
For Each objUser In objComputer
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.OpenTextFile("C:\Users\sgbvx\Desktop\test\test.txt",ForWriting, True)
On Error Resume Next
Wscript.Echo objUser.Name & ", " & objUser.LastLogin
File.WriteLine objUser.Name
File.Write objUser.LastLogin
File.Close
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo objUser.Name & ", "
End If
On Error GoTo 0
Next
File.Close
So apparently my code has some arrangement issue that created a lot errors.
Here's my answer and an updated code for the above :
Option Explicit
Dim strComputer, objComputer, objUser, FSO, File
Const ForWriting = 2
strComputer = "."
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.Filter = Array("user")
Set FSO = CreateObject("Scripting.FileSystemObject")
//You may change the file name or directory//
Set File = FSO.OpenTextFile("C:\temp\test.txt",ForWriting, True)
//Start of ForEach loop , previously Set FSO and Set File was in this loop//
For Each objUser In objComputer
On Error Resume Next
//Writes Username and LastLogin detail//
File.Write objUser.Name & ", " & objUser.LastLogin
File.WriteLine
If (Err.Number <> 0) Then
On Error GoTo 0
//Writes only Username if LastLogin was not detected//
File.Write objUser.Name & ", "
File.WriteLine
End If
On Error GoTo 0
Next
File.Close
I want to update the Unbound_DNS configuration file from a raw source but I can not get the desired result.
I would like to format each entry (each line):
address=/abc.com/0.0.0.0
To
local-zone: "abc.com" redirect
local-data: "abc.com 86400 IN A 0.0.0.0"
Here is what I did (thanks to hackoofr):
Option Explicit
Dim URL,Save2File,ws
If Not WScript.Arguments.Named.Exists("elevate") Then
CreateObject("Shell.Application").ShellExecute WScript.FullName _
, """" & WScript.ScriptFullName & """ /elevate", "", "runas", 1
WScript.Quit
End If
URL = "https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt"
Set ws = CreateObject("wscript.Shell")
Save2File = ws.ExpandEnvironmentStrings("%Windir%\Temp\test")
Call Download(URL,Save2File)
'**********************************************************************************************
Sub Download(URL,Save2File)
Dim File,Line,BS,ws,RegExp
On Error Resume Next
Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET",URL, False
File.Send
If err.number <> 0 then
Line = Line & vbcrlf & "Error Getting File"
Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & vbcrlf &_
err.description
Line = Line & vbcrlf & "Source " & err.source
MsgBox Line,vbCritical,"Error getting file"
Err.clear
wscript.quit
End If
If File.Status = 200 Then
'**********************************************************************************************
' Replace content for use with the file service.conf of soft Unbound_DNS
'
' address=/abc.com/0.0.0.0 to local-zone: "abc.com" redirect
' local-data: "abc.com 3600 IN A 0.0.0.0"
'**********************************************************************************************
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "address=/(.*)/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})"
File.ResponseBody = RegExp.Replace(File.ResponseBody, "local-zone: \""$1\"" redirect $1" & ret & ">local-data: \""$1 3600 IN A $2\""")
Set RegExp = Nothing
'**********************************************************************************************
' Write content
'**********************************************************************************************
Set BS = CreateObject("ADODB.Stream")
Set ws = CreateObject("wscript.Shell")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile Save2File, 2
'**********************************************************************************************
' Clean cache DNS
'**********************************************************************************************
wshShell.run("cmd /c psexec \\ -s ipconfig /flushdns >> & hostName,TRUE")
ElseIf File.Status = 404 Then
MsgBox "UpdateHostname.vbs : File Not Found : " & File.Status,vbCritical,"UpdateHostname.vbs : Error File Not Found"
Else
MsgBox "UpdateHostname.vbs : Unknown Error : " & File.Status,vbCritical,"UpdateHostname.vbs : Error getting file"
End If
End Sub
'**********************************************************************************************
Thank you in advance for your help.
Edit 1:
The content does not change. File.ResponseBody returns the content correctly, but no modification by the regexp!
Replace the following code:
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "address=/(.*)/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})"
File.ResponseBody = RegExp.Replace(File.ResponseBody, "local-zone: \""$1\"" redirect $1" & ret & ">local-data: \""$1 3600 IN A $2\""")
Set RegExp = Nothing
with this:
Dim objReg, strTest, objMatches, objMatch
Set objReg = New RegExp
strTest = File.ResponseBody 'address=/abc.com/0.0.0.0
objReg.Global = True
objReg.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})" 'abc.com gets stored in Group 1 and the IP address gets stored in Group 2
Set objMatches = objReg.Execute(strTest)
For Each objMatch In objMatches
strTest = "local zone: """ & objMatch.Submatches.Item(0) & """ redirect" & vbCrLf &_
"local data: """ & objMatch.Submatches.Item(0) & " 86400 in A " & objMatch.Submatches.Item(1)&""""
Next
File.ResponseBody = strTest
set objReg = Nothing
Click for Regex Demo(in the demo, / is escaped by \)
Regex Explanation:
address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})
address=/ - matches address=/ literally
(.*?) - matches 0+ occurrences of any character(except a newline), as few as possible. The parenthesis are used to capture this match as group 1
/ - matches / literally
(\d{1,3}(?:\.\d{1,3}){3}) - matches a string of the pattern 12.222.212.33 and captures it in Group 2
Update:
Here is my final solution. From what I could understand from your code, you first get the response body from the server, modify and store the updated response in a file called test in the temp folder. Below is the code I have written to do the same thing. I have tested it on my system and the final output which gets stored in the C:\Windows\Temp\test.txt file looks correct as shown in the attached screenshot. Now, this may not be exactly what you want but you can get an idea from this. Store this code in a new vbs file and run it directly as it is.
Note: Since the response text from the server is very long, It takes a bit long to get executed. If you just want to see if it is working or not, uncomment the code inside the for loop. You will be able to see that you are getting the desired result for the first few URLs
Regex Demo
Option Explicit
Dim File, objReg, strTest, objMatches, objMatch, saveToFile, fso, outFile, strReplace, objShell, i
Set objShell = CreateObject("wscript.shell")
saveToFile = objShell.ExpandEnvironmentStrings("%windir%\Temp\test.txt")
Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET","https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt", False
File.send
If File.Status = 200 Then
Set objReg = New RegExp
strTest = File.responseText 'address=/abc.com/0.0.0.0
objReg.Global = True
objReg.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})" 'abc.com gets stored in Group 1 and the IP address gets stored in Group 2
Set objMatches = objReg.Execute(strTest)
For Each objMatch In objMatches
strReplace = "local zone: """ & objMatch.Submatches.Item(0) & """ redirect" & vbCrLf &_
"local data: """ & objMatch.Submatches.Item(0) & " 86400 in A " & objMatch.Submatches.Item(1)&"""" & vbCrLf
strTest = Replace(strTest,objMatch.Value,strReplace)
'Uncomment the following code to see the result for the 1st 5 URLs, if the whole thing is taking too long to get executed
'i=i+1
'If(i>5) Then
' Exit for
'End If
Next
set objReg = Nothing
'**********************************************************************************************
' Write content
'**********************************************************************************************
Set fso = CreateObject("scripting.filesystemobject")
Set outFile = fso.OpenTextFile(saveToFile,2,True)
outFile.Write strTest
outFile.Close
End If
Output:
Here is the update of the code that works very well based on the response of #Gurman and the comment of #Ansgar Wiechers. Thank you for your help
Option Explicit
Dim File, objReg, strTest, RegExp, objMatches, objMatch, saveToFile, fso, outFile, strReplace, objShell, i
Set objShell = CreateObject("wscript.shell")
saveToFile = objShell.ExpandEnvironmentStrings("%windir%\Temp\test.txt")
Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET","https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt", False
File.send
If File.Status = 200 Then
'**********************************************************************************************
' Replace content for use with the file service.conf of soft Unbound_DNS
'
' address=/abc.com/0.0.0.0 to local-zone: "abc.com" redirect
' local-data: "abc.com 86400 IN A 0.0.0.0"
'**********************************************************************************************
strTest = File.responseText
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Global = True
RegExp.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})"
strReplace = "local-zone: ""$1"" redirect" & vbCrLf & "local-data: ""$1 86400 IN A $2"""
strTest = RegExp.Replace(strTest, strReplace)
Set RegExp = Nothing
'**********************************************************************************************
' Write content
'**********************************************************************************************
Set fso = CreateObject("scripting.filesystemobject")
Set outFile = fso.OpenTextFile(saveToFile,2,True)
outFile.Write strTest
outFile.Close
End If
How to replace a specific string with the filename? Example: I have several files with different names (like: Test.asp, Constant.asp, Letter.asp, etc.) within a subfolder that contain the text "ABC123". I would like to replace the "ABC123" in each file with the filename.
Below is the code I have that finds string and replaces it with a specific string but it doesn't do the job that I listed above.
Option Explicit
Dim objFilesystem, objFolder, objFiles, objFile, tFile, objShell, objLogFile,objFSO, objStartFolder, colFiles
Dim SubFolder, FileText, bolWriteLog, strLogName, strLogPath, strCount, strCount2, strOldText, strNewText, strEXT
bolWriteLog = True
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Set objFilesystem = WScript.CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
strLogName = "log.txt"
strLogPath = "C:\" & strLogName
strCount = 0
strCount2 = 0
strOldText = "ABC123"
strNewText = ""
strEXT = "asp"
'Initialize log file
If bolWriteLog Then
On Error Resume Next
Set objLogFile = objFileSystem.OpenTextFile(strLogPath, 2, True)
WriteLog "############### Start Log ##################"
If Not Err.Number = 0 Then
MsgBox "There was a problem opening the log file for writing." & Chr(10) & _
"Please check whether """ & strLogPath & """ is a valid file and can be openend for writing." & _
Chr(10) & Chr(10) & "If you're not sure what to do, please contact your support person.", vbCritical, "Script Error"
WScript.Quit
End If
On Error Goto 0
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "D:\MyFolder"
Set objFolder = objFSO.GetFolder(objStartFolder)
WScript.Echo objFolder.Path
Set colFiles = objFolder.Files
For Each objFile In colFiles
'WScript.Echo objFile.Name
' Now we have an exception for all files that can not be opened in text modus: all extensions such as "exe" should be listed upfront.
ReplaceText(objFile)
Next
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ReplaceText(objFile)
If InStr(1, strEXT, Right(LCase(objFile.Name), 3)) = 0 Or objFile.Size = 0 Then
Else
strCount = strCount + 1
WriteLog("Opening " & objFile.Name)
Set tFile = objFile.OpenAsTextStream(ForReading, TriStateUseDefault)
FileText = tFile.ReadAll
tFile.Close
If InStr(FileText, strOldText) Then
WriteLog("Replacing " & strOldText & " with " & strNewText & ".")
FileText = Replace(FileText, strOldText, strNewText)
WriteLog("Text replaced")
Else
WriteLog(strOldText & " was not found in the file.")
strCount2 = strCount2 + 1
End If
Set tFile = objFile.OpenAsTextStream(ForWriting, TriStateUseDefault)
tFile.Write FileText
tFile.Close
FileText = ""
strCount = 0
strCount2 = 0
End If
End Sub
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
'WScript.Echo Subfolder.Path
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
'WScript.Echo objFile.Name
ReplaceText(objFile)
Next
ShowSubFolders Subfolder
Next
End Sub
WriteLog "############### EndLog ##################"
WScript.Echo "Script Complete"
objShell.Run "C:\" & strLogName
'Clear environment and exit
On Error Resume Next
Set tFile = Nothing
Set objFile = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objLogFile = Nothing
Set objFilesystem = Nothing
Set objShell = Nothing
WScript.Quit
'Subs and functions ********** DO NOT EDIT ***************
Sub WriteLog(sEntry)
If bolWriteLog Then objLogFile.WriteLine(Now() & ": Log: " & sEntry)
End Sub
I can give you a one line Ruby solution, should be not too difficult to translate that in Python but somewhat more extensive in VbScript I am afraid. First a generic search and replace version.
ARGV[0..-3].each{|f| File.write(f, File.read(f).gsub(ARGV[-2],ARGV[-1]))}
Save it in a script, eg replace.rb
You start in on the command line (here cmd.exe) with
replace.rb *.txt <string_to_replace> <replacement>
broken down so that I can explain what's happening but still executable
# ARGV is an array of the arguments passed to the script.
ARGV[0..-3].each do |f| # enumerate the arguments of this script from the first to the last (-1) minus 2
File.write(f, # open the argument (= filename) for writing
File.read(f) # open the argument (= filename) for reading
.gsub(ARGV[-2],ARGV[-1])) # and replace all occurances of the beforelast with the last argument (string)
end
And finally your request to replace ABC123 with the filename.
Of course tested and working
ARGV[0..-1].each{|f| File.write(f, File.read(f).gsub('ABC123', f))}
Contents of one of my testfiles (1.txt) after executing
test phrase
1.txt
EDIT
I see you want subfolder recursion on a fixed folder, no problem
Dir['**/*'].each{|f| File.write(f, File.read(f).gsub('ABC123', f)) unless File.directory?(f) }
I'd like to write output from VBScript to notepad/wordpad in realtime. What's the best way to do this? I'm aware of sendkeys, but it requires that I parse the input for special commands.
SendKeys is the only method for writing to a third-party application in realtime. Why don't you use CScript and write to the standard output instead? That is what it is meant for.
' Force the script to run in the CScript engine
If LCase(Right(WScript.FullName, 11)) <> "cscript.exe" Then
strPath = WScript.ScriptFullName
strCommand = "%comspec% /k cscript " & Chr(34) & strPath & chr(34)
CreateObject("WScript.Shell").Run(strCommand)
WScript.Quit
End If
For i = 1 to 10
For j = 0 to 25
WScript.StdOut.WriteLine String(j, " ") & "."
WScript.Sleep 50
Next
For j = 24 to 1 Step - 1
WScript.StdOut.WriteLine String(j, " ") & "."
WScript.Sleep 50
Next
Next
Try this
Const fsoForWriting = 2
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open the text file
Dim objTextStream
Set objTextStream = objFSO.OpenTextFile("C:\SomeFile.txt", fsoForWriting, True)
'Display the contents of the text file
objTextStream.WriteLine "Hello, World!"
'Close the file and clean up
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing