'========================================================================================================
'========================================================================================================
' ### Script: httpping.vbs
' ### ScriptVersion: 42
' ### Created: 02/16/05
' ### Group: AHS
' ### Contact: timcho@safeco.com
' ### Description: access a URL and print the http response
'========================================================================================================
'========================================================================================================
Option Explicit
On Error Resume Next


'Declare variables
Dim WshShell,Wshnetwork,WshFile,HttpObj
Dim strServer,strArgs
Dim Inst,Temp
Dim strURL


Set WshShell = Wscript.CreateObject("Wscript.shell")
Set Wshnetwork = wscript.CreateObject("Wscript.Network")
Set Wshfile = wscript.CreateObject("Scripting.FileSystemObject")
Set HttpObj = CreateObject("WinHttp.WinHttpRequest.5.1")
If Err.Number <> 0 Then 
	Err.Clear
	Set HttpObj = CreateObject("WinHttp.WinHttpRequest.5")
End If


'Check to ensure we're using cscript
If InStr(1, wscript.fullname, "cscript.exe", 1) = 0 Then VerifyCscript


'Parse the command line
GetArgs()

wscript.echo ""


'Test HTTP
Test_HTTP strURL
'wscript.sleep 500



'========================================================================================================
'========================================================================================================
Sub Test_HTTP(strURL)
On error resume next
Dim Position

'Ensure we can connect to HTTP, if this fails exit
'header s/b something like this:
'HTTP/1.1 401 Access Denied
'Server: Microsoft-IIS/5.0
'Date: Mon, 20 Sep 2004 20:31:34 GMT
'WWW-Authenticate: Negotiate
'WWW-Authenticate: NTLM
'Connection: close
'Content-Length: 4431
'Content-Type: text/html


position = instr(lcase(strURL),"http")
	If position < 1 then
	wscript.echo "No http:// found in " & strURL & ", adding http:// ..."
	strURL = "http://" & strURL
END IF


wscript.echo "Testing " & strURL

	HttpObj.ScriptTimeOut = 1000
	HttpObj.Open "GET", strURL, false
	HttpObj.Send
	IF Err.Number <> 438 THEN
		wscript.echo 
		wscript.echo "HTTP test for server " & strServer & " FAILED!"
		wscript.sleep 1000
		Exit Sub
	ELSE
		'Just print the status from the header
		wscript.echo HttpObj.getAllResponseHeaders
		wscript.echo "HTTP " & HttpObj.Status & " " & HttpObj.StatusText

	END IF


End sub
'========================================================================================================
'========================================================================================================
Private Sub Scripthelp()
	WScript.Echo
	WScript.Echo
	WScript.Echo
	WScript.Echo "httpping.vbs"
	WScript.Echo "=========================================================="
	WScript.Echo "Access a URL and print the web server header"
	WScript.Echo "=========================================================="
	WScript.Echo ""
	WScript.Echo "Usage: httpping [[-?] http://hostname]"
	WScript.Echo "   -?:  Show usage"
	Wscript.Echo
	Wscript.Echo
	Wscript.Echo
	Wscript.Echo "tim@blackpondfarm.com"
	Wscript.Echo
	Wscript.Quit
End Sub
'========================================================================================================
'========================================================================================================
Function GetArgs()
On Error Resume Next
Dim a

For a = 0 To wscript.arguments.count - 1
	argtext = argtext & wscript.arguments(a) & " "
	strArgs = wscript.arguments(a)
next

	If strArgs <> "" Then
		strURL=strArgs
	
	Else
		Call SCRIPTHELP()
		Exit Function
	End If



	If ParseArgument("-?") Then
		Call SCRIPTHELP()
		Exit Function
	End If

	If ParseArgument("/?") Then
		Call SCRIPTHELP()
		Exit Function
	End If

	If Err.number <> 0 Then
        	LogError "End of Arguments Function", Err.number
	        Err.Clear
	End If
    
End Function
'========================================================================================================
'========================================================================================================
Function ParseArgument(strtext)
Dim a
On Error Resume Next
    
    For a = 0 To wscript.arguments.count - 1
        If wscript.arguments(a) = strtext Then ParseArgument = a + 1
    Next

End Function
'========================================================================================================
'========================================================================================================
Function VerifyCscript()
Dim temp

	'Sets up Vbscript to always run in command window
		temp = wshshell.Run("cmd /c ""wscript //h:cscript //nologo //s 1>nul 2>nul""", 0, true)
		temp = MsgBox ("The script has changed the default output of Windows Scripting Host to the command prompt." &_
		vbCrLf & "This is pop up is normal, just re-run the script!", 0, "WSH default changed to cscript.")
		wscript.quit

End Function
'========================================================================================================
'END OF SCRIPT
'========================================================================================================