programing

VBA - XMLHTTP 및 WinHttp 요청 속도

newstyles 2023. 8. 27. 08:59

VBA - XMLHTTP 및 WinHttp 요청 속도

아래는 매크로에서 구현하는 3가지 요청에 대해 선언된 변수입니다.나는 그들이 사용하는 라이브러리와 그들의 최신 바인딩을 코멘트에 나열했습니다.

Dim XMLHTTP As New MSXML2.XMLHTTP 'Microsoft XML, v6.0 'Set XMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
Dim ServerXMLHTTP As New MSXML2.ServerXMLHTTP 'Microsoft XML, v6.0 'Set ServerXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Dim http As New WinHttpRequest 'Microsoft WinHttp Services, version 5.1 'Set http = CreateObject("WinHttp.WinHttpRequest.5.1")

Internet Explorer 자동화를 사용하는 오래된 웹 스크래핑 매크로가 몇 개 있습니다.저는 이러한 요청으로 코딩을 청소하고 속도를 높이고 싶었습니다.

유감스럽게도 제가 주목한 것은MSXML2.ServerXMLHTTP그리고.WinHttpRequest온라인 상점의 20개 제품 테스트(34초 및 35초)에서 사진 및 활성 스크립팅 해제(24초)를 사용하는 IE 자동화보다 느립니다!MSXML2.XMLHTTP18초 안에 실행됩니다.저는 이 3개의 요청 중 일부가 다른 요청보다 2-3배 더 빠르거나 느린 상황을 보곤 했습니다. 그래서 저는 항상 어떤 요청이 가장 잘 수행되는지 테스트하지만 IE 자동화로 인해 요청이 손실된 적은 없었습니다.

결과가 포함된 메인 페이지는 아래와 같습니다. 결과는 모두 한 페이지에 1500개 이상이므로 요청하는 데 시간이 걸립니다(MS Word에 붙여넣은 경우 6500페이지).

www.justbats.com/products/bat type ~야구/?sortBy=총 매출 감소&page=1&size=2400

그런 다음 기본 결과 페이지에서 개별 링크를 엽니다.

http://www.justbats.com/product/2017-marucci-cat-7-bbcor-baseball-bat--mcbc7/24317/

브라우저 자동화 없이 웹사이트에서 데이터를 얻기 위해 이 세 가지 요청이 모두 옵션인지 알고 싶습니다.또한 브라우저 자동화가 이러한 요청 중 일부를 대체할 수 있는 가능성은 얼마나 됩니까?

갱신하다

저는 Robin Mackenzie의 답변에 따라 IE 캐시를 실행하기 전에 삭제하는 절차로 메인 결과 페이지를 테스트했습니다.적어도 이 특정 페이지에서는 후속 요청이 유사한 결과를 낳았기 때문에 캐싱이 명백한 이득을 얻지 못하는 것처럼 보였습니다.IE에서 활성 스크립팅을 사용할 수 없고 이미지를 로드하지 않았습니다.

IE automation method, Document length: 7593346 chars, Processed in: 8 seconds

WinHTTP method,  Document length: 7824059 chars, Processed in: 29 seconds

XML HTTP method, Document length: 7830217 chars, Processed in: 4 seconds

Server XML HTTP method, Document length: 7823958 chars, Processed in: 26 seconds

URL download file method, Document length: 7830346 chars, Processed in: 7 seconds

저에게 매우 놀라운 것은 이러한 방법으로 반환되는 문자의 양의 차이입니다.

언급한 방법 외에도 다음과 같은 방법이 있습니다.

  • IE 자동화
  • WinHTTP 요청
  • XMLHTTP
  • 서버 XMLHTTP

다음 두 가지 방법을 생각할 수 있습니다.

  • 사용CreateDocumentFromUrl의 방법MSHTML.HTMLDocument물건
  • Windows API 기능 사용URLDownloadToFileA

