VBS/WMI: Многопоточный WshController с ограничением длины очереди

SN="SomeScript.vbs"

Set fso = CreateObject("Scripting.FileSystemObject")
SNParentFolderName = fso.GetParentFolderName(Wscript.ScriptFullName) 
SNDestFilePath = fso.BuildPath(SNParentFolderName,SN) 
LF="result.log"


If Wscript.Arguments.Count=0 Then  ' признак основного потока

arrComputers = Array("host02","host03","host04","host06","host07","host08","host10","host13","host14","host15","host16","host17","host18","host20","host21","host22","host23","host24","host25","host26","host27","host29")


Set objService     = GetObject("winmgmts:\\.\Root\CIMV2")
Set objSinkProcess = WScript.CreateObject("WbemScripting.SWbemSink", "SinkProcess_")
objService.ExecNotificationQueryAsync objSinkProcess, "SELECT * FROM __InstanceDeletionEvent WITHIN 0.2 WHERE TargetInstance ISA 'Win32_Process'"
Set objSinkPing    = WScript.CreateObject("WbemScripting.SWbemSink", "SinkPing_")
Set objProcess     = objService.Get("Win32_Process")
Set objDictionary  = CreateObject("Scripting.Dictionary")



ret=LogEvent(String(28,"-") & " " & Now & String(28,"-"))

bdoneprocess = False
strCount=0    ' подсчёт отработавших хостов
intThread=0   ' подсчёт количества потоков
QueueLength=0 ' длина очереди
intElement=0  ' порядковый номер обрабатываемого элемента

Do While intElement<ubound(arrComputers)+1

If QueueLength<8 Then   ' ограничение очереди потоков
  Set objContext = CreateObject("WbemScripting.SWbemNamedValueSet")
  objContext.Add "hostname", arrComputers(intElement)
  objService.ExecQueryAsync objSinkPing, "select * from Win32_PingStatus where address ='" & arrComputers(intElement) & "'", , , , objContext
  intElement=intElement+1
  QueueLength=QueueLength+1
End If
  Wscript.Sleep 100
Loop

objSinkPing.Cancel


While Not bdoneprocess

If intThread=0 Then
bdoneprocess=True
End If

WScript.Sleep 100
Wend

objSinkProcess.Cancel

MsgBox "Готово !!!"


Else           ' признак потока с аргументом
strComputer=WScript.Arguments(0)

Set Controller = WScript.CreateObject("WSHController")
On Error Resume Next
Set RemoteScript = Controller.CreateScript(SNDestFilePath,strComputer)
WScript.ConnectObject RemoteScript, "remote_"
RemoteScript.Execute
If Err.Number<>0 Then  '2
ret=LogEvent(Now & vbtab & strComputer & " - Connection Error !!!")
Err.Clear
On Error Goto 0
Else

Do While RemoteScript.Status <> 2 
    WScript.Sleep 100
Loop
ret=LogEvent(Now & vbtab & strComputer & " - Ok !!!")
End If

WScript.DisconnectObject RemoteScript
Set Controller = Nothing


End If        ' конец условия по признакам потоков


Function LogEvent(strInput)
Set fso = CreateObject("Scripting.FileSystemObject")
LogParentFolderName = fso.GetParentFolderName(Wscript.ScriptFullName) 
LogDestFilePath = fso.BuildPath(LogParentFolderName,LF) 
Set objFile = fso.OpenTextFile(LogDestFilePath, 8, True)
objFile.WriteLine strInput
objFile.Close
End Function



Sub SinkPing_OnObjectReady(objWbemObject, objWbemAsyncContext)
strCount=strCount+1
Set strComputer = objWbemAsyncContext.Item("hostname")
res=""
  Select Case objWbemObject.StatusCode
    Case 0        ' хост пингуется
	objProcess.Create "wscript.exe " & Wscript.ScriptFullName & " " & strComputer, null, null, intProcessID
	Wscript.Sleep 10  ' профилактическая пауза, добавляет стабильности в работе механизма
	objDictionary.Add intProcessID, intProcessID
	intThread=intThread+1
    Case Else     ' хост не пингуется
	ret=Now & vbtab & LogEvent(Now & vbtab & strComputer & " - not respond to ping")
  End Select
End Sub

Sub SinkProcess_OnObjectReady(objLatestEvent, objAsyncContext)  
   If objDictionary.Exists(objLatestEvent.TargetInstance.ProcessID) Then
	objDictionary.Remove(objLatestEvent.TargetInstance.ProcessID)
	intThread=intThread-1
	QueueLength=QueueLength-1
   End If

End Sub

Sub remote_Error
    Set theError = RemoteScript.Error
    strError="Error " & theError.Number & " - Line: " & theError.Line & ", Char: " & theError.Character & vbCrLf & "Description: " & theError.Description
    ret=LogEvent(Now & vbtab & strComputer & " - " & strError)
End Sub