26

Re: VBScript / WMI : Асинхронный мультипинг

Поглядел скрипт. Очень заинтересовало. Единственное, что не понял - почему не захотели использовать HTA, чтобы наблюдать результат в динамике сразу на экране. И зачем сортировать Dictionary через самописную функцию, если можно создать Recordset с нужными полями и сортировать его через встроенный механизм. Предполагаю, что это быстрее. А так - КРУТО !!!

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

27

Re: VBScript / WMI : Асинхронный мультипинг

2Xameleon: как по мне, так ни текстового файла, ни HTA не нужно, важен сам перечень доступных машин, но выложу я именно вариант коллеги Евген с текстовым файлом (причём именно с передачей имени машины в «SWbemNamedValueSet», хотя именно в этом конкретном случае сие необязательно — имя машины можно получить в событии непосредственно из самого объекта Win32_PingStatus, но важна демонстрация таковой возможности сама по себе). И, думаю, если Вы сделаете описанный Вами вариант, он также пойдёт в ту же ветку Коллекции.

28 (изменено: Xameleon, 2010-12-28 13:19:53)

Re: VBScript / WMI : Асинхронный мультипинг

2 alexii: Хм.. Всё таки решил попробывать свои силы в HTA дизайнерстве. ) Вот что получилось
http://iserver.front.ru/flashcard/1/multiping.jpg

Сыровато пока что, но постарался несколько своих идей внести
1) Сортировка прямая и обратная по каждому из полей.
2) Поля подсвечиваются цветами в зависимости от статуса ответа.
3) Есть возможность сохранения записей в XML и обратная загрузка списка.

Постараюсь потом доделать.

Исходник multiping.hta:

<HTML>
    <HEAD>
    <SCRIPT language="VBScript">
        'Задаём стандартные размеры окна до его загрузки (Скрипт в HEAD срабатывает до загрузки окна)
        Const WindowWidth = 640
        Const WindowHeight = 480
        window.resizeTo WindowWidth,WindowHeight
    </SCRIPT>
    <TITLE>Multi Ping Application</TITLE>
    <HTA:APPLICATION
        ID="Application"
        APPLICATIONNAME="MultiPing"
        BORDER="normal"
        BORDERSTYLE="normal"
        INNERBORDER="no"
        CAPTION="yes"
        ICON=""
        MAXIMIZEBUTTON="yes"
        MINIMIZEBUTTON="yes"
        SHOWINTASKBAR="yes"
        SINGLEINSTANCE="no"
        SYSMENU="yes"
        VERSION="1.0"
        CONTEXTMENU="no"
        WINDOWSTATE="normal" />
        <STYLE>
        *
        {
        FONT-FAMILY:Verdana;
        FONT-SIZE:12;
        }
        BUTTON
        {
        WIDTH:100%;
        PADDING:5;
        }
        TABLE.table TBODY TD, TABLE.table TFOOT TD 
        {
        BORDER-RIGHT:solid 1px #cccccc;
        BORDER-BOTTOM:solid 1px #cccccc;
        PADDING:1;
        }
        TABLE.table TBODY TR.red
        {
        BACKGROUND-COLOR:#FF8C8C;
        }

        TABLE.table TBODY TR.green
        {
        BACKGROUND-COLOR:#BBFFA3;
        }
        
        SPAN
        {
        WIDTH:2;
        COLOR:#999999;
        FONT-SIZE:10;
        }
        
        DIV.Container
        {
            MARGIN: 0px auto;
            WIDTH: 100%;
            HEIGHT: 100%;
            OVERFLOW: auto
        }
        THEAD TR
        {
            BACKGROUND-COLOR:#D8D5CE;
            POSITION: relative;
            TOP: expression(offsetParent.scrollTop);
        }
        TABLE TFOOT TR
        {
            POSITION: relative;
            OVERFLOW-X: hidden;
            ;
            TOP: expression(parentNode.parentNode.offsetHeight >= offsetParent.offsetHeight ? 0 - parentNode.parentNode.offsetHeight + offsetParent.offsetHeight + offsetParent.scrollTop : 0)
        }
        TD:unknown
        {
            PADDING-RIGHT: 20px
        }
        
        </STYLE>
    </HEAD>
    <BODY SCROLL="no" bgcolor="#D8D5CE" style="ZOOM:1;">
        <TABLE width=100% height=100% cellspacing=0 cellpadding=0>
            <TR>
                <TD height=100% bgcolor="#ffffff" valign=top style="border:inset 2px;">
                    <DIV id="Container" class="Container" scrollY="" >
                    <TABLE id="list" class="table" style="height:100%;" width=100% cellspacing=0 cellpadding=0>
                        <THEAD id="table_header">
                            <TR class="HEADER">
                            </TR>
                        </THEAD>
                        <TBODY id="table_list">
                        </TBODY>
                        <TFOOT id="table_footer" style="height:100%">
                            <TR>
                            </TR>
                        </TFOOT>
                    </TABLE>
                    </DIV>
                </TD>
            </TR>
            <TR>
                <TD>
                    <TABLE cellpadding=5 cellspacing=5>
                        <TR>
                            <TD>
                                <BUTTON id="AddCommandButton" style="width:100%;">Добавить</BUTTON>
                            </TD>
                            <TD>
                                <BUTTON id="RemoveCommandButton">Удалить</BUTTON>
                            </TD>
                            <TD>
                                <BUTTON id="ScanCommandButton">Сканировать</BUTTON>
                            </TD>
                            <TD>
                                <BUTTON id="SaveCommandButton">Сохранить список</BUTTON>
                            </TD>
                            <TD>
                                <BUTTON id="LoadCommandButton">Загрузить список</BUTTON>
                            </TD>
                        </TR>
                    </TABLE>
                </TD>        
            </TR>
        </TABLE>
        <OBJECT id="objSink" style="display:none;" classid="clsid:75718C9A-F029-11D1-A1AC-00C04FB6C223"></OBJECT>
        <SCRIPT language="VBScript">
            Option Explicit
            ' Const
