' Listing 10: The getPingIP Function

Private Function getPingIP(ByVal strComputer, ByRef strPingStatus)
  Dim objList, objRegEX, objShell, objExecObject, strText, objItem, i
  Dim objIp, colItems
  Set objList = CreateObject("Scripting.Dictionary")
  Set objRegEX = New RegExp
  objRegEx.Pattern = "\[((\d+\.){3}\d+)\]"
  Set objShell = CreateObject("WScript.Shell")

  Set objExecObject = objShell.Exec _
    ("%comspec% /c ping -n 3 -w 1000 " & strComputer)

  Do Until objExecObject.StdOut.AtEndOfStream
    strText = objExecObject.StdOut.ReadLine
    If Len(strText) > 2 Then
      objList.Add objList.Count, strText
      If objList.Count = 2 Then Exit Do
      End If
  Loop

  For Each objItem In objList.Items
    i = i + 1
    If InStr(objItem,"could not find host") > 0 Then
      strPingStatus = "Unknown host"
      getPingIP = "No IP Address"
      Exit Function
    ElseIf InStr(1,objItem,strComputer,1) > 0 Then
      If i = 1 Then
        Set colItems = objRegEX.Execute(objItem)
        For Each objIp In colItems
          getPingIP = objIp.SubMatches(0)
        Next
      End If
    ElseIf InStr(objItem,"Reply from") > 0 Then
      strPingStatus = "On line"
      Exit Function
    ElseIf InStr(objItem,"Request timed") > 0 Then
      strPingStatus = "Off line"
      Exit Function
    End If
  Next
  Set objShell = Nothing: Set objExecObject = Nothing
  Set objRegEx = Nothing
End Function