Серый форум — VBS: класс для пинга для получения нескольких свойств

Re: VBS: класс для пинга для получения нескольких свойств

null@example.com (Rom5) — Thu, 06 Jun 2013 12:34:20 +0000

Выбросил из приведенного выше класса установку таймаута.

Зашел на свою тестовую XP, сильно удивился, что wmi-пинг вообще не срабатыват, методом тыка раскопал, что установка свойства "TypeofService" в строке Win32_PingStatus на моей XP приводит к неработоспособности создания пингового объекта - выбросил и эту строку "AND TypeofService=16"

Скрипт показывает на Вин7 (6.1.7600, Microsoft Windows 7 Enterprise) таймаут=4000, а на XP (5.1.2600, Microsoft Windows XP Professional, Service Pack 3) действительно = 1000.


'''' zzz_testPing_class.vbs

host = "127.0.0.1"

Do While true
    
    host = InputBox("Enter host address","CLASS for pingStatus", host)
    If Len(host)=0 Then Exit Do
    ku host
    
Loop
WScript.Quit




Function ku(pHost)
    set testHost=new class_pingWMI

    ret = testHost.ping_resolv( pHost )
    
    ' повторный старт, если результат=off
    ' If ret="off" then ret = testHost.ping_resolv( pHost )

    ' выводим свойства результата
    msgbox _
        "testHost.testAddress : " & vbTab & testHost.testAddress & vbCrLf & vbCrLf &_
        "testHost.descPing : " & vbTab & testHost.descPing & vbCrLf &_
        "FUNCTION _result_   : " & vbTab & ret & vbCrLf & vbCrLf &_
        "testHost.status : " & vbTab & testHost.status & vbCrLf &_
        "testHost.ipAddr : " & vbTab & testHost.ipAddr & vbCrLf &_
        "testHost.ipAddrResolved : " & vbTab & testHost.ipAddrResolved & vbCrLf &_
        "testHost.addrResolv_woDomain : " & vbTab & testHost.addrResolv_woDomain & vbCrLf &_
        "testHost.Timeout : " & vbTab & testHost.Timeout & vbCrLf &_
        "testHost.ResponseTime : " & vbTab & testHost.ResponseTime & vbCrLf &_
        "testHost.descResolv : " & vbTab & testHost.descResolv & vbCrLf &_
        "testHost.chkResolve : " & vbTab & testHost.chkResolve & vbCrLf &_
        vbCrLf, , "class_pingWMI"

    set testHost = Nothing

End FUNCTION

' --- Класс для получения набора свойств по результу опроса хоста через Win32_PingStatus
' Передаваемый параметр:
'   (str) testAddress - указываемый перед запуском функции "ping_resolv" (либо в ее параметре) адрес хоста (имя/айпи)
' 
' Дополнительно настраиваемое свойство:
'   (int) Timeout - таймаут пинга, по умолчанию - 1500 мс
' 
' Устанавливаемые свойства:
'   (str) result - тоже, что и сам результат функции (on/off)
'   (int) status - 0 (если ответ пинга успешен), либо равен коду статуса пинга (либо =-1, если код статуса был NULL)
'   (str) ipAddr - (свойство пинга ProtocolAddress) - по идее - айпи адрес, может быть - либо ipV4 (возможен и префикс), либо ipV6
'   (str) ipAddrResolved - (свойство пинга ProtocolAddressResolved) теоретически - отрезолвленное полное имя хооста (с доменом),
'                    но пингом может быть возвращен и айпи.
'   (str) addrResolv_woDomain - только отрезолвленое имя - это свойство ipAddrResolved с отсеченным от имени доменом, 
'                    и дополнительно - если в ProtocolAddressResolved был получен айпи вместо имени, то возвращается - "".
'   (int) chkResolve - результат сравнения имени тестируемого хоста с отрезолвленым именем_без_домена.
'                    0 - имена совпадают / 1 - не свопадают / -1 - сравнение некорректно, т.к. резолв имени не осуществлен.
'   (int) ResponseTime - xxx ms (свойство пинга ResponseTime) - по идее - число, соответствуещее количеству милисекунд, 
'                    прошедших в ожидании ответа от хоста. Если ответ не получен вообще будет равен -1.
'   (str) descPing - текстовое описание пинг-свойства "StatusCode".
'   (str) descResolv - текстовое описание пинг-свойства "PrimaryAddressResolutionStatus".
'
' Результат функции "ping_resolv" (str): "on" - ответ получен / "off" - не получен'
'
' Использование:
' Dim pHost : pHost = "compPupkinV" - тестируемый компьютер
' Dim sHost_Name, sHost_ip, ret
' Dim myVar
' Set myVar = NEW Class_pingWMI           '// объявляем объектную переменную
' '''myVar.Timeout = 2000                 '// меняем таймаут пинга'
' ret = myVar.ping_resolv( pHost )        '// запускаем пинг, свойства объекта заполняются, "ret" будет равно on/off
' sHost_Name = myVar.addrResolv_woDomain  '// обращаемся к свойствам объекта
' sHost_ip = myVar.ipAddr                 '// обращаемся к свойствам объекта
' Set myVar = Nothing                     '// удаляем объектную переменную
CLASS Class_pingWMI
    Dim testAddress, result, ipAddr, ipAddrResolved, addrResolv_woDomain, chkResolve
    Dim ResponseTime, status, descPing, descResolv, Timeout
    Function ping_resolv( paramAddress )
        testAddress = paramAddress
        ' Устанавливаем таймаут на дефоултный, если "Timeout" не содержит число от 1000'
        ' Dim defaultTimeout
        ' defaultTimeout = 1500
        ' If Not IsNull (Timeout) Then
            ' If Timeout=>1000 Then defaultTimeout = Timeout
        ' End IF
        Dim objPing 
        Set objPing = _
            GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery( _
            "select * from Win32_PingStatus where address = '" & testAddress & "'" &_
            " AND ResolveAddressNames='true'" &_
            "") 
                
            ' " AND TypeofService=16 " &_
            ' " AND Timeout=" & CStr(defaultTimeout) &_
            
        ' --- Значения по-умолчанию'
        result = ""
        ipAddr = ""
        ipAddrResolved = ""
        addrResolv_woDomain = ""
        chkResolve = -1
        ResponseTime = -1
        status = -1
        descPing = ""
        descResolv = ""
        
        For Each objStatus in objPing 
            With objStatus
            
                Timeout = .Timeout
                ' --- Ping command status codes.
                If IsNull(.StatusCode) or .StatusCode <> 0 Then 
                    result = "off" 
                Else
                    result = "on" 
                    ' --- Time elapsed to handle the request.
                    ResponseTime = .ResponseTime
                End If
                ' для "нормального" (числового) StatusCode формируем текст.описание
                If NOT IsNull(.StatusCode) Then
                    status = .StatusCode
                    descPing = GetStatusCode( status )
                Else 
                    status = -1 ' тоже - unknown'
                End IF
                
                
                ' --- Status of the address resolution process. If successful, the value is 0 (zero). 
                ' Any other value indicates an unsuccessful address resolution.
                descResolv = GetStatusCode( .PrimaryAddressResolutionStatus ) 
                
                ' --- Resolved address corresponding to the ProtocolAddress property. The default is "".
                ipAddrResolved = .ProtocolAddressResolved
                
                '--- отсекаем имя домена у отрезолвленного адреса'
                addrResolv_woDomain = ""
                If Len(ipAddrResolved)>0 Then
                    ' имеем непустое значение'
                    If Asc(Left(ipAddrResolved,1))>57 Then
                        ' значение не начинается с цифры, т.е. - не айпи'
                        IF InStr(ipAddrResolved,".")>0 Then
                            '... и содержит имя домена - убираем в имени все правее первой точки'
                            addrResolv_woDomain = Left(ipAddrResolved, InStr(ipAddrResolved,".") - 1 )
                        End IF
                        If Asc(Left(testAddress,1))>57 Then
                            ' Тестируемый хост был задан также именем, а не айпи.
                            ' Сравниваем имена (тестируемое с полученным), если отличий нет - устанавливаем переменную "chkResolve" в 0, 
                            '   иначе - в 1.
                            If UCase(testAddress) = UCase(addrResolv_woDomain) Then
                                chkResolve = 0
                            Else
                                chkResolve = 1
                            End IF
                        Else
                            ' тестируемый хост был указан айпи-адресом, его сравнение с полученым адресом не выполняем'
                        End IF
                    End IF
                End IF
                
                ' --- Address that the destination used to reply. The default is "".
                ' если получен IP-адрес с префиксом пробуем оставить один ip4-адрес'
                ipAddr = .ProtocolAddress
                If InStr(ipAddr,":")>0 And InStr(ipAddr,".")>0 Then 
                    ipAddr = Right( ipAddr, Len(ipAddr) - InStrRev(ipAddr,":") )
                End IF
                
            End With
        Next 
        Set objPing = Nothing
        
        ping_resolv = result
    End FUNCTION
    
    Function GetStatusCode (pIntCode)
        ' from http://msdn.microsoft.com/en-us/library/windows/desktop/aa394350(v=vs.85).aspx
        Select Case pIntCode
            Case 0 : GetStatusCode = "Success"
            Case 11001 : GetStatusCode = "Buffer Too Small"
            Case 11002 : GetStatusCode = "Destination Net Unreachable"
            Case 11003 : GetStatusCode = "Destination Host Unreachable"
            Case 11004 : GetStatusCode = "Destination Protocol Unreachable"
            Case 11005 : GetStatusCode = "Destination Port Unreachable"
            Case 11006 : GetStatusCode = "No Resources"
            Case 11007 : GetStatusCode = "Bad Option"
            Case 11008 : GetStatusCode = "Hardware Error"
            Case 11009 : GetStatusCode = "Packet Too Big"
            Case 11010 : GetStatusCode = "Request Timed Out"
            Case 11011 : GetStatusCode = "Bad Request"
            Case 11012 : GetStatusCode = "Bad Route"
            Case 11013 : GetStatusCode = "TimeToLive Expired Transit"
            Case 11014 : GetStatusCode = "TimeToLive Expired Reassembly"
            Case 11015 : GetStatusCode = "Parameter Problem"
            Case 11016 : GetStatusCode = "Source Quench"
            Case 11017 : GetStatusCode = "Option Too Big"
            Case 11018 : GetStatusCode = "Bad Destination"
            Case 11032 : GetStatusCode = "Negotiating IPSEC"
            Case 11050 : GetStatusCode = "General Failure"
            Case Else
                GetStatusCode = "_unknown_"
        End Select
    
    End FUNCTION
    