Const adFldMayBeNull = 64
            Const adPersistXML = 1
            Const adAffectAll = 3
            Const adBoolean = 11
            Const adDate = 7
            Const adFldKeyColumn = 32768
            Const adVarChar = 200
            
            Const cdlOFNExplorer = &H80000 
            Const cdlOFNFileMustExist = &H1000 
            Const cdlOFNHideReadOnly = &H4 
            Const cdlOFNPathMustExist = &H800 
            ' EndConst
    
            Dim Recordset, CommonDialog, objService, StartTime, SortName,Direction, ScanCount
            
            'Запускаем процедуру инициализации
            Initialize
    
            'Процедура инициализации
            Sub Initialize
                On Error Resume Next
                'Т.к не нашёл метода проверки загрузился Activex или нет, то использовал вызов метода объекта. Если он не произошёл с ошибкой, то он не загрузился
                objSink.Cancel
                If Err.number <> 0 Then
                    MsgBox "Не удалось загрузить объект ""WbemScripting.SWbemSink""",vbCritical
                    Exit Sub
                End If
                'Проверяем остальные объекты на загрузку стандартным методом
                Set CommonDialog = CreateObject("MSComDlg.CommonDialog.1")
                If Err.number = 0 Then
                    With CommonDialog
                        .MaxFileSize = 1024 
                        .Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly Or cdlOFNPathMustExist
                        .Filter = "лог (*.xml)|*.xml"
                    End With
                End If
        
                Set Recordset = CreateObject("ADODB.Recordset")
                If Err.number <>  0 Then
                    MsgBox "Не удалось загрузить объект ""ADODB.Recordset"". " & Err.Description,vbCritical
                    Exit Sub
                End If
        
                Set objService = GetObject("winmgmts:\\.\Root\CIMV2")
                If Err.number <> 0 Then
                    MsgBox "Не удалось получить ""winmgmts:\\.\Root\CIMV2"". " & Err.Description,vbCritical
                    Exit Sub
                End If
                'Заполняем поля рекордсета
                InitRecordset
                'Строим табличку по имеющимся полям таблицы
                BuildTable
            End Sub

            'Процедура заполнения полей
            Sub InitRecordset
                On Error Resume Next
                'Создаём необходимые поля
                With Recordset.Fields
                    .Append "CheckedState",adBoolean    
                    .Append "Computer",adVarChar,255,adFldKeyColumn    
                    .Append "ResponseTime", adDate
                    .Append "ResponseState",adBoolean,,adFldMayBeNull
                End With
                'Открываем рекордсет
                Recordset.Open
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"InitRecordset"
            End Sub
            
            'Процедура построения таблицы
            Sub BuildTable
                On Error Resume Next
                Dim FieldIndex, innerText
                'Т.к в заголовке всего одна строка, то работаем только с ней
                With table_header.rows(0)
                    'Перебираем все поля
                    For FieldIndex = 0 To Recordset.Fields.Count-1
                        'Выставляем русские аналоги для заголовков кнопок
                        Select Case LCase(Recordset(FieldIndex).Name)
                        Case "computer"
                            innerText = "Компьютер"
                        Case "responsetime"
                            innerText = "Время ответа"
                        Case "responsestate"
                            innerText = "Состояние"
                        End Select
                        'Вставляем в каждую ячейку кнопку с заголовком
                        .insertCell.innerHtml = "<BUTTON onclick=""Sort('" & Recordset(FieldIndex).Name & "')"">" & innerText & "</BUTTON>"
                        'Поля в футере заполняем пустыми строками, чтобы сделать вертикальные линии на всю высоту списка (для красоты)
                        table_footer.rows(0).insertCell.innerHtml = "&nbsp"
                    Next
                End With
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"BuildTable"
            End Sub

            'Кнопка запуска сканирования
            Sub ScanCommandButton_onclick()
                On Error Resume Next
                Dim objContext
                'Если записей нет, то сообщаем об этом пользователю
                If Recordset.RecordCount <=0 Then 
                    MsgBox "Нет хостов для сканирования.",vbCritical,"Ошибка !"
                    Exit Sub    
                End If
                'Снимаем фильтр
                Recordset.Filter = ""
                'Запоминаем время старта
                StartTime = Now
                'Сбрасываем старый запрос
                objSink.Cancel
                'Сбрасываем счётчик элементов которые нужно сканировать
                ScanCount = 0
                Do
                    'Если элемент выбран, то запускаем процесс пинга
                    If Recordset("CheckedState") Then
                        'Наращиваем счётчик.
                        ScanCount = ScanCount + 1
                        Set objContext = CreateObject("WbemScripting.SWbemNamedValueSet")
                        objContext.Add "hostname", Recordset("Computer").value
                        objService.ExecQueryAsync objSink, "select * from Win32_PingStatus where address ='" & Recordset("Computer").value & "'", , , , objContext
                    End If
                    Recordset.MoveNext
                Loop Until Recordset.EOF
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"ScanCommandButton_onclick"
            End Sub

            'Событие ответа компьютера
            Sub objSink_OnObjectReady(objWbemObject, objWbemAsyncContext)
                On Error Resume Next
                Dim strComputer
                Set strComputer = objWbemAsyncContext.Item("hostname")
                'Находим запись имя ответивший имя компьютер в ре
                Recordset.Filter = "Computer='" & strComputer & "'"
                'Если запись найдена
                If Not Recordset.EOF Then
                    ScanCount = ScanCount - 1
                    'Вычисляем время ответа
                    Recordset("ResponseTime") = FormatDateTime(StartTime-Now,3)
                    'Определяем статус компьютера
                    Recordset("ResponseState") = Not IsNull(objWbemObject.StatusCode)
                End If
                'Как и везде снимаем фильтр
                Recordset.Filter = ""
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"objSink_OnObjectReady"
                RedrawTable
                if ScanCount <= 0 Then MsgBox "Сканирование завершено",vbInformation
            End Sub
            
            'Добавление компьютера
            Sub AddCommandButton_onclick()
                On Error Resume Next
                Dim name
                'Получаем имя нового хоста
                name = InputBox("Введите имя Computerа или его IP", "")
                if name = "" then Exit Sub
                'проверяем существования данной записи
                Recordset.Filter = "Computer='" & name & "'"
                If Recordset.EOF Then
                    'Если такой записи нет, то добавляем её
                    Recordset.AddNew
                    Recordset("Computer") = name
                    Recordset("CheckedState") = True
                Else
                    MsgBox "запись уже существует",vbInformation
                    Exit Sub
                End If
                'Снимаем фильтр
                Recordset.Filter = ""
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"AddCommandButton_onclick"
                RedrawTable
            End Sub
            
            'Удаление элемента(ов) из рекордсета
            Sub RemoveCommandButton_onclick()
                On Error Resume Next
                'Отбираем все выбранные элементы
                Recordset.Filter = "CheckedState=1"
                Do
                    'Удаляем записи
                    Recordset.Delete
                    Recordset.MoveNext
                Loop Until Recordset.EOF
                'Снимаем фильтр
                Recordset.Filter = ""
                RedrawTable
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"RemoveCommandButton_onclick"
            End Sub
            
            'Замена состояния выбранности элемента в рекордсете
            Sub CheckItem(name)
                On Error Resume Next
                'Фильтруем по имени элемента
                Recordset.Filter = "Computer='" & name & "'"
                'Меняем состояние выбора на обратное
                Recordset("CheckedState") = Not Recordset("CheckedState")
                'Снимаем фильтр
                Recordset.Filter = ""
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"CheckItem"
            End Sub

            'Сохранение рекордсета из файла
            Sub SaveCommandButton_onclick
                On Error Resume Next
                CommonDialog.ShowSave
                If CommonDialog.FileName = "" Then Exit Sub
                Dim FileSystemObject
                Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
                If Err.number <> 0 Then
                    MsgBox "Не удалось создать объект Scripting.FileSystemObject. " & Err.Description,vbCritical
                    Exit Sub
                End If
                If FileSystemObject.FileExists(CommonDialog.FileName) Then
                    If MsgBox("Файл уже существует. Заменить ?",vbYesNo or vbQuestion) = vbNo Then Exit Sub
                    FileSystemObject.DeleteFile CommonDialog.FileName
                End If
                Recordset.Save CommonDialog.FileName, adPersistXML
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"SaveCommandButton_onclick"
            End Sub

            'Кнопка загрузки рекордсета из файла
            Sub LoadCommandButton_onclick
                On Error Resume Next
                Dim NewRecordset, FieldIndex
                'Показываем диалог загрузки файла
                CommonDialog.ShowOpen
                If CommonDialog.FileName = "" Then Exit Sub
                'Грузим в новый рекордсет данные
                Set NewRecordset = CreateObject("ADODB.Recordset")
                NewRecordset.Open CommonDialog.FileName
                'Проверяем совпадение количества полей
                If NewRecordset.Fields.Count <> Recordset.Fields.Count Then
                    MsgBox "Не удалось загрузить записи. Количество полей не совпадает (" & NewRecordset.Fields.Count & "/" & Recordset.Fields.Count & ")!",vbCritical
                    Exit Sub
                End If
                'Проверяем совпадение типов и имён полей
                For FieldIndex=0 To NewRecordset.Fields.Count-1
                    If NewRecordset.Fields(FieldIndex).Type <> NewRecordset.Fields(FieldIndex).Type Then
                        MsgBox "Не удалось загрузить записи. Тип поля " & FieldIndex & " не совпадает с исходным !",vbCritical
                        Exit Sub
                    End If
                    If NewRecordset.Fields(FieldIndex).Name <> NewRecordset.Fields(FieldIndex).Name Then
                        MsgBox "Не удалось загрузить записи. Имя поля " & FieldIndex & " не совпадает с исходным !",vbCritical
                        Exit Sub
                    End If
                Next
                'Если всё успешно, то заменяем старый рекордсет на новый
                Set Recordset = NewRecordset
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"LoadCommandButton_onclick"
                RedrawTable
            End Sub
            
            'Сортировка по нужному полю
            Sub Sort(name)
                On Error Resume Next
                'Если в рекордсете нет записей то выходим из процедуры
                If Recordset.RecordCount <=0 Then Exit Sub
                'Если повторно передано одно и тоже имя, то меняем направление сортировки
                If SortName = name Then 
                    If Direction = "desc" Then 
                        Direction = "asc"
                    Else
                        Direction = "desc" ' обратное
                    End If
                Else
                    'Если не передано, то по умолчанию выставляем ASC - прямое
                    Direction = "asc"
                End If
                'Запоминаем в переменной имя последнего имени сортировку
                SortName = name
                'Перематываем рекордсет на начало
                Recordset.MoveFirst
                'Сортируем по нужному полю
                Recordset.Sort = "[" & name & "] " & Direction
                if err.number <> 0 Then MsgBox Err.Description, vbCritical, "Sort"
                'Перерисовываем таблицу
                RedrawTable
            End Sub            
            
            'Процедура перерисовки таблицы
            Sub RedrawTable()
                On Error Resume Next
                Dim RowIndex,NewRow, CheckedState, FieldIndex, Value

                'Удаляем все строки таблицы
                For RowIndex = 0 To table_list.rows.Length-1
                    table_list.deleteRow
                Next

                'Если записей нет, то выходим из процедуры
                If Recordset.RecordCount <=0 Then Exit Sub

                'Переходим на первую запись                
                Recordset.MoveFirst
                
                'Запускаем перебор
                Do
                    'Создаём новую строку таблицы
                    Set NewRow = table_list.insertRow
                    'Отделть от всех полей обрабатываем галку состояния выбора поля
                    'Если элемент выбран, то в <INPUT> вставляем параметр checked.
                    if Recordset.Fields(0).Value Then CheckedState = "checked" Else CheckedState = ""
                    'Вставляем в ячейку инпут с галкой
                    NewRow.insertCell.innerHtml = "<INPUT style='width:100%;' onclick=""CheckItem('" & Recordset("Computer") & "')"" type=checkbox " & CheckedState & ">"
                    'Начиная со второго поля (первым является нулевое), заполняем ячейки из рекордсета
                    For FieldIndex = 1 To Recordset.Fields.Count-1                                        
                        Value = Recordset.Fields(FieldIndex).Value
                        'Если поле состояние хоста, то подставляем текстовое объяснение
                        If Recordset.Fields(FieldIndex).name = "ResponseState" Then
                            Select Case Value
                            Case True
                                Value = "Включен"
                                NewRow.className = "green"
                            Case False
                                Value = "Выключен"
                                NewRow.className = "red"
                            End Select
                        End If
                        NewRow.insertCell.innerHtml = Value & "&nbsp"
                    Next
                    Recordset.MoveNext
                Loop Until Recordset.EOF
                if err.number <> 0 Then MsgBox Err.Description,vbCritical,"RedrawTable"
            End Sub
        </SCRIPT>
    </BODY>
