'RemotePing.vbs
'Alan Kaplan alan dot kaplan at va dot gov 12/5/2005

'Does an ping from a remote XP/2003 system to another address
'GUI or command line syntax: 
'Host/target can be name or IP
' 	RemotePing /H:remotehost /T:Target  [/N:number of pings]
' 	Ex: RemotePing /h:MyDC /t:192.168.1.1 /n:4
'	Ex: remoteping /h:XPWS /t:AnyPC

Option Explicit
On Error Resume Next
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Dim WshShell, i
Set WshShell = WScript.CreateObject("WScript.Shell")
Dim arrReturns()
Dim strquery, colItems, objItem, strIP
Dim message, strHost, strTarget, iPingCount
Dim oWMI, iLossPct, strResolved
Dim newArray, iMax, iMin, iAv, iSleep, iNoReply, bGUI, iKeepOpen
bGUI = False
iNoReply = 0

'You can edit this...
iKeepOpen = 30		'Delay in seconds before closing window opend by GUI
iSleep = 1		 'delay in seconds between pings. Decimal value (ex: .5) is okay
'End optional edits

If (Not IsCScript()) Then 'If not CScript, re-run with cscript, preserving args
	Dim quote, strArgs
	quote=chr(34)
	
	For i  = WScript.Arguments.Count -1 to  0 Step -1
		strArgs = WScript.Arguments(i) & Space(1) &  strArgs
	Next
	
	'Added cmd /k to keep window open when done
	WshShell.Run "cmd /k CScript.exe " & quote & WScript.ScriptFullName & quote & space(1) & strArgs, 1, True
    WScript.Quit            	'...and stop running as WScript
End If


'Convert time between ping to sleep units
iSleep = iSleep * 1000

GetArgs

'add a line for readablity
WScript.Echo VbCrLf 
'Set array to number of pings
ReDim arrReturns(iPingCount-1)

'Connect to remote system WMI
Set oWMI = GetObject("winmgmts:\\" & strHost & "\root\CIMV2")
If Err <> 0 Then 
	MsgBox "WMI error from " & strHost & ". This could be a security issue.", _
	vbCritical + vbOKOnly,"Error" 	
	WScript.Quit 
End If 

'Check OS of remote host before starting...
If GoodVersion Then 
	wscript.Echo "Pinging " & strTarget &" from " &_
	strHost & " with 32 bytes of data:" & VbCrLf 
	
	For i = 0 To iPingCount -1
		Ping(strTarget)
		WScript.Sleep iSleep
	Next

	'Sort, then get max and min return time
	newArray = Sort(arrReturns)
	iMax = newArray(ubound(newarray))
	iMin = newArray(lbound(newarray))
	
	'Get Average Return times
	For i = 0 To UBound(newArray)
		iAv = iAv + newArray(i) 
	Next
	
	iAv = cint(iAv / (UBound(newArray)+1))

	'avoid division by zero
	If iNoReply > 0 Then 
		iLossPct = formatpercent((iNoReply/iPingCount),0)
	Else 
		iLossPct = "0%"
	End If  
	
	If strIP = "" Then strIP = strTarget
	
	'results
	 message = VbCrLf & "Ping statistics for " & strIP
	 
	 If Len(strResolved) > 0 Then 
	 	message = message &  " [" & strResolved & "]: " 
	 End If 
	 
	 message = message & VbCrLf & "	Packets: Sent = "& iPingCount & _
	 ", Received = " & iPingCount - iNoReply & _
    ", Lost = " & iNoReply & " (" & iLossPct &  " loss)"
 
   If iNoReply = 0 then
		message = message & "," & VbCrLf & _
		"Approximate round trip times in milli-seconds: " & VbCrLf & _
	    "	Minimum = "& iMin &"ms, Maximum = "& iMax &"ms, Average = " & iAv & "ms"
    End If 
    
    WScript.Echo message
Else 
	msgbox strHost & " does not support remote ping.",vbCritical + vbOKOnly,"Error"
End If

If bGUI Then 
	WScript.Echo VbCrLf & "Keeping window open for " & iKeepOpen & " seconds. " & _
	"You may close it when ready." & VbCrLf & "(This line does not appear if you use command line.)"
	WScript.Sleep iKeepOpen * 1000
