VBS - Ping Servers

Option Explicit

Dim objExplorer         ' Object used for displaying a 'Please wait...' box
Dim strOutputSuccess    ' The results to output to the user for sussessful pings
Dim strOutputFailure    ' The results to output to the user for any ping failures

' Display the progress box
Set objExplorer = CreateObject("InternetExplorer.Application")

display_progress(objExplorer)
main()
close_progress(objExplorer)
output_results()

WScript.Quit

'**
 ' Runs the main bulk of the script
 '*
Sub main()

    Dim objProgressDialog   ' Object to hold a progress dialog
    Dim objWSShell          ' Object to hold a Windows Script Shell
    Dim objWSExec           ' Object to hold the results of an Exec call
    Dim strTarget(3,1)      ' The IP addresses to ping
    Dim strPingResultsFull  ' The full results of the ping
    Dim strPingResultsPart  ' The line of the results to output to the user
    Dim strSingleLine       ' A single line of the output (used while looping to grab only the required lines)
    Dim i                   ' Dummy for looping

    ' Set error handling
    On Error Resume Next

    ' Set the targets to ping
    strTarget(0,0) = "192.168.1.6"
    strTarget(1,0) = "192.168.1.7"
    strTarget(2,0) = "192.168.1.14"
    strTarget(3,0) = "192.168.1.12"

    strTarget(0,1) = "TTSA"
    strTarget(1,1) = "TTSB"
    strTarget(2,1) = "TTSC"
    strTarget(3,1) = "TTSD"

    Set objWSShell = WScript.CreateObject("WScript.Shell")

    ' Loop through all of the targets to ping
    For i = 0 To UBound(strTarget)

        force_cScript()

        ' Ping the target
        Set objWSExec = objWSShell.Exec("ping -n 2 -w 500 " & strTarget(i, 0)) ' Send 2 echo requests, waiting 0.5 seconds maximum

        ' Set 'strPingResultsFull' and 'strPingResultsPart' to an empty string
        strPingResultsFull = ""
        strPingResultsPart = ""

        ' Grab the results of the ping
        Do Until objWSExec.StdOut.AtEndOfStream

            ' Grab the single line that is being looped
            strSingleLine = objWSExec.StdOut.ReadLine

            ' Add the single line to the whole output, gradually creating 'strPingResultsFull'
            strPingResultsFull = strPingResultsFull & strSingleLine

            'Check for the lines that should be output to the user and add them to 'strPingResultsPart'
            If Instr(strSingleLine, "Ping statistics for") <> 0 Then
                strPingResultsPart = strSingleLine
                strPingResultsPart = Replace(strPingResultsPart, ":", " [" & strTarget(i, 1) & "]:", 1, 1)
            End If
            If Instr(strSingleLine, "Packets:") <> 0 Then
                strPingResultsPart = strPingResultsPart & vbCrLf & "    " & strSingleLine
            End If

        Loop

        ' Check that there is something to output (there should be, even if the pings all fail)
        If strPingResultsPart <> "" Then

            ' Add the ping results to the correct results strings
            If InStr(strPingResultsFull, "Reply from") Then
                strOutputSuccess = strOutputSuccess & strPingResultsPart & vbCrLf
            Else
                strOutputFailure = strOutputFailure & strPingResultsPart & vbCrLf
            End If

        End If

        Set objWSExec = Nothing

    Next

    Set objWSShell = Nothing

End Sub

'**
 ' Output the results to the screen
 '*
Private Function output_results()

    Dim strResults  ' The results to output to the user

    If Len(strOutputSuccess) > 0 Then
        strResults = "Successful results" & vbCrLf & "------------------" & vbCrLf & vbCrLf & strOutputSuccess
    End If

    If Len(strOutputFailure) > 0 Then
        If Len(strOutputSuccess) > 0 Then strResults = strResults & vbCrLf
        strResults = "No reply from" & vbCrLf & "-------------" & vbCrLf & vbCrLf & strOutputFailure
    End If

    If Len(strResults) > 0 Then
        Msgbox strResults, vbOkOnly, "Ping Results"
    Else
        Msgbox "No results were found, indicating an error in the script. Please contact the author for support.", vbExclamation, "No Results Found"
    End If

End Function

'**
 ' Force an application to run in a Command Script window, so that no additional windows are opened
 '*
Private Function force_cScript()

     If InStr(UCase(WScript.FullName), "CSCRIPT.EXE") = 0 Then
         Dim objShell : Set objShell = CreateObject("WScript.Shell")
         objShell.Run "%comspec% /c cscript.exe " & Chr(34) & WScript.ScriptFullName & Chr(34), 0, False
         WScript.Quit()
     End If

End Function

'**
 ' Displays the progress box (in an Internet Explorer window)
 '
 ' @param required object 'objExplorer' The object that is to be the IE progress window
 '*
Private Function display_progress(objExplorer)

    objExplorer.Navigate "about:blank"
    objExplorer.ToolBar = 0
    objExplorer.StatusBar = 0
    objExplorer.Left = 600
    objExplorer.Top = 374
    objExplorer.Width = 400
    objExplorer.Height = 152
    objExplorer.Visible = 1

    Dim strStyle, strText, strButton

    strStyle = _
    "<style>" & vbCrLf & _
        "html, body{" & vbCrLf & _
            "height: 116px;" & vbCrLf & _
            "margin: 0;" & vbCrLf & _
            "overflow: hidden;" & vbCrLf & _
            "padding: 0;" & vbCrLf & _
        "}" & vbCrLf & _
        "#text{" & vbCrLf & _
            "height: 50px;" & vbCrLf & _
            "margin: 10px;" & vbCrLf & _
        "}" & vbCrLf & _
        "#buttons{" & vbCrLf & _
            "background-color: #F0F0F0;" & vbCrLf & _
            "height: 23px;" & vbCrLf & _
            "padding: 10px;" & vbCrLf & _
        "}" & vbCrLf & _
        "input[type=""button""]{" & vbCrLf & _
            "float: right;" & vbCrLf & _
        "}" & vbCrLf & _
        ".clear{" & vbCrLf & _
            "clear: both;" & vbCrLf & _
        "}" & vbCrLf & _
    "</style>"
    strText = "<div id=""text""><p>Please wait, servers are being pinged.</p><p>Results will be displayed as soon as they are ready.</p></div>"
    strButton = "<div id=""buttons""><input type=""button"" name=""submit"" value=""Cancel"" onclick=""window.open('', '_self', ''); window.close();"" /><div class=""clear""></div></div>"

    objExplorer.Document.Body.Style.Font = "11pt 'Halvetica'"
    objExplorer.Document.Body.Style.Cursor = "wait"
    objExplorer.Document.Title = "Server ping script"
    objExplorer.Document.Body.InnerHTML = strStyle & strText & strButton

End Function

'**
 ' Closes the progress box (in an Internet Explorer window)
 '
 ' @param required object 'objExplorer' The object that the IE progress window
 '*
Private Function close_progress(objExplorer)

    objExplorer.Document.Body.Style.Cursor = "default"
    objExplorer.Quit

End Function