Коллеги, в выводе скриптом результатов пинга в 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