I have searched the web for a solution to "auto-update" my Selenium EdgeDriver automatically. For those who use SeleniumBasic, you know it can be a hassle to manually download the driver from the respective webpage every so often when your main Host browser gets a major update.
In my web searching, I have found support for other languages to "auto-update" their versions of these drivers, but VBA, as usual, was lacking support.
Now I don't claim this to be the perfect solution, but it at least works. The problem I can see in the future is that layouts of each respective webpage may change, so I do welcome updates if this is the case and I will try to update as well. But for the most part, it should just work.
While this is a Self-Answered question, I absolutely would love to see other methods posted here for myself and other users to try out. SeleniumBasic is a good tool for certain applications, but often lacks community support as VBA is not as widely used in the community as other languages - at least not on a more sophisticated level.
I should start out by saying that I am only supporting Chrome and Edge drivers for the time being. But if you can follow along, you might be able to add your own support for any of the other SeleniumBasic-supported WebDrivers.
Before we get started, it is important to enable the following References by going to Tools > References within the VBE:
Next, you need to create a Class Module named SeleniumWebDriver.
I decided to make this a Class Object because I intend to build a little on it in the future. You may add your own Properties and functions as you wish, but the code being provided will only allow updating the WebDrivers, at least for now.
Here is the complete Class Module Code:
Option Explicit
Rem Did Chrome change their file url and break your code?
' Check for an update: https://stackoverflow.com/a/67996166/5781745
Private ChromeDriver As Selenium.ChromeDriver
Private EdgeDriver As Selenium.EdgeDriver
Private SeleniumFolder As String
Private TempZipFile As String
Private ChromeInit As Boolean, EdgeInit As Boolean
Public Enum dType
Chrome
Edge
End Enum
Public Property Get SeleniumFolderPath() As String
SeleniumFolderPath = SeleniumFolder
End Property
Public Property Let SeleniumFolderPath(ByVal FolderPath As String)
SeleniumFolder = FolderPath
End Property
Public Sub UpdateDriver(ByVal DriverType As dType)
'URLs to the drivers' home pages to which we can grab the curr versions
Dim URLPath As String
Select Case DriverType
Case dType.Chrome
URLPath = "https://chromedriver.chromium.org/home"
Case dType.Edge
URLPath = "https://developer.microsoft.com/en-us/microsoft-edge/tools/webdriver/"
End Select
'Grab the current Version # from the driver's webpage
Dim Doc As New HTMLDocument, DriverVer As String
With New MSXML2.XMLHTTP60
.Open "GET", URLPath
.send
Doc.body.innerHTML = .responseText
End With
DriverVer = getCurrentVersion(Doc, DriverType)
DownloadUpdatedDriver DriverVer, DriverType
ExtractZipAndCopy DriverType
End Sub
' For use in a later project. Not needed at this time
Private Sub InitializeDriver(ByVal DriverType As dType)
Select Case DriverType
Case dType.Chrome
Set ChromeDriver = New Selenium.ChromeDriver
ChromeDriver.Start
ChromeInit = True
Case dType.Edge
Set EdgeDriver = New Selenium.EdgeDriver
EdgeDriver.Start
EdgeInit = True
End Select
End Sub
Private Function getCurrentVersion(Doc As HTMLDocument, DriverType As dType) As String
Dim div As HTMLDivElement
Select Case DriverType
Case dType.Chrome
For Each div In Doc.getElementsByTagName("p")
If div.innerText Like "Latest stable release*" Then
With New VBScript_RegExp_55.RegExp
.Pattern = "ChromeDriver\s([\d\.]+)\b"
getCurrentVersion = .Execute(div.innerText)(0).SubMatches(0)
Exit Function
End With
End If
Next
Case dType.Edge
With New VBScript_RegExp_55.RegExp
.Pattern = "Version:\s([\d\.]+)"
For Each div In Doc.getElementsByClassName("module")(0).getElementsByTagName("p")
If .test(div.innerText) Then
getCurrentVersion = .Execute(div.innerText)(0).SubMatches(0)
Exit Function
End If
Next
End With
End Select
End Function
Private Sub DownloadUpdatedDriver(ByVal CurrVersion As String, DriverType As dType)
Dim URLPath As String
Select Case DriverType
Case dType.Chrome
URLPath = "https://chromedriver.storage.googleapis.com/" & CurrVersion & "/chromedriver_win32.zip"
Case dType.Edge
Kill Environ$("LocalAppData") & "\SeleniumBasic\Driver_Notes\*.*"
URLPath = "https://msedgedriver.azureedge.net/" & CurrVersion & "/edgedriver_win64.zip"
End Select
Dim FileStream As New ADODB.Stream
With New MSXML2.XMLHTTP60
.Open "GET", URLPath
.send
FileStream.Open
FileStream.Type = adTypeBinary
FileStream.Write .responseBody
FileStream.SaveToFile TempZipFile, adSaveCreateOverWrite
FileStream.Close
End With
End Sub
Private Sub ExtractZipAndCopy(ByVal DriverType As dType)
Dim FileName As String
Select Case DriverType
Case dType.Chrome: FileName = "\chromedriver.exe"
Case dType.Edge: FileName = "\edgedriver.exe"
End Select
'Delete the old WebDriver
Kill SeleniumFolder & FileName
'Copy the new driver from .zip file to SeleniumBasic folder
Dim oShell As New shell
oShell.Namespace(SeleniumFolder).CopyHere oShell.Namespace(TempZipFile).Items
'Selenium VBA expects 'edgedriver' for edge, but new drivers are named 'msedgedriver'.
'If we are updating Edge, we need to rename the file
If DriverType = dType.Edge Then
Name SeleniumFolder & "msedgedriver.exe" As SeleniumFolder & "edgedriver.exe"
End If
'Delete the temporary zip file
Kill TempZipFile
End Sub
Private Sub Class_Initialize()
' Set the default file path. Can be modified later using ChromeDriverPath property
SeleniumFolder = Environ$("LocalAppData") & "\SeleniumBasic\"
TempZipFile = Environ$("LocalAppData") & "\Temp\WebDriver.zip"
End Sub
Now that you've created your Selenium Class, you can now use it in a standard module such as:
Important Tip: I am not sure if there is a delay between when you update your web browser and when the drivers are officially released. Therefore before updating your driver, I would put some error handling to see if Selenium throws an error first. If the driver does not match the browser version, Selenium will throw error # 33. If you check for this error, you should be safe to go ahead and update the WebDriver at this point. What we want to prevent is that you update your driver before your browser is automatically updated, causing mismatching versions.
It is also possible that your browser may update and the Selenium driver hasn't been released yet - but unfortunately that is not something that we can control.
The remainder of this answer will just go into some detail as to what it's doing. If you don't care, you may leave now.
First, as with any other object, we have to initialize it. In the above example, we do that with the With New SeleniumWebDriver statement. This fires the Class_Initialize() event here:
Private Sub Class_Initialize()
' Set the default file path. Can be modified later using ChromeDriverPath property
SeleniumFolder = Environ$("LocalAppData") & "\SeleniumBasic\"
TempZipFile = Environ$("LocalAppData") & "\Temp\WebDriver.zip"
End Sub
The purpose of this is to set the default file paths for the SeleniumBasic folder and temp file. However, if your folder is somewhere else, this class has a property to which you can change the folder manually. Just use the ClassObj.SeleniumFolderPath() property to establish your new path.
The TempZipFile is a class-scoped variable that will store the .zip file you download from the respective websites.
Upon calling the UpdateDriver method, the class will place a GET request to the respective driver's webpage, then grab the current version # from the page. It will then pass this driver version to the DownloadUpdatedDriver routine, which stores the download links for each respective driver. For Chrome, the link is: https://chromedriver.storage.googleapis.com/<Version#>/chromedriver_win32.zip, and for Edge it's: https://msedgedriver.azureedge.net/<Version#>/edgedriver_win64.zip. It's important to realize that if you happen to be using the 32 bit version of Edge, you will need to change the URL to edgedriver_win32.zip. This routine downloads the .zip file to your local AppData's Temp Folder.
After the file has been downloaded, we then proceed to call the ExtractZipAndCopy routine. This simply extracts the .exe files to the Selenium Folder, first deleting the old file. Edge does a little extra maintenance work, but you're now essentially updated!
I hope this helps someone out there who is annoyed as I am having to periodically update these drivers and was wanting an automated solution. Please feel free to edit this answer if minor changes are needing to be made, such as if a URL is broken.
There is now an API to check Latest Release of ChromeDriver. So the code can become shorter. Also, adding a functionality to run the update only if the current chrome version does not match installed chromedriver version. And to copy using administrator rights.
I am not using Edge so that code functionality is not there in my code.
Function chkchromever()
Tempfolder = "D:\"
TempZipFile = Tempfolder & "Chromedriver.zip"
SeleniumFolder = Environ$("ProgramW6432") & "\SeleniumBasic\"
TempDrvFile = Tempfolder & "Chromedriver.exe"
'Delete chromedriver.exe from temporary folder if it already exists
If Dir(TempDrvFile) <> "" Then
Kill (TempDrvFile)
End If
Dim oShell As New WshShell
Dim objHttp As Object
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
'Get chrome version
chrversion = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Google\Chrome\BLBeacon\version")
dotsarr = Split(chrversion, ".")
leftchrver = dotsarr(0) & dotsarr(1)
'Get chromedriver version
gspath = Chr(34) & SeleniumFolder & "chromedriver.exe" & Chr(34)
torun = gspath & " --version"
errcode = oShell.Exec(torun).StdOut.ReadAll
verarr = Split(errcode, " ")
chrdrv = verarr(1)
dotsarr2 = Split(chrdrv, ".")
leftchrdrv = dotsarr(0) & dotsarr(1)
'If major version mismatch (first two numbers) then ask if update required
If leftchrver <> leftchrdrv Then
myyn = MsgBox("Wrong version of chromedriver. " & vbCrLf & "Chrome version is " & chrversion & vbCrLf & "Chrome driver version is " & chrdrv, vbYesNo, "Do you want to update Chromedriver ?")
If myyn = vbNo Then Exit Function
'Get latest release version of chromedriver which matches installed version of Chrome
url = "https://chromedriver.storage.googleapis.com/LATEST_RELEASE_" & dotsarr(0)
Call objHttp.Open("GET", url, False)
Call objHttp.send("")
version_number = objHttp.responseText
dotsarr3 = Split(version_number, ".")
leftversion_no = dotsarr3(0) & dotsarr3(1)
If leftchrver = leftversion_no Then
'If chromedriver found then download it
download_url = "https://chromedriver.storage.googleapis.com/" + version_number + "/chromedriver_win32.zip"
Call objHttp.Open("GET", download_url, False)
Call objHttp.send("")
Set fileStream = New ADODB.Stream
With fileStream
.Open
.Type = adTypeBinary
.Write objHttp.responseBody
.Position = 0
.SaveToFile TempZipFile, adSaveCreateOverWrite
.Close
End With
'Copy the new driver from .zip file to SeleniumBasic folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(Tempfolder).CopyHere oApp.Namespace(TempZipFile).Items
'Create batch file to copy chromedriver.exe to Seleniumbasic folder and run it using Administrator rights
tmpbatpath = Tempfolder & "copychdrv.bat"
'Check if Chromedriver downloaded successfully
If Dir(TempDrvFile) <> "" Then
Open tmpbatpath For Output As #1
'Enable these if required to copy chromedriver.exe
' Print #1, "taskkill /f /im GoogleCrashHandler.exe"
' Print #1, "taskkill /f /im GoogleCrashHandler64.exe"
' Print #1, "taskkill /f /im Chrome.exe"
' Print #1, "taskkill /f /im Googleupdate.exe"
If IsProcessRunning("Chromedriver.exe") Then
Print #1, "taskkill /f /im Chromedriver.exe"
End If
Print #1, "copy " & Chr(34) & TempDrvFile & Chr(34) & " " & Chr(34) & SeleniumFolder & "Chromedriver.exe" & Chr(34) & "/y"
Close #1
'copy it now by running batch file
success = ShellExecute(0, "runas", tmpbatpath, aPic, vbNullString, SW_SHOWNORMAL)
End If
'Cleanup
If Dir(TempZipFile) <> "" Then
Kill (TempZipFile)
End If
If Dir(tmpbatpath) <> "" Then
Kill (tmpbatpath)
End If
End If
End If
End Function
As i am on a company PC, I updated the code to work on a locked PC
Option Explicit
'**********************************************************
' PUBLIC FUNCTION
'/
'**********************************************************
' #Fn chkchromever
'
' #brief Check if Selenium Crome Driver is up to date or update it
'
' #param checks Crome version and Installed and availible Driver for Selenium
'
' #SUBs IsProcessRunning, ShellExecute
'
' Librarys Selenium Type library
' Windows Script Host Object Model - Dim oShell As New WshShell ,
' Microsoft ActiveX Data Objects 6.1 Library - Set fileStream = New ADODB.Stream
'
' #return new driver
'/
Public Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal Hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Function chkchromever()
Dim tempfolder As Variant, TempZipFile As Variant
Dim SeleniumFolder As String, TempDrvFile As String
Dim chrversion As String, leftchrver As String
Dim dotsarr() As String
Dim gspath As String, torun As String, errcode As String
Dim verarr() As String, chrdrv As String, leftchrdrv As String
Dim dotsarr2() As String
Dim myyn As Integer
Dim Url As String, version_number As String, leftversion_no As String
Dim dotsarr3() As String
Dim download_url As String
tempfolder = "C:\Temp\"
TempZipFile = tempfolder & "Chromedriver.zip"
'SeleniumFolder = Environ$("ProgramW6432") & "\SeleniumBasic\"
SeleniumFolder = Environ$("LOCALAPPDATA") & "\SeleniumBasic\"
TempDrvFile = tempfolder & "Chromedriver.exe"
'Delete chromedriver.exe from temporary folder if it already exists
If Dir(TempDrvFile) <> "" Then
Kill (TempDrvFile)
End If
Dim oShell As New WshShell
Dim objHttp As Object
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
'Get chrome version
chrversion = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Google\Chrome\BLBeacon\version")
dotsarr = Split(chrversion, ".")
leftchrver = dotsarr(0) & dotsarr(1)
'Get chromedriver version
gspath = Chr(34) & SeleniumFolder & "chromedriver.exe" & Chr(34) ' chr34 er gåseøjne
torun = gspath & " --version"
errcode = oShell.Exec(torun).StdOut.ReadAll
verarr = Split(errcode, " ")
chrdrv = verarr(1)
dotsarr2 = Split(chrdrv, ".")
leftchrdrv = dotsarr2(0) & dotsarr2(1)
'If major version mismatch (first two numbers) then ask if update required
If leftchrver <> leftchrdrv Then
myyn = MsgBox("Wrong version of chromedriver. " & vbCrLf & "Chrome version is " & chrversion & vbCrLf & "Chrome driver version is " & chrdrv, vbYesNo, "Do you want to update Chromedriver ?")
If myyn = vbNo Then Exit Function
'Get latest release version of chromedriver which matches installed version of Chrome
Url = "https://chromedriver.storage.googleapis.com/LATEST_RELEASE_" & dotsarr(0)
Call objHttp.Open("GET", Url, False)
Call objHttp.send("")
version_number = objHttp.responseText
dotsarr3 = Split(version_number, ".")
leftversion_no = dotsarr3(0) & dotsarr3(1)
If leftchrver = leftversion_no Then
'If chromedriver found then download it
download_url = "https://chromedriver.storage.googleapis.com/" + version_number + "/chromedriver_win32.zip"
Call objHttp.Open("GET", download_url, False)
Call objHttp.send("")
Dim fileStream As Object
Set fileStream = New ADODB.Stream
With fileStream
.Open
.Type = adTypeBinary
.Write objHttp.responseBody
.Position = 0
.SaveToFile TempZipFile, adSaveCreateOverWrite
.Close
End With
'unzip file
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(tempfolder).CopyHere oApp.Namespace(TempZipFile).Items
'Check if Chromedriver downloaded successfully
If Dir(TempDrvFile) <> "" Then
If IsProcessRunning("Chromedriver.exe") Then
Shell "cmd /c""" & "taskkill /f /im Chromedriver.exe"
End If
'Copy / Overwrite file in SeleniumBasic folder
FileCopy TempDrvFile, SeleniumFolder & "Chromedriver.exe"
End If
'Cleanup
If Dir(TempZipFile) <> "" Then
Kill (TempZipFile)
End If
If Dir(TempDrvFile) <> "" Then
Kill (TempDrvFile)
End If
End If
End If
End Function
Function IsProcessRunning(process As String)
Dim objList As Object
Set objList = GetObject("winmgmts:") _
.ExecQuery("select * from win32_process where name='" & process & "'")
IsProcessRunning = objList.Count > 0
End Function
I had to modify the code posted above by Jesper Martin Schumacher as our IT department has updated all Office Applications to 64-bit.
That code was failing on instances of "New" keyword, so I researched and found:
compile error User-defined type not defined at "oShell As WshShell"
The suggestion there was to use "Late Binding" CreateObject method instead, as below.
Set oShell = CreateObject("WScript.Shell") 'Had to edit this line. It WAS "Set oShell = New WshShell"
Set fileStream = CreateObject("ADODB.Stream") 'Had to edit this line. It WAS "Set fileStream = New ADODB.Stream"
Related
I am using the zip component to create a zip from memory and stream that file to download. It was working for a while, but in FireFox it won't let me download the file. Here is the code that I am using:
' NewZip initializes the zip object. It does not write
' the file. The "test.zip" file, in this case, will never be written.
success = zip.NewZip("lib-files.zip")
If (success <> True) Then
'MsgBox(zip.LastErrorText)
Exit Sub
End If
For Each oRow As Data.DataRow In oData.Tables(0).Rows
If System.IO.File.Exists(Application("LibUploadedDocumentPath") & oRow("DocFileName").ToString) = True Then
success = zip.AppendOneFileOrDir(Application("LibUploadedDocumentPath") & oRow("DocFileName").ToString, False)
Dim entry As Chilkat.ZipEntry
Dim fFile As FileInfo = New FileInfo(Application("LibUploadedDocumentPath") & oRow("DocFileName").ToString)
Dim sNewFileName As String = oRow("DocName").ToString
entry = zip.GetEntryByName(oRow("DocFileName").ToString)
If (entry Is Nothing) Then
MsgBox("Failed to find entry in .zip")
Exit Sub
End If
'Dim sTestName As String = ""
entry.FileName = sNewFileName & fFile.Extension.ToLower
Else
Response.Write("All the files are not found. Download aborted.")
Exit Sub
End If
Next
If (success <> True) Then
'MsgBox(zip.LastErrorText)
Exit Sub
End If
Dim Data As Byte()
Data = zip.WriteToMemory
Response.Clear()
Response.ContentType = "application/octet-stream"
Response.AddHeader("Content-Length", Data.Length.ToString())
Response.AddHeader("Content-Disposition",
"attachment; filename=""" & zip.FileName & """")
Response.BinaryWrite(Data)
Response.Flush()
Response.End()
In FireFox it says, "the source file cannot be saved, because the source file could not be read". I've tried it in Chrome, and it allows me to download there. Not sure if its the component that's being used, or something else I need to add. Any thoughts?
Maybe change the content type to "application/zip"?
Response.ContentType = "application/zip"
This question already has answers here:
VBS with Space in File Path
(4 answers)
Closed 4 years ago.
In VBA I am running a piece of external software I wrote. I know the software works well. I can run it from the command line. But when I attempt to execute it using WScript.Shell.Run, it returns a 1 and it never runs. I can't even tell that it executes the software at all.
Here is the executing portion of the VBA class.
Public Function Execute() As Integer
Dim wsh As Object
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Dim exitCode As Integer: exitCode = -1
Set wsh = VBA.CreateObject("WScript.Shell")
'Run program with arguments and wait for the program to finish
If Me.PrinterType = 1 Then exitCode = wsh.Run(Me.Path & " /serial=" & Me.SerialNumber & " /position=" & Me.Location & "", windowStyle, waitOnReturn)
If Me.PrinterType = 2 Then exitCode = wsh.Run(Me.Path & " /boxid=" & Me.Location & " /version=" & Me.Version, windowStyle, waitOnReturn)
Execute = exitCode
End Function
An example of the full execute string:
C:.path.to.\PrintLabel.exe /serial=EOSJ61110044 /position=2
Evidence that the script runs without error from the same machine the VBA is executing on:
So I've got no idea what's going on.
I can use the following VBA Shell function successfully:
If Me.PrinterType = 1 Then exitCode = Shell(Me.Path & " /serial=" & Me.SerialNumber & " /position=" & Me.Location, vbHide)
But the problem then becomes that the VBA doesn't wait on the software to finish before continuing. So I need to continue to try and make WScript.Shell work. What am I missing? Are there any specific references that need to be enabled that I could be missing?
Update 1:
Tried this to mimic this SO post, but still didn't have success:
If Me.PrinterType = 1 Then fullExecutionString = Me.Path & " /serial=" & Me.SerialNumber & " /position=" & Me.Location
If Me.PrinterType = 2 Then fullExecutionString = Me.Path & " /boxid=" & Me.Location & " /version=" & Me.Version
wsh.Run fullExecutionString, windowStyle, waitOnReturn
Update 2:
Made a small method that repeats the process in windows cmd console. It works (more or less) with the same code. I am guessing it has something to do with the command path string with arguments?
Private Sub Button2_Released()
Dim wsh As Object
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Dim exitCode As Integer: exitCode = 0
Set wsh = VBA.CreateObject("WScript.Shell")
exitCode = wsh.Run("C:\Windows\System32\cmd.exe", windowStyle, waitOnReturn)
End Sub
Answering my own question:
After much debugging I resolved that the path with spaces is causing the issue. If I directly input the following (notice the quote placement), the code successfully runs:
exitCode = wsh.Run("""C:\path.to\PrintLabel.exe"" /serial=EOSJ61110044 /position=2", windowStyle, waitOnReturn)
So in the end I adjusted my Path property:
Public Property Let Path(ByVal NewValue As String)
actPath = Chr(34) & NewValue & Chr(34)
End Property
Public Property Get Path() As String
Path = actPath
End Property
In Outlook I have setup the following code to temporarily display a message.
However I cannot work out how to pass a variable (aMessageLabel) containing the text to be displayed.
Sub Test()
Dim aShell
Set aShell = CreateObject("WScript.Shell")
aMessageLabel = Chr(34) & "No Emails to be Forwarded!" & Chr(34)
aShell.Run "mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup(aMessageLabel,5,""Message""))"
End Sub
this works
Sub Test()
' this is the resulting windows command (you can run at command prompt)
' mshta.exe vbscript:close(CreateObject("WScript.shell").Popup("No Emails to be Forwarded!",5,"Message"))
' the "5" is number of seconds that the popup message will live
Dim aShell
Set aShell = CreateObject("WScript.Shell")
aMessageLabel = "No Emails to be Forwarded!"
Dim cmd As String
' multiline
cmd = "mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup("""
cmd = cmd & aMessageLabel
cmd = cmd & """,5,""Message""))"
Debug.Print cmd
aShell.Run cmd
' one line
aShell.Run "mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup(""" & aMessageLabel & """,5,""Message""))"
End Sub
I am trying to download files from FTP using SSIS script task, I have written some code to download files from FTP using the ftpWebRequest class which is working. But I also need to take in to account that we might be asked to download it from a sFTP. Since many are suggesting that WinSCP assemblies are the best way to download sFTP files, can some provide me with some examples to download files using a SSIS script with the WinSCP classes.
PS: I am new to Vb.net
Yes, as people have said the only option is to use a library like WinSCP.
Take a look at the examples here on the WinSCP website - http://winscp.net/eng/docs/script_vbnet_robust_example
Here is the source code from the example
Imports System
Imports System.IO
Imports System.Diagnostics
Imports System.Xml
Imports System.Xml.XPath
Imports System.Configuration.ConfigurationManager
Public Class SFTP
' SFTP support, built on WinSCP
Public Shared Function PutSFTP(ByRef filename As String, ByRef remotehost As String, ByRef username As String, ByRef password As String, _
Optional ByVal outfilename As String = Nothing, Optional ByVal output As String = Nothing,
Optional ByRef errmsg As String = Nothing) As Boolean
' Run hidden WinSCP process
Dim winscp As Process = New Process()
Dim logname As String = Path.ChangeExtension(Path.GetTempFileName, "xml")
With winscp.StartInfo
' SFTPExecutable needs to be defined in app.config to point to winscp.com
Try
.FileName = AppSettings("SFTPExecutable")
If .FileName Is Nothing OrElse .FileName.Length = 0 Then Throw (New Exception("from PutSFTP: SFTPExecutable not set in config file."))
Catch ex As Exception
errmsg = ex.Message
Return False
End Try
.Arguments = "/xmllog=" + logname
.UseShellExecute = False
.RedirectStandardInput = True
.RedirectStandardOutput = True
.CreateNoWindow = True
End With
Try
winscp.Start()
Catch ex As Exception
errmsg = "from PutSFTP: Could not run the WinSCP executable " & winscp.StartInfo.FileName & Environment.NewLine & ex.Message
Return False
End Try
' Feed in the scripting commands
With winscp.StandardInput
.WriteLine("option batch abort")
.WriteLine("option confirm off")
.WriteLine("open sftp://" & username & ":" & password & "#" & remotehost & "/")
If outfilename Is Nothing Then .WriteLine("put " & filename) Else .WriteLine("put " & filename & " """ & outfilename & """")
.Close()
End With
If output IsNot Nothing Then output = winscp.StandardOutput.ReadToEnd()
' Wait until WinSCP finishes
winscp.WaitForExit()
' Parse and interpret the XML log
' (Note that in case of fatal failure the log file may not exist at all)
If Not File.Exists(logname) Then
errmsg = "from PutSFTP: The WinSCP executable appears to have crashed."
Return False
End If
Dim log As XPathDocument = New XPathDocument(logname)
Dim ns As XmlNamespaceManager = New XmlNamespaceManager(New NameTable())
ns.AddNamespace("w", "http://winscp.net/schema/session/1.0")
Dim nav As XPathNavigator = log.CreateNavigator()
' Success (0) or error?
Dim status As Boolean = (winscp.ExitCode = 0)
If Not status Then
errmsg = "from PutSFTP: There was an error transferring " & filename & "."
' See if there are any messages associated with the error
For Each message As XPathNavigator In nav.Select("//w:message", ns)
errmsg &= Environment.NewLine & message.Value
Next message
End If
Try
My.Computer.FileSystem.DeleteFile(logname)
Catch ex As Exception
' at least we tried to clean up
End Try
Return status
End Function
End Class
I'm using the following code inside an ActiveX Script job on SQl Server to call an URL every X minutes.
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "iexplore.exe http://www.google.com.br"
Set WsShell = Nothing
it is working but the processes created keep running:
Any way of changin that code to call the URL and kill the recent called process or call it with a "time-to-live". I think it is more secure, I wouldn't want to kill the wrong process.
Following up on the suggestion by #Ted, you can also fetch a URL using native Microsoft capabilities in an in-process fashion. You can do this via a component known as WinHTTP (the latest appears to be WinHTTP 5.1).
See my script below which includes a function to simply obtain the status of a URL. When I run this script I get the following output:
http://www.google.com => 200 [OK]
http://www.google.com/does_not_exist => 404 [Not Found]
http://does_not_exist.google.com => -2147012889
[The server name or address could not be resolved]
If you want the actual content behind a URL, try oHttp.ResponseText. Here's the WinHTTP reference if you are interested in other capabilities as well.
Option Explicit
Dim aUrlList
aUrlList = Array( _
"http://www.google.com", _
"http://www.google.com/does_not_exist", _
"http://does_not_exist.google.com" _
)
Dim i
For i = 0 To UBound(aUrlList)
WScript.Echo aUrlList(i) & " => " & GetUrlStatus(aUrlList(i))
Next
Function GetUrlStatus(sUrl)
Dim oHttp : Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error Resume Next
With oHttp
.Open "GET", SUrl, False
.Send
End With
If Err Then
GetUrlStatus = Err.Number & " [" & Err.Description & "]"
Else
GetUrlStatus = oHttp.Status & " [" & oHttp.StatusText & "]"
End If
Set oHttp = Nothing
End Function
The way you start IE is external, you have little control over the process once it is started.
A better interactive way is like this
Function GetData(strUrl) 'As String
Set web = CreateObject("InternetExplorer.Application")
web.Navigate strUrl
Do While web.Busy
wscript.sleep 100
Loop
Set doc = Nothing
Do Until Not doc Is Nothing
Set doc = web.Document
Loop
strWebPage = doc.all(1).innerHTML 'This does return the head sections
web.Quit
GetData = strWebPage
End Function
wscript.echo GetData("www.google.com")
UPDATE: As it stands now, it looks like this is not a viable solution. After multiple invocations, IE processes begin to accumulate with this approach as well. It appears this behavior has something to do with IE's session management. IE doesn't like to be abruptly terminated.
I found some very useful information about managing processes via WMI here. Using that as a basis, I came up with the code I show below. One of the nice aspects of the WMI approach is that you are given access to the unique ID for the process. I consider my code a starting point as I'm sure further improvements are possible (including the addition of exception handling).
Perhaps others with deeper knowledge of WMI can offer additional advice.
PS: Hope you like that I wrapped this functionality inside a VBScript class called Process.
Option Explicit
' Const PROG = "notepad.exe"
Const TARGET = "http://www.google.com"
Dim PROG : PROG = "C:\Program Files\Internet Explorer\iexplore.exe " & TARGET
Const ABOVE_NORMAL = 32768 ' what are the other priority constants?
Dim oProc : Set oProc = New Process
oProc.Name = PROG
' oProc.Priority = ABOVE_NORMAL
oProc.Launch
WScript.Echo "Launched '" & PROG & "' with process ID '" & oProc.ID & "'"
WScript.Sleep 5000
oProc.Terminate
WScript.Echo "Process " & oProc.ID & " killed."
Set oProc = Nothing
' ----------------------------------------------------------------------
Class Process
Public Computer
Public Name
Public Priority
Public ID
Public IsRunning
Private mHandle
Private Sub Class_Initialize()
Me.Computer = "."
Me.Name = Null
Me.ID = -1
Me.Priority = Null
Me.IsRunning = False
Set mHandle = Nothing
End Sub
Private Sub Class_Terminate()
Set mHandle = Nothing
End Sub
Public Sub Launch()
Dim oWmi, oStartup, oConfig
Dim nPid
Set oWmi = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& Me.Computer & "\root\cimv2")
Set oStartup = oWmi.Get("Win32_ProcessStartup")
If Not IsNull(Me.Priority) Then
Set oConfig = oStartup.SpawnInstance_
oConfig.PriorityClass = Me.Priority
End If
Set mHandle = GetObject("winmgmts:root\cimv2:Win32_Process")
mHandle.Create Me.Name, Null, oConfig, nPid
' WScript.Echo "TypeName Is [" & TypeName(mHandle) & "]"
Me.ID = nPid
Me.IsRunning = True
End Sub
Public Sub Terminate()
' mHandle.Terminate ' hmmm, doesn't work...
Dim oWmi
Dim colProcessList, oProc
Set oWmi = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& Me.Computer & "\root\cimv2")
Set colProcessList = oWmi.ExecQuery _
("Select * from Win32_Process Where ProcessId = '" & Me.ID & "'")
For Each oProc In colProcessList ' should be only one process
' WScript.Echo "TypeName Is [" & TypeName(oProc) & "]"
oProc.Terminate
Next
Me.IsRunning = False
End Sub
End Class
Could you consider using a lightweight command line URL retrieval program, like CURL ( http://curl.haxx.se/docs/manpage.html ) or WGET ( http://www.gnu.org/software/wget/ )? These programs can be executed from the command line quite simply:
wget http://www.google.com
curl http://www.google.com
You can execute them from VBScript like this:
sub shell(cmd)
' Run a command as if you were running from the command line
dim objShell
Set objShell = WScript.CreateObject( "WScript.Shell" )
objShell.Run(cmd)
Set objShell = Nothing
end sub
shell "wget http://www.google.com"
The only downside to this is that WGET and CURL won't execute javascript, download affiliated images, or render the HTML; they will simply download the web page. In my experience, I use CURL and WGET regularly as long as I only have to retrieve a single HTML page; but if I have to render something or trigger AJAX functions I use an automatable web browser toolkit like Selenium, WATIN, or IMacros.