다음과 같이 무시하는 다른 Windows API가 있습니다.InternetOpen,InternetOpenUrl잠재적인 성능은 응답 길이 추측, 응답 버퍼링 등의 복잡성으로 인해 상쇄됩니다.

URL에서 문서 만들기

CreateDocumentFromUrl방법 그것은 당신의 샘플 웹사이트에 문제가 있습니다 왜냐하면 그것은 그것이 만들기를 시도하기 때문입니다.HTMLDocument다음과 같은 오류와 함께 허용되지 않는 프레임:

프레임 금지됨

그리고.

이 웹 사이트에 입력하는 정보의 보안을 보호하기 위해 이 콘텐츠의 게시자는 이 콘텐츠를 프레임에 표시할 수 없습니다.

그래서 우리는 이 방법을 사용해서는 안 됩니다.

URL 파일 A로 다운로드

저는 당신이 동등한 가 필요하다고 생각했습니다.file_get_contents그리고 이 방법을 찾았습니다.쉽게 사용할 수 있고(이 링크를 확인하십시오), 큰 요청에 사용할 때 다른 방법보다 성능이 뛰어납니다(예: 야구방망이 2000개 이상일 때 사용해 보세요).XMLHTTP또한 방법은 다음을 사용합니다.URLMon라이브러리를 사용하는 것은 중간자의 논리를 조금 잘라내는 것일 뿐이며 파일 시스템 처리를 해야 하기 때문에 분명히 단점이 있습니다.

Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
    ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long

Sub TestUrlDownloadFile(strUrl As String)

    Dim dteStart As Date
    Dim dteFinish As Date
    Dim strTempFileName As String
    Dim strResponse As String
    Dim objFso As FileSystemObject

    On Error GoTo ExitFunction

    dteStart = Now
    strTempFileName = "D:\foo.txt"
    DownloadFile strUrl, strTempFileName
    Set objFso = New FileSystemObject
    With objFso.OpenTextFile(strTempFileName, ForReading)
        strResponse = .ReadAll
        .Close
    End With
    objFso.DeleteFile strTempFileName
    dteFinish = Now

    Debug.Print "URL download file method"
    Debug.Print "Document length: " & Len(strResponse) & " chars"
    Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
    Debug.Print VBA.vbNewLine

ExitFunction:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
    End If

End Sub

'http://www.vbaexpress.com/forum/archive/index.php/t-27050.html
Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
  Dim lngRetVal As Long
  lngRetVal = URLDownloadToFileA(0, URL, LocalFilename, 0, 0)
  If lngRetVal = 0 Then DownloadFile = True
End Function

URLDownloadToFileA데 약 가 걸립니다.XMLHTTP메서드(아래 전체 코드).

URL:

www.justbats.com/products/bat type ~야구/?sortBy=총 매출 감소&page=1&size=2400

다음은 출력입니다.

Testing...


XML HTTP method
Document length: 7869753 chars
Processed in: 4 seconds


URL download file method
Document length: 7869753 chars
Processed in: 1 seconds

코드

여기에는 논의된 모든 방법이 포함됩니다.IE 자동화, WinHTTP 요청, XMLHTTP, ServerXMLHTTP, 문서 작성 원본URL 및 URL 다운로드 파일입니다.

프로젝트에는 다음과 같은 모든 참조가 필요합니다.

enter image description here

여기 있습니다.

Option Explicit

Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
    ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long

Sub Test()

    Dim strUrl As String

    strUrl = "http://www.justbats.com/products/bat type~baseball/?sortBy=TotalSales Descending&page=1&size=2400"

    Debug.Print "Testing..."
    Debug.Print VBA.vbNewLine

    'TestIE strUrl
    'TestWinHHTP strUrl
    TestXMLHTTP strUrl
    'TestServerXMLHTTP strUrl
    'TestCreateDocumentFromUrl strUrl
    TestUrlDownloadFile strUrl

End Sub

