Solved

How to I fix the web monitoring status?

Posted on 2009-04-14
12
297 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
 
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
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Meet the world's only “Transparent Cloud™” from Superb Internet Corporation. Now, you can experience firsthand a cloud platform that consistently outperforms Amazon Web Services (AWS), IBM’s Softlayer, and Microsoft’s Azure when it comes to CPU and …
The purpose of this video is to demonstrate how to reset a WordPress password if you are locked out and cannot reset the password. A typical use would be if you cannot access the email to which WordPress would send the password recovery email to…
The purpose of this video is to demonstrate how to set up basic WordPress SEO. This will be demonstrated using a Windows 8 PC. The plugin used will be WordPress SEO by Yoast. Go to your WordPress login page. This will look like the following: myw…

708 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now