1 Тема от Xameleon

  • Xameleon
  • Разработчик
  • Неактивен

Тема: HTA+VBS: Множественные асинхронные запросы WinHttpRequest

Помню, когда то давно эта тема поднималась. Но почему то тогда добиться нормальной асинхронности не удалось. Решил собрать примерчик с подобием Wrapper-а на событие WinHttpRequest. Ну и поделиться с Вами.

файл WinHttpEventWrapper.hta


<html>
	<head>
		<meta charset="Windows-1251">
	</head>
	<body>
		<script language=vbscript>
		
			Dim UrlArray, Url, WinHttpRequest, EventWrapper, StartTime
			
			'Заполняем массив URL адресов
			
			StartTime = Now
			
			UrlArray = Array("http://www.ya.ru","http://www.google.ru","http://creep.ru","http://www.rambler.ru","http://creep.ru","http://yandex.ru","http://moskva.fm")
			
			'Запускаем цикл перебора элементов массива
			For Each Url in UrlArray
				'Создаём новый объект WinHttpRequest
				Set WinHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
				'Создаём Wrapper обработки его события
				Set EventWrapper = New clsWinHttpEventWrapper
				'Подключаем событие к нашей процедуре обработки
				Set EventWrapper.onResponseFinished = GetRef("WinHttpRequest_OnResponseFinished")
				'Делаем HTTP запрос
				WinHttpRequest.Open "GET", Url, True
				WinHttpRequest.Send()
				'Запускаем обработчик события
				EventWrapper.CatchEvent WinHttpRequest
			Next
			
			'Процедура события завершения запросов
			Sub WinHttpRequest_OnResponseFinished(EventObject)
				Dim Url, Status
				On Error Resume Next
				Url = EventObject.Option(1)
				Status = EventObject.Status
				On Error Goto 0
				document.body.innerHtml = document.body.innerHtml & Url & " - " & Status & " - " & Second(Now-StartTime) & "с. <br>"
			End Sub
			
			'Класс Wrapper для асинхронной обработки запросов
			Class clsWinHttpEventWrapper
				Private timerID, whr, callback
				
				'Метод для запуска отлова событий объекта
				Sub CatchEvent(WinHttpRequest)
					Set whr = WinHttpRequest
					'Цепляем таймер к внешнему публичному свойству нашего класс модуля. Чтобы вызывать свойство onResponseFinished циклически
					timerID = setInterval(Me,1)
				End Sub
				
				'Свойство которое опрашивается по таймеру. (Указание Default сделано для того чтобы сделать его доступным для передачи в setInterval) 
				Public Default Property Get onResponseFinished()
					On Error Resume Next
					'Проверяем состояние объекта
					If whr.WaitForResponse(0) Then
						On Error Goto 0
						'Если callback установлен, то вызываем его и передаём параметром ссылку на наш объект
						if isObject(callback) Then callback(whr)
						'Останавливаем таймер
						clearInterval timerID
					End if
				End Property
				
				'Свойство для установки callback
				Public Property Set onResponseFinished(ref)
					Set callback = ref
				End Property
				
			End Class
		</script>
	</body>
</html>

Результат работы скрипта у меня:

http://www.google.ru/ - 200 - 1с.
http://www.ya.ru/ - 200 - 1с.
http://creep.ru/ - 200 - 1с.
http://www.rambler.ru/ - 200 - 1с.
http://creep.ru/ - 200 - 1с.
http://www.yandex.ru/ - 200 - 1с.
http://www.moskva.fm/ - 200 - 2с.

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

2 Ответ от pad0nak

  • pad0nak
  • Участник
  • Неактивен

Re: HTA+VBS: Множественные асинхронные запросы WinHttpRequest

За идею 5+, но есть одно маленькое НО.
Затестив данный примерчик выявился маленький баг (а может и задумка автора), который заключается в том, что  при запуске скрипт зацикливается на определённом УРЛе и начинает к нему долбиться с бешаными темпами, вешая всё на свете
Я, будучи в этой сфере магии и волшебства новичком, на свой страх и риск осмелился маленько подкрутить и повертеть сие творение и в строчке timerID = setInterval(Me,1) поменял интервал с 1 млс. на 100 и всё чудесно заработало.

