ping

RE: ping (kytto)

Tue, 27 Feb 2007 18:53:18 GMT

dm

thanks m8

RE: ping (dm_4ever)

Tue, 27 Feb 2007 17:33:00 GMT

This version should work on Win2k and WinXP

 Option Explicit
 'On Error Resume Next
 
 Dim objFSO, objFile1, objFile2, strInputFile, strOutputFile, strHost
 
 Const ForReading = 1  :  Const ForWriting = 2  :  Const ForAppending = 8
 
 strInputFile = "list.txt"
 strOutputFile = "output.txt"
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objFile1 = objFSO.OpenTextFile(strInputFile, ForReading)
 Set objFile2 = objFSO.OpenTextFile(strOutputFile, ForAppending, True)
 
 Do Until objFile1.AtEndOfStream
     strHost = objFile1.ReadLine
     If Reachable(strHost) Then
         objFile2.WriteLine strHost & vbTab & "Online"
     Else 
         objFile2.WriteLine strHost & vbTab & "Offline"
     End If
 Loop
 
 objFile1.Close
 objFile2.Close
 
 Function Reachable(strComputer)
 '     On Error Resume Next
 
     Dim objShell, objExec, strCmd, strTemp
     
     strCmd = "ping -n 1 " & strComputer
     
     Set objShell = CreateObject("WScript.Shell")
     Set objExec = objShell.Exec(strCmd)
     strTemp = UCase(objExec.StdOut.ReadAll)
     
     If InStr(strTemp, "REPLY FROM") Then
         Reachable = True 
     Else
         Reachable = False
     End If
 End Function

RE: ping (dm_4ever)

Tue, 27 Feb 2007 14:46:51 GMT

You can try something like this. Just remember that this requires the machine running it to be WinXP or Win2k3

 Option Explicit
 'On Error Resume Next
  
 Dim objFSO, objFile1, objFile2, strInputFile, strOutputFile, strHost
  
 Const ForReading = 1  :  Const ForWriting = 2  :  Const ForAppending = 8
  
 strInputFile = "list.txt"
 strOutputFile = "output.txt"
  
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objFile1 = objFSO.OpenTextFile(strInputFile, ForReading)
 Set objFile2 = objFSO.OpenTextFile(strOutputFile, ForAppending, True)
  
 Do Until objFile1.AtEndOfStream
  strHost = objFile1.ReadLine
  If Reachable(strHost) Then
   objFile2.WriteLine strHost & vbTab & "Online"
  Else 
   objFile2.WriteLine strHost & vbTab & "Offline"
  End If
 Loop
  
 Function Reachable(strComputer)
 '  On Error Resume Next
  
  Dim wmiQuery, objWMIService, objPing, objStatus
  
  wmiQuery = "Select * From Win32_PingStatus Where Address = '" & strComputer & "'"
  
  Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
  Set objPing = objWMIService.ExecQuery(wmiQuery)
  
  For Each objStatus in objPing
   If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
    Reachable = False 'if computer is unreacable, return false
   Else
    Reachable = True 'if computer is reachable, return true
   End If
  Next
 End Function

RE: ping (kytto)

Tue, 27 Feb 2007 14:34:06 GMT

he always returns the value "On Line", even if the computer doesn't exists ;(

regarding your code, how can I put it with an input file and an output log??

RE: ping (Country73)

Tue, 27 Feb 2007 11:27:44 GMT

Personally, I like to use:

FUNCTION PingMe(strComputer)
    Set cPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" + strComputer + "'")
        For Each oPingResult In cPingResults
            If oPingResult.StatusCode = 0 Then
                Call OnlineEvent(strComputer)
            Else
                Call OfflineEvent(strComputer)
            End If
        Next
END FUNCTION

I try to use this function in all of my scripts, but here's an older one that I've used: (I know I have a few older ones, but this is one that I found pretty quickly)

-----------------------------------------------------------------------
FUNCTION ping(strComputer)
    SET oExec = oShell.Exec("nbtstat -a " & strComputer)

    strOutput = ""
    DO UNTIL oExec.StdOut.AtEndOfStream
        strOutput = strOutput & oExec.StdOut.Read(1)
    LOOP

    IF INSTR(strOutput,"Host not found") > 0 THEN
        call output(strComputer,"OFFLINE")
    ELSE
        CALL NextStep(strComputer)
    END IF
