Inspired by Paul (in this thread), here are two scripts that take this a step further. The first script can be stand alone and scheduled (windows scheduler or whatever), the second runs the first one in a loop until a "stop.txt" file is detected. The second script could be placed in the startup group or Run key in the registry to run when the PC/Server is started. I wrote the second one so I don't have to have a ton of scheduled tasks, nothing against Paul, just don't like task scheduler that much. It would be easy enough to write the windows event log for those of you who have an eventlog monitoring tool. Oh yeah, these scripts are SAMPLE scripts, use at your own discretion. No warranty as to use or fitness is expressed or implied. Please read all the TODO comments.
'___________________________________________________________________
'Copy/Paste this script to a file named WebSiteMon_v0.1.vbs
Option Explicit
'TODO: Change default location and file name if desired
'TODO: Add sites in the Init section
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim objXMLHTTP 'global xml html object
Dim objFS 'global file system object
Dim objDict 'global dictionary object
Dim strDefaultLocation 'folder log file will be written to; set in Init
Dim strFileName 'log file name; set in Init
Init
Main
Enit
Sub Init()
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
Set objFS = CreateObject ( "Scripting.FileSystemObject")
Set objDict = CreateObject("Scripting.Dictionary")
strDefaultLocation = WScript.ScriptFullName 'get the FQN for this script file
strDefaultLocation = Left(strDefaultLocation,InStrRev(strDefaultLocation,"\")) 'get just the path portion with trailing \
strFileName = "WebSiteMonLog.csv"
With objDict
'TODO:
'Copy and paste the following line once for each site you want to add
'Change "Site" to be the site you want, leave it in quotes
'Change "URL" to the actual url, leave it in quotes
'Uncomment the line (remove the begining ' )
'.Add "Site", "URL"
End With
End Sub
Sub Main()
Dim intCount, intElapsed, intNumSites
Dim dtmStart, dtmEnd, objItem, strLog
Dim strErr, intLen
'Uncomment the following line if you want a fresh log file each time this script runs
'If objFS.FileExists(strDefaultLocation & strFileName) Then objFS.DeleteFile strDefaultLocation & strFileName
'WriteLog "Time, URL, Elapsed, Bytes" 'uncommend this if you need a header
With objXMLHTTP
intNumSites = objDict.Count
For Each objItem in objDict
strLog = ""
strErr = ""
intCount = 0
intLen = 0
dtmStart = Now()
With objXMLHTTP
On Error Resume Next
.Open "GET", objDict(objItem), FALSE
If Err.Number <> 0 Then strErr = "Site not found: "
.Send()
Do Until .readyState = 4 'loop until page is loaded
.waitForResponse 1000 'wait one second
intCount = intCount + 1
If intCount > 10 Then 'if the site doesn't load after ~10 seconds; continue with next site
Err.Raise 999
strErr = "Site not found: "
Exit Do
End If
Loop
intLen = Len(.responseText)
On Error GoTo 0
End With
dtmEnd = Now()
intElapsed = DateDiff("s",dtmStart,dtmEnd)
strLog = dtmStart & "," & strErr & objDict(objItem) & "," & intElapsed & "," & intLen
WriteLog strLog
Next
End With
End Sub
Sub WriteLog(strLogText)
Dim objFile
Set objFile = objFS.OpenTextFile(strDefaultLocation & strFileName,ForAppending,True)
With objFile
.WriteLine strLogText
.close
End With
Set objFile = Nothing
End Sub
Sub Enit()
Set objXMLHTTP = Nothing
Set objFS = Nothing
Set objDict = Nothing
End Sub
'___________________________________________________________________
'___________________________________________________________________
'Copy/Paste this script to a file named RunWebSiteMon_v0.1.vbs
Option Explicit
'To stop the loop, create a file named stop.txt (can be empty)
Dim intInterval, objShell, objFS
Dim varReturn 'could do without but is handy for troubleshooting
Dim strLocation, strRunFile, strStopFile
Set objFS = CreateObject("Scripting.FileSystemObject")
intInterval = 5
strStopFile = "stop.txt"
With WScript
strLocation = .ScriptFullName 'get the FQN for this script file
strLocation = Left(strLocation,InStrRev(strLocation,"\")) 'get just the path portion with trailing \
strRunFile = """" & Replace(.ScriptFullName,"Run","") & """" 'works as long as file names are not changed from original
End With
Set objShell = WScript.CreateObject("WScript.Shell")
Do 'loop until stop file is present
On Error Resume Next
varReturn = objShell.Run(strRunFile, 0, TRUE)
On Error GoTo 0
If Len(Trim(varReturn)) = 0 Then Exit Do 'if we don't have a valid return code; bail
If varReturn <> 0 Then Exit Do 'if the app didn't run properly; bail
If objFS.FileExists(strLocation & strStopFile) Then 'if stop file is present; bail
objFS.DeleteFile strLocation & strStopFile 'delete stop file
Exit Do 'exit loop, then script will end
End If
WScript.Sleep intInterval * 1000 'convert miliseconds to seconds
Loop
Set objShell = Nothing
Set objFS = Nothing
'___________________________________________________________________