VBS: Callback с параметрами (пример)

Option Explicit

RunInConsoleMode

Dim urls, url, xhr, i, n
urls = Array("http://www.altavista.com", _
			"http://www.google.ru", _
			"http://www.rambler.ru", _
			"http://www.unknownurl.com", _
			"http://www.yandex.ru", _
			"http://www.vesti.ru", _
			"http://www.gazeta.ru")
			
For i = Lbound(urls) to Ubound(urls)
	url = urls(i)
	Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
	WScript.Echo "Request " & i & " " & url
	With xhr
		.setTimeouts 5000, 5000, 15000, 15000
		.onreadystatechange = New Callback.Set(Array(GetRef("xhr_onreadystatechange"), i, xhr, url))
		.open "GET", url, true
		.send
	End With
Next

WScript.Echo(String(50,"-"))

WScript.Sleep 3000

'Функция обратного вызова
Function xhr_onreadystatechange(i, xhr, url)
	if xhr.readyState <> 4 then Exit Function
	WScript.Echo "Response " & i & " " & url & " " & xhr.status & " " & xhr.statusText
End Function
				

WScript.Echo "Press ""Enter"" to close"

WScript.StdIn.ReadLine
 
Class Callback
	Private arr
	'Функция установки параметров
	'args - Array(Object, [MethodName], [arg1], [arg2], ..., [argN])
	'Object - Object / Class / Function / Sub
	Function [Set](args)
		If Not isArray(args) Then Err.Raise 13, TypeName(Me)
		arr = args
		Set [Set] = Me
	End Function
	
	'Метод, вызываемый у объекта по умолчанию
	Public Default Sub []()
		Dim i, Code, lb
		If Not isArray(arr) Then Exit Sub
		lb = Lbound(arr)
		For i = lb + 1 to Ubound(arr)
			Code = Code & ",arr(" & i & ")"
		Next
		Code = "(" & mid(Code,2) & ")"
		Eval "arr(lb)" & Code
	End Sub
End Class

Sub RunInConsoleMode()
	If InStr(1,WScript.FullName,"cscript",1) > 0 Then Exit Sub
	CreateObject("WScript.Shell").Run("cscript /nologo """ & WScript.ScriptFullName & """")
	WScript.Quit
End Sub