END FUNCTION
-----------------------------------------------------------------------

RE: ping (kytto)

Tue, 27 Feb 2007 10:45:16 GMT

btw, do you think thats the best ping command to use??

RE: ping (kytto)

Tue, 27 Feb 2007 10:26:22 GMT

thanks Country73

RE: ping (Country73)

Tue, 27 Feb 2007 10:18:36 GMT

GREEN is what can be deleted, while ORANGE is what I added.
**Did not test out, just threw together.

-------------------------------------------------------------------------------------------------------------
x=ReportFileStatus("List.txt")

Function ReportFileStatus(filespec)
   Dim fso, msg, MyVar
   'Dim MyVar
   Set fso = CreateObject("Scripting.FileSystemObject")
   IF NOT fso.FileExists(filespec) THEN
   'If (fso.FileExists(filespec)) Then
    'Else
       MyVar = MsgBox ("""List.txt"" not found!" &_
       Chr (13) & "Make sure the list of computers is in the current directory" &_
       Chr (13) & "" &_
       Chr (13) & "       Have a Nice Day :)", 016, "Ping Script") &_
       WScript.Quit
   End If
End Function

'Set objExcel = CreateObject("Excel.Application")
'   objExcel.Visible = True
'   objExcel.Workbooks.Add
'   intRow = 2
'   objExcel.Cells(1, 1).Value = "Computer Name"
'   objExcel.Cells(1, 2).Value = "Result"

Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("List.Txt")

Set MyInfo = fso.OpenTextFile("File_to_store_information.txt",8,TRUE)

DO UNTIL InputFile.AtEndOfStream
'Do While Not (InputFile.atEndOfStream)
   HostName = InputFile.ReadLine
   Set WshShell = WScript.CreateObject("WScript.Shell")
   Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
   'objExcel.Cells(intRow, 1).Value = HostName
   Select Case Ping
       'Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
       Case 0
           myMsg = HostName & VBTAB & "On Line"
       'Case 1 objExcel.Cells(intRow, 2).Value = "Off Line"
       Case 1
           myMsg = HostName & VBTAB & "Off Line"
   End Select
   'intRow = intRow + 1
   MyInfo.WriteLine myMsg
Loop
' objExcel.Range("A1:B1").Select
' objExcel.Selection.Interior.ColorIndex = 19
' objExcel.Selection.Font.ColorIndex = 11
' objExcel.Selection.Font.Bold = True
' objExcel.Cells.EntireColumn.AutoFit
   MyInfo.Close
SET MyInfo = NOTHING
wscript.echo "Ping Process as Terminated"
WScript.Quit
-------------------------------------------------------------------------------------------------------------

ping (kytto)

Tue, 27 Feb 2007 09:54:41 GMT

-------------------------------------------------------------------------------------------------------------
x=ReportFileStatus("List.txt")
Function ReportFileStatus(filespec)
Dim fso, msg
Dim MyVar
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(filespec)) Then
  Else
   MyVar = MsgBox ("""List.txt"" not found!" &_
   Chr (13) & "Make sure the list of computers is in the current directory" &_
   Chr (13) & "" &_
   Chr (13) & "       Have a Nice Day :)", 016, "Ping Script") &_
   WScript.Quit
End If

End Function

Set objExcel = CreateObject("Excel.Application")
  objExcel.Visible = True
  objExcel.Workbooks.Add
  intRow = 2
  objExcel.Cells(1, 1).Value = "Computer Name"
  objExcel.Cells(1, 2).Value = "Result"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("List.Txt")
Do While Not (InputFile.atEndOfStream)
  HostName = InputFile.ReadLine
Set WshShell = WScript.CreateObject("WScript.Shell")
  Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
  objExcel.Cells(intRow, 1).Value = HostName
Select Case Ping
  Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
  Case 1 objExcel.Cells(intRow, 2).Value = "Off Line"
End Select
  intRow = intRow + 1
Loop
  objExcel.Range("A1:B1").Select
  objExcel.Selection.Interior.ColorIndex = 19
  objExcel.Selection.Font.ColorIndex = 11
  objExcel.Selection.Font.Bold = True
  objExcel.Cells.EntireColumn.AutoFit
wscript.echo "Ping Process as Terminated"
WScript.Quit
-------------------------------------------------------------------------------------------------------------

instead of excel, how can I have this result saved on txt (notepad)