Кодинг, как много в этом слове...

3 Ответ от mikser (изменено: mikser, 2012-02-29 07:56:30)

  • mikser
  • Участник
  • Неактивен

Re: HTA+VBS: Множественные асинхронные запросы WinHttpRequest

Игрушка для детей что бы поиграться. В серьёзных проектах использование сет интервала  ничего хорошего не сулит.
Так например при 100 параллельных запросах, тормозит интерфейс скроллбары могут в любой момент перестать двигаться, кнопки  не сразу нажимаются. Ядро процессора загружено на 100%. Несерьёзно это. Нельзя использовать сетинтервал для опроса а не изменилась ли переменная. Это приводит к тормозам. Надо искать другой способ.

Но почему то тогда добиться нормальной асинхронности не удалось. Решил собрать примерчик с подобием Wrapper-а на событие WinHttpRequest.

Вы просто не поняли JS скрипт который там выкладывали, именно с сетинтервалом. Или мы про разные темы говорим. Нормальной асинхронности там действительно не удалось достичь. Ваша новация заключается в том что бы спрятать сетинтервал внутрь класса, но инкапсуляция которая безусловно наводит красоту в коде, не отменяет того  факта что код в котором юзается сет интервал для опроса переменной  приводит к тормозам. На деле к жутчайшим тормозам.

Предлагаю всем нашим коммьюнити признать что WinHttpReques.5.1 плохо реализован, и нуждается в доработке, а также выразить  публичное ФИ Майкрософту ,  почему нельзя из скриптовых языков цепляться за события винхттп реквеста?

4 Ответ от Xameleon

  • Xameleon
  • Разработчик
  • Неактивен

Re: HTA+VBS: Множественные асинхронные запросы WinHttpRequest

2 mikser + pad0nak Согласен ). Но к сожалению я это заметил только после создания порядка тысячи запросов. Видать комп достаточно мощный. ) Переписал весь код с использованием одно setInterval. При этом вполне приемлемо работает. Нет загрузки проца на 100%. Если будет нужно - потом выложу.

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

5 Ответ от pad0nak

  • pad0nak
  • Участник
  • Неактивен

Re: HTA+VBS: Множественные асинхронные запросы WinHttpRequest

Xameleon выложи пожалуйста, думаю очень пригодится

Кодинг, как много в этом слове...

6 Ответ от Xameleon

  • Xameleon
  • Разработчик
  • Неактивен

Re: HTA+VBS: Множественные асинхронные запросы WinHttpRequest

Хорошо, буду на работе, закину. )

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

7 Ответ от DnsIs (изменено: DnsIs, 2012-03-06 07:14:01)

  • DnsIs
  • Участник
  • Неактивен

Re: HTA+VBS: Множественные асинхронные запросы WinHttpRequest

А зачем для каждого URL-а создавать отдельный WinHttpRequest?

Если исходный код был на JS, покажите его пожалуйста.

Нас невозможно сбить с пути, нам пофигу куда идти.

8 Ответ от Xameleon

  • Xameleon
  • Разработчик
  • Неактивен

Re: HTA+VBS: Множественные асинхронные запросы WinHttpRequest

2 DnsIs: Для того чтобы обрабатывать запросы к нескольким URL одновременно.

Решил собрать пример максимально просто. Без проверок на содержимое подгружаемого файла. Дабы не загружать код.
http://dc132.file.qip.ru/img/kZMmzcVJ/s7/0.7783681950517776/proxychecker.gif

proxychecker.hta


