VBScript website monitor

A simple and free website surveillance utility implemented in VBScript. Configured as a scheduled task, one or more URLs can be monitored for availability and content can be checked. When a site or URL is down, or if the content returned (or a specified fragment of it) does not match the last returned content, an alert email is sent to a specified email address.

Please note:

• The code uses the free Persits.MailSender object, which must be present on the machine running the script. It can be downloaded at www.aspemail.com (you don't have to install the full package, you can just manually extract the files from the installer and register AspEmail.dll with regsvr32.exe).
• Remember to replace "smtp.yourisp.com" and "alerts@yourdomain.com" with the correct hostname for your SMTP server and the correct email addresses.
• If just content update monitoring is needed (and any server downtime should be ignored), please use this script instead.

Save the code below as a .vbs file.

Option Explicit

Dim strSMTPServer
Dim strEmailFrom
Dim strEmailTo
strSMTPServer = "smtp.yourisp.com"
strEmailFrom = "alerts@yourdomain.com"
strEmailTo = "alerts@yourdomain.com"

'Syntax: CheckSite "CheckURL", "CutBefore", "CutAfter"
'
'CheckURL - is the URL you want to monitor for changes.
'CutBefore - is a string to search for. Any content data before this
'  string is ignored. Leave empty if no ignoring is needed
'CutAfter - is a string to search for. Any content data after this
'  string is ignored. Leave empty if no ignoring is needed
'
'Add multiple function calls to monitor different sites.

' ---- Insert sites you want to monitor in this section -------------

CheckSite "http://www.google.com/", "<title>", "</title>"
CheckSite "http://www.yourdomain.com/", "<div id=""main"">", "</div>"

' -------------------------------------------------------------------

If FileExist("alertList.txt") Then
  Call SendMail(strEmailFrom, "Website monitor", strEmailTo, _
    "Website monitor alert", Readfile("alertList.txt"))
  Call DeleteFile("alertList.txt")
End If

Sub WriteFile(strFileName, strContent)
  Const blnOverwr = True
  Const blnAppend = False
  Const blnUnicode = True
  Const blnASCII = False
  Dim objFS
  Dim objFSFile
  Set objFS = CreateObject("Scripting.FileSystemObject")
  Set objFSFile = objFS.CreateTextFile(strFileName, blnOverwr, blnUnicode)
  objFSFile.Write(strContent)
  objFSFile.Close
  Set objFSFile = nothing
  Set objFS = nothing
End Sub

Sub AppendFile(strFileName, strContent)
  Const intRead = 1
  Const intWrite = 2
  Const intAppend = 8
  Const blnCreate = True
  Const blnNoCreate = False
  Const intASCII = 0
  Const intUnicode = -1
  Const intDefault = -2
  Dim objFS
  Dim objTS
  Set objFS = CreateObject("Scripting.FileSystemObject")
  Set objTS = objFS.OpenTextFile(strFileName, intAppend, blnCreate, intASCII)
  objTS.writeLine(strContent)
  objTS.close()
  Set objTS = nothing
  Set objFS = nothing
End Sub

Function ReadFile(strFileName)
  Const intRead = 1
  Const intWrite = 2
  Const intAppend = 8
  Const blnCreate = True
  Const blnNoCreate = False
  Const intASCII = 0
  Const intUnicode = -1
  Const intDefault = -2
  Dim strContents
  Dim objFS
  Dim objTS
  strContents = ""
  Set objFS = CreateObject("Scripting.FileSystemObject")
  If objFS.FileExists(strFilename) Then
    Set objTS = _
      objFS.OpenTextFile(strFileName, intRead, blnNoCreate, intDefault)
    strContents = objTS.ReadAll
    objTS.Close
    Set objTS = nothing
  End If
  Set objFS = nothing
  Readfile = strContents
End Function

Function FileExist(strFileName)
  Dim objFS
  Set objFS = CreateObject("Scripting.FileSystemObject")
  if objFS.FileExists(strFileName) Then
    FileExist = True
  Else
    FileExist = False
  End if
  Set objFS = nothing
End Function

Sub DeleteFile(strFileName)
  Dim objFS
  Set objFS = CreateObject("Scripting.FileSystemObject")
  If objFS.FileExists(strFileName) Then
    objFS.DeleteFile strFileName, true
  End If
  Set objFS = nothing
End Sub

Sub SendMail(strEmailFrom, strFromName, strEmailTo, strSubject, strMessage)
  Dim objEmail
  Set objEmail = CreateObject("Persits.MailSender")
  objEmail.Host = strSMTPServer
  objEmail.From = strEmailFrom
  objEmail.FromName = strFromName
  'objEmail.AddReplyTo(strEmailFrom)
  objEmail.AddAddress(strEmailTo)
  objEmail.isHTML = false
  objEmail.Subject = strSubject
  objEmail.Body = strMessage
  'objEmail.AddAttachment("status.dat")
  objEmail.Send()
  Set objEmail = nothing
End Sub

Function GenerateFileName(strURL)
  Dim objRegExpr
  Dim strIntermediate
  Set objRegExpr = New regexp
  objRegExpr.Global = True
  objRegExpr.Pattern = "[^0-9a-zA-Z]" ' Match anything not alphanumeric
  strIntermediate = objRegExpr.Replace(strURL, "")
  Set objRegExpr = Nothing
  GenerateFileName = strIntermediate & ".txt"
End Function

Function ChopChop(strInput, strCutBefore, strCutAfter)
  If strCutBefore <> "" Then
    If InStr(strInput, strCutBefore) > 0 Then
      strInput = Right(strInput, _
        Len(strInput) - InStr(strInput, strCutBefore) + 1)
    End If
  End If
  If strCutAfter <> "" Then
    If InStr(strInput, strCutAfter) > 0 Then
      strInput = Left(strInput, _
        InStr(strInput, strCutAfter) + Len(strCutAfter) - 1)
        'Use InStrRev instead to search from end to beginning
    End If
  End If
  ChopChop = strInput
End Function

Sub CheckSite(strCheckURL, strCutBefore, strCutAfter)
  Dim objWinHttp
  Dim strContent
  Dim strContentFile
  strContentFile = GenerateFileName(strCheckURL)
  Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
  objWinHttp.SetTimeouts 29000, 29000, 29000, 29000
  objWinHttp.Option(0) = "Website_monitor_light/1.0"
  objWinHttp.Option(6) = True
  objWinHttp.Open "GET", strCheckURL
  On Error Resume Next
  objWinHttp.Send()
  If Err.number = 0 Then
    If (objWinHttp.Status = 200) Then
      strContent = objWinHttp.ResponseText
      strContent = ChopChop(strContent, strCutBefore, strCutAfter)
      If strContent <> Readfile(strContentFile) Then
        Call AppendFile("alertList.txt", Now() & _
          " Content change detected on the URL " & strCheckURL)
        Call WriteFile(strContentFile, strContent)
      End If
    Else
      strContent = "HTTP " & objWinHttp.Status & " " & _
        objWinHttp.StatusText
      If strContent <> Readfile(strContentFile) Then
        Call AppendFile("alertList.txt", Now() & _
          " The URL " &  strCheckURL & " returned http status " & _
          objWinHttp.Status & " " & objWinHttp.StatusText)
        Call WriteFile(strContentFile, strContent)
      End If
    End If
  Else
    strContent = "Error " & Err.Number & " " & Err.Source & " " & _
      Err.Description
    If strContent <> Readfile(strContentFile) Then
      Call AppendFile("alertList.txt", Now() & _
        " Error connecting to " & strCheckURL & " " & Err.Description)
      Call WriteFile(strContentFile, strContent)
    End If
  End If
  On Error GoTo 0
  Set objWinHttp = Nothing
End Sub