1

Тема: VBScript: асинхронная обработка множественных запросов WMI

Асинхронная обработка множественных запросов WMI на примере «Win32_PingStatus»

Данный скрипт квази-одновременно, за счёт асинхронной обработки, посылает пинги по адресам, указанным в массиве arrComputers, и получает результат.

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

Option Explicit

Dim arrComputers
Dim strComputer

Dim objSWbemServicesEx
Dim objSWbemSink
Dim objSWbemNamedValueSet

Dim lngCount


' Массив адресов/имён опрашиваемых машин
' В принципе, можно получать из сетевого окружения, с контроллера домена
' или перебором доступных адресов подсети
arrComputers = Array("google.com", "www.ru", "localhost", "test")
lngCount     = UBound(arrComputers) + 1

Set objSWbemServicesEx = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\Root\CIMV2")
Set objSWbemSink       = WScript.CreateObject("WbemScripting.SWbemSink", "Sink_")

For Each strComputer In arrComputers
    ' В коллекции «objSWbemNamedValueSet» будем передавать адрес/имя хоста (замечание: в данном конкретном случае
    ' сие, в принципе, необязательно, поскольку класс Win32_PingStatus и так содержит
    ' свойство «.Address», но тут показана сама технология передачи данных в процедуру асинхронной обработки)
    Set objSWbemNamedValueSet = WScript.CreateObject("WbemScripting.SWbemNamedValueSet")
    objSWbemNamedValueSet.Add "HostName", strComputer
    
    ' Все запросы будут обрабатываться в единственной процедуре обработки
    objSWbemServicesEx.ExecQueryAsync objSWbemSink, "SELECT * FROM Win32_PingStatus WHERE ADDRESS = '" & strComputer & "'", , , , objSWbemNamedValueSet
Next

' Ожидаем, пока не будут обработаны все асинхронные запросы
Do
    WScript.Sleep 100
Loop Until lngCount = 0

objSWbemSink.Cancel

Set objSWbemSink       = Nothing
Set objSWbemServicesEx = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
' Процедура асинхронной обработки экземпляра объекта (замечание: в данном конкретном случае
' будет возвращаться единственный объект, однако, в большинстве случаев запросы
' возвращают множество объектов)
Sub Sink_OnObjectReady(objWbemObject, objWbemAsyncContext)
    Dim strComputer
    
    strComputer = objWbemAsyncContext.Item("HostName")
    
    If Not IsNull(objWbemObject.StatusCode) Then
        If objWbemObject.StatusCode = 0 Then
            WScript.Echo strComputer & vbTab & "On" & vbTab & "Response time: " & objWbemObject.ResponseTime & " ms"
        Else
            WScript.Echo strComputer & vbTab & "Off" & vbTab & "Status code: " & objWbemObject.StatusCode
        End If
    Else
        WScript.Echo strComputer & vbTab & "Not found"
    End If
End Sub
'=============================================================================

'=============================================================================
' Процедура, вызываемая при завершении асинхронной обработки
Sub Sink_OnCompleted(iHResult, objWbemErrorObject, objWbemAsyncContext)
    objWbemAsyncContext.DeleteAll
    Set objWbemAsyncContext = Nothing
    
    ' Уменьшаем счётчик оставшегося числа асинхронных обработок
    lngCount = lngCount - 1
End Sub
'=============================================================================

Автор идеи — Евген. Посильное участие, прочие плодотворные идеи и тестирование — kiber_punk, Dmitrii, Xameleon, mozers, alexii.

2

Re: VBScript: асинхронная обработка множественных запросов WMI

Развитие предыдущего примера. Одновременно выполняются не все запросы, а только часть. Как только завершается обработка очередного запроса — делается следующий запрос.

Option Explicit

Dim arrComputers
Dim strComputer

Dim objSWbemServicesEx
Dim objSWbemSink
Dim objSWbemNamedValueSet

Dim lngCount
Dim lngQueueCurrLength, lngQueueMaxLength
Dim i


' Массив адресов/имён опрашиваемых машин
' В принципе, можно получать из сетевого окружения, с контроллера домена
' или перебором доступных адресов подсети
arrComputers = Array("google.com", "www.ru", "127.0.0.1", "server", "scite.net.ru", "ya.ru", "script-coding.com", "ixbt.com")

' Максимальная длина очереди (в данном примере — сколько машин будут пинговаться одновременно),
' выбирается произвольно
lngQueueMaxLength  = 3
' Текущая длина очереди
lngQueueCurrLength = 0

lngCount = UBound(arrComputers)
i = 0

Set objSWbemServicesEx = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\Root\CIMV2")
Set objSWbemSink       = WScript.CreateObject("WbemScripting.SWbemSink", "Sink_")

While (i <= lngCount) Or (lngQueueCurrLength > 0) ' Пингуем пока не кончатся компы и очередь
    If (i <= lngCount) And (lngQueueCurrLength < lngQueueMaxLength) Then
        WScript.Echo "> [" & i & "] " & arrComputers(i) ' Добавляем очередной комп в очередь для пинга
        
        ' В коллекции «objSWbemNamedValueSet» будем передавать адрес/имя хоста (замечание: в данном конкретном случае
        ' сие, в принципе, необязательно, поскольку класс Win32_PingStatus и так содержит
        ' свойство «.Address», но тут показана сама технология передачи данных в процедуру асинхронной обработки)
        Set objSWbemNamedValueSet = WScript.CreateObject("WbemScripting.SWbemNamedValueSet")
        objSWbemNamedValueSet.Add "HostName", arrComputers(i)
        
        ' Все запросы будут обрабатываться в единственной процедуре обработки
        objSWbemServicesEx.ExecQueryAsync objSWbemSink, "SELECT * FROM Win32_PingStatus WHERE ADDRESS = '" & arrComputers(i) & "'", , , , objSWbemNamedValueSet
        
        i = i + 1
        lngQueueCurrLength = lngQueueCurrLength + 1
    Else
        ' Ожидаем, пока не будут обработаны все асинхронные запросы
        WScript.Sleep 100
    End If
Wend

objSWbemSink.Cancel

Set objSWbemSink       = Nothing
Set objSWbemServicesEx = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
' Процедура асинхронной обработки экземпляра объекта (замечание: в данном конкретном случае
' будет возвращаться единственный объект, однако, в большинстве случаев запросы
' возвращают множество объектов)
Sub Sink_OnObjectReady(objWbemObject, objWbemAsyncContext)
    Dim strComputer
    
    strComputer = objWbemAsyncContext.Item("HostName")
    
    If Not IsNull(objWbemObject.StatusCode) Then
        If objWbemObject.StatusCode = 0 Then
            WScript.Echo "  " & strComputer & vbTab & "On" & vbTab & "Response time: " & objWbemObject.ResponseTime & " ms"
        Else
            WScript.Echo "  " & strComputer & vbTab & "Off" & vbTab & "Status code: " & objWbemObject.StatusCode
        End If
    Else
        WScript.Echo "  " & strComputer & vbTab & "Not found"
    End If
End Sub
'=============================================================================

'=============================================================================
' Процедура, вызываемая при завершении асинхронной обработки
Sub Sink_OnCompleted(iHResult, objWbemErrorObject, objWbemAsyncContext)
    objWbemAsyncContext.DeleteAll
    Set objWbemAsyncContext = Nothing
    
    ' Уменьшаем длину очереди
    lngQueueCurrLength = lngQueueCurrLength - 1
    'lngCount = lngCount - 1
End Sub
'=============================================================================

Автор идеи — mozers.