End CLASS

Re: VBS: класс для пинга для получения нескольких свойств

null@example.com (alexii) — Thu, 06 Jun 2013 09:59:38 +0000

пока на своей рабочей Вин7 в тестах не вывел сие значение и удивился, что там 4000.

Покажите, какой код использовали, попробуем.

т.е. для меня последовательность пинга имеет значение,

В указанном примере последовательность значения не имеет, поскольку (первый пример без очереди опроса) очень слабо зависит от количества машин и, практически, почти не превышает времени опроса одной отключённой машины, поскольку запросы делаются асинхронно. Т.е., если у Вас пять машин в списке и из них две отключённых — их опрос займёт больше времени, нежели способом, указанным по ссылке.

Re: VBS: класс для пинга для получения нескольких свойств

null@example.com (Rom5) — Thu, 06 Jun 2013 09:20:41 +0000

alexii пишет:

по умолчанию я его уже занизил с 4000мс до 1500мс
Разве таймаут не 1000?

Я и не думал таймаут менять, пока на своей рабочей Вин7 в тестах не вывел сие значение и удивился, что там 4000.

Поменял, поганял тесты двумя вариантами приложения на подразделении со слабым каналом - количество неответивших машин не менялось, а скорость работы (в тестируемом списке - весомое количество просто отключенных машин) ощутимо выросла.

