'Alan dot Kaplan at va dot gov 
'Pings text list of computer names, requires Excel
'2/12/2010

dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")

If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	dim quote, strArgs, i
	quote=chr(34)
	
	For i  = WScript.Arguments.Count -1 to  0 Step -1
		strArgs = WScript.Arguments(i) & Space(1) &  strArgs
	Next
	
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote & space(1) & strArgs, 1, true
    WScript.Quit            	'...and stop running as WScript
End If


Dim oXL 
Set WshShell = WScript.CreateObject("WScript.Shell")
Dim retval, strIP, message
Dim strFilePath
message = "This script pings a text list of computers, one per line.  It requires Excel."

retval = msgbox (message,vbokcancel+vbQuestion,"Ping List")
If retval = vbcancel Then WScript.Quit

strFilePath = ExcelOpenDialog("Choose a text file with PC Names", "Text Files (*.txt),*.txt",strFilePath ) 

oXL.Workbooks.Add
oXL.ActiveSheet.name = "Ping Replies"

intRow = 2

oXL.Columns(1).ColumnWidth = 25
oXL.Columns(2).ColumnWidth = 15
oXL.Columns(3).ColumnWidth = 15

oXL.Cells(1, 1).Value = "Machine Name"
oXL.Cells(1, 2).Value = "Results"
oXL.Cells(1, 3).Value = "IP"
oXL.Visible = True

Set fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile(strFilePath)

Do While Not (InputFile.atEndOfStream)
	strIP="Not Found"
	strComputer = InputFile.ReadLine
	retval = PingReply(strComputer)
	oXL.Cells(intRow, 1).Activate
	oXL.Cells(intRow, 1).Value = strComputer	
	oXL.Cells(intRow, 2).Value = retval 
	oXL.Cells(intRow, 3).Value = strIP 
	intRow = intRow + 1
Loop

oXL.Range("A1:C1").Select
oXL.Selection.Interior.ColorIndex = 19
oXL.Selection.Font.ColorIndex = 11
oXL.Selection.Font.Bold = True
oXL.Cells.EntireColumn.AutoFit

WshShell.popup "Ping complete!",3,"Done"
 
Function PingReply(strcomputer) 
	Dim objScriptExec, strPingResults
	Dim objRE, match, matches, strOut 

	'RegEx pattern from Bill Stewart
	Set objRE = New RegExp
    objRE.Pattern = " [0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}"
	
	'Three lines from Steve Cathersalc 
	Set objScriptExec=wshShell.Exec("ping -n 2 -w 1000 " & strComputer)
	strOut = lcase(objScriptExec.StdOut.Readall)

	If InStr(strOut,"could not find host") Then 
		PingReply = "No Host Record"
		Exit Function
	End If  
	
	If InStr(strOut,"unreachable") Then 
		PingReply = "Unreachable"
	End If  
	
	If  InStr(strOut,"bytes=") = 0 Then 
		PingReply = "Offline"
	Else
		PingReply = "Online"
	End If  
	
	Set matches = objRE.Execute(strOut)   ' Execute search.

	If Matches.count = 1 Then 
	   For Each Match in Matches   ' Iterate Matches collection.
	     strIP = trim(Match.Value) 'Cleanup
	   Next
	Else
		strIP = ""
	End If 
End Function

Function ExcelOpenDialog( sPrompt, sFilter, strDefaultFile ) 
	'Based on code by Michael Hardt 
   	'http://www.softimage.com/community/xsi/discuss/archives/xsi.archive.0111/msg00066.htm

	On Error Resume Next 
	Set oXL = CreateObject("Excel.Application") 
	If Err =  0 Then 
	Dim sFile 
   	sFile = oXL.GetOpenFilename ( sFilter, , sPrompt) 	   	
	'Cancel or no file name? 
	   	If sFile <> False Then 
	      	ExcelOpenDialog = sFile 
	   	Else 
	     	 Wscript.quit
	   	End If 
	 Else
	 	Err.Clear
		MsgBox "Script requires Excel, quitting",vbCritical + vbOKOnly,"No Action"
		WScript.Quit
	 End If 
	'On Error GoTo 0
End Function 


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