*********************************************************************************
'
' Script Name - HTTPPing
'
' Version     - 2.0.0 (20-jul-2004)
'
' Purpose     - Checks the HTTP status code returned from a given URL.
'
' Events        1000 - HTTPPing to URL was successful (expected HTTP status code returned)
'               1001 - HTTPPing to URL did not return the expected HTTP status code
'               1002 - HTTPPing to URL returned a blacklisted HTTP status code
'               1003 - Missing parameters
'
' Parameters  - URL               = URL to check the HTTP status code of.
'               HTTPCodeWhiteList = Alert if the HTTP status code returned is different than any of the values
'                                   specified here. Seperate multiple HTTP status codes with semi-colon (";")
'               HTTPCodeBlackList = Alert if the HTTP status code returned matches any of the values specified
'                                   here. Seperate multiple HTTP status codes with semi-colon (";")
'               IncludeComputers  = List of computers that should be allowed to run the script.
'                                   Leave blank to allow all. Seperate multiple values by ";".
'               ExcludeComputers  = List of computers that should NOT be allowed to run the script.
'                                   Exclude overrule Include. Seperate multiple values by ";".
'               SuppressEvents    = List of events to suppress. Seperate multiple values by ";".
'                                   (Fx. "1000;1002")
'
' Notes       - See a list of HTTP status codes in the "HTTP Status Codes" section below.
'               The blacklist takes presedence over the whitelist, i.e. if something is specified in
'               both lists then only the blacklist is interpreted.
'
' Author      - Nicolaj Rasmussen
'
'*********************************************************************************
Option Explicit

' --- Define Constants ---
' Event types
Const Event_Type_Success                  = 0
Const Event_Type_Error                    = 1
Const Event_Type_Warning                  = 2
Const Event_Type_Info                     = 4
Const Event_Type_Audit_Success            = 8
Const Event_Type_Audit_Failure            = 16
' Default values
' None
' Event properties
Const HTTPPing_Success_EventTxt           = "HTTPPing to '[URL]' was successful. The server returned HTTP status code [HTTPStatusCode] ([HTTPStatusCodeTxt])."
Const HTTPPing_Success_EventID            = 1000
Const HTTPPing_Success_EventType          = 0
Const HTTPPing_Not_Expected_SC_EventTxt   = "HTTPPing to '[URL]' failed with HTTP status code [HTTPStatusCode] ([HTTPStatusCodeTxt]). The server did not return an expected HTTP status code (whitelist = '[HTTPCodeWhiteList]')."
Const HTTPPing_Not_Expected_SC_EventID    = 1001
Const HTTPPing_Not_Expected_SC_EventType  = 0
Const HTTPPing_Blacklisted_SC_EventTxt    = "HTTPPing to '[URL]' failed with HTTP status code [HTTPStatusCode] ([HTTPStatusCodeTxt]). The server returned a blacklisted HTTP status code (blacklist = '[HTTPCodeBlackList]')."
Const HTTPPing_Blacklisted_SC_EventID     = 1002
Const HTTPPing_Blacklisted_SC_EventType   = 0
Const Error_Missing_Parameters_EventTxt   = "Missing parameters ([MissingParameters])!"
Const Error_Missing_Parameters_EventID    = 1003
Const Error_Missing_Parameters_EventType  = 1