<html>
    <head>
        <meta charset="windows-1251">
        <style>
        *{font-family:Tahoma;font-size:12px;}
        </style>
        <title>PROXY CHECKER</title>
    </head>
    <body>
        <object id=HtmlDlgHelper classid="clsid:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B" style="width:0;height:0;"></object>
        url: <input id="inpUrl" size=30 value="http://www.yandex.ru">
        <br><br>
        <button id="btnLoadProxyList">Загрузить список прокси</button>
        &nbsp;
        <button id="btnStartCheck">Запустить</button>
        &nbsp;
        <button id="btnStopCheck" disabled>Остановить</button>
        <hr>
        <div id="ProxyListContainer">
            <table id="tblProxyList">
                <thead>
                    <tr>
                    <th>№</th>
                    <th>Прокси</th>
                    <th>Статус</th>
                    </tr>
                </thead>
                <tbody>
                </tbody>
            </table>
        </div>
        <script language="vbscript">
        Option Explicit
        
        Dim FileSystemObject, TextStream, Dictionary, timerID, tBody, ExitScan
        Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
        Set Dictionary = CreateObject("Scripting.Dictionary")
        Set tBody = tblProxyList.TBodies(0)

        'Событие нажатие на кнопку загрузки файла
        Sub btnLoadProxyList_onclick()
            Dim FileName, TextLine, n
            'Используем объект HtmlDlgHelper для выбора файла
            FileName = HtmlDlgHelper.openfiledlg("","","proxy list (*.txt)|*.txt|Все файлы (*.*)|*.*|","Выберите файл...")
            if FileName = "" Then Exit Sub
            'Открываем файл на чтение
            Set TextStream = FileSystemObject.OpenTextFile(FileName,1,False)
            'Очищаем табличку со списком прокси серверов
            Do While tBody.rows.length > 0
               tBody.deleteRow
            Loop
            'Читаем строки и заполняем таблицу
            Do While Not TextStream.AtEndOfStream
                n = n + 1
                TextLine = TextStream.ReadLine
                With tBody.insertRow
                    'Устанавливаем у строк таблицы идентификаторы типа row1, row2, row3. Для дальнейшей связки с ними
                    .id = "row" & n
                    .insertCell.innerText = n & "."
                    .insertCell.innerText = TextLine
                    .insertCell.innerText = "-"
                End With
            Loop
        End Sub
        
        'Событие нажатия на кнопку Start
        Sub btnStartCheck_onclick()
            Dim row
            if tBody.rows.length <=0 Then Exit Sub
            'Перебираем записи в таблице. Запускаем проверку прокси. В качестве параметра id передаём row.id,
            'чтобы в событии окончания проверки знать с какой строкой таблицы нам работать
            For Each row in tBody.rows
                CheckProxy row.id, row.Cells(1).innerText, inpUrl.value
                row.Cells(2).innerText = "-"
            Next
            
            'Отключаем нужные кнопки и включаем нужные
            btnStartCheck.disabled = True
            btnLoadProxyList.disabled = True
            inpUrl.disabled = True
            btnStopCheck.disabled = false
        End Sub
        
        'Процедура инициализации проверки прокси
        Sub CheckProxy(id, ProxyServer, url)
            Dim WinHttpRequest
            Set WinHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
            'Устанавливаем прокси
            WinHttpRequest.SetProxy 2, ProxyServer
            WinHttpRequest.Open "GET", url, True
            WinHttpRequest.Send
            'Получаем номер и описание ошибки, если они есть
            AttachEventMonitor id, WinHttpRequest
        End Sub
        
        'Событие нажатия на кнопку остановки
        Sub btnStopCheck_onclick()
            'Вызываем процедуру оконачания обработки, дабы не дублировать код включения кнопок
            RequestsComplete
        End Sub
        
        'Процедура добавления объектов запроса в коллекцию обработки
        Sub AttachEventMonitor(id, WinHttpRequest)
            Dictionary.Add id, WinHttpRequest
            if Dictionary.Count = 1 Then timerID = setInterval("WaitForResponse()",100)
        End Sub
        
        'Процедура ожидания ответа от серверов
        Sub WaitForResponse()
            Dim Key, Status, ErrorNumber, ErrorDescription
            For Each Key in Dictionary.Keys
                On Error Resume Next
                if Dictionary(Key).WaitForResponse(0) = True Then
                    ErrorNumber = Err.number
                    ErrorDescription = Err.Description
                    On Error Goto 0

                    if ErrorNumber <> 0 Then
                        OnProxyCheckError Key, ErrorNumber, ErrorDescription
                    Else
                        OnProxyChecked Key, Dictionary(Key).Status, Dictionary(Key).StatusText
                    End if
                    Dictionary.Remove Key
                    'Если таймер остановлен, а цикл ещё продолжает итерации, то выходим из процедуры
                    if timerID = 0 Then Exit Sub
                    if Dictionary.Count <=0 Then
                        RequestsComplete()
                    End if
                End if
            Next
        End Sub
       
        'Событие ответа прокси
        Sub OnProxyChecked(id, Status, StatusText)
            document.getElementById(id).Cells(2).innerText = Status & " " & StatusText
        End Sub
        
        'Событие ошибки ответа от прокси
        Sub OnProxyCheckError(id, ErrorNumber,ErrorDescription)
            document.getElementById(id).Cells(2).innerText = ErrorDescription
        End Sub
        
        'Событие окончания обработки всех запросов
        Sub RequestsComplete()
            clearInterval timerID
            timerID = 0
            
            Dictionary.RemoveAll
            
            btnStartCheck.disabled = false
            btnLoadProxyList.disabled = false
            inpUrl.disabled = false
            btnStopCheck.disabled = true
            
            MsgBox "Сканирование завершено", vbInformation, document.title
        End Sub
        </script>
    </body>