Для ускорения опроса группы машин изумительно подходит: VBScript: асинхронная обработка множественных запросов WMI...

Именно в том моем hta-приложении мне асинхронный пинг не особо и нужен, т.к. пинги осуществляются с целью поиска залогиненного пользователя среди довольно ограниченного списка его машин.

А список тот специальным образом выстраивается, чтобы проверка шла сначала среди машин его юнита причем в первую очередь на тех, где он он был в последних пользователях (по запросу к MS SCCM) и где он указан менеджером (запросы к AD) - т.е. для меня последовательность пинга имеет значение, на искомую машину попадаю довольно оперативно.

ps. Хотя надо поизучать устройство "LANAdmin.hta (c) mozers" - если юзер вообще нигде не залогинен, а машин разрешенных много, то обработку программа завершит, согласен, что ранее.

Re: VBS: класс для пинга для получения нескольких свойств

null@example.com (alexii) — Thu, 06 Jun 2013 08:13:00 +0000

по умолчанию я его уже занизил с 4000мс до 1500мс

Разве таймаут не 1000?

Timeout
Data type: uint32
Access type: Read-only
Qualifiers: Key
Time-out value in milliseconds. If a response is not received in this time, no response is assumed. The default is 1000 milliseconds.

Для ускорения опроса группы машин изумительно подходит: VBScript: асинхронная обработка множественных запросов WMI (Страница 1) — Windows Script Host, HTA (VBScript, JScript) — Серый форум.

