1 (изменено: Евген, 2009-10-14 10:47:37)

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

Надо же название какое модное выдумал
Итак, асинхронностью меня зацепило :-) и я тут на днях подумал, и решил не терять своё время, ожидая pong-ов от ping-ов и реализовать данное действо асинхронно

В результате вот что получилось (если можно, то в коллекцию)

arrComputers = Array("strcomp02","strcomp03","strcomp04","strcomp06","strcomp07","strcomp08","strcomp09","strcomp10","strcomp11","strcomp13","strcomp15","strcomp16","strcomp17","strcomp18","strcomp20","strcomp21","strcomp22","strcomp23","strcomp24","strcomp26","strcomp27","strcomp29")
Set objDictionary = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
Set objService = GetObject("winmgmts:\\.\Root\CIMV2")
Set objSink = WScript.CreateObject("WbemScripting.SWbemSink", "Sink_")
bdone = False
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 Not bdone
if objDictionary.Count=ubound(arrComputers)+1 Then
bdone=True
Set file = fso.OpenTextFile("Result.log", 2, True) 
ret=SortDictionary(objDictionary, 1)
For Each strKey in objDictionary.Keys
file.WriteLine strKey & vbtab & objDictionary.Item(strKey)
Next
file.Close
CreateObject ("WScript.shell").run ("notepad Result.log")    ' открытие файла результата
end if
    WScript.Sleep 100
Wend

Sub Sink_OnObjectReady(objWbemObject, objWbemAsyncContext)
Set strComputer = objWbemAsyncContext.Item("hostname")
res=""
  Select Case objWbemObject.StatusCode
    Case 0
      res = "On"
    Case Else
      res = "Off"
  End Select
objDictionary.Add strComputer, res
End Sub


Function SortDictionary(objDict, intSort)

    Const dictKey  = 1
    Const dictItem = 2

    Dim strDict()
    Dim objKey
    Dim strKey,strItem
    Dim X,Y,Z

    Z = objDict.Count

    If Z > 1 Then
      ReDim strDict(Z,2)
      X = 0

      For Each objKey In objDict
          strDict(X,dictKey)  = CStr(objKey)
          strDict(X,dictItem) = CStr(objDict(objKey))
          X = X + 1
      Next

      For X = 0 To (Z - 2)
        For Y = X To (Z - 1)
          If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
              strKey  = strDict(X,dictKey)
              strItem = strDict(X,dictItem)
              strDict(X,dictKey)  = strDict(Y,dictKey)
              strDict(X,dictItem) = strDict(Y,dictItem)
              strDict(Y,dictKey)  = strKey
              strDict(Y,dictItem) = strItem
          End If
        Next
      Next

      objDict.RemoveAll

      For X = 0 To (Z - 1)
        objDict.Add strDict(X,dictKey), strDict(X,dictItem)
      Next

    End If

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

2

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

Евген пишет:

(если можно, то в коллекцию)

Для Коллекции необходимо описание скрипта. Что он делает, как его запускать, каков результат и т.п.

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

3 (изменено: Евген, 2009-10-13 12:57:13)

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

Данный скрипт ОДНОВРЕМЕННО посылает пинги по адресам, указанным в массиве arrComputers
после этого дожидается последнего pong-а (ответа на ping) и как только его получает (все понги хранятся в объекте словаря), то упорядочивает ключи объекта словаря по алфавиту (т.к. pong-и приходят асинхронно, т.е не в порядке отсыла ping-а) и записывает содержимое словаря в текстовый файлик result.log - в удобном для просмотра виде.

Эффективно при мониторинге большого количества сетевой аппаратуры, НАМНОГО !!! быстрее можно получить обшую картину происходящего.

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

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

4

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

Одно сейчас не могу победить как данную строчку скрипта

Set objSink = WScript.CreateObject("WbemScripting.SWbemSink", "Sink_")

перевести на VBA, а имеено, хочу этот скрипт облачить в форму Excel.

Всё дело в том, что "Sink_" VBA принимает за удалённый компьютер

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

5

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

Спасибо.
Прошу проверить выложенный скрипт, кто может.

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

6

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

Народ, плиз, кто-нибудь, протестите работоспособность асинхронного мультипинга из 1-го поста  на своём компе !!!
Нужно подтверждение работоспособности !!!

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

7

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

Евген пишет:

Данный скрипт ОДНОВРЕМЕННО посылает…

Ну, всё ж таки не одновременно. Я бы назвал сие хорошим и привычным словом квазипараллельно или квазиодновременно. Это будет и более честно, и ближе к сути.

Я возьмусь поглядеть и попробовать, возможно, даже завтра.

Евген, попробуйте на этом примере:
VBScript:

Option Explicit

Dim boolDone

Dim objSWbemServicesEx
Dim objSWbemSink


Set objSWbemServicesEx = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objSWbemSink = WScript.CreateObject("WbemScripting.SWbemSink", "Synk_")

objSWbemServicesEx.ExecQueryAsync objSWbemSink, "SELECT * FROM Win32_Process"

boolDone = False

Do
    WScript.Sleep 100
Loop Until boolDone

objSWbemSink.Cancel

Set objSWbemSink       = Nothing
Set objSWbemServicesEx = Nothing

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

'=============================================================================
Sub Synk_OnObjectReady(objSWbemObjectEx, objSWbemAsyncContext)
    WScript.Echo objSWbemObjectEx.Caption & " [" & objSWbemObjectEx.ProcessID & "]"
End Sub
'=============================================================================

'=============================================================================
Sub Synk_OnCompleted(iHResult, objWbemErrorObject, objWbemAsyncContext)
    boolDone = True
End Sub
'=============================================================================

VBA (должна быть установлена ссылка на «Microsoft WMI Scripting Library» посредством \Tools\References…):

Option Explicit

Dim boolDone

Dim objSWbemServicesEx As WbemScripting.SWbemServicesEx
Dim WithEvents objSWbemSink As WbemScripting.SWbemSink

Sub Main()
    Set objSWbemServicesEx = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set objSWbemSink = New WbemScripting.SWbemSink
    
    objSWbemServicesEx.ExecQueryAsync objSWbemSink, "SELECT * FROM Win32_Process"
    
    boolDone = False
    
    Do
        DoEvents
    Loop Until boolDone
    
    objSWbemSink.Cancel
    
    Set objSWbemSink = Nothing
    Set objSWbemServicesEx = Nothing
End Sub

