Тема: HTA/VBScript: Проблемы синтаксиса...
Коллеги, приветствую !
Есть следующий код: (асинхронный мультипинг)
<html>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
<style type="text/css">
*{font-family:tahoma;font-size:11px;padding:0px 0px 0px 0px;margin-bottom:0px;margin-top:0px;margin-left:0px;margin-right:0px;}
table{cellspacing="0";cellpadding="0";}
table td{padding:0px;cellpadding="0";}
</style>
<body style="overflow-x:auto; overflow-y:auto">
<table id="result">
</table>
<OBJECT id="objSink" style="display:none;" classid="clsid:75718C9A-F029-11D1-A1AC-00C04FB6C223"></OBJECT>
<SCRIPT LANGUAGE=VBScript>
Document.Title="ЗАПУЩЕНО - " & Now
window.resizeto 300,100
Public objDictionary,arrComputers,bDone,IDTimer,strFirst
arrComputers = Array("195.219.232.84","213.140.114.17","94.230.136.33")
Sub window_onload()
strFirst=1
Call Pinger()
End Sub
Sub Pinger()
Window.clearInterval(IDtimer)
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objService = GetObject("winmgmts:\\.\Root\CIMV2")
'Set objSink = 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
If strFirst=1 Then
IDtimer = window.setInterval("vbscript: call First()", 500)
Else
IDtimer = window.setInterval("vbscript: call Waiter()", 500)
End If
End Sub
Sub First()
If objDictionary.Count=Ubound(arrComputers)+1 Then
Window.clearInterval(IDtimer)
objSink.Cancel
ret=SortDictionary(objDictionary, 1)
For r=0 to Document.GetElementByID("result").Rows.Length-1
Document.GetElementByID("result").deleteRow
Next
Document.GetElementByID("result").insertRow
With Document.GetElementByID("result").Rows(rowIndex).insertCell
.innerHtml = "Адрес"
.align="center"
End With
With Document.GetElementByID("result").Rows(rowIndex).insertCell
.innerHtml = "Время<BR>ответа"
.align="center"
End With
With Document.GetElementByID("result").Rows(rowIndex).insertCell
.innerHtml = "Пропавшие<BR>пакеты"
.align="center"
End With
With Document.GetElementByID("result").Rows(rowIndex).insertCell
.innerHtml = "Последний<BR>обрыв"
.align="center"
End With
For Each strKey in objDictionary.Keys
Document.GetElementByID("result").insertRow
rowIndex=Document.GetElementByID("result").Rows.Length-1
With Document.GetElementByID("result").Rows(rowIndex).insertCell
strBad=0
If Left(objDictionary.Item(strKey),2)="On" Then
.style.backgroundcolor="Green"
.innerHtml = " " & strKey & " "
Else
.style.backgroundcolor="Red"
.innerHtml = " " & strKey & " "
strBad=1
End If
End With
Document.GetElementByID("result").Rows(rowIndex).insertCell
With Document.GetElementByID("result").Rows(rowIndex).Cells(1)
.innerHtml = " " & Mid(objDictionary.Item(strKey),4,Len(objDictionary.Item(strKey))-3)
.align="center"
End With
With Document.GetElementByID("result").Rows(rowIndex).insertCell
.align="center"
If strBad=0 Then
.innerHtml = 0
Else
.innerHtml = 1
End If
End With
With Document.GetElementByID("result").Rows(rowIndex).insertCell
.align="center"
.style.whitespace="nowrap"
If strBad=0 Then
.innerHtml = " "
Else
.innerHtml = Now
End If
End With
Next
objDictionary.RemoveAll
strFirst=0
IDtimer = window.setInterval("vbscript: call Pinger()", 300)
End If
End Sub
Sub Waiter()
If objDictionary.Count=Ubound(arrComputers)+1 Then
Window.clearInterval(IDtimer)
objSink.Cancel
ret=SortDictionary(objDictionary, 1)
'For r=0 to Document.GetElementByID("result").Rows.Length-1
'Document.GetElementByID("result").deleteRow
'Next
'Document.GetElementByID("result").insertRow
'Document.GetElementByID("result").Rows(rowIndex).insertCell.innerHtml = "Адрес"
'Document.GetElementByID("result").Rows(rowIndex).insertCell.innerHtml = "Время<BR>ответа"
row=1
For Each strKey in objDictionary.Keys
With Document.GetElementByID("result").Rows(row).Cells(0)
If Left(objDictionary.Item(strKey),2)="On" Then
.style.backgroundcolor="Green"
.innerHtml = " " & strKey & " "
Else
.style.backgroundcolor="Red"
.innerHtml = " " & strKey & " "
Document.GetElementByID("result").Rows(row).Cells(2).innerHTML=CInt(Document.GetElementByID("result").Rows(row).Cells(2).innerHTML)+1
Document.GetElementByID("result").Rows(row).Cells(3).innerHTML=Now
End If
End With
Document.GetElementByID("result").Rows(row).Cells(1).innerHtml = " " & Mid(objDictionary.Item(strKey),4,Len(objDictionary.Item(strKey))-3)
row=row+1
Next
objDictionary.RemoveAll
IDtimer = window.setInterval("vbscript: Pinger()", 300)
End If
End Sub
Sub objSink_OnObjectReady(objWbemObject, objWbemAsyncContext)
strComputer = objWbemAsyncContext.Item("hostname")
res=""
Select Case objWbemObject.StatusCode
Case 0
res = "On " & objWbemObject.ResponseTime
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
</SCRIPT>
</body>
</html>В среде Win XP SP3 x86 работает замечательно, но в Win7 Ultimate x64 в строке №33
objService.ExecQueryAsync objSink, "select * from Win32_PingStatus where address ='" & strComputer & "'", , , , objContextвыдаёт
Generic failure
WTF ?
Времени не хватает... :-(
