Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1529

The fastest way to download web pages(GET,POST)

$
0
0
Research using multiple methods to download web pages and choose the fastest solution

2021/3/17 14:29:29--WinHttp4(No Options) UsedTime=19795 Ms,Size=319628
2021/3/17 14:29:09--WinHttpRequest3 UsedTime=21714.3689 Ms,Size=319628,Crc32=-2146165443
2021/3/17 14:28:47--WinHttpRequest3_GZIP UsedTime=5174.1903 Ms,Size=59198,Crc32=-2146165443,UnGzip Used Time=2.5319 Ms

Winhttp DonwLoad Use 21 Seconds,by GZIP,only use 5 Seconds

One of the test application examples:
best way to get or save utf-8 content url faster?(https support)-VBForums
https://www.vbforums.com/showthread....https-support)

in my computer, i don't khnow why WinHttpRequest is slowly
WinHttp.WinHttpRequest.5.1,Used 28 seconds
Xmlhttp used 5 seconds


Code:

Sub WinHttpRequest3_GZIP(URL As String, Optional ByVal TimeoutSec As Long = 5)
On Error Resume Next
    QueryPerformanceCounter CPUv1
    Dim http As WinHttpRequest
    Set http = New WinHttpRequest
    With http
        .open "GET", URL, True
        .Option(WinHttpRequestOption_SecureProtocols) = SecureProtocol_ALL
        .Option(WinHttpRequestOption_EnableRedirects) = True
        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
       
        .setRequestHeader "Accept-Encoding", "gzip, deflate"
        .setRequestHeader "Accept-Language", "zh-CN,zh;q=0.9,ru;q=0.8"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.198 Safari/537.36"
        .send
        .waitForResponse (TimeoutSec)
    End With
   
    QueryPerformanceCounter CPUv2
    UsedTime1 = (CPUv2 - CPUv1) / MsCount
    Dim bt() As Byte, Bytes As Long
    bt = http.responseBody
    Bytes = UBound(bt) + 1
    Result = "WinHttpRequest3_GZIP UsedTime=" & UsedTime1 & " Ms,Size=" & Bytes
   
   
    Debug.Print Result
End Sub

Download Sample Xmlhttp_WithEvent-2.zip

test result:
2021/3/16 21:39:29 --Xmlhttp DownStart
2021/3/16 21:39:29 --XmlhttpState=1(UsedTime=6.8953 Ms)
2021/3/16 21:39:34 --XmlhttpState=2(UsedTime=4597.2895 Ms)
2021/3/16 21:39:34 --XmlhttpState=3(UsedTime=4598.3393 Ms)
2021/3/16 21:39:34 --XmlhttpState=4(UsedTime=4599.6692 Ms)
DownLoad Url UsedTime=4599.6692 Milliseconds ,Size=318284
------------
2021/3/16 21:31:57 --XmlhttpState=1
2021/3/16 21:32:01 --XmlhttpState=2
2021/3/16 21:32:01 --XmlhttpState=3
2021/3/16 21:32:13 --XmlhttpState=4
DownLoad Url UsedTime=15834.51 Milliseconds


Code:

Private Declare Function timeBeginPeriod Lib "winmm.dll" _
  (ByVal uPeriod As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Sub Form_Load()
timeBeginPeriod 1
End Sub

Method 1:
Reference DLL:Microsoft scripting runtime,Microsoft Active Data Object,Microsoft MsXml

Code:

Public Function doSome() 'Set AS Class Default Method
    QueryPerformanceCounter CPUv2
    UsedTime1 = (CPUv2 - CPUv1) / MsCount
    Debug.Print Now & " --XmlhttpState=" & XmlhttpObj.readyState & "(UsedTime=" & UsedTime1 & " Ms)"
 
  If XmlhttpObj.readyState = 4 Then
    On Error Resume Next
    Dim bt() As Byte, Bytes As Long
    bt = XmlhttpObj.responseBody
    Bytes = UBound(bt) + 1
    Debug.Print "DownLoad Url UsedTime=" & UsedTime1 & " Milliseconds ,Size=" & Bytes
        Form1.Command1.Caption = "DownLoad Used " & UsedTime1 & " Milliseconds"
    Call SaveByte
  End If
End Function

Form1 code
Code:


  Public a As MSXML2.XMLHTTP
 

Private Sub Command1_Click()
  Dim d As Class1
  Set a = New MSXML2.XMLHTTP
  a.open "get", "http://www.ljc.com/sll.txt", True
  Set d = New Class1
  a.onreadystatechange = d
  a.send
End Sub

Class1 CODE:
Code:

Dim b As ADODB.Stream
 Dim fso As Scripting.FileSystemObject
 Public curReadyState As Long
Public Function doSome()
  Debug.Print Form1.a.readyState
  If Form1.a.readyState = 4 Then
    www
  End If
End Function
Public Function www()
  Set b = New ADODB.Stream
  b.Type = 1
  b.open
  Set fso = New Scripting.FileSystemObject
  If Form1.a.readyState = 4 Then
        b.Write (Form1.a.responseBody)
        If Not fso.FileExists("c:/mmm.txt") Then
          b.SaveToFile "c:/mmm.txt"
        End If
  End If
  b.Close
  Set b = Nothing
  Set fso = Nothing
End Function

Attached Files

Viewing all articles
Browse latest Browse all 1529

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>