InternetOpenUrl挂起并在第三次和后续调用时失败

时间:2016-02-16 18:28:49

标签: vba http wininet

这是一些奇怪但可重现的行为。我可以为每个URL调用两次InternetOpenUrl,一切都按照我的预期运行。如果我在此之后再次调用它,它会在60秒时超时,并且不会返回Web资源的句柄。

我创建了以下最小代码示例来演示问题(这是对AllAPI Mentalis sample的修改):

Private Const scUserAgent = "API-Guide test program"
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function InternetOpen _
                          Lib "wininet" Alias "InternetOpenA" _
                              (ByVal sAgent As String, ByVal lAccessType As Long, _
                               ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle _
                          Lib "wininet" _
                              (ByRef hInet As Long) As Long
Private Declare Function InternetReadFile _
                          Lib "wininet" _
                              (ByVal hFile As Long, ByVal sBuffer As String, _
                               ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl _
                          Lib "wininet" Alias "InternetOpenUrlA" _
                              (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
                               ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, _
                               ByVal dwFlags As Long, ByVal dwContext As Long) As Long

Sub TestInternetOpenUrl(sURL As String)
    Dim hOpen As Long, hFile As Long, i As Integer, Start As Long
    For i = 1 To 4
        Start = GetTickCount
        'Create an internet connection
        hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, _
                             vbNullString, vbNullString, 0)
        'Open the url
        hFile = InternetOpenUrl(hOpen, sURL, vbNullString, ByVal 0&, _
                                INTERNET_FLAG_RELOAD, ByVal 0&)
        'clean up
        InternetCloseHandle hFile
        InternetCloseHandle hOpen
        Debug.Print i; GetTickCount - Start; " ms elapsed ("; hFile; ")"
        DoEvents
    Next i
End Sub

以下是两次测试运行的结果:

TestInternetOpenUrl "http://www.yahoo.com"
 1  390  ms elapsed ( 13369203 )
 2  187  ms elapsed ( 13369217 )
 3  60000  ms elapsed ( 0 )
 4  60000  ms elapsed ( 0 )

TestInternetOpenUrl "http://www.duckduckgo.com"
 1  203  ms elapsed ( 13369448 )
 2  93  ms elapsed ( 13369460 )
 3  60047  ms elapsed ( 0 )
 4  60047  ms elapsed ( 0 )

2 个答案:

答案 0 :(得分:2)

我通过改变你关闭手柄的方式来完成这项工作。我能够执行30次迭代,并且效果很好。

这是修改后的工作代码。此外,对InternetCloseHandle的API调用(使用ByRef而不是ByVal)似乎存在问题,该问题在下面进行了更正:

Private Const scUserAgent = "API-Guide test program"
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function InternetOpen _
                          Lib "wininet" Alias "InternetOpenA" _
                              (ByVal sAgent As String, ByVal lAccessType As Long, _
                               ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer    
Private Declare Function InternetReadFile _
                          Lib "wininet" _
                              (ByVal hFile As Long, ByVal sBuffer As String, _
                               ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl _
                          Lib "wininet" Alias "InternetOpenUrlA" _
                              (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
                               ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, _
                               ByVal dwFlags As Long, ByVal dwContext As Long) As Long

Private Sub CloseHandle(ByRef hHandle As Long)
   If (hHandle <> 0) Then
        Call InternetCloseHandle(hHandle)
        hHandle = 0
    End If
End Sub

Sub TestInternetOpenUrl(sURL As String)
    Dim hOpen As Long, hFile As Long, i As Integer, Start As Long
    Dim ret As Boolean: ret = False

    For i = 1 To 4
        Start = GetTickCount
        'Create an internet connection
        hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, _
                             vbNullString, vbNullString, 0)
        'Open the url
        hFile = InternetOpenUrl(hOpen, sURL, vbNullString, ByVal 0&, _
                                INTERNET_FLAG_RELOAD, ByVal 0&)

        CloseHandle (hFile)
        CloseHandle (hOpen)

        Debug.Print i; GetTickCount - Start; " ms elapsed ("; hFile; ")"
        DoEvents
    Next i
End Sub

我通过使用yahoo运行30次来快速分析代码。以下是相关的描述性统计数据。每次通话需要大约半秒钟。

Click here for Stats

答案 1 :(得分:0)

今天我遇到了同样的问题,因为在我的代码中没有调用InternetCloseHandle函数(我认为是这样)。

您需要检查函数InternetCloseHandle的返回值以确定。