Solved

How to I fix the web monitoring status?

Posted on 2009-04-14
12
302 Views
Last Modified: 2013-12-20
Hello,

The following code will basically check for the two sites that I had listed and send an email to inform either its OK or the other way around. However, it seems i have problem of displaying coldfusion as well as certain sites which if you try to browse, it works fine. Can i know what went wrong on the code?

The status that i will be getting for both these sites are:-

4/15/2009 10:21:19 AM Status FAIL for the URL http://senireka.com.my/index.cfm?sc=52 - returned http status 500 Internal Server Error
4/15/2009 10:21:20 AM Error connecting to http://mail.budgetshops.net The server returned an invalid or unrecognized response
Option Explicit
 
Dim strSMTPServer
Dim strEmailFrom
Dim strEmailTo
strSMTPServer = "mail.yourdomain.com"
strEmailFrom = "alerts@yourdomain.com"
strEmailTo = "admin@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://senireka.com.my/index.cfm?sc=52", "<title>", "</title>"
CheckSite "http://mail.budgetshops.net", "<title>", "</title>"
 
 
' -------------------------------------------------------------------
 
If FileExist("alertList.txt") Then
  Call SendMail(strEmailFrom, "Website monitoring", strEmailTo, _
    "Web Monitoring", 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() & _
          " Status OK for 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() & _
          " Status FAIL for 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

Open in new window

0
Comment
Question by:loong
  • 6
  • 4
12 Comments
 
LVL 52

Expert Comment

by:_agx_
ID: 24169797
I don't know asp, so I can't help you with the second link.  

But the problem with the first link is that it is setup to expect browser information.  If you dump the http response, you'll see an error like the one below.  It is because that page is not set up to handle cases where there browser information is missing.  Unless you have access to correct that code, your only option is to modify your http call to send a  "UserAgent" value (like "MSIE 7...")

Also, if you only need to confirm the status you might consider using "HEAD" instead of a full "GET".

CFM Error:
================
         Variable BROWSERTYPE is undefined.  
         ....
        <cfset clientOS = "Other"> 131 : </cfif> 132 : <cfset caller.BrowserType = BrowserType>
       133 :  <cfset caller.OS = clientOS>
       134 : <cfset caller.Version =  "#checkVersion(browserType,cgi.HTTP_USER_AGENT)#">  
0
 
LVL 52

Expert Comment

by:_agx_
ID: 24170353
... In other words, change your http call so the request looks like it is coming from a browser  (Firefox, IE, etc..)
0
 

Author Comment

by:loong
ID: 24173585
Hi aqx,

Errmm...can you probably advice us on the http request to something that is working?

Uncertain of which is required to be changed.
0
3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

 
LVL 52

Expert Comment

by:_agx_
ID: 24173628
Hi loong,

It is been a while since I've used VBScript, but try adding a user agent, right after you open the request:

objWinHttp.Open "GET", strCheckURL
' ***** ADD USER AGENT HERE *********
objWinHttp.setRequestHeader("User-Agent", "MSIE 7.0;");
' continue with rest of code ....
On Error Resume Next
   objWinHttp.Send()
....

0
 
LVL 52

Expert Comment

by:_agx_
ID: 24173644
... I am not sure about the syntax.  It might be more like this, but you get the idea.

objWinHttp.SetRequestHeader "User-Agent", "MSIE 7.0;"
0
 

Author Comment

by:loong
ID: 24173804
aqx, hope you dont mind..

Can you please provide a full snippet of where to insert the codes?

Or anyone else that can probably assist?
0
 
LVL 52

Accepted Solution

by:
_agx_ earned 500 total points
ID: 24173944
It would go in the CheckSite routine.  

But bear in mind my vbscript is _very_ rusty.  If it doesn't work, you may be better off asking a more knowledgable expert about that part.  Though I would be happy to assist with any CF problems.  That is more my area of expertise :)
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
  ' ***** NEW CODE:  USER AGENT ADDED HERE *********
  objWinHttp.SetRequestHeader "User-Agent", "MSIE 7.0;"
 
  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() & _
          " Status OK for 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() & _
          " Status FAIL for 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

Open in new window

0
 

Author Comment

by:loong
ID: 24202684
We are almost there...It works, i believe...Now we bump into these.

CheckSite "http://mail.budgetshops.net", "<div id=""main"">", "</div>"
CheckSite "http://202.75.53.15", "<div id=""main"">", "</div>"

We will be getting error message as well. Is there anything that we can do to accept IP address as well?
0
 
LVL 52

Expert Comment

by:_agx_
ID: 24204204
You could probably add other headers, just like you did with User-Agent. You just have to figure out which ones are needed by those url's.  

Unfortunately, those are .net pages which outside my area of expertise.  I would suggest opening a new question, so an expert with vbscript/.net experience could assist you.
0
 

Author Comment

by:loong
ID: 24210976
Alright aqx. Thank you very much mate :)
0

Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

When you try to share a printer , you may receive one of the following error messages. Error message when you use the Add Printer Wizard to share a printer: Windows could not share your printer. Operation could not be completed (Error 0x000006…
In this article, I am going to show you how to simulate a multi-site Lab environment on a single Hyper-V host. I use this method successfully in my own lab to simulate three fully routed global AD Sites on a Windows 10 Hyper-V host.
The purpose of this video is to demonstrate how to add AdSense Ads to a WordPress Website, and how to set up WordPress to automatically place Ads in Sidebars. This will be demonstrated using a Windows 8 PC. Log into your AdSense account. : Cli…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

803 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question