' HTTP Status Codes
Dim HTTP_Continue                      : HTTP_Continue                      = Array(100, "Continue")
Dim HTTP_Switching_Protocols           : HTTP_Switching_Protocols           = Array(101, "Switching Protocols")
Dim HTTP_OK                            : HTTP_OK                            = Array(200, "OK")
Dim HTTP_Created                       : HTTP_Created                       = Array(201, "Created")
Dim HTTP_Accepted                      : HTTP_Accepted                      = Array(202, "Accepted")
Dim HTTP_NonAuthoritative_Information  : HTTP_NonAuthoritative_Information  = Array(203, "NonAuthoritative Information")
Dim HTTP_No_Content                    : HTTP_No_Content                    = Array(204, "No Content")
Dim HTTP_Reset_Content                 : HTTP_Reset_Content                 = Array(205, "Reset Content")
Dim HTTP_Partial_Content               : HTTP_Partial_Content               = Array(206, "Partial Content")
Dim HTTP_Multiple_Choices              : HTTP_Multiple_Choices              = Array(300, "Multiple Choices")
Dim HTTP_Moved_Permanently             : HTTP_Moved_Permanently             = Array(301, "Moved Permanently")
Dim HTTP_Moved_Temporarily             : HTTP_Moved_Temporarily             = Array(302, "Moved Temporarily")
Dim HTTP_See_Other                     : HTTP_See_Other                     = Array(303, "See Other")
Dim HTTP_Not_Modified                  : HTTP_Not_Modified                  = Array(304, "Not Modified")
Dim HTTP_Use_Proxy                     : HTTP_Use_Proxy                     = Array(305, "Use Proxy")
Dim HTTP_Bad_Request                   : HTTP_Bad_Request                   = Array(400, "Bad Request")
Dim HTTP_Unauthorized                  : HTTP_Unauthorized                  = Array(401, "Unauthorized")
Dim HTTP_Payment_Required              : HTTP_Payment_Required              = Array(402, "Payment Required")
Dim HTTP_Forbidden                     : HTTP_Forbidden                     = Array(403, "Forbidden")
Dim HTTP_Not_Found                     : HTTP_Not_Found                     = Array(404, "Not Found")
Dim HTTP_Method_Not_Allowed            : HTTP_Method_Not_Allowed            = Array(405, "Method Not Allowed")
Dim HTTP_Not_Acceptable                : HTTP_Not_Acceptable                = Array(406, "Not Acceptable")
Dim HTTP_Proxy_Authentication_Required : HTTP_Proxy_Authentication_Required = Array(407, "Proxy Authentication Required")
Dim HTTP_Request_TimeOut               : HTTP_Request_TimeOut               = Array(408, "Request TimeOut")
Dim HTTP_Conflict                      : HTTP_Conflict                      = Array(409, "Conflict")
Dim HTTP_Gone                          : HTTP_Gone                          = Array(410, "Gone")
Dim HTTP_Length_Required               : HTTP_Length_Required               = Array(411, "Length Required")
Dim HTTP_Precondition_Failed           : HTTP_Precondition_Failed           = Array(412, "Precondition Failed")
Dim HTTP_Request_Entity_Too_Large      : HTTP_Request_Entity_Too_Large      = Array(413, "Request Entity Too Large")
Dim HTTP_RequestURL_Too_Large          : HTTP_RequestURL_Too_Large          = Array(414, "RequestURL Too Large")
Dim HTTP_Unsupported_Media_Type        : HTTP_Unsupported_Media_Type        = Array(415, "Unsupported Media Type")
Dim HTTP_Server_Error                  : HTTP_Server_Error                  = Array(500, "Server Error")
Dim HTTP_Not_Implemented               : HTTP_Not_Implemented               = Array(501, "Not Implemented")
Dim HTTP_Bad_Gateway                   : HTTP_Bad_Gateway                   = Array(502, "Bad Gateway")
Dim HTTP_Out_Of_Resources              : HTTP_Out_Of_Resources              = Array(503, "Out Of Resources")
Dim HTTP_Gateway_TimeOut               : HTTP_Gateway_TimeOut               = Array(504, "Gateway TimeOut")
Dim HTTP_Version_Not_supported         : HTTP_Version_Not_supported         = Array(505, "Version Not supported")
Dim HTTP_Unknown                       : HTTP_Unknown                       = Array(12007, "Unknown")

' Declare variables
' Objects
Dim objParams
' Strings
Dim strMissingParameters, strURL, strHTTPCodeWhiteList, strHTTPCodeBlackList, strIncludeComputers
Dim strExcludeComputers, strSuppressEvents, strLocalComputerName, strIncludeComputerName
Dim strHTTPStatusCode, strEventMsg, strSuppressEvent
' Booleans
Dim blnExcludeComputer, blnIncludeComputer, blnExecuteOnComputer, blnSuppressEvents, blnSubmitEvent
Dim blnHTTPCodeBlackListed, blnHTTPCodeWhiteListed, blnUseHTTPCodeWhiteList, blnUseHTTPCodeBlackList
' Arrays
Dim arrHTTPCodeWhiteList, arrHTTPCodeBlackList, arrIncludeComputers, arrHTTPStatusCode, arrSuppressEvents
' Integers
Dim intEventID, intEventType