VBS: класс для пинга для получения нескольких свойств

null@example.com (Rom5) — Thu, 06 Jun 2013 07:49:19 +0000

Захотел, чтобы своя функция пингования возвращала не только айпи-адрес полученый при успешном пинге, но еще и резолв имени, время ответа, описание причины неуспешности прохождения пинга.

Решил попробовать создать свой класс для пингования машин, функция пинга вернет всего один результат - "on" или "off", но зато и установит переменные класса в интересуемые полученные пингом свойства.

Перед стартом пинга можно изменить время таймаута, по умолчанию я его уже занизил с 4000мс до 1500мс - последовательный тест списка машин из юнита, в котором предостаточно невключенных машин, ускорился ~40%.

Вот, код с комментариями, буду рад претензиям, т.к. за написание класса взялся впервые:


' --- Класс для получения набора свойств по результу опроса хоста через Win32_PingStatus
' Передаваемый параметр:
'   (str) testAddress - указываемый перед запуском функции "ping_resolv" (либо в ее параметре) адрес хоста (имя/айпи)
' 
' Дополнительно настраиваемое свойство:
'   (int) Timeout - таймаут пинга, по умолчанию - 1500 мс
' 
' Устанавливаемые свойства:
'   (str) result - тоже, что и сам результат функции (on/off)
'   (int) status - 0 (если ответ пинга успешен), либо равен коду статуса пинга (либо =-1, если код статуса был NULL)
'   (str) ipAddr - (свойство пинга ProtocolAddress) - по идее - айпи адрес, может быть - либо ipV4 (возможен и префикс), либо ipV6
'   (str) ipAddrResolved - (свойство пинга ProtocolAddressResolved) теоретически - отрезолвленное полное имя хооста (с доменом),
'                    но пингом может быть возвращен и айпи.
'   (str) addrResolv_woDomain - только отрезолвленое имя - это свойство ipAddrResolved с отсеченным от имени доменом, 
'                    и дополнительно - если в ProtocolAddressResolved был получен айпи вместо имени, то возвращается - "".
'   (int) chkResolve - результат сравнения имени тестируемого хоста с отрезолвленым именем_без_домена.
'                    0 - имена совпадают / 1 - не свопадают / -1 - сравнение некорректно, т.к. резолв имени не осуществлен.
'   (int) ResponseTime - xxx ms (свойство пинга ResponseTime) - по идее - число, соответствуещее количеству милисекунд, 
'                    прошедших в ожидании ответа от хоста. Если ответ не получен вообще будет равен -1.
'   (str) descPing - текстовое описание пинг-свойства "StatusCode".
'   (str) descResolv - текстовое описание пинг-свойства "PrimaryAddressResolutionStatus".
'
' Результат функции "ping_resolv" (str): "on" - ответ получен / "off" - не получен'
'
' Использование:
' Dim pHost : pHost = "compPupkinV" - тестируемый компьютер
' Dim sHost_Name, sHost_ip, ret
' Dim myVar
' Set myVar = NEW Class_pingWMI           '// объявляем объектную переменную
' '''myVar.Timeout = 2000                 '// меняем таймаут пинга'
' ret = myVar.ping_resolv( pHost )        '// запускаем пинг, свойства объекта заполняются, "ret" будет равно on/off
' sHost_Name = myVar.addrResolv_woDomain  '// обращаемся к свойствам объекта
' sHost_ip = myVar.ipAddr                 '// обращаемся к свойствам объекта
' Set myVar = Nothing                     '// удаляем объектную переменную
CLASS Class_pingWMI
    Dim testAddress, result, ipAddr, ipAddrResolved, addrResolv_woDomain, chkResolve
    Dim ResponseTime, status, descPing, descResolv, Timeout
    Function ping_resolv( paramAddress )
        testAddress = paramAddress
        ' Устанавливаем таймаут на дефоултный, если "Timeout" не содержит число от 1000'
        Dim defaultTimeout
        defaultTimeout = 1500
        If Not IsNull (Timeout) Then
            If Timeout=>1000 Then defaultTimeout = Timeout
        End IF
        Dim objPing 
        Set objPing = _
            GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery( _
            "select * from Win32_PingStatus where address = '" & testAddress & "'" &_
            " AND ResolveAddressNames='true'" &_
            " AND Timeout=" & CStr(defaultTimeout) &_
            " AND TypeofService=16 " &_
            "") 
        ' --- Значения по-умолчанию'
        result = ""
        ipAddr = ""
        ipAddrResolved = ""
        addrResolv_woDomain = ""
        chkResolve = -1
        ResponseTime = -1
        status = -1
        descPing = ""
        descResolv = ""
        
        For Each objStatus in objPing 
            With objStatus
            
                Timeout = .Timeout
                ' --- Ping command status codes.
                If IsNull(.StatusCode) or .StatusCode <> 0 Then 
                    result = "off" 
                Else
                    result = "on" 
                    ' --- Time elapsed to handle the request.
                    ResponseTime = .ResponseTime
                End If
                ' для "нормального" (числового) StatusCode формируем текст.описание
                If NOT IsNull(.StatusCode) Then
                    status = .StatusCode
                    descPing = GetStatusCode( status )
                Else 
                    status = -1 ' тоже - unknown'
                End IF
                
                
                ' --- Status of the address resolution process. If successful, the value is 0 (zero). 
                ' Any other value indicates an unsuccessful address resolution.
                descResolv = GetStatusCode( .PrimaryAddressResolutionStatus ) 
                
                ' --- Resolved address corresponding to the ProtocolAddress property. The default is "".
                ipAddrResolved = .ProtocolAddressResolved
                
                '--- отсекаем имя домена у отрезолвленного адреса'
                addrResolv_woDomain = ""
                If Len(ipAddrResolved)>0 Then
                    ' имеем непустое значение'
                    If Asc(Left(ipAddrResolved,1))>57 Then
                        ' значение не начинается с цифры, т.е. - не айпи'
                        IF InStr(ipAddrResolved,".")>0 Then
                            '... и содержит имя домена - убираем в имени все правее первой точки'
                            addrResolv_woDomain = Left(ipAddrResolved, InStr(ipAddrResolved,".") - 1 )
                        End IF
                        If Asc(Left(testAddress,1))>57 Then
                            ' Тестируемый хост был задан также именем, а не айпи.
                            ' Сравниваем имена (тестируемое с полученным), если отличий нет - устанавливаем переменную "chkResolve" в 0, 
                            '   иначе - в 1.
                            If UCase(testAddress) = UCase(addrResolv_woDomain) Then
                                chkResolve = 0
                            Else
                                chkResolve = 1
                            End IF
                        Else
                            ' тестируемый хост был указан айпи-адресом, его сравнение с полученым адресом не выполняем'
                        End IF
                    End IF
                End IF
                
                ' --- Address that the destination used to reply. The default is "".
                ' если получен IP-адрес с префиксом пробуем оставить один ip4-адрес'
                ipAddr = .ProtocolAddress
                If InStr(ipAddr,":")>0 And InStr(ipAddr,".")>0 Then 
                    ipAddr = Right( ipAddr, Len(ipAddr) - InStrRev(ipAddr,":") )
                End IF
                
            End With
        Next 
        Set objPing = Nothing
        
        ping_resolv = result
    End FUNCTION
    
    Function GetStatusCode (pIntCode)
        ' from http://msdn.microsoft.com/en-us/library/windows/desktop/aa394350(v=vs.85).aspx
        Select Case pIntCode
            Case 0 : GetStatusCode = "Success"
            Case 11001 : GetStatusCode = "Buffer Too Small"
            Case 11002 : GetStatusCode = "Destination Net Unreachable"
            Case 11003 : GetStatusCode = "Destination Host Unreachable"
            Case 11004 : GetStatusCode = "Destination Protocol Unreachable"
            Case 11005 : GetStatusCode = "Destination Port Unreachable"
            Case 11006 : GetStatusCode = "No Resources"
            Case 11007 : GetStatusCode = "Bad Option"
            Case 11008 : GetStatusCode = "Hardware Error"
            Case 11009 : GetStatusCode = "Packet Too Big"
            Case 11010 : GetStatusCode = "Request Timed Out"
            Case 11011 : GetStatusCode = "Bad Request"
            Case 11012 : GetStatusCode = "Bad Route"
            Case 11013 : GetStatusCode = "TimeToLive Expired Transit"
            Case 11014 : GetStatusCode = "TimeToLive Expired Reassembly"
            Case 11015 : GetStatusCode = "Parameter Problem"
            Case 11016 : GetStatusCode = "Source Quench"
            Case 11017 : GetStatusCode = "Option Too Big"
            Case 11018 : GetStatusCode = "Bad Destination"
            Case 11032 : GetStatusCode = "Negotiating IPSEC"
            Case 11050 : GetStatusCode = "General Failure"
            Case Else
                GetStatusCode = "_unknown_"
        End Select
    
    End FUNCTION
    
End CLASS