'==========================================================================
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.0
'
' NAME: HTTPCheck.vbs
' AUTHOR: Neale Brown , AKOS Technology Services
' DATE  : 12/4/2006
' COMMENT: Checks the availability and response time of a secified website.
'
' PARAMETERS: 
' 		URL: Can be HTTP or HTTPS
'			ex. http://www.microsoft.com
'		SearchString: Text string that should be somehwere in the HTML
'			code.
'		ChartAvailability: Set to 1 if you want to chart your availability.
'			If it set, it will log a performance counter with a value of 1 
'			to signify it is up.  A zero to signify it is down.		
'		LogSuccess: Enables the processing of successfull logging of
'			alerts and events. For Troubleshooting only.
'		Threshold: A response time threshold in seconds for the site to 
' 			return the 	data.  If the site exceeds this time, then the
'			will raise an alert.  Set to 0 if you want to disable (will
'			also disable the performance counter logging as well).
'==========================================================================

'map alert types & numbers to friendly names
const ALERT_SUCCESS = 10
const ALERT_INFORMATION = 20
const ALERT_WARNING = 30
const ALERT_ERROR = 40
const ALERT_CRITICAL_ERROR = 50
const ALERT_SECURITY_BREACH = 60
const ALERT_SERVICE_UNAVAILABLE = 70

'map event types & numbers to friendly names
const EVENT_TYPE_SUCCESS = 0
const EVENT_TYPE_ERROR = 1
const EVENT_TYPE_WARNING = 2
const EVENT_TYPE_INFORMATION = 4
const EVENTLOG_AUDIT_SUCCESS = 8
const EVENTLOG_AUDIT_FAILURE = 16

'set constants for http call
Const toResolve = 6000
Const toConnect = 6000
Const toSend = 6000
Const toReceive = 2000

'Declare Variables.
Dim strURL, intStatus, strData, intSearchFlag, strSearchString, intStart, intEnd, intTotal, intAvailability, intErrorStatus
Dim intChartAvailabilty
intSearchFlag = 1

'Get Parameters from MOM
strURL = ScriptContext.Parameters.Get("URL")
strSearchString = ScriptContext.Parameters.Get("SearchString")
intChartAvailability = ScriptContext.Parameters.Get("ChartAvailability")
blnLogSuccess = ScriptContext.Parameters.Get("LogSuccess")
intThreshold = ScriptContext.Parameters.Get("Threshold")
'End Parameters

'Check for the existence of a search string
if Len(strSearchString) <= 0 Then
	intSearchFlag = 0
End If 

'Try calling MSXML2.ServerXMLHTTP.3.0 
'This allows the script to retrieve HTML from target site
Set objURL = CreateObject("MSXML2.ServerXMLHTTP.3.0")

'Start Timer
intStart = Timer

'The open command will try to get html data from the target url passed to the Function
On Error Resume Next
objURL.setTimeouts toResolve, toConnect, toSend, toReceive
objURL.open "GET",strURL, false
objURL.send

'If there is a generic problem with the HTTP Get, it is caught by this routine
'and an alert is generated.
If Err.Number <> 0 Then
	strDesc = "The " & Err.Source & " returned an internal error:"
	strDesc = strDesc & vbCr & "Error Number: " & Err.Number
	strDesc = strDesc & vbCr & "Error Description: " & Err.Description
	strDesc = strDesc & vbCr & "URL: " & strURL
	strDesc = strDesc & vbCr & "Search String: " & strSearchString
	strDesc = strDesc & vbCr & "Threshold: " & FormatNumber(intThreshold,2,,,0)
	strDesc = strDesc & vbCr & "Success Logging: " & blnLogSuccess
	strDesc = strDesc & vbCr & "Chart Availability: " & intChartAvailability
	GenerateEvent "41001", EVENT_TYPE_ERROR, strDesc
	intAvailability = 0
