闲来无事，研究了下HTTP的断点续传，用VB6写了小Demo。
关于HTTP-Range细节可参考：
http://www.w3.org/Protocols/rfc2616/rfc2616.html
http://www.liqwei.com/network/protocol/2011/886.shtml
以在“下载吧”下载notepad++的安装程序为例，其主要流程为：
1.判断资源是否支持断点续传。
2.如果支持则返回文件的大小，用作后面做分段任务使用。
3.将下载任务分成4个任务流（姑且把winsock当做多线程来看），然后按照文件大小分配下载额度。
4.启动下载的任务流后，监视下载完成度。
5.文件下载完成后，合并到本地。
测试了下，5.4M的程序下载大约在5秒钟左右就完成了（应该不是我网速快的原因），还是很快的。像那个下载工具IDM（Internet Download Manger）原理上就跟这个Demo差不多。由于用了控件不太好封装了，看到那些公共变量也是醉了，菜手捂脸遁了。另外，我这个Demo因为下载的文件较小，将数据完全存在内存中。如果是大文件，还是要先落地再合并。
具体实现代码：
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As Long)'分段下载的任务属性
Private Type RangeTask
host As String
port As Integer
head As String
buff() As Byte
size As Long
done As Boolean
End Type'定义任务组
Private Tasks() As RangeTask'延时函数
Private Sub Sleep(ByVal dwDelay As Long)
Dim dwDeadline As Long
dwDeadline = GetTickCount() + dedelay
Do While dwdeadlin > GetTickCount()
DoEvents
Loop
End Sub'判断资源是否支持断点续传
Private Function IsServerRanged(ByVal url As String, ByRef Length As Long) As Boolean
On Error GoTo ERROR_HANDLER:
IsServerRanged = False
Dim http As Object
Const USER_AGENT = "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.0 Safari/537.36" Set http = CreateObject("msxml2.xmlhttp")
Call http.Open("HEAD", url, False)
Call http.setRequestHeader("User-Agent", USER_AGENT)
Call http.send Do Until http.readyState =
Call Sleep()
Loop If http.getResponseHeader("Accept-Ranges") <> "" Then
IsServerRanged = True
Length = http.getResponseHeader("Content-Length")
End IfERROR_HANDLER:
Err.Clear
Set http = Nothing
End Function'分配任务，主要计算Range的起止点
Private Sub TaskAssignment(ByVal url As String, ByVal Length As Long)
ReDim Tasks() As RangeTask
temp = Split(url, "/")()
If InStr(temp, ":") Then
host = Split(temp, ":")()
port = Split(temp, ":")()
Else
host = temp
port =
End If
file = "/" & Split(url, "/", )()
over = Length Mod
ttmp = (Length - (Length Mod )) / For i = To
Tasks(i).host = host
Tasks(i).port = port
Tasks(i).size = ttmp + IIf(i = , over, )
ReDim Tasks(i).buff(Tasks(i).size - ) As Byte
Tasks(i).head = "GET " & file & " HTTP/1.1" & vbCrLf & _
"Host: " & host & vbCrLf & _
"Connection: closed" & vbCrLf & _
"User-Agent: Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.0 Safari/537.36" & vbCrLf & _
"Accept: */*" & vbCrLf & _
"Accept-Encoding: gzip,deflate,sdch" & vbCrLf & _
"Range: bytes=" & i * ttmp & "-" & (i + ) * ttmp + IIf(i = , over, ) - & vbCrLf & vbCrLf
Tasks(i).done = False
Next
End Sub'启动分段下载
Private Sub SetupRangeTasks()
For i = To
RangeLoader(i).Protocol = sckTCPProtocol
RangeLoader(i).RemoteHost = Tasks(i).host
RangeLoader(i).RemotePort = Tasks(i).port
RangeLoader(i).Connect
Next
End Sub'将下载完的字节写入本地文件
Private Sub BuildRangeFile(ByVal filepath As String)
Open filepath For Binary Access Write As #
For i = To
Put #, , Tasks(i).buff
Erase Tasks(i).buff
Next
Close #
Erase Tasks
End Sub'各段下载完毕
Private Sub RangeLoader_Close(Index As Integer)
Call RangeLoader(Index).Close
Tasks(Index).done = True
For i = To
If Not Tasks(i).done Then
Exit Sub
End If
Next
Call BuildRangeFile("d:\NotepadPlusPlus_6.6.9_XiaZaiBa.exe")
Debug.Print "END", Now()
End Sub'与Server端连接后，GET文件
Private Sub RangeLoader_Connect(Index As Integer)
Call RangeLoader(Index).SendData(Tasks(Index).head)
End Sub'数据接收时，计算下载率
'如果下载完成则拷贝出原始数据
Private Sub RangeLoader_DataArrival(Index As Integer, ByVal bytesTotal As Long)
If RangeLoader(Index).BytesReceived > Tasks(Index).size Then
Dim buff() As Byte
Call RangeLoader(Index).GetData(buff, vbByte)
Call CopyMemory(Tasks(Index).buff(), buff(UBound(buff) - Tasks(Index).size + ), Tasks(Index).size)
Erase buff
Else
'这个WinSock貌似每次下载的数据量都在3752字节左右
Debug.Print "RangeLoader"; Index, Round(RangeLoader(Index).BytesReceived / Tasks(i).size * , ) & "%"
End If
End Sub'下载文件
Private Sub Command1_Click()
Dim url As String
Dim Length As Long
url = "http://xiazai.xiazaiba.com/Soft/N/NotepadPlusPlus_6.6.9_XiaZaiBa.exe"
If IsServerRanged(url, Length) Then
Call TaskAssignment(url, Length)
Call SetupRangeTasks
Debug.Print "START", Now()
Else
Debug.Print "task cannot be ranged."
End If
End Sub
运行后信息输出大体是这个样子：
立即窗口：START // ::
...
RangeLoader 89.53%
RangeLoader 89.8%
RangeLoader 89.8%
RangeLoader 86.76%
RangeLoader 82.2%
RangeLoader 82.22%
RangeLoader 90.07%
RangeLoader 82.47%
RangeLoader 90.33%
RangeLoader 86.88%
RangeLoader 87.02%
RangeLoader 82.73%
RangeLoader 82.8%
RangeLoader 90.38%
RangeLoader %
RangeLoader 90.87%
RangeLoader 87.46%
RangeLoader 83.27%
RangeLoader 83.38%
RangeLoader 90.96%
RangeLoader 87.46%
RangeLoader 83.53%
RangeLoader 91.4%
RangeLoader 87.72%
RangeLoader 83.97%
RangeLoader 91.55%
RangeLoader 84.07%
RangeLoader 88.05%
RangeLoader 91.94%
RangeLoader 88.26%
RangeLoader 84.34%
RangeLoader 92.13%
RangeLoader 88.63%
RangeLoader 92.71%
RangeLoader 88.79%
...
END // ::
