Показать сообщение отдельно
  #1 (permalink)  
Старый 30.03.2010, 17:57
Новичок на форуме
Отправить личное сообщение для roman Посмотреть профиль Найти все сообщения от roman
 
Регистрация: 30.03.2010
Сообщений: 6

трабла с xmlhttp
Есть прога работает через поднятый аппач по localhost:8080.
Но часто тупо забиваться сокетами CLOSE_WITE и естественно зависает.
Надо определить когда вырубаеться и ребутать процесс.
Ось - ВАЖНО - windows 2000 server, IE6.0

Решил запрашивать методом POST если не проходит ребутать, скрипт на WSH.
Добился того что запрос то отправляться и все ок когда работает прога, когда зависает xmlhttp/send отправляет запрос и ждет результата т.е. и не выходит. Что делать про timeout я в курсе только он есть в IE8 а мне его не посавить т.к. Win2000.

Вопрос как можно решить это? Заранее все спс, я в скриптах не особо. С бубном пляшу уже больше недели вот наконец то решил спросить у гуру =)

Сам собственно код.
Пока запускаю его из cmd - cscript path_name_script path_name_localhost.



'<script language="vbscript">
Option Explicit
If Not (InStr(2,WScript.FullName, "CScript.exe",1)>0) Then 'Проверяем под чем выполняется
   WScript.Echo "Используйте CScript.exe для вызова данной программы" & vbCrLf & _
                "Пример: cscript.exe " & WScript.ScriptFullName & " /?" & vbCrLf & vbCrLf & _ 
                "Установить по умолчанию исполняемый сервер сценариев на CScript.exe:"  & vbCrLf & _ 
                "CScript.exe //H:CScript"
   WScript.Quit(1) 'Выходим с ошибкой
End if
Public StdIn, StdOut, strUserInput: Set StdIn=WScript.StdIn: Set StdOut=WScript.StdOut
Public strHELP, strHTTPmethod, strURL
strHELP="Использование: HTTP-test.vbs [HTTPmethod] URL [filename]" & vbCrLf & _ 
        "HTTPmethod - Необязательный. Метод HTTP запроса: GET или HEAD."  & vbCrLf & _ 
        "             по умолчанию (если аргумент не передан) используется HEAD"  & vbCrLf & _ 
        "URL        - Обязательный. URL к которому выполняется запрос. В случае,"  & vbCrLf & _ 
        "             если содержит QUERY_STRING (аргументы передаваемые в строке), "  & vbCrLf & _ 
        "             необходимо заключить в двойные кавычки." & vbCrLf & _ 
        "filename   - Необязательный. Имя файла в который сохраняется тело ответа" & vbCrLf & _ 
        "             сервера. Если не указывается полный путь, файл создается в " & vbCrLf & _ 
        "             каталоге самого скрипта." & vbCrLf & vbCrLf & _ 
        "Скрипт возвращает слудующие кода ошибок" & vbCrLf & _ 
        "(для использования IF ERRORLEVEL в bat-файлах): "  & vbCrLf & _ 
        "0       -  нет ошибки, но запрос не выполнен" & vbCrLf & _
        "1       -  неопределенная ошибка" & vbCrLf & _
        "2       -  ошибка соединения компонента XMLHTTP" & vbCrLf & _
        "100-5xx -  статусный код HTTP-ответа сервера (200 ; OK и пр.)"  & vbCrLf & vbCrLf & _
        "Примеры:     HTTP-test.vbs ""www.some.ru/file.asp?aa=23&bb=cc""" & vbCrLf & _ 
        "             HTTP-test.vbs head www.microsoft.com" & vbCrLf & _ 
        "             HTTP-test.vbs get label.pp.ru/images/fox.gif d:\Лис.gif" 