End If 
' ========== Subs and Function ==============
Function GoodVersion()
	Dim strVersion
	'Quick check for OS ver > 5.0 
	Set colItems = oWMI.ExecQuery("SELECT version FROM Win32_OperatingSystem", "WQL", _
       wbemFlagReturnImmediately + wbemFlagForwardOnly)
 
    For Each objItem In colItems
       	strVersion = objItem.version
    Next
	
	If Left(strVersion,3) > 5 Then 
		GoodVersion = True
	Else
		GoodVersion = False
	End If 
End Function 


Function Ping(strTarget)
	'Note syntax in query to get address and resolved name
	strquery = "SELECT * FROM Win32_PingStatus where " & _ 
	" ResolveAddressNames = 'True' and address = '" & strTarget & "'"
	
	Set colItems = oWMI.ExecQuery(strQuery, "WQL", _
	    wbemFlagReturnImmediately + wbemFlagForwardOnly)
	
	For Each objItem In colItems
		If objitem.PrimaryAddressResolutionStatus <> 0 Then
			MsgBox "Host not found or name failed to resolve.", _
				vbCritical + vbOKOnly,strTarget
			WScript.Quit
		End If
	
		strIP = objitem.ProtocolAddress
		strResolved = ucase(objitem.protocoladdressresolved)
		If strIP <> "" Then 
			'Add response time to array with returns
		    arrReturns(i) = objItem.ResponseTime
		    If objItem.ResponseTime > 0 Then 
				WScript.Echo "Reply from " & strIP & _
				 ": bytes="& objItem.ReplySize & " time=" & objItem.ResponseTime &_
				  "ms TTL=" & objItem.ResponseTimeToLive
			Else
				 WScript.Echo "Reply from " & strIP & _
				 ": bytes="& objItem.ReplySize & " time=<1ms TTL=" & objItem.ResponseTimeToLive
			End If 
		Else
			'put zero into return time
		    arrReturns(i) = 0
		    iNoReply = iNoReply + 1
			WScript.Echo "Request timed out."
		End If 	   
	Next

End Function 

Sub GetArgs()
	'handle optional argument, wrong count, etc.
	Dim argCount
	argCount = WScript.Arguments.Count 
	
	Select Case argCount
		Case 2
			strHost = WScript.Arguments.Named.Item("H")
			strTarget = WScript.Arguments.Named.Item("T")
			iPingCount = 4
		Case 3
			strHost = WScript.Arguments.Named.Item("H")
			strTarget = WScript.Arguments.Named.Item("T")
			iPingCount = WScript.Arguments.Named.Item("N")
		Case 0
			bGUI = True
			message = "Enter the name or IP of the remote computer that will initiate the ping." & _
				VbCrLf & VbCrLf &  "(Remote system must be Windows 2003 or Windows XP, " & _
				" and you must have admin rights for WMI query.):"
			
			strHost = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
			strHost = InputBox(message,"Ping From",strHost)
			If strHost = "" Then WScript.Quit
			
			strTarget = InputBox("Enter the computer name or IP address to ping:","Ping To")
			If strTarget = "" Then WScript.Quit
				
			iPingCount = InputBox("Ping count","Count",4)
			If iPingCount = "" Then WScript.Quit
		Case Else
			message = "RemotePing does a ping from a remote XP/2003 system to another address." & _
			" You must be an administrator with rights for WMI query on the remote host PC.  " & _
			" It has a GUI and command line support: " & VbCrLf  & VbCrLf & _ 
			"The host and target can be name or IP. Default ping count is 4. Syntax: " & VbCrLf & VbCrLf & _
			"RemotePing /H:remotehost /T:Target  [/N:number of pings]" & VbCrLf & _
			"Ex: RemotePing /h:MyDC /t:192.168.1.1 /n:4" & VbCrLf & _
			"Ex: remoteping /h:XPWS /t:AnyPC"
			MsgBox message,vbInformation + vbOKOnly,"RemotePing Syntax"
			WScript.Quit
		End Select
		
		strHost = UCase(strHost)
		strTarget = UCase(strTarget)
End Sub 


Function Sort(arrSort) 'yet another bubble sort.  Not mine
	Dim j, temp
	for i = UBound(arrSort) - 1 To 0 Step -1
	    for j= 0 to i
	        if arrSort(j)>arrSort(j+1) Then
	            temp=arrSort(j+1)
	            arrSort(j+1)=arrSort(j)
	            arrSort(j)=temp
	        end if
	    Next
	Next 
	Sort = arrSort
End Function 

Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function