InitVars
CreateObjects
GetParameters
ParseParameters
CheckIfExecute

' Start main routine if script is allowed to run on the local agent computer
If blnExecuteOnComputer = True Then
  ' Only start if no parameters are missing
  If strMissingParameters = "" Then
    ' Reset variables
    ResetVariables
    arrHTTPStatusCode = HTTPPing(strURL)
    If blnUseHTTPCodeBlackList Then
      For Each strHTTPStatusCode In arrHTTPCodeBlackList
        If IsNumeric(strHTTPStatusCode) Then
          If CInt(arrHTTPStatusCode(0)) = CInt(strHTTPStatusCode) Then
            blnHTTPCodeBlackListed = True
          End If
        End If
      Next
    End If
    
    If blnUseHTTPCodeWhiteList Then
      For Each strHTTPStatusCode In arrHTTPCodeWhiteList
        If IsNumeric(strHTTPStatusCode) Then
          If CInt(arrHTTPStatusCode(0)) = CInt(strHTTPStatusCode) Then
            blnHTTPCodeWhiteListed = True
          End If
        End If
      Next
    End If
    
    If (blnUseHTTPCodeBlackList And Not blnHTTPCodeBlackListed) Or _
       (blnUseHTTPCodeWhiteList And blnHTTPCodeWhiteListed) Then
      ' HTTPPing successful
      ' Build event
      strEventMsg = ReplaceEventVariables(HTTPPing_Success_EventTxt)
      intEventID = HTTPPing_Success_EventID
      intEventType = HTTPPing_Success_EventType
      ' Submit event
      CreateSubmitEvent strEventMsg, intEventID, intEventType, ""
    ElseIf (blnUseHTTPCodeBlackList And blnHTTPCodeBlackListed) Then
      ' HTTPPing failed, HTTP status code blacklisted
      ' Build event
      strEventMsg = ReplaceEventVariables(HTTPPing_Blacklisted_SC_EventTxt)
      intEventID = HTTPPing_Blacklisted_SC_EventID
      intEventType = HTTPPing_Blacklisted_SC_EventType
      ' Submit event
      CreateSubmitEvent strEventMsg, intEventID, intEventType, ""
    ElseIf (blnUseHTTPCodeWhiteList And Not blnHTTPCodeWhiteListed) Then
      ' HTTPPing failed, HTTP status code not expected
      ' Build event
      strEventMsg = ReplaceEventVariables(HTTPPing_Not_Expected_SC_EventTxt)
      intEventID = HTTPPing_Not_Expected_SC_EventID
      intEventType = HTTPPing_Not_Expected_SC_EventType
      ' Submit event
      CreateSubmitEvent strEventMsg, intEventID, intEventType, ""
    End If
  Else
    ' Missing parameters, create event and exit
    ' Build event
    strEventMsg = ReplaceEventVariables(Error_Missing_Parameters_EventTxt)
    intEventID = Error_Missing_Parameters_EventID
    intEventType = Error_Missing_Parameters_EventType
    ' Submit event
    CreateSubmitEvent strEventMsg, intEventID, intEventType, ""
  End If
End If

' Kill objects
DeleteObjects

' -------------------- Functions and subs --------------------

' HTTPPing(strURL) - Returns the HTTP Status Code from the server when contacting an URL.
' Returns Array(-1, "Unknown Error") if an error occurs while using Msxml2.XMLHTTP to
' send the GET command to the URL.
' Returns Array(-2, "Invalid URL") if the URL string doesn't start with HTTP´.
Function HTTPPing(strURL)
  ' Declare variables
  Dim objXML
  Dim strHTTPResponse
  ' Validate URL
  If (UCase(Left(strURL, 4)) = "HTTP") And (InStr(strURL, "://") > 0) Then
    ' Create objects
    Set objXML = CreateObject("Msxml2.XMLHTTP")
    ' Enable internal errorhandling and clear errorlog
    On Error Resume Next
    Err.Clear
    Call objXML.Open("GET", strURL, False)
    Call objXML.Send()
    ' Check for errors
    If Err.Number > 0 Then
      HTTPPing = Array(-1, "Unknown Error")
    Else
      HTTPPing = Array(objXML.Status, objXML.StatusText)
    End If
    ' Clear errorlog and disable internal errorhandling
    Err.Clear
    On Error Goto 0
    ' Kill objects
    Set objXML = Nothing
  Else
    HTTPPing = Array(-2, "Invalid URL")
  End If
End Function

' Replace event variables with the corresponding script variables and return string
Function ReplaceEventVariables(strEventMsg)
  Dim strTemp
  strTemp = Replace(strEventMsg, "[URL]", strURL)
  strTemp = Replace(strTemp, "[HTTPCodeBlackList]", strHTTPCodeBlackList)
  strTemp = Replace(strTemp, "[HTTPCodeWhiteList]", strHTTPCodeWhiteList)
  strTemp = Replace(strTemp, "[MissingParameters]", strMissingParameters)
  If IsArray(arrHTTPStatusCode) Then strTemp = Replace(strTemp, "[HTTPStatusCode]", arrHTTPStatusCode(0))
  If IsArray(arrHTTPStatusCode) Then strTemp = Replace(strTemp, "[HTTPStatusCodeTxt]", arrHTTPStatusCode(1))
  ReplaceEventVariables = strTemp
End Function

' Sub         : ErrorHandling(blnState, blnClearErrorLog)
' Parameters  : blnState         = True to enable errorhandling, false to disable
'               blnClearErrorLog = True to clear errorlog, false to leave it be
' Description : Check if a eventID should be suppressed (specified in the parameters)
Sub ErrorHandling(blnState, blnClearErrorLog)
  Select Case blnState
    Case True
      ' Enable internal errorhandling and clear errorlog
      On Error Resume Next
      If blnClearErrorLog = True Then Err.Clear
    Case False
      ' Disable internal errorhandling and clear errorlog
      On Error Resume Next
      If blnClearErrorLog = True Then Err.Clear
  End Select
End Sub

' Function    : CheckSuppressEvent(intEventID)
' Parameters  : intEventID = The eventID that should be checked for suppression
' Description : Check if a eventID should be suppressed (specified in the parameters)
Function CheckSuppressEvent(intEventID)
  If blnSuppressEvents = True Then
    For Each strSuppressEvent In arrSuppressEvents
      If CInt(strSuppressEvent) = CInt(intEventID) Then
        CheckSuppressEvent = True
      End If
    Next
  Else
    CheckSuppressEvent = False
  End If
End Function

' Function    : GetLocalComputerName()
' Parameters  : None
' Description : Gets the name of the local computer
Function GetLocalComputerName()
  Dim objNetwork
  Set objNetwork = CreateObject("WScript.Network")
  GetLocalComputerName = objNetwork.ComputerName
  Set objNetwork = Nothing
End Function

' Sub         : CreateObjects
' Parameters  : None
' Description : Creates objects used by the script
Sub CreateObjects
End Sub

' Sub         : DeleteObjects
' Parameters  : None
' Description : Deletes objects used by the script
Sub DeleteObjects
End Sub

' Sub         : GetParameters
' Parameters  : None
' Description : Retrieves the parameters used in the script
Sub GetParameters()
  ' Create parameter object
  Set objParams = ScriptContext.Parameters
  ' Read script parameters
  strURL               = LCase(objParams.Get("URL"))               ' Always lowercase
  strHTTPCodeWhiteList = LCase(objParams.Get("HTTPCodeWhiteList")) ' Always lowercase
  strHTTPCodeBlackList = LCase(objParams.Get("HTTPCodeBlackList")) ' Always lowercase
  strIncludeComputers  = LCase(objParams.Get("IncludeComputers"))  ' Always lowercase
  strExcludeComputers  = LCase(objParams.Get("ExcludeComputers"))  ' Always lowercase
  strSuppressEvents    = objParams.Get("SuppressEvents")
  ' Delete parameter object
  Set objParams = Nothing
End Sub

' Sub         : ParseParameters
' Parameters  : None
' Description : Parses the parameters used in the script
Sub ParseParameters
  ' Parameter: FileSpec
    If strURL = "" Then strMissingParameters = strMissingParameters & "URL, "
  ' Parameter: SourceDir
    If strHTTPCodeWhiteList = "" Then
      blnUseHTTPCodeWhiteList = False
    Else
      blnUseHTTPCodeWhiteList = True
      arrHTTPCodeWhiteList = Split(strHTTPCodeWhiteList, ";")
    End If
  ' Parameter: TargetDir
    If strHTTPCodeBlackList = "" Then
      blnUseHTTPCodeBlackList = False
    Else
      blnUseHTTPCodeBlackList = True
      blnUseHTTPCodeWhiteList = False
      arrHTTPCodeBlackList = Split(strHTTPCodeBlackList, ";")
    End If
  ' Parameter: IncludeComputer
    ' Set strIncludeComputer to local computername if it is not specified in the parameters
    If strIncludeComputers = "" Then strIncludeComputers = GetLocalComputerName()
    ' Split names into array if multiple computernames are specified.
    arrIncludeComputers = Split(strIncludeComputers, ";", -1, 1)
  ' Parameter: ExcludeComputers
    ' If any computernames are specified in the parameters to be excluded split names into array
    If strExcludeComputers <> "" Then
      blnExcludeComputer = True
      arrExcludeComputers = Split(strExcludeComputers, ";", -1, 1)
    End If
  ' Parameter: SuppressEvents
    If strSuppressEvents <> "" Then
      blnSuppressEvents = True
      arrSuppressEvents = Split(strSuppressEvents, ";", -1, 1)
    End If
  ' Variable: strMissingParameters - Remove trailing ", "
    If Right(strMissingParameters, 2) = ", " Then strMissingParameters = Mid(strMissingParameters, 1, Len(strMissingParameters)-2)
End Sub

' Sub         : InitVars
' Parameters  : None
' Description : Inits the variables used in the script
Sub InitVars
  strMissingParameters    = ""
  blnExcludeComputer      = False
  blnExecuteOnComputer    = False
  blnSuppressEvents       = False
  blnSubmitEvent          = True
  blnHTTPCodeBlackListed  = False
  blnHTTPCodeWhiteListed  = False
  blnUseHTTPCodeBlackList = False
  blnUseHTTPCodeWhiteList = False
End Sub

' Sub         : ResetVariables
' Parameters  : None
' Description : Reset the variables used in the script
Sub ResetVariables
  blnSubmitEvent        = True
End Sub

' Sub         : CreateSubmitEvent
' Parameters  : None
' Description : Create and submit an event
Sub CreateSubmitEvent(varEventMsg, varEventID, varEventType, varEventParam1)
  ' Check if the event should be suppressed
  If Not CheckSuppressEvent(varEventID) Then
    ' Create and submit event if blnSubmitEvent is set to true
    If blnSubmitEvent Then 
      Dim objNewEvent
      Set objNewEvent = ScriptContext.CreateEvent
      objNewEvent.Message = varEventMsg
      objNewEvent.EventNumber = varEventID
      objNewEvent.EventType = varEventType
      ' If varEventParam1 contains anything then include the text as Event_Parameter1
      If varEventParam1 <> "" Then objNewEvent.SetEventParameter(varEventParam1)
      ScriptContext.Submit(objNewEvent)
      Set objNewEvent = Nothing
    End If
  End If
End Sub

' Sub         : CheckIfExecute
' Parameters  : None
' Description : Check if the local computername matches one of those specified in
'               the parameters. This prevents the script from running on other agent
'               computers if otherwise is specified in the parameters.
Sub CheckIfExecute
  ' Get local computername
  strLocalComputerName = LCase(GetLocalComputerName())
  ' Check is the local computername is specified in the parameter IncludeComputer
  For Each strIncludeComputerName In arrIncludeComputers
    If LCase(strIncludeComputerName) = strLocalComputerName Then blnExecuteOnComputer = True
  Next
  ' Check if the local computername is specified in the parameter ExcludeComputer
  If blnExcludeComputer = True Then
    For Each strExcludeComputerName In arrExcludeComputers
      If LCase(strExcludeComputerName) = strLocalComputerName Then blnExecuteOnComputer = False
    Next
  End If
End Sub