'*******************************************************************************************
'Парсим аргументы скрипта (в ASP разбираем соответственно коллекцию Request.QueryString)
'*******************************************************************************************
If WScript.Arguments.Count > 0 Then
   If WScript.Arguments.Count > 1 Then 'Если передано больше одного аргумента
      strHTTPmethod=Trim(UCase(WScript.Arguments(0))) 'Значит первым должен быть метод?
      If strHTTPmethod="HEAD" or strHTTPmethod="GET" Then
         'Все ок, первый аргумент метод, и это правильно
         strURL=Trim(WScript.Arguments(1)) 'а второй тоды URL
         Call CheckURL()
      Else
         WScript.Echo "Первый аргумент должен быть HTTP-метод GET или HEAD"
         WScript.Quit(1) 'Выходим с ошибкой
      End If
   Else  'значит передан только один аргумент - (это должен быть URL)
      strURL=Trim(WScript.Arguments(0)) 'значит метод пропущен, а передан только URL
      'стандартные аргументы для help'а
      If (strURL="/?" Or strURL="-?" Or strURL="?" Or Ucase(strURL)="/H" Or Ucase(strURL)="-H") Then
         WScript.Echo strHELP: WScript.Quit(0) 'Кажем хелп и выходим
      End If
      Call CheckURL(): strHTTPmethod="HEAD" 'используем метод по умолчанию...  
   End If
Else  'Если аргументы скрипта вообще пропущены
   'Просим ввести тестируемый URL 
   StdOut.Write "Введите URL на который посылаем HEAD-запрос: " : strURL=StdIn.ReadLine()
   Call CheckURL(): strHTTPmethod="HEAD" 'используем метод по умолчанию...  
End If
'*******************************************************************************************
'распарсили. считаем что метод и URL переданы правильно и существуют 
'(с именем файла пока не разбираемся)
'*******************************************************************************************

'Создаем объект XMLHTTP (для сервера лучше использовать ServerXMLHTTP)
Dim objHTTP: Set objHTTP = CreateObject("MSXML2.XMLHTTP") 
'objHTTP.timeout = 600000


Dim sngStart, sngEnd 'переменные для таймера
Dim jopa  'переменая для проверки зависа
Err.Clear: On Error Resume Next  'Отключаем остановку на ошибке
WScript.Echo : WScript.Echo "Посылаем " & strHTTPmethod & " запрос на " &  strURL
sngStart=Timer()
jopa = 0
With objHTTP
   .open strHTTPmethod, strURL, false
   .onreadystatechange = GetRef("HTTP_onreadystatechange")
   .setRequestHeader "Connection", "close": .setRequestHeader "Cache-Control", "no-cache"
   .setRequestHeader "Accept-Language", "ru, en"
   .setRequestHeader "Accept-Charset", "windows-1251;q=1, koi8-r;q=0.6, ISO-8859-5;q=0.4, ISO-8859-1;q=0.1"
   .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
   .setRequestHeader "Connection","Keep-Alive"
   .send  "parameters" 'Посылаем!!!
WScript.Echo "Время выполнеия запроса " & FormatNumber((sngEnd-sngStart),3,-1) & " c"
End With
sngEnd=Timer()



If Err.number<>0 Then 'значит ошибка соединения с сервером
   WScript.Echo "ОШИБКА СОЕДИНЕНИЯ: " & "Err.Number " &  Err.number & _ 
               " Описание: " & Replace(Err.Description,vbCrLf,"")  
   WScript.Quit(2) 'выходим и возвращаем ошибку соединения
