Блог

Я использовал следующий код, чтобы проверить, отвечает ли URL-адрес RSS через 5 секунд, чтобы я мог использовать RSS-канал, однако попытка открыть URL-адрес вызывает ошибку, когда целевой URL-адрес не может быть разрешен. Что еще мне нужно, кроме waitForResponse как справиться с этой ситуацией?

     Set http = Server.CreateObject("MSXML2.ServerXMLHTTP")
    http.open "POST", "https://persiadigest.com/fa/rss/8", True
    http.send
    
    If http.waitForResponse(5) Then
        body=http.responsetext
    Else
        response.write "Target url is not responding"
    End If
    Set http = Nothing
 

Сведения об ошибке:

msxml3.dll ошибка ‘80072ee7’ Не удалось разрешить имя или адрес сервера

Попробуйте этот пример и сообщите мне результаты :

 Option Explicit
Dim Title : Title = "Get RSS FEED"
Dim ArrURL : ArrURL = Array("https://persiadigest.com/fa/rss/8","http://khabarfoori.com/rss/mm")
Dim URL 
For Each URL in ArrURL
    If CheckURL(URL) = "200"  Then 
        MsgBox chr(34) amp; URL amp; chr(34) amp; " ==> is active"amp; vbCrLF amp;_
        "Status : " amp; CheckURL(URL),vbInformation,Title 
        MsgBox GetDataFromURL(URL,"GET",""),vbInformation,Title
    Else 
        MsgBox chr(34) amp; URL amp; chr(34) amp; " ==> is inactive" amp; vbCrLF amp;_
        "Status : " amp; CheckURL(URL),vbCritical,Title 
    End if
Next
'---------------------------------------------------------------------------
Function GetDataFromURL(strURL, strMethod, strPostData)
    Dim lngTimeout
    Dim strUserAgentString
    Dim intSslErrorIgnoreFlags
    Dim blnEnableRedirects
    Dim blnEnableHttpsToHttpRedirects
    Dim strHostOverride
    Dim strLogin
    Dim strPassword
    Dim strResponseText
    Dim objWinHttp
    lngTimeout = 59000
    strUserAgentString = "http_requester/0.1"
    intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
    blnEnableRedirects = True
    blnEnableHttpsToHttpRedirects = True
    strHostOverride = ""
    strLogin = ""
    strPassword = ""
    Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
    objWinHttp.Open strMethod, strURL
    If strMethod = "POST" Then
        objWinHttp.setRequestHeader "Content-type", _
        "application/x-www-form-urlencoded"
    End If
    If strHostOverride <> "" Then
        objWinHttp.SetRequestHeader "Host", strHostOverride
    End If
    objWinHttp.Option(0) = strUserAgentString
    objWinHttp.Option(4) = intSslErrorIgnoreFlags
    objWinHttp.Option(6) = blnEnableRedirects
    objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
    If (strLogin <> "") And (strPassword <> "") Then
        objWinHttp.SetCredentials strLogin, strPassword, 0
    End If
    On Error Resume Next
    objWinHttp.Send(strPostData)
    If Err.Number = 0 Then
        If objWinHttp.Status = "200" Then
            GetDataFromURL = objWinHttp.ResponseText
        Else
            GetDataFromURL = "HTTP " amp; objWinHttp.Status amp; " " amp; _
            objWinHttp.StatusText
        End If
    Else
        GetDataFromURL = "Error " amp; Err.Number amp; " " amp; Err.Source amp; " " amp; _
        Err.Description
    End If
    On Error GoTo 0
    Set objWinHttp = Nothing
End Function 
'---------------------------------------------------------------------------
Function CheckURL(vURL)
    On Error Resume Next
    Dim xhr
    Set xhr = CreateObject("MSXML2.ServerXMLHTTP.3.0")
    xhr.Open "HEAD", vURL, false
    xhr.Send
    If Err.Number = 0 Then
        'MsgBox xhr.status
        CheckURL = xhr.status
    Else
        CheckURL = Err.Description
    End If
End Function
'---------------------------------------------------------------------------
 

Простая функция, которая игнорирует ошибки, будет работать.

 Function WaitIgnoreError(ByRef requestObject, timeout)
    On Error Resume Next
    WaitIgnoreError  = requestObject.WaitForResponse(timeout)
End Function
 

Использование:

 If WaitIgnoreError(http, 5) Then
    body = http.responsetext
Else
    response.write "Target url is not responding"
End If