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

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

null@example.com (Rumata) — Wed, 26 Dec 2012 10:52:55 +0000

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

ping -b broadcast-addr

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

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

null@example.com (Rom5) — Wed, 31 Oct 2012 15:46:14 +0000

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

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

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

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

null@example.com (Rom5) — Sat, 18 Feb 2012 20:41:33 +0000

Xameleon пишет:

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

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

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

null@example.com (alexii) — Sat, 18 Feb 2012 18:58:56 +0000

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

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

null@example.com (Xameleon) — Sat, 18 Feb 2012 16:21:19 +0000

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

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

null@example.com (alexii) — Sat, 18 Feb 2012 15:25:55 +0000

Rom5 пишет:

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

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

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

null@example.com (Евген) — Sat, 18 Feb 2012 14:05:03 +0000

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

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

null@example.com (Rom5) — Sat, 18 Feb 2012 09:11:31 +0000

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

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

documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & strComputer & " Off
"

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

Сейчас сделал вывод специальным методом 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 = "" & _
    "" & _
    "Настройка пинга подсети" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "Имя искомой машины: 
Подсеть: 
Начальный адрес *.*.*.___: 
Завершающий     *.*.*.___: 
Кол-во `одновременных` запросов: 
Имя DNS-сервера: 
Останов на первом доступном компьютере: 
Пинг диапазона адресов подсети с определением имен ответивших машин и с остановкой цикла при нахождении указанной машины." & _
    "" & _
    ""

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 & "
" & objScriptExec.StdErr.ReadAll & ""
        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, "" & sAdrIP & "")
						'выделяем из адреса машины адрес сети'
						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 = "" & _
        "" & _
        "Протокол пинга подсети" & _
        "" & _
        "" & _
        "
" & _
				"" & _
        "" & _
				"" & _
        "" & _
        ""
    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 = "Scanning " & sIpSubnet & "." & Cstr(iIpStart) & " ... " & Cstr(giIpEnd) & " / " & CStr(giMaxPingQuery)
		uf_addStrLog str & "
" 

    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 "[" & CStr(giStatusPinged) & "] " & str & "
"
        
            ' В коллекции «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 "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 = "Error WMI"
			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 = "no System name Or Access denied."
						uf_addStrLog "" & sNamePC & ""
					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 "
" & gsNamePC & " finded!"
							lFinded = True
							glCancel = True
						End IF
						sNamePC = "" & sNamePC & " " & sUsrLogin
						If glStopping Then 'был признак остановки на ближайшей доступной машине'
							uf_addStrLog "Accessible computer finded."
							glStopping = False
							glCancel = True
						End IF
					End IF
				Next
			End IF 'Err.Number <> 0'
			On Error GoTo 0
			If lFinded Then 'завершение выделяющего блока'
				uf_addStrLog "" & strComputer & " On -- " & sNamePC  & "
"
			else
				uf_addStrLog "" & strComputer & " On -- " & sNamePC  & "
"
			End IF
			Set colItems = Nothing
			Set objWMIService = Nothing
		Else
			uf_addStrLog strComputer & " Off
"
		End If
	Else
		uf_addStrLog strComputer & " Not found.
"
	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 = "" &_
    "" & _
    ""
    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

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

null@example.com (Rom5) — Sat, 28 Jan 2012 22:14:25 +0000

alexii пишет:

OFF:
Rom5 пишет:
К управлению серверами я отношения в нашей конторе не имею. Просто мне и коллегам моего отдела приходится принимать тот факт…
Что тут скажешь?! Как обычно — «Это печально ».

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

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

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

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

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

null@example.com (alexii) — Tue, 15 Nov 2011 00:20:19 +0000

OFF:

Rom5 пишет:

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

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

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

null@example.com (Rom5) — Mon, 14 Nov 2011 18:35:03 +0000

alexii пишет:

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

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

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

null@example.com (alexii) — Mon, 14 Nov 2011 13:02:11 +0000

OFF:

mozers пишет:

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

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

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

null@example.com (mozers) — Mon, 14 Nov 2011 10:37:06 +0000

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

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

null@example.com (Rom5) — Fri, 11 Nov 2011 21:09:31 +0000

Коллеги, хочу предоставить на тестирование/использование еще одно прикладное применение Вашим наработкам:
"мультипингу" (Евген & 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 совпадает):

Скриншот окна лога по команде "SCANNING":

Сам 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 = "" & _
    "" & _
    "Настройка пинга подсети" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "" & _
    "Имя искомой машины: 
Подсеть: 
Начальный адрес *.*.*.___: 
Завершающий     *.*.*.___: 
Кол-во `одновременных` запросов: 
Имя DNS-сервера: 
Пинг диапазона адресов подсети с определением имен ответивших машин и с остановкой цикла при нахождении указанной машины." & _
    "" & _
    ""

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 & "
" & objScriptExec.StdErr.ReadAll & ""
        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 = "" & _
        "" & _
        "Протокол пинга подсети" & _
        "" & _
        "" & _
        "
" & _
				"" & _
        "" & _
        ""
    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 = "Scanning " & sIpSubnet & "." & Cstr(iIpStart) & " ... " & Cstr(giIpEnd) & " / " & CStr(giMaxPingQuery)
    If Len(gsNamePC)>0 Then str = str & "  Find: " & gsNamePC
    documentLog.all.divLog.innerHTML = str & "
" 

    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 & _
                "[" & giCurrIP - iIpStart + 1 & "] " & str & "
"
        
            ' В коллекции «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 & "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 = "Error WMI"
			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 = "no System name Or Access denied."
					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 & _
								"" & gsNamePC & " finded!
"
							giCurrIP = giIpEnd + 2 ' для досрочного выхода из цикла'
						End IF
						sNamePC = "" & sNamePC & " " & sUsrLogin
					End IF
				Next
			End IF 'Err.Number <> 0'
			On Error GoTo 0
			documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & _
				"" & strComputer & " On -- " & sNamePC  & "
"
			Set colItems = Nothing
			Set objWMIService = Nothing
		Else
			documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & strComputer & " Off
"
		End If
	Else
		documentLog.all.divLog.innerHTML = documentLog.all.divLog.innerHTML & strComputer & " Not found.
"
	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 = "" &_
    "" & _
    ""
    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

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

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

null@example.com (Евген) — Tue, 02 Mar 2010 04:21:52 +0000

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

Имя искомой машины:
Подсеть:
Начальный адрес ..*.___:
Завершающий ..*.___:
Кол-во `одновременных` запросов:
Имя DNS-сервера:
Останов на первом доступном компьютере:


Пинг диапазона адресов подсети с определением имен ответивших машин и с остановкой цикла при нахождении указанной машины.