End If
On Error Goto 0 
Dim intHTTPstatus: intHTTPstatus=objHTTP.status
If (intHTTPstatus<>200) Then WScript.Echo "HTTP статус " & intHTTPstatus & " Описание: " & objHTTP.statusText
WScript.Echo String(70,"-"): WScript.Echo "Заголовки ответа:": WScript.Echo String(70,"-")
StdOut.Write objHTTP.getAllResponseHeaders() 'Выводим все заголовки ответов
'Запоминаем тип содержимого ответа
Dim strContentType: strContentType= objHTTP.getResponseHeader("Content-Type")
'Если метод GET завершился успешно и передан аргумент в какой файл писать ответ 
'или вернулось текстовое содержимое...
If strHTTPmethod="GET" And intHTTPstatus=200 And _ 
   (WScript.Arguments.Count > 2 Or Left(strContentType,4)="text") Then 
   Dim i, intOutLen, strOutputData: strOutputData=""
   'Если это текстовое содержание:  text/html,  text/css,  text/xml и пр. и кодировка указана в заголовке ответа   
   If LCase(Left(strContentType,4))="text" And InStr(4,strContentType,"charset=",1)>4 Then
      strOutputData=objHTTP.responseText 'Получаем этот текст ответа
   Else 'иначе (если нетекстовое содержание или не указана кодировка)
			'поскольку мы не можем в VBScript объявить динамический массив из элементов типа byte 
			Dim strUU: strUU=objHTTP.responseBody 'то сохраняем массив байтов в строку...
			intOutLen=LenB(strUU) 'Некоторые манипуляции для избавления от этого извращения
			'ниче в голову лучше не пришло :-(
			For i=1 to intOutLen: strOutputData=strOutputData & Chr(AscB(MidB(strUU,i,1))):	Next
   End If
   'Если передан аргумент имя файла в который писать
   If WScript.Arguments.Count > 2 Then 'Значит этот последний аргумент - имя файла
      Dim strFileName: strFileName=WScript.Arguments(2)
      'Проверяем, пеередали ли полное имя файла в который писать (по типу d:\sime\f.ext)
      If InStr(1,strFileName,":\")< 2 Then  'если нету имени диска (и пути соотв.),
         'по умолчанию берем каталог где лежит сам этот скрипт
         strFileName=Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,WScript.ScriptName,-1,1)-1) & strFileName
      End If
      Dim objFS:   Set objFS=CreateObject("Scripting.FileSystemObject")
      Dim objFile: Set objFile=objFS.CreateTextFile(strFileName, True, False)
      objFile.Write strOutputData 'Пишем в файл и закрываем его
      objFile.Close: Set objFile=Nothing: Set objFS=Nothing
      WScript.Echo String(70,"-"): WScript.Echo "Тело ответа сохранено в файле " & strFileName
   End If 'конец писания в файл
   'Если таки текстовой ответ
   If Left(strContentType,4)="text" Then
      WScript.Echo String(70,"-"): WScript.Echo "Тело ответа:":WScript.Echo String(70,"-")
      StdOut.Write strOutputData 'выводим на консоль (ну или куда перенаправление стоит)
   End If   
End If 'If strHTTPmethod="GET" And intHTTPstatus=200 
WScript.Echo String(70,"-")
WScript.Echo "Время выполнеия запроса " & FormatNumber((sngEnd-sngStart),3,-1) & " c"
Set objHTTP=Nothing: WScript.Quit(intHTTPstatus) 'выходим и возвращаем HTTP статус

'Процедура, вызываемая при изменении состояния выполнения запроса
Sub HTTP_onreadystatechange() 
     Dim strState
     Select Case objHTTP.readyState
         Case 0: strState="UNINITIALIZED"
         Case 1: strState="LOADING"
         Case 2: strState="LOADED"
         Case 3: strState="INTERACTIVE"
         Case 4: strState="COMPLETED"
         Case Else: strState="unspecific"
     End Select
     StdOut.Write strState & "...  "
     if objHTTP.readyState=4 Then StdOut.Write vbCrLf
End Sub
Sub CheckURL() 'Процедура проверки URL-а
    If Len(strURL)< 5 Then WScript.Echo "Странный URL... выходим " : WScript.Quit(1)
    If Not (LCase(Left(strURL,7))="http://") Then strURL="http://" & strURL
End Sub
'</script>

ребутну сам только мне бы как-то выйти из данного висяка.

Последний раз редактировалось roman, 01.04.2010 в 14:38.
Ответить с цитированием