VB6之断点续传

闲来无事，研究了下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 If

ERROR_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           // ::