Function TestCompIsOn(ByRef sHost As String) As Boolean

'~~[author]~~       Michael Holzemer   ms2kguru@pacbell.net
'~~[scriptType]~~   vbscript
'~~[subType]~~      DomainAdministration
'// Michael Holzemer  2 / 12 / 2003 
'// Needed to keep a constant eye on several servers.
'// This script will ping servers (and email whomever is chosen - исключено).
'// I used ideas and code from Richard Mayston's  "Determine if a host is reachable"  script and
'// ideas and constants from Nathan Strimling to make the code I got from MS to work

'Модифицировал Processor  15 . 08 . 2003 
'Модификации касаются обработки файла ответов команды ping.

TestCompIsOn = False
Dim oWsh As New WshShell, oFSO As Scripting.FileSystemObject
Dim sTempFldr As Scripting.Folder
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set sTempFldr = oFSO.GetSpecialFolder(TemporaryFolder)
Dim sTmpFN As String, sTempFile As String
sTmpFN = oFSO.GetTempName
    If Len(sTempFldr) > 3 Then
        sTempFile = sTempFldr & "\" & sTmpFN
    Else
        sTempFile = sTempFldr & sTmpFN
    End If
'// I am going to try to get the servername by using the -a switch
oWsh.Run  "%comspec% /c ping.exe -a -n 5  -w  100  " & sHost &  ">"  & sTempFile,  0 , True

Set oWsh = Nothing
'// Open the file for reading
Dim nStr As Long        'к-во строк с IP-адресом
Dim IPisFound As Boolean, IPAddress As String, p As Long, q As Long
IPisFound = False
Dim oTFile As Scripting.TextStream
Set oTFile = oFSO.OpenTextFile(sTempFile,  1 , False)
    Do While oTFile.AtEndOfStream <> True
        '// Grab a line from the file.
        Dim sLine As String, aping As Variant
        sLine = oTFile.ReadLine
        '// See if there is a reply in the ping file
        If Not IPisFound Then   'имя хоста есть, адрес пока неизвестен
           If InStr(1, sLine, sHost, vbTextCompare) > 0 Then
                'в первой непустой строке д.б. имя хоста.
                'Если хост зарегистрирован, за ним д.б. его адрес,
                'иначе ответ такой:
                'sHost: неизвестный адрес
               p = InStr(1, sLine, "[")
               q = InStr(1, sLine, "]")
               If p > 0 Then
                    IPAddress = Mid(sLine, p + 1, q - p - 1)
                    IPisFound = True
               End If
           End If
        Else
            If InStr(1, sLine, IPAddress, vbTextCompare) Then nStr = nStr + 1
        End If
    Loop
oTFile.Close
DoEvents
oFSO.DeleteFile (sTempFile)
DoEvents
Set sTempFldr = Nothing
Set oTFile = Nothing
Select Case nStr        'сколько раз найден IP-адрес в файле ответа:
    Case  0 
            txtComment =  "Не зарегистрирован" 
'        MsgBox sHost & " не зарегистрирован в сети.", vbExclamation + vbOKOnly, "ping " & sHost
    Case 1
            txtComment = "Выключен"
'        MsgBox sHost &  " выключен." , vbExclamation + vbOKOnly,  "ping "  & sHost
    Case  2  To  5 
            txtComment =  "Плохая связь" 
'        MsgBox sHost &  ": потеря "  &  6  - nStr &  " пакетов из 5 .", vbExclamation + vbOKOnly,  "ping "  & sHost
    Case Else
    TestCompIsOn = True
End Select
End Function