大文件断点续传的方法

vbexcelhome

在下载的时候只要在请求头“Range”中设置“bytes=开始字节-结束字节”。就可以下载指定块（不是所有网站都支持），下面是找到的一段代码，虽然不实用，但是完整的演示了原理。
备注：在用OPEN的Binary 模式打开文件时，可以任意指定读写文件位置，也就是可以设置文件读写指针，这个指针是整数类型，最大范围不能超过2G，由于VB没有无符号整数，所以最大只能在1G多，如果超过1G的文件只能用别的方法解决。


下面是网友“lyserver”的代码
Dim m_blnStop As Boolean
Private Type BlockInfo
    FlagSucceed As Boolean
    FlagDone As Boolean
    FlagAddProcess As Boolean
    Start As Long
    End As Long
    index As Long
End Type

Private Sub Command1_Click()
    '下载，由于在局域网内测试，因此分块设置较大（400K）
    Dim t
    t = Timer
    DownFileByHTTP Text1.Text, Text2.Text, 4096 * 5, True
    Debug.Print Timer - t
    If m_blnStop = True Then
        MsgBox "数据下载被中断！", vbCritical, "提示"
    Else
        MsgBox "数据下载完毕！", vbInformation, "提示"
    End If
End Sub

'* -------------------------------------------
' 函数说明：基于XMLHTTP的数据下载函数（支持断点续传）
' 参数说明：URL待下载的URL
'           FileName保存下载结果的文件
'           BlockSize分块大下，根据网络情况而定，以便VB能及时执行DoEvents来获得鼠标和键盘动作并刷新界面
'           ResumeTransfer是否支持断点续传
' 编码：lyserver
'* -------------------------------------------
Private Sub DownFileByHTTP(ByVal Url As String, FileName As String, Optional BlockSize As Long = 4096, Optional ResumeTransfer As Boolean)
    Dim xmlHttp As Object
    Dim bytData() As Byte
    Dim i As Long, fn As Integer, lTotalSize As Long

    '获得文件长度
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "HEAD", Url, False
    xmlHttp.Send
    lTotalSize = xmlHttp.GetResponseHeader("Content-Length")
    Debug.Print lTotalSize / 1024
    Debug.Print Len(xmlHttp.ResponseBody)
    Set xmlHttp = Nothing

    '打开文件
    fn = FreeFile()
    Open FileName For Binary As #fn

    '判断是否需要断点续传
    If ResumeTransfer = True Then
        i = LOF(fn)
        Seek fn, i + 1
    End If

    '分块下载数据，并保存到文件中
    m_blnStop = False '重置中断标志
    Do While i < lTotalSize And m_blnStop = False '没有使用For循环是因为需要下载数与实际下载数可能不一致
        '获得文件数据

        Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
        xmlHttp.Open "GET", Url, False
        xmlHttp.SetRequestHeader "Referer", Left(Url, InStr(InStr(Url, "//") + 2, Url, "/") - 1)
        xmlHttp.SetRequestHeader "Accept", "*/*"
        xmlHttp.SetRequestHeader "User-Agent", "lyserver" '"Baiduspider+(+http://www.baidu.com/search/spider.htm)"
        xmlHttp.SetRequestHeader "Range", "bytes=" & i & "-" & CStr(i + IIf(lTotalSize - i > BlockSize, BlockSize, lTotalSize - i) - 1) '分段
        xmlHttp.SetRequestHeader "Content-Type", "application/octet-stream"
        xmlHttp.SetRequestHeader "Pragma", "no-cache"
        xmlHttp.SetRequestHeader "Cache-Control", "no-cache"
        xmlHttp.Send
        '转换为字节数组
        bytData = xmlHttp.ResponseBody
'        Debug.Print UBound(bytData), Len(xmlHttp.ResponseBody)
        Set xmlHttp = Nothing
        '保存到文件中
        Put fn, , bytData
        '重置下载开始位置
        i = i + UBound(bytData) + 1
        '释放控制权
        DoEvents
        '显示进度
        Debug.Print VBA.FormatPercent(i / lTotalSize)
    Loop
    Close fn
End Sub