Solved

How to I fix the web monitoring status?

Posted on 2009-04-14
12
299 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
New My Cloud Pro Series - organize everything!

With space to keep virtually everything, the My Cloud Pro Series offers your team the network storage to edit, save and share production files from anywhere with an internet connection. Compatible with both Mac and PC, you're able to protect your content regardless of OS.

 

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

Backup Your Microsoft Windows Server®

Backup all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

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

Suggested Solutions

Data center, now-a-days, is referred as the home of all the advanced technologies. In-fact, most of the businesses are now establishing their entire organizational structure around the IT capabilities.
This guide will walk you through the essential considerations and tech stack for building scalable websites. Know how to grow your business the smart way!
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…
The purpose of this video is to demonstrate how to set up the permalinks on a WordPress Website. This will be demonstrated using a Windows 8 PC. Go to your WordPress login page. This will look like the following: mywebsite.com/wp-login.php : Go t…

895 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

12 Experts available now in Live!

Get 1:1 Help Now