</HTML>
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

29

Re: VBScript / WMI : Асинхронный мультипинг

Получилось, действительно, симпатично
Правда, если честно, у меня сбоит по страшной силе... Ну да не в этом дело.
Просто я предлагаю (независимо от того какое прелестное HTA приложение получится в конце пути) поместить в Коллекцию самый первоначальный код от Евген. Даже не его, а несщадно урезанный его вариант, в котором и заключается все ноухау. "Коллекция" - в первую очередь сборник идей, от которых можно толкаться в своих разработках, а вся идея - тут:

arrComputers = Array("google.com", "www.ru", "localhost", "test")
Set objService = GetObject("winmgmts:\\.\Root\CIMV2")
Set objSink = WScript.CreateObject("WbemScripting.SWbemSink", "Sink_")
ping = 0
For Each strComputer In arrComputers
    Set objContext = CreateObject("WbemScripting.SWbemNamedValueSet")
    objContext.Add "hostname", strComputer
    objService.ExecQueryAsync objSink, "select * from Win32_PingStatus where address ='" & strComputer & "'", , , , objContext
Next

While ping < ubound(arrComputers)+1
    WScript.Sleep 100 ' Не даем завершится скрипту пока все не пропинговали
Wend

' Функция вызывается асинхронно после каждого пинга
Sub Sink_OnObjectReady(objWbemObject, objWbemAsyncContext)
    Set strComputer = objWbemAsyncContext.Item("hostname")
    If objWbemObject.StatusCode = 0 Then
        WScript.Echo strComputer, "On", objWbemObject.ResponseTime & "ms"
    Else
        WScript.Echo strComputer, "Off"
    End If
    ping = ping + 1
