vba - InternetOpenUrl 在第三次及后续调用时挂起并失败

Question

这是一些奇怪但可重现的行为。我可以为每个 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 )

Answer 1

我通过改变关闭 handle 的方式来完成这项工作。我能够执行 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 次，快速分析了代码。以下是相关的描述性统计数据。每次调用大约需要半秒。