Sub TestIE(strUrl As String)

    Dim dteStart As Date
    Dim dteFinish As Date
    Dim objIe As InternetExplorer
    Dim objHtml As MSHTML.HTMLDocument
    Dim strResponse As String

    On Error GoTo ExitFunction

    dteStart = Now
    Set objIe = New SHDocVw.InternetExplorer
    With objIe
        .navigate strUrl
        .Visible = False
        While .Busy Or .readyState <> READYSTATE_COMPLETE
           DoEvents
        Wend
        Set objHtml = .document
        strResponse = objHtml.DocumentElement.outerHTML
        .Quit
    End With
    dteFinish = Now

    Debug.Print "IE automation method"
    Debug.Print "Document length: " & Len(strResponse) & " chars"
    Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
    Debug.Print VBA.vbNewLine

ExitFunction:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
    End If
    If Not objIe Is Nothing Then
        objIe.Quit
    End If
    Set objIe = Nothing

End Sub

Sub TestWinHHTP(strUrl As String)

    Dim dteStart As Date
    Dim dteFinish As Date
    Dim objHttp As WinHttp.WinHttpRequest
    Dim objDoc As HTMLDocument
    Dim strResponse As String

    On Error GoTo ExitFunction

    dteStart = Now
    Set objHttp = New WinHttp.WinHttpRequest
    With objHttp
        .Open "get", strUrl, False
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Pragma", "no-cache"
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        .WaitForResponse
        strResponse = .responseText
    End With
    dteFinish = Now

    Debug.Print "WinHTTP method"
    Debug.Print "Document length: " & Len(strResponse) & " chars"
    Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
    Debug.Print VBA.vbNewLine

ExitFunction:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
    End If
    Set objDoc = Nothing
    Set objHttp = Nothing

End Sub

Sub TestXMLHTTP(strUrl As String)

    Dim dteStart As Date
    Dim dteFinish As Date
    Dim objXhr As MSXML2.XMLHTTP60
    Dim objDoc As MSHTML.HTMLDocument
    Dim strResponse As String

    On Error GoTo ExitFunction

    dteStart = Now
    Set objXhr = New MSXML2.XMLHTTP60
    With objXhr
        .Open "get", strUrl, False
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Pragma", "no-cache"
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        While .readyState <> 4
            DoEvents
        Wend
        strResponse = .responseText
    End With
    dteFinish = Now

    Debug.Print "XML HTTP method"
    Debug.Print "Document length: " & Len(strResponse) & " chars"
    Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
    Debug.Print VBA.vbNewLine

ExitFunction:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
    End If
    Set objDoc = Nothing
    Set objXhr = Nothing

End Sub

Sub TestServerXMLHTTP(strUrl As String)

    Dim dteStart As Date
    Dim dteFinish As Date
    Dim objXhr As MSXML2.ServerXMLHTTP60
    Dim objDoc As MSHTML.HTMLDocument
    Dim strResponse As String

    On Error GoTo ExitFunction

    dteStart = Now
    Set objXhr = New MSXML2.ServerXMLHTTP60
    With objXhr
        .Open "get", strUrl, False
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Pragma", "no-cache"
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        While .readyState <> 4
            DoEvents
        Wend
        strResponse = .responseText
    End With
    dteFinish = Now

    Debug.Print "Server XML HTTP method"
    Debug.Print "Document length: " & Len(strResponse) & " chars"
    Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
    Debug.Print VBA.vbNewLine

ExitFunction:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
    End If
    Set objDoc = Nothing
    Set objXhr = Nothing

End Sub

Sub TestUrlDownloadFile(strUrl As String)

    Dim dteStart As Date
    Dim dteFinish As Date
    Dim strTempFileName As String
    Dim strResponse As String
    Dim objFso As FileSystemObject

    On Error GoTo ExitFunction

    dteStart = Now
    strTempFileName = "D:\foo.txt"
    If DownloadFile(strUrl, strTempFileName) Then
        Set objFso = New FileSystemObject
        With objFso.OpenTextFile(strTempFileName, ForReading)
            strResponse = .ReadAll
            .Close
        End With
        objFso.DeleteFile strTempFileName
    Else
        Debug.Print "Error downloading file from URL: " & strUrl
        GoTo ExitFunction
    End If
    dteFinish = Now

    Debug.Print "URL download file method"
    Debug.Print "Document length: " & Len(strResponse) & " chars"
    Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
    Debug.Print VBA.vbNewLine