End Sub

И HTA приложение тоже надо поместить. Но только когда оно работать будет как часы.

30 (изменено: Xameleon, 2009-10-20 22:19:03)

Re: VBScript / WMI : Асинхронный мультипинг

mozers пишет:

Правда, если честно, у меня сбоит по страшной силе... Ну да не в этом дело.

А вот тут можно по подробнее плз На каким местах сбоит ? Если можно - строка и текст ошибки

Я слегка подзабил на доделку, т.к решил, что это никому не нужно.

А так займусь доработкой.

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

31

Re: VBScript / WMI : Асинхронный мультипинг

Xameleon пишет:

т.к решил, что это никому не нужно.

Здрастье , я ж писал:

alexii пишет:

…если Вы сделаете описанный Вами вариант, он также пойдёт в ту же ветку Коллекции.

От своих слов не отказываюсь.

mozers пишет:

Просто я предлагаю (независимо от того какое прелестное HTA приложение получится в конце пути) поместить в Коллекцию самый первоначальный код от Евген. Даже не его, а несщадно урезанный его вариант, в котором и заключается все ноухау. "Коллекция" - в первую очередь сборник идей, от которых можно толкаться в своих разработках, а вся идея - тут:

Полностью согласен. Я в #22 тоже выкинул сортировку словаря (из уже созданного просто удаляются лишние ключи), а отслеживал окончание по такому же принципу счётчика, только его декрементом.

