Submitted By: Sergio Marchi

Monitors computer availability using a modified version of Ping.

Visual Basic
Edit|Remove
On Error Resume Next
Dim IpAddress1,IpAddress2,IpAddress3,IpAddress4
Dim Options, Parameters,BeepAfterResume,PingNumbers,TimeToLive,TimeOut,Summary
Dim aParameters()

Set Options = WScript.Arguments.Named
Set Parameters = WScript.Arguments.Unnamed
If Parameters.Count=0 Then
	WScript.Echo "Usage : Sping Ipaddress1 [ipadress2] [IpaddressN] [/b:] [/s:1] [/t:] [/ttl:] [/timeout:]"
	WScript.Echo ""
	WScript.Echo "Options:"
	WScript.Echo "   /b:       Second    Second to wait to sound the beep, when a host became reachable again (default is 10)"
	WScript.Echo "   /s:1                Set the summary mode"	
	WScript.Echo "   /t:       count     Number of ping to perform (default is 999999)"
	WScript.Echo "   /ttl:     TTL       Time to Live (default is 80)"
	WScript.Echo "   /timeout: timeout   Timeout in milliseconds to wait for each reply (default is 1000)"
	WScript.quit 
End if
ReDim aParameters(Parameters.count,4) 
For O =0 To Parameters.Count -1 
	 aParameters(o,0)=Parameters(o)
	 aParameters(o,1)=0 'lost packets
	 aParameters(o,2)=0 'total packets
	 aParameters(o,3)=0 'recived packets
	 aParameters(o,4)=0 'a counter to set as unreachable the host
Next

' Set the default option
If isEmpty (options("b")) Then BeepAfterResume=10 Else BeepAfterResume=cint(options("b")) end If '
If isEmpty (options("t")) Then PingNumbers=999999 Else PingNumbers=cint(options("t")) end If
If isEmpty (options("ttl")) Then TimeToLive=80 Else TimeToLive=cint(options("ttl")) end If
If isEmpty (options("timeout")) Then TimeOut=1000 Else TimeOut=cint(options("timeout")) end If
If (options("s"))=1 Then Summary=true Else Summary=False end If
For n=1 To PingNumbers
Reply=""
	For p= 0 To Ubound(aParameters)-1
		
	    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
	        ExecQuery("select * from Win32_PingStatus where ( address = '" & aParameters(p,0) & "' and TimeToLive=" & TimeToLive & " and TimeOut=" & TimeOut & " )" )
	       For Each objStatus in objPing
	       If Summary Then
	       		
	       		If IsNull(objStatus.StatusCode) Or objStatus.StatusCode<>0 Then 
		           Reply=Reply & aParameters(p,0) & " : :-( | "
		           aParameters(p,1)=aParameters(p,1)+1
		           If aParameters(p,4)<5 Then aParameters(p,4)=aParameters(p,4)+1
		        Else
		        	aParameters(p,2)=aParameters(p,2)+1
		        	aParameters(p,3)=aParameters(p,3)+1
		        	If aParameters(p,4)=5 Then 	
		        		Beep(2)
		        		aParameters(p,4)=0
		        	Else
		        		aParameters(p,4)=0
		        	 End If
		        	Reply=Reply & aParameters(p,0) & ": :-D " & " | "
		        End If

	       		
	       Else
		        If IsNull(objStatus.StatusCode) Or objStatus.StatusCode<>0 Then 
		            Reply=Reply & aParameters(p,0) & " : " & PingError(objStatus.StatusCode) & " | "
		            aParameters(p,1)=aParameters(p,1)+1
		           If aParameters(p,4)<5 Then aParameters(p,4)=aParameters(p,4)+1
		        Else
		        	aParameters(p,2)=aParameters(p,2)+1
		        	aParameters(p,3)=aParameters(p,3)+1
		        	If aParameters(p,4)=5 Then 	
		        		Beep(3)
		        		aParameters(p,4)=0
		        	Else
		        		aParameters(p,4)=0
		        	 End If
					 Reply=Reply & "Rpl frm "& aParameters(p,0) & ": By:" & ObjStatus.BufferSize & " tm:" &  ObjStatus.ResponseTime & " lst:" & aParameters (p,1) & " rcv:x" & Hex(aParameters(p,3)) & " | "
		        End If
		   End if
		   Next
	Next
	WScript.Echo "snt:x"& Hex(n) & " " & Reply
Next 


Function PingError(byval CodeNumber)
	Select Case CodeNumber	
		Case 0 PingError="Success"
		case 11001 PingError="Buffer Too Small"
		case 11002 PingError="Destination Net Unreachable"
		case 11003 PingError="Destination Host Unreachable" 
		case 11004 PingError="Destination Protocol Unreachable"
		case 11005 PingError="Destination Port Unreachable"
		case 11006 PingError="No Resources"
		case 11007 PingError="Bad Option" 
		case 11008 PingError="Hardware Error"
		case 11009 PingError="Packet Too Big"
		case 11010 PingError="Request Timed Out"
		case 11011 PingError="Bad Request"
		case 11012 PingError="Bad Route"
		case 11013 PingError="TimeToLive Expired Transit"
		case 11014 PingError="TimeToLive Expired Reassembly"
		case 11015 PingError="Parameter Problem"
		case 11016 PingError="Source Quench"
		case 11017 PingError="Option Too Big" 
		case 11018 PingError="Bad Destination" 
		case 11032 PingError="Negotiating IPSEC"
		case 11050 PingError="General Failure"
		Case Else PingError="Bad Address"
	End Select
End Function

Sub Beep(nTime)
	Dim objShell
	Set objShell = CreateObject("Wscript.Shell")
	
	For k=1 To nTime
		WScript.Sleep (1000)
		
	Next
	Set objShell = Nothing
End sub