ExitFunction:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
    End If

End Sub

'http://www.vbaexpress.com/forum/archive/index.php/t-27050.html
Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFileA(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then
        DownloadFile = True
    Else
        DownloadFile = False
    End If
End Function

Sub TestCreateDocumentFromUrl(strUrl As String)

    Dim dteStart As Date
    Dim dteFinish As Date
    Dim strResponse As String
    Dim objDoc1 As HTMLDocument
    Dim objDoc2 As HTMLDocument

    On Error GoTo ExitFunction

    dteStart = Now
    Set objDoc1 = New HTMLDocument
    Set objDoc2 = objDoc1.createDocumentFromUrl(strUrl, "null")
    While objDoc2.readyState <> "complete"
        DoEvents
    Wend
    strResponse = objDoc2.DocumentElement.outerHTML
    Debug.Print strResponse
    dteFinish = Now

    Debug.Print "HTML Document Create from URL method"
    Debug.Print "Document length: " & Len(strResponse) & " chars"
    Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
    Debug.Print VBA.vbNewLine

ExitFunction:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
    End If
    Set objDoc2 = Nothing
    Set objDoc1 = Nothing

End Sub

대부분의 시간은 서버의 응답을 기다리는 데 사용됩니다.따라서 실행 시간을 개선하려면 요청을 병렬로 전송합니다.

저는 또한 "Msxml2"를 사용할 것입니다.캐싱을 구현하지 않으므로 ServerXMLHTTP.6.0" 개체/인터페이스입니다.

다음은 작동하는 예입니다.

Sub TestRequests()
  GetUrls _
    "http://stackoverflow.com/questions/34880012", _
    "http://stackoverflow.com/questions/34880013", _
    "http://stackoverflow.com/questions/34880014", _
    "http://stackoverflow.com/questions/34880015", _
    "http://stackoverflow.com/questions/34880016", _
    "http://stackoverflow.com/questions/34880017"

End Sub

Private Sub OnRequest(url, xhr)
  xhr.Open "GET", url, True
  xhr.setRequestHeader "Content-Type", "text/html; charset=UTF-8"
  xhr.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
  xhr.Send
End Sub

Private Sub OnResponse(url, xhr)
  Debug.Print url, Len(xhr.ResponseText)
End Sub

Public Function GetUrls(ParamArray urls())
    Const WORKERS = 10

    ' create http workers
    Dim wkrs(0 To WORKERS * 2 - 1), i As Integer
    For i = 0 To UBound(wkrs) Step 2
      Set wkrs(i) = CreateObject("Msxml2.ServerXMLHTTP.6.0")
    Next

    ' send the requests in parallele
    Dim index As Integer, count As Integer, xhr As Object
    While count <= UBound(urls)
      For i = 0 To UBound(wkrs) Step 2
        Set xhr = wkrs(i)

        If xhr.readyState And 3 Then  ' if busy
          xhr.waitForResponse 0.01    ' wait 10ms
        ElseIf Not VBA.IsEmpty(wkrs(i + 1)) And xhr.readyState = 4 Then
          OnResponse urls(wkrs(i + 1)), xhr
          count = count + 1
          wkrs(i + 1) = Empty
        End If

        If VBA.IsEmpty(wkrs(i + 1)) And index <= UBound(urls) Then
          wkrs(i + 1) = index
          OnRequest urls(index), xhr
          index = index + 1
        End If
      Next
    Wend
End Function

언급URL : https://stackoverflow.com/questions/41523223/vba-xmlhttp-and-winhttp-request-speed