'----------------------------------------------------------------------
'
' Copyright (c)  All rights reserved.

'
' AUTHOR: tudimon.com
' DATE: 24.08.2011
' NAME: ping2log.vbs
'
' COMMENT:
'
' Проверка доступности соединения методом ping-а и запись результатов
' проверки в лог-файл
'
' Завершить выполнение скрипта можно прибив в Диспетчере задач процесс
' wscript.exe
'
'----------------------------------------------------------------------

compip = "77.88.21.13"      ' ip адрес сервера, который будем пинговать
LogFilePath = "c:\log.log"    ' лог-файл
timeout = "30"                 ' таймаут проверки в секундах

On Error Resume Next


do

    Set objShell = CreateObject("WScript.Shell")

    ' Пингом проверим что сервер доступен
        Set objScriptExec = objShell.Exec("%comspec% /c ping.exe -n 2 " & compip)
        strPingResults = LCase(objScriptExec.StdOut.ReadAll)
    
        If InStr(strPingResults, "ttl=") Then
            ' доступен

            ' пишем лог
            Set FSO = CreateObject("Scripting.FileSystemObject")
            Set LogFile = FSO.OpenTextFile(LogFilePath, 8, True)
            LogFile.WriteLine Now & " " & compip & " доступен"
            LogFile.Close

            'MsgBox compip & " пингуется :) "
        Else
            ' не доступен
        
            ' пишем лог
            Set FSO = CreateObject("Scripting.FileSystemObject")
            Set LogFile = FSO.OpenTextFile(LogFilePath, 8, True)
            LogFile.WriteLine Now & " " & compip & " не доступен"
            LogFile.Close
        
            'MsgBox compip & " не пингуется. Попробуйте позвонить позднее :) "
        End If
    
' заснем на указанное кол-во секунд
wscript.sleep timeout*1000

loop

'----------------------------------------------------------------------
'
' Copyright (c)  All rights reserved.
'
'
' AUTHOR: tudimon.com
' DATE: 04.10.2011
' NAME: ping2log_v2.vbs
'
' COMMENT:
'
' Проверка доступности соединения методом ping-а и запись результатов
' проверки в лог-файл
'
' Завершить выполнение скрипта можно прибив в Диспетчере задач процесс
' wscript.exe
'
'----------------------------------------------------------------------

compip = "77.88.21.13"      ' ip адрес сервера, который будем пинговать
LogFilePath = "c:\log.log"    ' лог-файл
timeout = "30"                 ' таймаут проверки в секундах

On Error Resume Next

do
    
        If fnPing(compip) = 1 Then
            ' доступен

            ' пишем лог
            Set FSO = CreateObject("Scripting.FileSystemObject")
            Set LogFile = FSO.OpenTextFile(LogFilePath, 8, True)
            LogFile.WriteLine Now & " " & compip & " доступен"
            LogFile.Close

            'MsgBox compip & " пингуется :) "
        Else
            ' не доступен
        
            ' пишем лог
            Set FSO = CreateObject("Scripting.FileSystemObject")
            Set LogFile = FSO.OpenTextFile(LogFilePath, 8, True)
            LogFile.WriteLine Now & " " & compip & " не доступен"
            LogFile.Close
        
            'MsgBox compip & " не пингуется. Попробуйте позвонить позднее :) "
        End If
    
' заснем на указанное кол-во секунд
wscript.sleep timeout*1000

loop




'-------------------------------------------------------------------------------
Function fnPing( strHost )
' fnPing = 0  - не пингуется
' fnPing = 1  - пингуется
Dim objPing, objRetStatus
Set objPing = GetObject( "winmgmts:{impersonationLevel=impersonate}" ).ExecQuery( "select * from Win32_PingStatus where address = '" & strHost & "'" )
        'http://msdn.microsoft.com/en-us/library/aa394350(VS.85).aspx

For Each objRetStatus in objPing
   If IsNull( objRetStatus.StatusCode ) or objRetStatus.StatusCode <> 0 Then
        fnPing = 0
   Else
        fnPing = 1
        'ResponseTime - Time elapsed to handle the request.
        'fnPing = objRetStatus.ResponseTime
   End If
Next
End Function
'-------------------------------------------------------------------------------