Using VB to write asynchronous multithread downloading program

Source: Internet
Author: User
Tags comments goto integer thread file transfer protocol
program | multithreading | download | Asynchronous in order to efficiently download a site's web page, we can use the VB Internet Transfer control to write our own download program, the Internet Transfer control supports Hypertext Transfer Protocol (HTTP) and File Transfer Protocol (FTP), You can use the Internet Transfer control to connect to any site that uses both protocols by using the OpenURL or Execute method and retrieve files. This program uses multiple Internet Transfer controls to download a site at the same time. You can determine whether the file has been downloaded or downloaded and is older than the current file on the server to decide whether to download again. The links in all downloaded files are adjusted to facilitate local lookup.
The OpenURL method transmits data synchronously. Synchronization means that no other procedure can be performed until the transfer operation is completed. This data transfer must be completed before other code is executed.
The Execute method transmits the data asynchronously. When the Execute method is invoked, the transport operation is independent of other procedures. This way, when the Execute method is invoked, other code is executed while the data is received in the background.
The OpenURL method allows you to directly obtain data streams that can be saved to disk or read directly in a TextBox control (if the data is in text format). When you use the Execute method to get the data, you must monitor the connection state of the control with the StateChanged event. When the appropriate state is reached, the GetChunk method is invoked to fetch data from the control's buffer.
 
First, set up the initial HTTP retrieval connection,
Public g as Variant
Public K as Variant
Public spath as String
Dim links () as String
G = 0
spath = local save path for download file
Links (0) = starting URL
Inet1.execute links (0), "get" comment: Using the Get method.
 
Event Monitor subroutine (Event Monitor subroutine corresponding to each Internet Transfer control setting):
The control's connection state is monitored with the statechanged event, and when the request has been completed and all data has been received, the GetChunk method is invoked to fetch data from the control's buffer.
Private Sub inet1_statechanged (ByVal State as Integer)
Note: state = 12 o'clock, use the GetChunk method to retrieve the response of the server.
Select Case State
Comments:... No other cases are listed.
 
Case icresponsecompleted Note: 12
Remarks: Gets the protocol, host, and pathname in links (g).
Addsuf = Left (links (g), InStrRev (links (g), "/")
Remarks: Gets the name of the file in the links (g).
FName = Right (links (g), Len (links (g))-InStrRev (links (g), "/")
Note: To determine whether a hypertext file, is a hypertext file to analyze the link, if not save as a binary file.
If InStr (1, fname, "htm", vbTextCompare) = True Then
Note: Initializes the FileSystemObject object that is used to save the file.
Set fs = CreateObject ("Scripting.FileSystemObject")
Dim Vtdata as Variant annotation: Data variable.
Dim strdata as String:strdata = ""
Dim bdone as Boolean:bdone = False
 
Note: Get the first block.
Vtdata = Inet1. GetChunk (1024, icstring)
DoEvents
Do as not bdone
strdata = strdata & Vtdata
DoEvents
Note: Get the next piece.
Vtdata = Inet1. GetChunk (1024, icstring)
If Len (Vtdata) = 0 Then
Bdone = True
End If
Loop
 
Notes: Gets the links in the document and places them in the array.
Dim I as Variant
Dim PO1 as Variant
Dim PO2 as Variant
Dim Oril as String
Dim NEWL as String
Dim Lmtime, CTime
PO1 = INSTR (1, strdata, "href=", vbTextCompare) + 5
PO2 = 1
Dim newstr as String:newstr = ""
Dim whostr as String:whostr = ""
i = 0
Do while PO1 > 0
Newstr = Mid (Strdata, PO2, PO1)
Whostr = Whostr + newstr
PO2 = InStr (PO1, Strdata, ">", vbTextCompare)
Note: Change the original link to a new link
Oril = Mid (strdata, PO1 + 1, po2-po1-1)
Note: If there are quotes, remove the quotes
ln = Replace (Oril, "" "", "", vbTextCompare)
NEWL = right (ln, Len (LN)-InStrRev (LN, "/")
Whostr = whostr & NEWL
If ln <> "" Then
Note: Determine if the file has been downloaded.
If fileexists (spath & newl) = False Then
Links (i) = Addsuf & LN
i = i + 1
Else
Lmtime = Inet1.getheader ("last-modified")
Set f = fs.getfile (spath & NEWL)
CTime = f.datecreated
Comments: Determining whether a file is updated
If DateDiff ("s", Lmtime, CTime) < 0 Then
i = i + 1
End If
End If
End If
PO1 = InStr (po2 + 1, strdata, "href=", vbTextCompare) + 5
Loop
Newstr = Mid (strdata, PO2)
Whostr = Whostr + newstr
 
Set a = Fs.createtextfile (spath & fname, True)
A.write Whostr
A.close
K = i
Else
Dim Vtdata as Variant
Dim B () as Byte
Dim bdone as Boolean:bdone = False
Vtdata = Inet2.getchunk (1024, Icbytearray)
Do as not bdone
B () = B () & Vtdata
Vtdata = Inet2.getchunk (1024, Icbytearray)
If Len (Vtdata) = 0 Then
Bdone = True
End If
Loop
Open spath & fname for Binary Access Write as #1
Put #1, B ()
Close #1
End If
Call Devjob Note: Calling the thread Dispatcher subroutine
End Select
 
End Sub
 
Private Sub inet2_statechanged (ByVal State as Integer)
...
End Sub
 
...
 
Thread Dispatcher subroutine, G and is k common variable, K is the last linked array index plus one, g initial value is zero, add one at a time until the last link is processed.
Private Sub Devjob ()
 
If not G + 1 < k Then GoTo Reportline
If inet1.stillexecuting = False Then
g = g + 1
Inet1.execute links (g), "get"
End If
If not G + 1 < k Then GoTo Reportline
If inet2.stillexecuting = False Then
g = g + 1
Inet2.execute links (g), "get"
End If
 
...
 
Reportline:
If inet1.stillexecuting = False and inet2.stillexecuting = False and ... Then
MsgBox ("download ended.") ")
End If
End Sub


Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.