Тема: VBS: класс для пинга для получения нескольких свойств
Захотел, чтобы своя функция пингования возвращала не только айпи-адрес полученый при успешном пинге, но еще и резолв имени, время ответа, описание причины неуспешности прохождения пинга.
Решил попробовать создать свой класс для пингования машин, функция пинга вернет всего один результат - "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
WBR. Roman