Private Sub objSWbemSink_OnCompleted(ByVal iHResult As WbemScripting.WbemErrorEnum, ByVal objWbemErrorObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
    boolDone = True
End Sub

Private Sub objSWbemSink_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
    Debug.Print objWbemObject.Caption & " [" & objWbemObject.ProcessID & "]"
End Sub

8 (изменено: kiber_punk, 2009-10-14 07:57:56)

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

Отлично! Вот и затравка для многопоточного сетевого сканера.

OFF: сейчас ещё "атипичных" идеек  напридумываем, так и общую производительность труда повысим!

[По поводу кода]

Серьёзнейший недочёт: полное отсутствие комментариев.

Мелкие недочёты:   можно было бы сделать массив arrComputers немного покороче. (да и отделить от основного кода несколькими пустыми строками, для большей наглядности кода)
при неодинаковой длине имён компьютеров ("comp","megacomp","very_long_name_of_comp") напроч пропападает читабельность вывода. [здесь надо будет задействовать подсчёт длины строки имени компа и в соответствии с результатом выделять определённое количество разделителей (tab'ов). ]

..и уже по традиции:
[ ну и до полной "клиники":
ввод имён\адресов  компутеров через InputBox (главная задача будет в совмещении функции Inputbox и Array)
получение имён\адресов  компутеров из внешнего файла-списка, заданного параметром запуска скрипта]

[Проверка скрипта на работоспособность]
Даже при отсутствии подключения к сети, всегда есть выход - localhost
Он всегда имеет целую подсеть (или домен?) "рабочих станций"
127.0.0.1 - уже в печёнках сидит.

В общем первую строку скрипта заменяем на:

arrComputers = array ("localhost","127.12.0.2","offline_comp","127.32.44.69","127.0.22.2","strcomp08","strcomp09","127.55.55.55")

Для автоматизации просмотра результатов (советую подобное делать всегда при отладке скриптов, время сэкономит), последней строкой добавляем:

CreateObject ("WScript.shell").run ("notepad Result.log")

P.S. 2The gray Cardinal, имхо, экзамен сдан.

9 (изменено: Евген, 2009-10-14 07:41:06)

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

2 kiber_punk - спасибо за тесты
2 alexii - спасибо за конс по переводу на VBA

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

10

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

Евген, далеко не уходи
Скрипт-то доделай , исправь недочёты, описание поэстетичней. В таком оформлении для Коллекции не годится.

11 (изменено: Евген, 2009-10-14 09:01:12)

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

Сорри, что может быть кому покажется, что отмазываюсь...

полное отсутствие комментариев. - практически никогда ничего не комментирую (очень-очень редко когда бывает, когда код сильно большой...)

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

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

12

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

2 alexii

В Tool / References поставил ссылку на Microsoft WMI Scripting V1.2 Library
строчка которая ниже - не канает, и самое плохое - к процедурам события не обращается

Dim WithEvents objSWbemSink As WbemScripting.SWbemSink

У Вас работает ?

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

13

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

Евген, а как по поводу "клиники?"
Вторая запись вроде не очень сложна в реализации и намного у простит "интерфейс" взаимодействия со скриптом.

14

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

Евген пишет:

В Tool / References поставил ссылку на Microsoft WMI Scripting V1.2 Library

Правильно.

Евген пишет:

строчка которая ниже - не канает, и самое плохое - к процедурам события не обращается

Евген, Вы вставили полный код из поста #7 как есть и запустили процедуру «Main»? Или попытались перенести строку

Dim WithEvents objSWbemSink As WbemScripting.SWbemSink

внутрь какой-либо процедуры/функции? Какая у Вас версия MS Office?

15 (изменено: Евген, 2009-10-14 10:46:17)

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

вставил как есть и запустил процедуру «Main» - именно так, не правильно ?
Office 2003 SP3

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

16

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

kiber_punk пишет:

Евген, а как по поводу "клиники?"
Вторая запись вроде не очень сложна в реализации и намного у простит "интерфейс" взаимодействия со скриптом.

- ДОБАВЛЕНО !!!

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

17

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

Евген пишет:

вставил как есть и запустил процедуру «Main» - именно так, не правильно ?
Office 2003 SP3

Аналогично, коллега:

System Idle Process [0]
System [4]
smss.exe [748]
csrss.exe [812]
winlogon.exe [836]
services.exe [880]
lsass.exe [892]
svchost.exe [1068]
svchost.exe [1144]
svchost.exe [1184]
svchost.exe [1244]

EXCEL.EXE [3756]
unsecapp.exe [3688]
wmiprvse.exe [3224]

Идей, почему у Вас не отрабатывает, нет.

18

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

Возможно, я понял . Сделайте перед запуском «\View\Immediate window».

19

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

The gray Cardinal пишет:

Прошу проверить выложенный скрипт, кто может.

Евген пишет:

Нужно подтверждение работоспособности

Проверено в домене со 176 станциями. Ошибок не возникло.
Тип запуска сценария: консольный.
Текущие условия: ответило 79 станций, не ответило 97.
Время опроса: 4,48 секунды (с учётом времени, которое понадобилось на вывод сообщений о результатах проверки связи с каждой станцией).
Примечание: массив имён станций формировался автоматически из AD.

Совет автору: добавить в сценарий индикатор хода опроса, чтобы было видно, что процесс "идёт", а не "висит".

20

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

Проверил, работает.

Евген, вопрос: а зачем сортировать словарь? Я думаю, что можно проще — отсортировать массив «arrComputers» в самом начале. Что скажете?

21 (изменено: Dmitrii, 2009-10-14 16:46:37)

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

alexii пишет:

... а зачем сортировать словарь? Я думаю, что можно проще — отсортировать массив «arrComputers» в самом начале...

Хотя вопрос и не ко мне, но, думаю, в данной ситуации неважно, кто ответит.

alexii, здесь сортировка словаря обусловлена асинхронностью приходящих от станций откликов относительно посланных запросов. То есть результирующий список почти неизбежно будет не сортированым.
У меня, например, массив имён станций был отсортирован, а вот в списке результатов была уже "каша".

22

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

Dmitrii, спасибо, ясно. Увы мне, увы , не обратил внимания, что словарь строится внутри «_OnObjectReady». Теперь понятно и с условием окончания.

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

23

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

2 Dmitrii - спасибо что за меня ответил, я просто сейчас пореже буду на форум забегать, просто ASP проект хороший подвернулся...  ещё и ёмкий такой !!!

Разомну мозги как следует...  :-)

2 alexii - получается попозже разберусь с конвертацией скрипта в Excel...  (как всегда времени не хватает )

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

24

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

Евген, далеко не убегайте , у меня ещё вопросы будут.

25

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

Ок...

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

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 : Асинхронный мультипинг

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

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

51

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

Хорошо, вечером попробую вспомнить .

52

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

Заранее благодарен

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

53

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

Прошу: Sample.7z, 6929 байт, MD5: B9B7254DDCD8C98579A7E6BEB0D4654E.

P.S. Я, кажется, понял, в чём дело: Вы вставляли в текст отдельного модуля, а я — в модуль самой рабочей книги .

54 (изменено: Евген, 2010-03-02 08:25:38)

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

Спасибо
Просто супер  
да, я пробовал этот код вставить в отдельный модуль...   в модуль рабочей книги - как-то не догадался... 

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

55 (изменено: Rom5, 2011-11-12 01:31:07)

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

Коллеги, хочу предоставить на тестирование/использование еще одно прикладное применение Вашим наработкам:
"мультипингу" (Евген & mozers - http://forum.script-coding.com/viewtopi … 557#p29557) и работе с HTA из vbs  (Xameleon - http://forum.script-coding.com/viewtopi … 858#p45858).

Идея этого скрипта пинга появилась из-за появляющейся необходимости узнавать айпи-адрес работающей машины, имя которой мы точно знаем, подсеть в которой она находится - можем предположить, но подключиться к машине по имени не получается - DNS-сервера все еще по некоторым причинам резолвят ее имя в какой-то "другой" айпи (по которому отзывается уже совсем другая машина), а с помощью юзера выяснить айпи машины иногда проблематично.
Ранее я использовал медленный перебор всех адресов подсети батником, но сложив идею ассинхронного vbs-пинга с желанием дать пользователю минимальный интерфейс для ввода параметров и отображения результата, наконец-то реализовал это одним vbs-скриптом.

Что делает скрипт:
- создает начальное окошко, в котором нужно указать имя искомой машины и подсеть в виде xxx.yyy.zzz и диапазон пингуемых адресов;
- до старта собственно скана сети есть возможность из окошка запустить cmd-шные ping и nslookup;
- открывает еще одно hta-окно для вывода результатов пинга;
- цикл ассинхронных пинг-запросов по указанным адресам, если от машины отзыв положительный, то делается wmi-запрос определения ее имени (и залогиненного пользователя), если полученное имя совпадает с искомым, то запуск новых пингов прекращается;
- результаты отображаются в окне динамически по ходу цикла, по окончанию пингов для полного завершения работы скрипта - окно лога надо закрыть.

Скриншот стартового окна параметров (данный скан приведен просто для примера, данная машина резолвилась нормально - результат с nslookup совпадает):
http://s2.ipicture.ru/uploads/20111112/nKiYttlG.png

Скриншот окна лога по команде "SCANNING":
http://s2.ipicture.ru/uploads/20111111/JF4Zb61K.png

Сам vbs-скрипт


'----- scanNet.vbs -----------------------------------------------------------------------'
' Ассинхронный пинг указанного диапазона адресов подсети для "срочного" поиска айпи машины,
' которая пока еще не корректно резолвится DNS-серверами.
' Roman, rgv15@list.ru
' по материалам форума:
' работа с HTA - http://forum.script-coding.com/viewtopic.php?pid=45858#p45858'
' "мультипинг  - http://forum.script-coding.com/viewtopic.php?pid=29557#p29557'
' ----- 11.11.2011 --- '

Option Explicit


'--- Значения по-умолчанию'
Dim gsDefaultNet   : gsDefaultNet   = "???.???.???"
Dim gsDefaultIpEnd : gsDefaultIpEnd = "255"
Dim gsDefaultDNS   : gsDefaultDNS   = ""
Dim giMaxPingQuery : giMaxPingQuery = 3 'кол-во в пачке "одновременных" ping-запросов'
'-----

Dim gsNamePC 'глобальная, т.к. будем с ней сравнивать при определении имени системы пропингованного хоста'
gsNamePC = ""

Dim A : Set A=Wscript.Arguments
If A.Count>=1 Then  ' имеется переданный параметр
	gsNamePC = A(0)
End IF

Dim Html, window, document, ExitDo
Dim ExitDoLog : ExitDoLog = True

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

Dim lngQueueCurrLength
Dim giCurrIP 'текущий счетчик-адрес, глобален, т.к. будем менять для выхода из цикла'
Dim giIpEnd 'нужно знать - для выхода из цикла'
Dim documentLog 'глобально, т.к. с разных процедур будем писать в окно лога'


'Формируем тело формы
Html = "<HTML>" & _
    "<HEAD>" & _
    "<TITLE>Настройка пинга подсети</TITLE>" & _
    "<STYLE>" & _
    "*{font-family:Verdana;font-size:11;}" & _
    "</STYLE>" & _
    "</HEAD>" & _
    "<BODY scroll=no bgcolor='D4D0C8' style='border:0;'>" & _
    "<TABLE style='width:100%;'>" & _
    "<TR><TD><b>Имя искомой машины:</b></TD><TD><INPUT id=tNamePC value='"&gsNamePC&"' title='Интересуемое имя машины - для прерывания сканирования'></TD><TR>" & _
    "<TR><TD><b>Подсеть:</b></TD><TD><INPUT id=tIpSubnet value='"&gsDefaultNet&"' title='Начальные 3 группы IP-адреса'></TD><TR>" & _
    "<TR><TD>Начальный адрес *.*.*.___:</TD><TD><INPUT id=tIpStart value='1' title='Адрес, с которого начинам сканирование'></TD><TR>" & _
    "<TR><TD>Завершающий     *.*.*.___:</TD><TD><INPUT id=tIpEnd value='"&gsDefaultIpEnd&"' title='Адрес, на котором заканчиваем сканирование'></TD><TR>" & _
    "<TR><TD>Кол-во `одновременных` запросов:</TD><TD><INPUT id=tMaxPingQuery value='"&giMaxPingQuery&"' title='Максимальное количество одновременно ожидаемых ping-ов'></TD><TR>" & _
    "<TR><TD>Имя DNS-сервера:</TD><TD><INPUT id=tNameDNS value='"&gsDefaultDNS&"' title='Сервер для nslookup'></TD><TR>" & _
    "<TR><TD><BUTTON id=btNSLOOKUP style='width:100%;' title='Выполнение NsLookup.exe к имени машины и указанным сервером'>NsLookup PC</BUTTON></TD>" & _
    "<TD><BUTTON id=btPING style='width:100%;' title='Выполнение ping-а имени машины'>ping -t PC</BUTTON></TD><TR>" & _
    "<TD colspan=2><BUTTON type='submit' id=btOK style='width:100%;' title='Запуск сканирования указанных адресов'>SCANNING</BUTTON></TD></TR>" & _
    "<TD colspan=2 bgcolor='silver'><span id='spnInfo'><hr>Пинг диапазона адресов подсети с определением имен ответивших машин и с остановкой цикла при нахождении указанной машины.</span></TD></TR>" & _
    "</TABLE>" & _
    "</BODY>" & _
    "</HTML>"

Set window = CreateWindow(Html,"contextmenu=no border=dialog maximizebutton=no minimizebutton=no",,,410,340)

'Проверяем, создалось ли окно
if window is Nothing Then
    msgbox "Не удалось создать окно !",vbCritical
    WScript.Quit
End if

'Получаем ссылку на документ в окне
set document = window.document

document.all.tNamePC.focus() 'для удобства изначально даем фокус полю ввода имени машины'

'Подключаем событие выгрузки формы
document.body.onunload = GetRef("window_onunload")

'подключаем событие нажания на кнопку btNSLOOKUP к запуску теста хоста NsLookup
window.btNSLOOKUP.onclick = GetRef("startCmdNSLOOKUP")
Sub startCmdNSLOOKUP
    Dim sNamePC, sNameDNS, WshShell
    sNamePC = window.tNamePC.value
    sNameDNS = window.tNameDNS.value
    If Len(sNamePC)>0 Then
        Set WshShell = CreateObject("WScript.Shell")
        Dim objScriptExec, strResults
        Set objScriptExec = WshShell.Exec("%comspec% /c nslookup " & sNamePC & " " & sNameDNS) 
        strResults = objScriptExec.StdOut.ReadAll & "<br><font color='red'>" & objScriptExec.StdErr.ReadAll & "</font>"
        Set objScriptExec = Nothing
        Set WshShell = Nothing
        window.document.all.spnInfo.innerHTML = strResults
    else
        window.alert("Не указано имя машины.")
    End IF
End Sub

'подключаем событие нажания на кнопку btPING к запуску теста хоста бесконечныи пингом
window.btPING.onclick = GetRef("startCmdPing")
Sub startCmdPing
    Dim sNamePC, WshShell
    sNamePC = window.tNamePC.value
    If Len(sNamePC)>0 Then
        Set WshShell = CreateObject("WScript.Shell")
        WshShell.Run "%comspec% /c ping -t " & sNamePC & " &Echo.&Pause&Exit", 1
        Set WshShell = Nothing
    else
        window.alert("Не указано имя машины.")
    End IF
End Sub


'подключаем событие нажания на кнопку btOK к нашей процедуре начала сканирования
window.btOK.onclick = GetRef("startScan")
Sub startScan
    Dim sIpSubnet, iIpStart
    gsNamePC  = UCase(Trim(window.tNamePC.value))
    sIpSubnet = Trim(window.tIpSubnet.value)
    iIpStart  = CInt(window.tIpStart.value)
    giIpEnd   = CInt(window.tIpEnd.value)
    giMaxPingQuery = CInt(window.tMaxPingQuery.value)
    If iIpStart > giIpEnd Then
        window.alert("Некорректно указаны начало и конец диапазона")
        exit sub
    End IF
    If InStr(sIpSubnet,"?")>0 Then
        window.alert("Не указан адрес тестируемой сети")
        exit sub
    End IF
    
		Dim gt_spnDetTimeStart : gt_spnDetTimeStart = Now()

    Dim HtmlLOG 'Окно протокола должно скроллиться'
    HtmlLOG = "<HTML>" & _
        "<HEAD>" & _
        "<TITLE>Протокол пинга подсети</TITLE>" & _
        "<STYLE>" & _
        "*{font-family:Verdana;font-size:10;}" & _
        "</STYLE>" & _
        "</HEAD>" & _
        "<BODY scroll=yes style='border:0;'><div id='divLog'></div><hr>" & _
				"<BUTTON type='submit' id=btClose style='width:100%;' title='Close window' onclick='window.close();'>Exit</BUTTON>" & _
        "</BODY>" & _
        "</HTML>"
    Dim windowLog
    Set windowLog = CreateWindow(HtmlLog,"showintaskbar=yes",,,460,680)
    'Проверяем, создалось ли окно
    if windowLog is Nothing Then
        msgbox "Не удалось создать окно !",vbCritical
        WScript.Quit
    End if
		
    'Получаем ссылку на документ в окне
    set documentLog = windowLog.document
		
		ExitDoLog = False
		'Подключаем событие выгрузки формы
		documentLog.body.onunload = GetRef("windowLog_onunload")
		
    Dim str : str = ""
    str = "<p align=center>Scanning " & sIpSubnet & "." & Cstr(iIpStart) & " ... " & Cstr(giIpEnd) & " / " & CStr(giMaxPingQuery)
    If Len(gsNamePC)>0 Then str = str & "  Find: " & gsNamePC
    documentLog.all.divLog.innerHTML = str & "</p><hr>" 

    Dim objSWbemServicesEx
    Dim objSWbemSink
    Dim objSWbemNamedValueSet
    Dim lngQueueMaxLength

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

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

    While (giCurrIP <= giIpEnd) Or (lngQueueCurrLength > 0) ' Пингуем пока не кончатся компы и очередь
        If (giCurrIP <= giIpEnd) And (lngQueueCurrLength < lngQueueMaxLength) Then
            ' Добавляем очередной комп в очередь для пинга
            str = sIpSubnet & "." & CStr(giCurrIP) 'формируем очередной ip-адрес'
            documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & _
                "<b>[" & giCurrIP - iIpStart + 1 & "] " & str & "</b><br>"
        
            ' В коллекции «objSWbemNamedValueSet» будем передавать адрес/имя хоста (замечание: в данном конкретном случае
            ' сие, в принципе, необязательно, поскольку класс Win32_PingStatus и так содержит
            ' свойство «.Address», но тут показана сама технология передачи данных в процедуру асинхронной обработки)
            Set objSWbemNamedValueSet = WScript.CreateObject("WbemScripting.SWbemNamedValueSet")
            objSWbemNamedValueSet.Add "HostName", str
        
            ' Все запросы будут обрабатываться в единственной процедуре обработки
            objSWbemServicesEx.ExecQueryAsync objSWbemSink, "SELECT * FROM Win32_PingStatus WHERE ADDRESS = '" & _
                str & "'", , , , objSWbemNamedValueSet
        
            giCurrIP = giCurrIP + 1
            lngQueueCurrLength = lngQueueCurrLength + 1
        Else
            ' Ожидаем, пока не будут обработаны все асинхронные запросы
            WScript.Sleep 100
        End If
    Wend

    objSWbemSink.Cancel

    Set objSWbemSink       = Nothing
    Set objSWbemServicesEx = Nothing
    
    documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & "<hr>End Scan. Time: " &_
			CStr(FormatNumber( (Now() - gt_spnDetTimeStart) * 100000, 6))
		documentLog.all.btClose.focus()
		
		window.close
End Sub

'=============================================================================
' From http://forum.script-coding.com/viewtopic.php?id=3739
' Процедура асинхронной обработки экземпляра объекта (замечание: в данном конкретном случае
' будет возвращаться единственный объект, однако, в большинстве случаев запросы
' возвращают множество объектов)
Sub Sink_OnObjectReady(objWbemObject, objWbemAsyncContext)
	Dim strComputer
	strComputer = objWbemAsyncContext.Item("HostName")
    
	If Not IsNull(objWbemObject.StatusCode) Then
		If objWbemObject.StatusCode = 0 Then
			'--- определяем имя машины и пользователя'
			Dim sNamePC : sNamePC = ""
			Dim sUsrLogin : sUsrLogin = ""
			Dim objWMIService : Dim colItems : Dim objItem
			On Error Resume Next
			Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
			If Err.Number <> 0 Then
				sNamePC = "<strong><i>Error WMI</i></strong>"
			else
				Set colItems = objWMIService.ExecQuery ("SELECT * FROM Win32_ComputerSystem", "WQL", _
					wbemFlagReturnImmediately + wbemFlagForwardOnly)
				For Each objItem In colItems
					sNamePC = objItem.Caption
					If IsNull(sNamePC) OR Len(sNamePC)=0 Then 'возможно данный хост - не Win-System'
						sNamePC = "<i>no System name Or Access denied.</i>"
					Else
						If IsNull(objItem.UserName) Then 
							sUsrLogin="IsNull(UserName)"
						else
							sUsrLogin = "user:" & objItem.UserName
						End IF
						sUsrLogin = "("&sUsrLogin&")."
						If UCase(sNamePC)=gsNamePC Then '--- поиск завершен!'
							documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & _
								"<font color='darkred'>" & gsNamePC & " finded!</font><br>"
							giCurrIP = giIpEnd + 2 ' для досрочного выхода из цикла'
						End IF
						sNamePC = "<u>" & sNamePC & "</u> " & sUsrLogin
					End IF
				Next
			End IF 'Err.Number <> 0'
			On Error GoTo 0
			documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & _
				"<font color='Blue'><u>" & strComputer & "</u> On -- " & sNamePC  & "</font><br>"
			Set colItems = Nothing
			Set objWMIService = Nothing
		Else
			documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & strComputer & " Off<br>"
		End If
	Else
		documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & strComputer & " Not found.<br>"
	End If
	documentLog.all.btClose.focus()
End Sub

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

'=============================================================================
'Событие закрытия формы
Sub window_onunload()
    ExitDo = True
End Sub

'Запускаем цикл ожидания, чтобы скрипт не завершался, а ждал обработки событий
Do
    WScript.Sleep 100
Loop Until ExitDo

'Событие закрытия формы
Sub windowLog_onunload()
    ExitDoLog = True
End Sub

Do
    WScript.Sleep 100
Loop Until ExitDoLog


MsgBox "Выполнение скрипта завершено.",vbInformation

'=============================================================================
' FROM: http://forum.script-coding.com/viewtopic.php?pid=45858#p45858
Function CreateWindow(content,features,x,y,width,height)
    On Error Resume Next
    Dim ShellWindows,ShellWindow,CodeForLinking,wshExec,form_id,id,i,document,window
    Set CreateWindow = Nothing
    Set ShellWindows = CreateObject("Shell.Application").Windows: Randomize: id = Clng(Rnd*100000)
    CodeForLinking = "<script>moveTo(-1000,-1000);resizeTo(0,0);</script>" &_
    "<hta:application " & features & " />" & _
    "<object id=" & id & " style='display:none' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2' viewastext><param name=RegisterAsBrowser value=1></object>"
    Set wshExec = CreateObject("WScript.Shell").Exec("mshta about:""" & CodeForLinking & """")
    For i=1 to 2000
        For Each ShellWindow in ShellWindows: form_id = Clng(ShellWindow.id)
            if form_id = id Then
                Set document = ShellWindow.container:
                Set window = document.parentWindow
                document.open: window.execScript "var Host": Set window.Host = me
                document.write content: document.close
                if x <= 0 Then x = (window.screen.width - width) / 2
                if y <= 0 Then y = (window.screen.height - height) / 2
                window.execScript "document.onkeydown = function(){if(event.keyCode == 116){return false}};" &_
                "setInterval('var e;try{Host.WScript}catch(e){close()}',100);moveTo(" & x & "," & y & ");resizeTo(" & width & "," & height & ")"
                Set CreateWindow = window
                Exit Function
            End if
        Next
    Next
    wshExec.Terminate()
End Function

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

WBR. Roman

56

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

Сделано культурненько. Все работает как задумано.
Правда цель использования несколько странновата: "DNS-сервера все еще по некоторым причинам резолвят ее имя в какой-то другой айпи". Если бы у меня такое приключилось, то я в первую очередь стал бы заниматься DNS сервером, а не писать скрипты, находящие машину в обход DNS.
Но тут мы обсуждаем не нетипичную ситуацию, а скрипт. А скрипт - отличный

57

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

OFF:

mozers пишет:

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

Именно! Я ранее промолчал, дабы не портить впечатление от самой идеи, но по сути замечание абсолютно верное — надо смотреть, что не так с сервером и с клиентскими машинами.

58

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

alexii пишет:

OFF:

mozers пишет:

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

Именно! Я ранее промолчал, дабы не портить впечатление от самой идеи, но по сути замечание абсолютно верное — надо смотреть, что не так с сервером и с клиентскими машинами.

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

WBR. Roman

59

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

OFF:

Rom5 пишет:

К управлению серверами я отношения в нашей конторе не имею. Просто мне и коллегам моего отдела приходится принимать тот факт…

Что тут скажешь?! Как обычно — «Это печально ».

60 (изменено: Rom5, 2012-01-29 02:18:36)

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

alexii пишет:

OFF:

Rom5 пишет:

К управлению серверами я отношения в нашей конторе не имею. Просто мне и коллегам моего отдела приходится принимать тот факт…

Что тут скажешь?! Как обычно — «Это печально ».

Еще один "печальный" момент - не прохождение между сетями UDP-пакета для "Wake-Up On Lan" вынудило добавить в скрипт поиска wmi-пингом в сети интересующей машины еще и такой вариант поиска - скрипт останавливает запуск пингов после первой же "удовлетворительно" ответившей станции.

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

Хочу еще кое-что дорисовать, но текущий вариант скрипта и описание к нему можно увидеть по ссылке - scannet-vbs

ps. А "будить" машины приходится так: ищу в базе SCCM мак-адрес выключеной машины, редактирую соответствующим образом батник запуска wolcmd.exe, ищу скриптом доступную машину - скрипт автоматом берет адрес ее подсети из ответа nslookup, забрасываю на машину батник и wolcmd, захожу на нее "телнетным" cmd.exe (стартую его через PsExec.exe) и запускаю батник, который после отправки пакета по мак-адресу запускает еще и бесконечный пинг ожидаемой станции.

WBR. Roman

61 (изменено: Rom5, 2012-02-18 13:17:50)

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

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

Вывод в окно на тот момент осуществлялся набором конструкций типа:

documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & strComputer & " Off<br>"

Были сделаны такие попытки "лечения" - все конструкции вывода замещены вызовом дополнительной функции, а в самой функции сначала пытался сделать паузу по наличию признака (по выставляемому значению глобальной переменной), но это приводило к непредсказуемым зацикливаниям ожидания вывода, потом решил поместить на страницу таблицу и функцией вывода инсертить в нее новые строки, в строки - ячейки и уже в добавленной ячейке менять содержимое - "затерания" прекратились, но вывод скриптом стал намного тормознутее, кстати, возможно через эту "тормознутость" данные и не терялись)

Сейчас сделал вывод специальным методом insertAdjacentHTML - добавления своего кода в существующий:

documentLog.all.divLog.insertAdjacentHTML "beforeEnd", "втавляемый HTML-код"

О, чудо! Работа скрипта ощутимо ускорилась даже в сравнении с первоначальным вариантом. Испытания на предмет "затерания" данных не проводились еще - дома в сетке нет тридцати хостов)

Вот, новый код скрипта "scanNet.vbs":

'----- scanNet.vbs -----------------------------------------------------------------------'
' Ассинхронный пинг указанного диапазона адресов подсети для "срочного" поиска айпи машины,
' которая пока еще не корректно резолвится DNS-серверами.
' Roman.Gerashchenko@otpbank.com.ua, rgv15@list.ru
' по материалам форума http://forum.script-coding.com/viewtopic.php?id=4196'
' 18.02.2012'
'  !  изменение метода вывода в окно протокола для избежания "затерания" его содержимого'
' 27.01.2012 
'  +  определение и установка адреса сети при обработке результатов nslookup
'  +  при старте скана без установленого адреса сети, но с имеющимся именем машина - авт.запуск nslookup'
'  +  настройка прекращения скана на первой же доступной машине сети'

Option Explicit


'--- Значения по-умолчанию'
Dim gsDefaultNet   : gsDefaultNet   = "???.???.???"
Dim gsDefaultIpEnd : gsDefaultIpEnd = "255"
Dim gsDefaultDNS   : gsDefaultDNS   = "UAAAD01" 'используется командой NSLOOKUP'
Dim giMaxPingQuery : giMaxPingQuery = 6 'кол-во в пачке "одновременных" ping-запросов'
'-----

Dim gsNamePC 'глобальная, т.к. будем с ней сравнивать при определении имени системы пропингованного хоста'
gsNamePC = ""

Dim A : Set A=Wscript.Arguments
If A.Count>=1 Then  ' имеется переданный параметр
	gsNamePC = A(0)
End IF

Dim Html, window, document, ExitDo
Dim ExitDoLog : ExitDoLog = True

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

Dim lngQueueCurrLength
Dim giCurrIP 'текущий счетчик-адрес, глобален, т.к. будем менять для выхода из цикла'
Dim giIpEnd 'нужно знать - для выхода из цикла'
Dim documentLog 'глобально, т.к. с разных процедур будем писать в окно лога'
Dim glStopping : glStopping = False 'признак необходимости прекращения скана по нахождению доступной машины'
Dim glCancel   : glCancel = False 'признак прекращения цикла скана (условия поиска были достигнуты)'
Dim giStatusAll : giStatusAll = 0 'кол-во адресов для пинга'
Dim giStatusPinged : giStatusPinged = 0 'кол-во адресов, пинг на которые был отправлен'
Dim giStatusPonged : giStatusPonged = 0 'кол-во адресов, понг от которых был получен'



'Формируем тело формы
Html = "<HTML>" & _
    "<HEAD>" & _
    "<TITLE>Настройка пинга подсети</TITLE>" & _
    "<STYLE>" & _
    "*{font-family:Verdana;font-size:11;}" & _
    "</STYLE>" & _
    "</HEAD>" & _
    "<BODY scroll=no bgcolor='D4D0C8' style='border:0;'>" & _
    "<TABLE style='width:100%;'>" & _
    "<TR><TD><b>Имя искомой машины:</b></TD><TD><INPUT id=tNamePC value='"&gsNamePC&"' title='Интересуемое имя машины - для прерывания сканирования'></TD><TR>" & _
    "<TR><TD><b>Подсеть:</b></TD><TD><INPUT id=tIpSubnet value='"&gsDefaultNet&"' title='Начальные 3 группы IP-адреса'></TD><TR>" & _
    "<TR><TD>Начальный адрес *.*.*.___:</TD><TD><INPUT id=tIpStart value='1' title='Адрес, с которого начинам сканирование'></TD><TR>" & _
    "<TR><TD>Завершающий     *.*.*.___:</TD><TD><INPUT id=tIpEnd value='"&gsDefaultIpEnd&"' title='Адрес, на котором заканчиваем сканирование'></TD><TR>" & _
    "<TR><TD>Кол-во `одновременных` запросов:</TD><TD><INPUT id=tMaxPingQuery value='"&giMaxPingQuery&"' title='Максимальное количество одновременно ожидаемых ping-ов'></TD><TR>" & _
    "<TR><TD>Имя DNS-сервера:</TD><TD><INPUT id=tNameDNS value='"&gsDefaultDNS&"' title='Сервер для nslookup'></TD><TR>" & _
    "<TR><TD>Останов на первом доступном компьютере:</TD><TD><INPUT type=checkbox id=cbStop title='Останов сканирования при нахождении не интересуемой машины, а первой доступной'></TD><TR>" & _
    "<TR><TD><BUTTON id=btNSLOOKUP style='width:100%;' title='Выполнение NsLookup.exe к имени машины и указанным сервером'>NsLookup PC</BUTTON></TD>" & _
    "<TD><BUTTON id=btPING style='width:100%;' title='Выполнение ping-а имени машины'>ping -t PC</BUTTON></TD><TR>" & _
    "<TD colspan=2><BUTTON type='submit' id=btOK style='width:100%;' title='Запуск сканирования указанных адресов'>SCANNING</BUTTON></TD></TR>" & _
    "<TD colspan=2 bgcolor='silver'><span id='spnInfo'><hr>Пинг диапазона адресов подсети с определением имен ответивших машин и с остановкой цикла при нахождении указанной машины.</span></TD></TR>" & _
    "</TABLE>" & _
    "</BODY>" & _
    "</HTML>"

Set window = CreateWindow(Html,"contextmenu=no border=dialog maximizebutton=no minimizebutton=no",,,410,360)

'Проверяем, создалось ли окно
if window is Nothing Then
    msgbox "Не удалось создать окно ! Запустите скрипт еще раз.",vbCritical
    WScript.Quit
End if

'Получаем ссылку на документ в окне
set document = window.document

document.all.tNamePC.focus() 'для удобства изначально даем фокус полю ввода имени машины'

'Подключаем событие выгрузки формы
document.body.onunload = GetRef("window_onunload")

'подключаем событие нажания на кнопку btNSLOOKUP к запуску теста хоста NsLookup
window.btNSLOOKUP.onclick = GetRef("startCmdNSLOOKUP")
Sub startCmdNSLOOKUP
    Dim sNamePC, sNameDNS, WshShell
    sNamePC = window.tNamePC.value
    sNameDNS = window.tNameDNS.value
    If Len(sNamePC)>0 Then
        Set WshShell = CreateObject("WScript.Shell")
        Dim objScriptExec, strResults, strOK
        Set objScriptExec = WshShell.Exec("%comspec% /c nslookup " & sNamePC & " " & sNameDNS)
				strOK = objScriptExec.StdOut.ReadAll
        strResults = strOK & "<br><font color='red'>" & objScriptExec.StdErr.ReadAll & "</font>"
        Set objScriptExec = Nothing
        Set WshShell = Nothing
				Dim iPos, sMsg, sAdrIP, sNetIP
				sNetIP = ""
				iPos = InStr(strOK, "Name:")
				If iPos>0 Then
					sMsg = Right(strOK, Len(strOK) - iPos - 4)
					'выделяем из строки айпи'
					sAdrIP = ""
					iPos = InStr(sMsg, "Address:")
					If iPos>0 Then
						sAdrIP = Right(sMsg, Len(sMsg) - iPos - 8)
						sAdrIP = Replace(sAdrIP," ","")
						sAdrIP = Replace(sAdrIP,vbCrLf,"")
						strResults = Replace( strResults, sAdrIP, "<b>" & sAdrIP & "</b>")
						'выделяем из адреса машины адрес сети'
						sNetIP = Left(sAdrIP, InStrRev(sAdrIP, ".") - 1 )
					End If
				End IF
        window.document.all.spnInfo.innerHTML = strResults
				If Len(sNetIP)>0 And sNetIP<>window.tIpSubnet.value Then
					If MsgBox ("Из nslookup-адреса машины (" & sAdrIP & ") был выделен адрес сети: " & sNetIP & vbCr & vbCr & _
						"Устанавливаем его в качестве сканируемой сети ?", vbQuestion+vbOKCancel, "Адрес сети")=vbOK Then
						window.tIpSubnet.value = sNetIP
					End IF
				End IF
    else
        window.alert("Не указано имя машины.")
    End IF
End Sub

'подключаем событие нажания на кнопку btPING к запуску теста хоста бесконечныи пингом
window.btPING.onclick = GetRef("startCmdPing")
Sub startCmdPing
    Dim sNamePC, WshShell
    sNamePC = window.tNamePC.value
    If Len(sNamePC)>0 Then
        Set WshShell = CreateObject("WScript.Shell")
        WshShell.Run "%comspec% /c ping -t " & sNamePC & " &Echo.&Pause&Exit", 1
        Set WshShell = Nothing
    else
        window.alert("Не указано имя машины.")
    End IF
End Sub

'подключаем событие нажания на кнопку btOK к нашей процедуре начала сканирования
window.btOK.onclick = GetRef("startScan")
Sub startScan
		glCancel = False
    Dim sIpSubnet, iIpStart
    gsNamePC  = UCase(Trim(window.tNamePC.value))
    sIpSubnet = Trim(window.tIpSubnet.value)
    iIpStart  = CInt(window.tIpStart.value)
    giIpEnd   = CInt(window.tIpEnd.value)
		giStatusAll = giIpEnd - iIpStart + 1
    giMaxPingQuery = CInt(window.tMaxPingQuery.value)
		glStopping = window.cbStop.checked
    If iIpStart > giIpEnd Then
        window.alert("Некорректно указаны начало и конец диапазона")
        exit sub
    End IF
    If InStr(sIpSubnet,"?")>0 Then
        window.alert("Не указан адрес тестируемой сети")
				If Len(gsNamePC)>0 Then 'т.к. машина указана, то запускаем NSLOOKUP для определения сети'
					startCmdNSLOOKUP
					sIpSubnet = Trim(window.tIpSubnet.value)
					If InStr(sIpSubnet,"?")>0 Then exit sub 'сеть так и не указали'
				else
					exit sub
				End IF
    End IF
    
		Dim gt_spnDetTimeStart : gt_spnDetTimeStart = Now()
				
    Dim HtmlLOG 'Окно протокола должно скроллиться'
    HtmlLOG = "<HTML>" & _
        "<HEAD>" & _
        "<TITLE>Протокол пинга подсети</TITLE>" & _
        "<STYLE>" & _
        "*{font-family:Verdana;font-size:10;}" & _
        "</STYLE>" & _
        "</HEAD>" & _
        "<BODY scroll=yes style='border:0;'><div id='divLog'></div><hr>" & _
				"<table id='tblLog' width='100%' cellpadding='0' cellspacing='0' border='0'></table>" & _
        "<div id='divStatus' style='color:darkred;'></div>" & _
				"<BUTTON type='submit' id=btClose style='width:100%;' title='Close window' onclick='window.close();'>Close Log</BUTTON>" & _
        "</BODY>" & _
        "</HTML>"
    Dim windowLog
    Set windowLog = CreateWindow(HtmlLog,"showintaskbar=yes",,,460,680)
    'Проверяем, создалось ли окно
    if windowLog is Nothing Then
        msgbox "Не удалось создать окно !",vbCritical
        WScript.Quit
    End if
		
    'Получаем ссылку на документ в окне
    set documentLog = windowLog.document
		
		ExitDoLog = False
		'Подключаем событие выгрузки формы
		documentLog.body.onunload = GetRef("windowLog_onunload")
		
    Dim str : str = ""
    str = "<p align=center>Scanning " & sIpSubnet & "." & Cstr(iIpStart) & " ... " & Cstr(giIpEnd) & " / " & CStr(giMaxPingQuery)
		uf_addStrLog str & "</p><hr>" 

    Dim objSWbemServicesEx
    Dim objSWbemSink
    Dim objSWbemNamedValueSet
    Dim lngQueueMaxLength

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

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

    While ((giCurrIP <= giIpEnd) Or (lngQueueCurrLength > 0)) AND (glCancel=False)' Пингуем пока не кончатся компы и очередь
        If ((giCurrIP <= giIpEnd) And (lngQueueCurrLength < lngQueueMaxLength)) AND (glCancel=False) Then
            ' Добавляем очередной комп в очередь для пинга
						
						' Наращивание счетчиков и отображение статуса'
						giStatusPinged = giStatusPinged + 1  
						documentLog.all.divStatus.innerHTML = CStr(giStatusPonged) & " / " & CStr(giStatusPinged) & " / " & CStr(giStatusAll)
            str = sIpSubnet & "." & CStr(giCurrIP) 'формируем очередной ip-адрес'
						uf_addStrLog "<b>[" & CStr(giStatusPinged) & "] " & str & "</b><br>"
        
            ' В коллекции «objSWbemNamedValueSet» будем передавать адрес/имя хоста (замечание: в данном конкретном случае
            ' сие, в принципе, необязательно, поскольку класс Win32_PingStatus и так содержит
            ' свойство «.Address», но тут показана сама технология передачи данных в процедуру асинхронной обработки)
            Set objSWbemNamedValueSet = WScript.CreateObject("WbemScripting.SWbemNamedValueSet")
            objSWbemNamedValueSet.Add "HostName", str
        
            ' Все запросы будут обрабатываться в единственной процедуре обработки
            objSWbemServicesEx.ExecQueryAsync objSWbemSink, "SELECT * FROM Win32_PingStatus WHERE ADDRESS = '" & _
                str & "'", , , , objSWbemNamedValueSet
        
            giCurrIP = giCurrIP + 1
            lngQueueCurrLength = lngQueueCurrLength + 1
        Else
            ' Ожидаем, пока не будут обработаны все асинхронные запросы
            WScript.Sleep 100
        End If
    Wend

    objSWbemSink.Cancel

    Set objSWbemSink       = Nothing
    Set objSWbemServicesEx = Nothing
    
		uf_addStrLog "<hr>End Scan. Time: " & CStr(FormatNumber( (Now() - gt_spnDetTimeStart) * 100000, 4))
		
		window.close
End Sub

'=============================================================================
' From http://forum.script-coding.com/viewtopic.php?id=4196
' Процедура асинхронной обработки экземпляра объекта (замечание: в данном конкретном случае
' будет возвращаться единственный объект, однако, в большинстве случаев запросы
' возвращают множество объектов)
Sub Sink_OnObjectReady(objWbemObject, objWbemAsyncContext)
	Dim strComputer
	strComputer = objWbemAsyncContext.Item("HostName")
	giStatusPonged = giStatusPonged + 1
	documentLog.all.divStatus.innerHTML = CStr(giStatusPonged) & " / " & CStr(giStatusPinged) & " / " & CStr(giStatusAll)
	Dim lFinded : lFinded = False
    
	If Not IsNull(objWbemObject.StatusCode) Then
		If objWbemObject.StatusCode = 0 Then
			'--- определяем имя машины и пользователя'
			Dim sNamePC : sNamePC = ""
			Dim sUsrLogin : sUsrLogin = ""
			Dim sTmp : sTmp = ""
			Dim objWMIService : Dim colItems : Dim objItem
			On Error Resume Next
			Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
			If Err.Number <> 0 Then
				sNamePC = "<strong><i>Error WMI</i></strong>"
			else
				Set colItems = objWMIService.ExecQuery ("SELECT * FROM Win32_ComputerSystem", "WQL", _
					wbemFlagReturnImmediately + wbemFlagForwardOnly)
				For Each objItem In colItems
					sNamePC = objItem.Caption
					If IsNull(sNamePC) OR Len(sNamePC)=0 Then 'возможно данный хост - не Win-System'
						sNamePC = "<i>no System name Or Access denied.</i>"
						uf_addStrLog "<font color='red'><b>" & sNamePC & "</b></font>"
					Else
						If IsNull(objItem.UserName) Then 
							sUsrLogin="IsNull(UserName)"
						else
							sUsrLogin = "user:" & objItem.UserName
						End IF
						sUsrLogin = "("&sUsrLogin&")."
						If UCase(sNamePC)=gsNamePC Then '--- поиск завершен!'
							uf_addStrLog "<hr><div style='background-color: white; color:green;'><b>" & gsNamePC & " finded!</b></div>"
							lFinded = True
							glCancel = True
						End IF
						sNamePC = "<u>" & sNamePC & "</u> " & sUsrLogin
						If glStopping Then 'был признак остановки на ближайшей доступной машине'
							uf_addStrLog "<font color='darkgreen'><b>Accessible computer finded.</b></font><hr>"
							glStopping = False
							glCancel = True
						End IF
					End IF
				Next
			End IF 'Err.Number <> 0'
			On Error GoTo 0
			If lFinded Then 'завершение выделяющего блока'
				uf_addStrLog "<div style='background-color: beige; color:darkred;'><u>" & strComputer & "</u> On -- " & sNamePC  & "</div><hr>"
			else
				uf_addStrLog "<span style='background-color: white; color:Blue;'><u>" & strComputer & "</u> On -- " & sNamePC  & "</span><br>"
			End IF
			Set colItems = Nothing
			Set objWMIService = Nothing
		Else
			uf_addStrLog strComputer & " Off<br>"
		End If
	Else
		uf_addStrLog strComputer & " Not found.<br>"
	End If
	
End Sub

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

'=============================================================================
'Событие закрытия формы
Sub window_onunload()
    ExitDo = True
End Sub

'Запускаем цикл ожидания, чтобы скрипт не завершался, а ждал обработки событий
Do
    WScript.Sleep 100
Loop Until ExitDo

'Событие закрытия формы
Sub windowLog_onunload()
    ExitDoLog = True
End Sub

Do
    WScript.Sleep 100
Loop Until ExitDoLog


' MsgBox "Выполнение скрипта завершено.",vbInformation

'=============================================================================
'from -- http://forum.script-coding.com/viewtopic.php?pid=34583#p34583'
Function CreateWindow(content,features,x,y,width,height)
    On Error Resume Next
    Dim ShellWindows,ShellWindow,CodeForLinking,wshExec,form_id,id,i,document,window
    Set CreateWindow = Nothing
    Set ShellWindows = CreateObject("Shell.Application").Windows: Randomize: id = Clng(Rnd*100000)
    CodeForLinking = "<script>moveTo(-1000,-1000);resizeTo(0,0);</script>" &_
    "<hta:application " & features & " />" & _
    "<object id=" & id & " style='display:none' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2' viewastext><param name=RegisterAsBrowser value=1></object>"
    Set wshExec = CreateObject("WScript.Shell").Exec("mshta about:""" & CodeForLinking & """")
    For i=1 to 2000
        For Each ShellWindow in ShellWindows: form_id = Clng(ShellWindow.id)
            if form_id = id Then
                Set document = ShellWindow.container:
                Set window = document.parentWindow
                document.open: window.execScript "var Host": Set window.Host = me
                document.write content: document.close
                if x <= 0 Then x = (window.screen.width - width) / 2
                if y <= 0 Then y = (window.screen.height - height) / 2
                window.execScript "document.onkeydown = function(){if(event.keyCode == 116){return false}};" &_
                "setInterval('var e;try{Host.WScript}catch(e){close()}',100);moveTo(" & x & "," & y & ");resizeTo(" & width & "," & height & ")"
                Set CreateWindow = window
                Exit Function
            End if
        Next
    Next
    wshExec.Terminate()
End Function

'--- Вывод полученной строки в окно протокола -------------------------'
Function uf_addStrLog( pStr )
	'--- специальный метод вставки нового кода в существующий код элемента'
	'--beforeEnd - будет вставлен перед закрывающим тегом текущего элемента страницы (но после всего содержимого тега);'
	documentLog.all.divLog.insertAdjacentHTML "beforeEnd", pStr 
	'фокус переносим на кнопку - для скроллинга'
	documentLog.all.btClose.focus()
End Function

Описание к скритпу все так же можно увидеть по ссылке -  sites.google.com/site/scripttools/home/scannet-vbs

WBR. Roman

62

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

Коллеги, так приятно !!!
Первый пост в данной теме я сделал 2009-10-13 15:04:39 !!!
А тема всё ещё жива и актуальна !!!
Очень приятно, что кому-то это пригодилось

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

63

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

Rom5 пишет:

О, чудо! big_smile Работа скрипта ощутимо ускорилась…

Естественно.

64

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

Сейчас глянул код. Не понял, почему сразу в HTA нельзя было собрать ? Экономия кода же очень существенная будет ?

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

65

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

Xameleon, изначально демонстрировалась сама идея возможности асинхронного подхода в чистом виде. Ну, а пинг — наиболее яркий пример практической демонстрации.

66

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

Xameleon пишет:

Не понял, почему сразу в HTA нельзя было собрать ?

Желание реализовать в HTA у меня было сразу, но если честно, то мне, как все лишь продвинутому "чайнику" - трудно сходу использовать асинхронный подход в HTA (уважаемые, буду рад такому примеру), а предоставленный в ветке vbs-код был лаконичен, доходчиво описан автором, работоспособен, а когда еще на форуме разжевали и идею работы в vbs-скрипте с hta-окном, то я и не удержался сделать именно такую реализацию.
Может это кому-то пригодится.

WBR. Roman

67 (изменено: Rom5, 2012-10-31 19:49:34)

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

В скрипт сканирования сетки добавил еще один "побочный эффект": при сканировании хоста, не являющегося компьютером, а например, сетевым принтером/МФУ, выполняется проверка http-доступа URL-а по адресу данного хоста. Это дает возможность увидеть название устройства (по тегу title с полученной страницы) и выполнить прямо из окна протокола переход на WEB-интерфейс управления устройством.

Т.е. можно увидеть доступные (с http-интрефейсом) в этой подсети принтера, по которым неизвестны/сменился ip-адрес, а имя хоста неизвестно.

Архив со скриптом scanNet_ver2012-10-31.zip

https://sites.google.com/site/scripttools/_/rsrc/1351695069276/home/scannet-vbs/scanNet_log_http-resources.png

WBR. Roman

68

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

Пока еще не вдавался в подробности, только в общих чертах ознакомился с обсуждением, без тестирования кода. Верно ли я понял, что в этой теме также обсуждается аналог broadcast ping - известного в юникс-мире способа узнать соседей в своей подсети, пингуя broadcast-адрес?

ping -b broadcast-addr

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

( 2 * b ) || ! ( 2 * b )