2All: В принципе, это ещё не всё, что хотелось бы получить. Асинхронную обработку я делал и с помощью WshRemote, это несложно. Что, на мой взгляд, требуется ещё (и это главное).

Рассмотрим, отвлекаясь от конкретного класса Win32_PingStatus. Представим себе, что нужно сделать обработку 1000, 100000, 1000000000 условных запросов — машина просто ляжет (не факт, как, но, что ляжет, — точно ). То есть, требуется сделать на базе технологии, приведённой в #29, изменение, позволяющее делать подобную обработку порциями, условно по N запросов за раз, затем следующие N запросов, затем ещё, ещё и ещё, пока не будет исчерпан весь список. Сие тоже достаточно несложно реализуемо.

А теперь основное, к чему я веду: сделать практически то же самое, но делать очередной «запрос» сразу, как только закончится обработка какого-либо из запущенных (вот тут WshRemote уже не годится, поскольку в одной обработке нельзя узнать от какого именно объекта WshRemote эта обработка была вызвана; SWbemSink же такую возможность предоставляет). То есть, условно говоря, поддерживать длину очереди обрабатываемых запросов постоянной, равной некоторому условно выбранному значению.

32

Re: VBScript / WMI : Асинхронный мультипинг

2Xameleon
Даже не знаю что ответить... Дело было так:
Запустил приложение, составил список, нажал "Сканировать" - получил алерт "ScanCommandButton_onclick" с текстом ошибки. Недолго думая, залез в код и закомментировал все найденные "On Error Resume Next" (чтобы найти строчку с ошибкой). Запустил - ошибка пропала. Что это было? - неясно...
Так что в настоящее время только не сохраняет список ("SaveCommandButton_onclick", "Safety settings on this computer prohibit accessing a data source on another domain.")
Еще мелочь - при закрытии диалога открытия списка (если файл так и не выбран) выдает "Не удалось загрузить записи. Количество полей не совпадает (0/4)!". Проверить загрузку реального списка не удалось (т.к. не в курсе какой список ему надо).
Применение "ADODB.Recordset" считаю излишним, т.к. и читать и писать прямо в html проще и удобнее, но тут уж каждый использует что ему более привычно. (Написал эту строчку с надеждой на то, что талантливый автор, взявшийся за освоение hta, постепенно будет переходить от неприспособленного для этих дел VBS к DHTML и JS

33

Re: VBScript / WMI : Асинхронный мультипинг

У меня в какой-то момент было предупреждение о том, что отсутствует текущая запись.

34 (изменено: Евген, 2009-10-21 15:33:53)

Re: VBScript / WMI : Асинхронный мультипинг

Всем привет Зашёл сегодня на огонёк, а смотрю - моя тема живет !!! И мало того - активно развивается !
Очень рад Почитал пост alexii

alexii пишет:

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

- ВОТ ЭТО РЕАЛЬНО МЕГАИДЕЯ !!! Причём нужная для конкретно большого массива адресов !!!
идея реализуемая...   
Очень рад что Xameleon присоединился к теме, как освобожусь (видать совсем не скоро ), обязательно подтянусь...

Времени не хватает... :-(

35

Re: VBScript / WMI : Асинхронный мультипинг

Поместил в код в Коллекцию: VBScript: асинхронная обработка множественных запросов WMI.

Добавил чистку терявшихся по дороге «SWbemNamedValueSet» — хоть и мелочь, а неприятно. Отсчёт количества перенёс в идеологически более верную процедуру обработки события «_OnCompleted».

С комментариями у меня что-то туго. Кто-нибудь возьмётся получше откомментировать? А я исправлю.

36

Re: VBScript / WMI : Асинхронный мультипинг

2Евген

alexii написал:
...То есть, условно говоря, поддерживать длину очереди обрабатываемых запросов постоянной, равной некоторому условно выбранному значению.

- ВОТ ЭТО РЕАЛЬНО МЕГАИДЕЯ !!! Причём нужная для конкретно большого массива адресов !!!

Незнаю как насчет "мегаидеи", ИМХО это - твой скрипт + обычная арифметика

arrComputers = Array("google.com", "www.ru", "127.0.0.1", "server", "scite.net.ru", "ya.ru", "script-coding.com", "ixbt.com")
queue_len_max = 3 ' Max размер очереди (сколько компов будут пинговаться одновременно)

Set objService = GetObject("winmgmts:\\.\Root\CIMV2")
Set objSink = WScript.CreateObject("WbemScripting.SWbemSink", "Sink_")
comp_count = UBound(arrComputers): queue_len = 0: i = 0

While (i <= comp_count) Or (queue_len > 0) ' Пингуем пока не кончатся компы и очередь
    If (i <= comp_count) And (queue_len < queue_len_max) Then
        ' -----------------------------------------------------------
        ' WScript.Echo "> [" & i & "] " & arrComputers(i) ' Добавляем очередной комп в очередь для пинга
        Set objContext = CreateObject("WbemScripting.SWbemNamedValueSet")
        objContext.Add "hostname", arrComputers(i)
        objService.ExecQueryAsync objSink, "select * from Win32_PingStatus where address ='" & arrComputers(i) & "'", , , , objContext
        ' -----------------------------------------------------------
        i = i + 1
        queue_len = queue_len + 1
    Else
        WScript.Sleep 100
    End If
Wend
WScript.Quit

' Функция вызывается асинхронно после каждого пинга
Sub Sink_OnObjectReady(objWbemObject, objWbemAsyncContext)
    Set strComputer = objWbemAsyncContext.Item("hostname")
    If objWbemObject.StatusCode = 0 Then
        WScript.Echo strComputer, "On", objWbemObject.ResponseTime & "ms"
    Else
        WScript.Echo strComputer, "Off"
    End If
    queue_len = queue_len - 1
End Sub

37

Re: VBScript / WMI : Асинхронный мультипинг

mozers, спасибо, попробуем.

Евген, коллега mozers совершенно прав — никакой грандиозной идеи тут нет, обычная проверка граничных случаев приводит к такой мысли.

38

Re: VBScript / WMI : Асинхронный мультипинг

2 Xameleon Мне очень понравилась твоя идея с HTA, и внешне - гламурненько получилось, жаль что пока что сбоит...  но уверен ты своего добьёшься.
    Есть пожелание (важное для меня) в твоём случае в таблице HTA в колонке - "Компьютер" - заносится адрес (или имя являющееся адресом), мне бы хотелось чтобы ты ещё добавил колонку описания, поясню зачем... 

Потому что в моём случае мониторить в корпоративной сети надо по IP-шникам (всех в памяти не упомнишь) и эти IP-шники я бы уш и описал (банкомат NNNNN,банкомат NNNNN+1, Терминал NNNNN,Терминал NNNNN+1, Криптошлюз "XXXXX", Сервер "ССССС")

Заранее спасибо...

Времени не хватает... :-(

39 (изменено: Евген, 2009-10-22 10:10:57)

Re: VBScript / WMI : Асинхронный мультипинг

Кстате !!! HTA Xameleon-а заработало !!! (ещё бы столбик с комментом...   плиз...)
Просто лицензии на ComDlg32.ocx посмотрите в инете - и пропишите в реестре...

Тока почему-то у всех адресов мне выдаёт что включено... (*скальпель в студию*)

Времени не хватает... :-(

40

Re: VBScript / WMI : Асинхронный мультипинг

А можно вопросец, каким образом можно определить в указаном выше скрипте количество потерянных пакетов? скорость прохождения - эт хорошо, но если надо увидеть, теряются ли пакеты?!

41

Re: VBScript / WMI : Асинхронный мультипинг

Смотрите сами, что там есть: Win32_PingStatus Class (Windows).

42

Re: VBScript / WMI : Асинхронный мультипинг

спс, там уже смотрел.

43

Re: VBScript / WMI : Асинхронный мультипинг

OFF:

alexii пишет:

... нужно сделать обработку 1000, 100000, 1000000000 условных запросов — машина просто ляжет (не факт, как, но, что ляжет, — точно...

В общем случае, мысль, разумеется, здравая. Однако если не отвлекаться-таки от класса Win32_PingStatus, то, например, при 10000 запросов мой подопытный аппарат - не "лёг". На бо'льшем количестве тестировать было неохота (может быть позже при случае проверю на бо'льших порядках).

44

Re: VBScript / WMI : Асинхронный мультипинг

Dmitrii, спасибо! Сие не может не радовать [меня на высказывание отчасти спровоцировала вот эта тема: VBScript: скрипт для обнаружения в сети компютеров]. Правильнее мне было бы в этом случае выражаться о забитии сети , но, с другой стороны, как я там смотрел при отладке, опрос идёт весьма не шустро (может быть при этом какие-то внутренние механизмы ограничения WMI включаются — не знаю, тут я, как тут принято говорить, совершенно не копенгаген, как сия кухня изнутри устроена ; по внешнему впечатлению — не должно бы забивать сеть).

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

Хотя, конечно, меня в первую очередь интересовала именно сама псевдопараллельная, так сказать, технология, как таковая. Понятно, что есть и чисто физические ограничения на её применение: скажем, нет особого смысла организовывать таким образом псевдопараллельную массовую обработку файлов в пределах одного физического диска — в общем случае выйдет только хуже.

45

Re: VBScript / WMI : Асинхронный мультипинг

2alexii

как можно заранее, в автоматическом режиме, определять её длину в общем случае

Для меня так же непонятно от каких исходных данных отталкиваться для определения этой длины "в автоматическом режиме".
И, простите за назойливость, мой вариант фиксированного задания длины этой очереди, чем не устраивает?

46

Re: VBScript / WMI : Асинхронный мультипинг

mozers, не, коллега, я вовсе не про Ваш код. Ваш вариант вполне устраивает (я ещё не тестировал, но Вы бы не выложили неработающий код). Я вслух ворчу (а надо бы себе под нос) о том же:

mozers пишет:

Для меня так же непонятно от каких исходных данных отталкиваться для определения этой длины "в автоматическом режиме".

47

Re: VBScript / WMI : Асинхронный мультипинг

Добавил скрипт из #36 в Коллекцию. Я его несколько синхронизировал с предыдущим. Если есть замечания — пишите.

48 (изменено: Евген, 2010-03-01 10:32:44)

Re: VBScript / WMI : Асинхронный мультипинг

2 alexii - плиз, если не сложно, выложите Excel - евский файл где-нить для download'а...
никак не могу успокоиться...

Времени не хватает... :-(

49

Re: VBScript / WMI : Асинхронный мультипинг

Евген пишет:

выложите Excel - евский файл где-нить для download'а...

никак не могу успокоиться...

Вы про это, коллега?

50

Re: VBScript / WMI : Асинхронный мультипинг

Да...  именно !!!

Времени не хватает... :-(