Else
On Error GoTo 0
	intStatus = objURL.status
	strData = objURL.responseText

	'Search String Flag test
	'If flag is 0 then it runs a HTTP status check
	If intSearchFlag = 0 Then
		If intStatus >= 400 Then
			strDesc = "The Server is up but a response from the Web Server indicates a problem returning data."
			strDesc = strDesc & vbCr & "The response from " & strURL & " is " & intStatus
			strDesc = strDesc & vbCr & "Please check out the website." 
			GenerateEvent "41001", EVENT_TYPE_ERROR, strDesc
			intAvailability = 0
		Else
			intAvailability = 1
			If blnLogSuccess then
				strDesc = "The Server is up recieved a good response from the Web Server."
				strDesc = strDesc & vbCr & "The response from " & strURL & " is " & intStatus
				strDesc = strDesc & vbCr
				GenerateEvent "41002", EVENT_TYPE_SUCCESS, strDesc	
				
			End If
		End If
	'Search flag is 1, then it checks for the predifined string in the 
	'returned HTML data
	Else
		intSearchReturn = InStr(strData, strSearchString)
		If intSearchReturn > 0 Then
			intAvailability = 1
			If blnLogSuccess then	
				strDesc = "The search string was found in the HTML data returned by the server."
				strDesc = strDesc & vbCr & "The search string is " & strSearchString 
				strDesc = strDesc & vbCr & "The URL is " & strURL
				GenerateEvent "41004", EVENT_TYPE_SUCCESS, strDesc
			End If
		Else
			strDesc = "The search string was not found in the returned HTML data."
			strDesc = strDesc & vbCr & "The search string is " & strSearchString 
			strDesc = strDesc & vbCr & "The URL is " & strURL
			GenerateEvent "41003", EVENT_TYPE_ERROR, strDesc
			intAvailability = 0
		End If
	End If

	'End Time
	intEnd = Timer
	intTotal = intEnd - intStart
	
	'If Threshold is present in parameters, it will continue, otherwise it
	'will ignore the calculated time.
	If intThreshold > 0 Or intThreshold <> Null Then
		if intAvailability = 1 Then 
			CreatePerfData "Synthetic HTTP Transaction",strURL,"MON-MGT-01", FormatNumber(intTotal,2,,,0)
		Else
			CreatePerfData "Synthetic HTTP Transaction",strURL,"MON-MGT-01", "0"
		End If 
		If intTotal > intThreshold and intAvailability = 1 Then
			strDesc = "The site " & strURL & " responsed but in a time greater than the provided threshold."
			strDesc = strDesc & vbCr & "Threshold is " & FormatNumber(intThreshold,2,,,0)
			strDesc = strDesc & vbCr & "The response time is " & FormatNumber(intTotal,2,,,0)
			strName = "'Synthetic HTTP Response Latency - " & strURL
			GenerateAlert ALERT_WARNING,strDesc,strName
		Else
			If blnLogSuccess Then
				strDesc = "The site " & strURL & " responsed within the provided threshold."
				strDesc = strDesc & vbCr & "Threshold is " & FormatNumber(intThreshold,2,,,0)
				strDesc = strDesc & vbCr & "The response time is " & FormatNumber(intTotal,2,,,0)
				strName = "'Synthetic HTTP Response Latency - " & strURL
				GenerateAlert ALERT_SUCCESS,strDesc,strName
			End if
		End If
	End If
End If

'If the ChartAvailability parameter is set to 1, then it will log a 
'1 for up and 0 for down in the performance object.
If intChartAvailability Then 
	CreatePerfData "Synthetic HTTP Availability",strURL,"MON-MGT-01",intAvailability
End If 


'******************************************************************************
'Name:		GenerateEvent
'Purpose:	Raises an event
'Parameters:
'	intEventNo - Number to alert identity for Mom
'	intEventType - Severity Level of event	
'	strMessage - Event Description
'Returns: Nothing
'******************************************************************************/
function GenerateEvent(intEventNo, intEventType, strMessage)
    
    Dim MyEvent
    Set MyEvent = ScriptContext.CreateEvent()
    MyEvent.EventNumber = intEventNo
    MyEvent.EventType = intEventType
    MyEvent.Message = strMessage
    MyEvent.EventSource = "Synthetic HTTP Transaction"
    ScriptContext.Submit MyEvent
End Function

'* --------------------------------------------------------------------
'Name:		GenerateAlert
'Purpose:	Raises an alert
'Parameters:
'	intSeverity - The severity of the alert.
'	strDescription - The alert description.
'	strName - Unique name for success/fail alert differentiation
'Returns: Nothing
'* --------------------------------------------------------------------
function GenerateAlert(intSeverity, strDescription, strName)
	 
	 Dim objAlert
	 Set objAlert = ScriptContext.CreateAlert
     objAlert.Name = strName
	 objAlert.AlertSource = "Synthetic HTTP Transaction"
	 objAlert.Description = strDescription
	 objAlert.AlertLevel = intSeverity
	 ScriptContext.Submit objAlert 
End Function

'*******************************************************************************
'Name:		CreatePerfData
'Purpose:	Creates a performance object to display response time in Performance View
'Parameters:
'	strObjectName - Name of the script
'	strCounterName - Name for the performance information logged
'	strInstanceName - Where the script will be running
'	intValue - Performance number to submit to MOM 
'Returns: Nothing
'******************************************************************************
function CreatePerfData(strObjectName,strCounterName,strInstanceName,intValue)
	
	dim objPerfData 
	Set objPerfData = ScriptContext.CreatePerfData()
	objPerfData.ObjectName = strObjectName
	objPerfData.CounterName =strCounterName
	objPerfData.InstanceName = strInstanceName
	objPerfData.Value = intValue
	ScriptContext.Submit objPerfData
	Set objPerfData = nothing
End Function