Код:
Option Explicit
Dim strHost
Dim lngCheckInterval
Dim objSWbemLocator
Dim objSWbemServicesEx
Dim collSWbemObjectSet
Dim objSWbemObjectEx
Dim objDictionary
'strHost = "google.com"
strHost = "192.0.0.22"
lngCheckInterval = 1000
Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
With objDictionary
.Add 0, "Success"
.Add 11001, "Buffer Too Small"
.Add 11002, "Destination Net Unreachable"
.Add 11003, "Destination Host Unreachable"
.Add 11004, "Destination Protocol Unreachable"
.Add 11005, "Destination Port Unreachable"
.Add 11006, "No Resources"
.Add 11007, "Bad Option"
.Add 11008, "Hardware Error"
.Add 11009, "Packet Too Big"
.Add 11010, "Request Timed Out"
.Add 11011, "Bad Request"
.Add 11012, "Bad Route"
.Add 11013, "TimeToLive Expired Transit"
.Add 11014, "TimeToLive Expired Reassembly"
.Add 11015, "Parameter Problem"
.Add 11016, "Source Quench"
.Add 11017, "Option Too Big"
.Add 11018, "Bad Destination"
.Add 11032, "Negotiating IPSEC"
.Add 11050, "General Failure"
End With
Set objSWbemLocator = WScript.CreateObject("WbemScripting.SWbemLocator")
Set objSWbemServicesEx = objSWbemLocator.ConnectServer(".", "root\cimv2")
Do
Set collSWbemObjectSet = objSWbemServicesEx.ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" & strHost & "'")
For Each objSWbemObjectEx In collSWbemObjectSet
With objSWbemObjectEx
If Not IsNull(.StatusCode) Then
WScript.Echo Now(), .Address, .StatusCode, "[" & objDictionary.Item(.StatusCode) & "]", .ResponseTime
Else
WScript.Echo Now(), "Error!"
End If
End With
Exit For
Next
Set collSWbemObjectSet = Nothing
WScript.Sleep lngCheckInterval
Loop
Set objSWbemServicesEx = Nothing
Set objSWbemLocator = Nothing
Set objDictionary = Nothing
WScript.Quit 0