</html>

proxylist.txt

207.241.164.68:80
212.26.44.98:80
64.34.197.103:8118
208.64.176.157:80
149.249.17.34:8080
80.81.159.21:80
80.81.159.21:8080
92.50.133.26:81
109.123.111.99:80
160.79.35.27:80
116.55.19.96:808
212.88.118.181:8080
121.192.32.221:808
93.78.125.33:8088
220.113.15.21:8080
59.175.137.122:3128
80.63.56.146:8118
209.88.88.40:80
93.166.121.107:8118
219.142.62.13:8080
211.144.20.13:8080
217.219.115.138:80
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

9 Ответ от Xameleon

  • Xameleon
  • Разработчик
  • Неактивен

Re: HTA+VBS: Множественные асинхронные запросы WinHttpRequest

Захотелось всё таки более подробно ответить... )

2 mikser:

mikser пишет:

В серьёзных проектах использование сет интервала  ничего хорошего не сулит.
Так например при 100 параллельных запросах, тормозит интерфейс скроллбары могут в любой момент перестать двигаться, кнопки  не сразу нажимаются. Ядро процессора загружено на 100%. Несерьёзно это. Нельзя использовать сетинтервал для опроса а не изменилась ли переменная. Это приводит к тормозам. Надо искать другой способ.

Не знаю как у Вас, но я подгрузил список из 3055 прокси серверов. Запустил на тест. Никаких тормозов и загрузки процессора не наблюдаю. У меня слишком мощный комп ? Не думаю. Рядовая двухядерная машинка Core 2 Duo, которая стоит у многих дома. Да, загрузка проца определённо есть. до 20-30% у меня скачки были. но это вполне терпимо, как мне кажется.

mikser пишет:

Ваша новация заключается в том что бы спрятать сетинтервал внутрь класса, но инкапсуляция которая безусловно наводит красоту в коде, не отменяет того  факта что код в котором юзается сет интервал для опроса переменной  приводит к тормозам. На деле к жутчайшим тормозам.

Тормоза возникают в случае кривокодописания. ) Не отрицаю, что мой первый пример был именно таким. Я экспериментировал с разными способами обработки событий.

mikser пишет:

Предлагаю всем нашим коммьюнити признать что WinHttpReques.5.1 плохо реализован, и нуждается в доработке, а также выразить  публичное ФИ Майкрософту ,  почему нельзя из скриптовых языков цепляться за события винхттп реквеста?

Ммм. ) Флаг в руки. Согласен, что мелкомягкие могли бы наладить обработку событий для WinHttpRequest в скриптах. Но раз они этого не сделали ни в XP, ни в Vista, ни Win 7 и думаю в Win 8 тоже не сделают, то значит на это были какие то причины. )

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !