'=========================================================================
' CheckHTTPStatus.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: https://sigkillit.com
' DATE: 1/17/2013
' COMMENTS: Pass the URL and optionally a username/password to the Function
' and it will check the HTTP return status code.
' EXAMPLE: Check If Website is Running
' Dim strURL: strURL = "http://www.domain.com"
' Dim strUsername: strUsername = ""
' Dim strPassword: strPassword = ""
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strURL: strURL = "http://www.domain.com"
Dim strUsername: strUsername = ""
Dim strPassword: strPassword = ""
' ------ END CONFIGURATION ------
Wscript.Echo CheckHTTPStatus(strURL, strUsername, strPassword)
Function CheckHTTPStatus(url, uname, password)
On Error Resume Next ' Start Error Handling
Dim strResult
' Create Objects
'Dim objHTTP: Set objHTTP = createobject("msxml2.xmlhttp")
Dim objHTTP: Set objHTTP = WScript.CreateObject("MSXML2.ServerXMLHTTP.6.0")
objHTTP.SetOption 2, 13056 ' Ignore all SSL errors
' Open Web Page
objHTTP.open "GET", url, false, uname, password
objHTTP.send
' Error Check and Get Results
If Err.Number <> 0 Then
strResult = "!~ERROR~!"
If isnull(objHttp.Status) Then
strResult = strResult & "UNKNOWN_STATUS"
Else
strResult = strResult & objHTTP.Status & " " & objHTTP.StatusText
End If
Else
If isnull(objHTTP.status) Then
strResult = "!~ERROR~!UNKNOWN_STATUS"
Else
If objHTTP.status < 200 or objHTTP.status >= 300 Then
strResult = "!~ERROR~!"
End If
strResult = strResult & objHTTP.Status & " " & objHTTP.StatusText
End If
End If
Set objHTTP = Nothing
CheckHTTPStatus = strResult
On Error Goto 0 ' End Error Handling
End Function
