VB中如何实现断点续传？

[gugh]

如题·

[帝企鹅已被占用]

vb冒是不能。
等高手。

[liquoryellow]

http://www.downcode.com/downcode/j_13765.shtml
http://www.soojoo.cn/ziliao/2556.html
http://www.vbgood.com/viewthread.php?tid=75217
由于目前没有VB环境，所以只能是这样帮你了。

[贝隆]

[Quote=引用 2 楼 liquoryellow 的回复:]
http://www.downcode.com/downcode/j_13765.shtml
http://www.soojoo.cn/ziliao/2556.html
http://www.vbgood.com/viewthread.php?tid=75217
由于目前没有VB环境，所以只能是这样帮你了。

[/Quote]

学习

[guyehanxinlei]

用http形式可以做到.
在以http形式下载数据时,返回的头中含有文件大小,类型等信息.去掉不必要的头信息,余下的就是文件的内容.
下载过程中,本地需要记录上一次读取到的字节,下次从此处继续读取.

[guyehanxinlei]

利用Winsock下载文件（支持断点续传）
第一步，建立工程，引用Winsock（Visual Basic最好打SP6,否则MS有一个Bug）,在此省略

第二步，具体实现代码步骤1：发送请求
说明：
(1)这里简单采用了判断是否已经有同名文件表示是否要断点续传
(2)下载的地址，大小和已下载字节数也只是简单地存在ini文件中，更安全的做法本文不作讨论
有兴趣的朋友可以联系我

'--------------------------------------------------------------------------------
'   Name:DownloadFile
'   Author:Reker 2004/3/20
'   Desc:连接远端主机，发送接收文件请求，等待远端主机响应
'   Params:None
'   History:None
'--------------------------------------------------------------------------------
Private Sub DownloadFile()
    On Error Resume Next
    StartTime = Time()
    With WinSck
        .RemoteHost = Host '远端主机地址
        .RemotePort = 80
        .Connect
        '等待服务器连接相应
        Do While .State <> sckConnected
            DoEvents: DoEvents: DoEvents: DoEvents
            '20秒超时
            If DateDiff("s", StartTime, Time()) > 20 Then
                ShowInfo "连接超时"
                .Close
                Exit Sub
            End If
        Loop
        '发送下载文件请求
        '此处使用HTTP/1.0协议
        strCommand = "GET " + UpdateURL + " HTTP/1.0" + VBCrLf '下载地址
        strCommand = strCommand + "Accept: */*" + vbCrLf      '这句可以不要
        strCommand = strCommand + "Accept: text/html" + vbCrLf '这句可以不要
        strCommand = strCommand + vbCrLf
        strCommand = strCommand & "Host: " & Host & vbCrLf
        If Dir(SaveFileName) <> "" Then '是否已经存在下载文件
            Dim confirm
            confirm = MsgBox("已经存在文件，是否断点续传?", vbYesNo + vbQuestion, "提示")
            If confirm = vbYes Then
                DownPosition = ""
                If Not oFileCtrl.ReadKeyFromIni("Update", "DownSize", AppPath + "Update.ini", DownPosition) Then
                '读取上次下载的字节数
                    MsgBox "读取大小错误", vbInformation, "提示"
                End If
                '发送断点续传请求
                strCommand = strCommand & "Range: bytes=" & CLng(DownPosition) & "-" & vbCrLf
            Else
                Kill SaveFileName '删除原文件
            End If
        End If
        strCommand = strCommand & "Connection: Keep-Alive" & vbCrLf
        strCommand = strCommand & vbCrLf
        .SendData strCommand
    End With
    If Err Then
        lblProcessResult.Caption = lblProcessResult.Caption & vbCrLf & vbCrLf & "下载文件出错：" & Err.Description
        lblProcessResult.Refresh
    End If
End Sub


第二步，具体实现代码步骤2：接收数据
'--------------------------------------------------------------------------------
'   Name:Winsck_DataArrival
'   Author:Reker 2004/3/20
'   Desc:略
'   Params:略
'   Return:None
'   History:None
'--------------------------------------------------------------------------------
Private Sub Winsck_DataArrival(ByVal bytesTotal As Long)
    On Error Resume Next
    'DoEvents: DoEvents
    Dim ByteData() As Byte
    WinSck.GetData ByteData(), vbByte
    ReceiveData = ReceiveData & StrConv(ByteData(), vbUnicode)
    If InStr(1, ReceiveData, "Content-Length:") > 0 And FileSize = 0 Then '仅第一次计算,FileSize=0
        Dim pos1 As Long, pos2 As Long
        pos1 = InStr(1, ReceiveData, "Content-Length:")
        pos2 = InStr(pos1 + 16, ReceiveData, vbCrLf)
        If pos2 > pos1 Then
            FileSizeByte = Mid(ReceiveData, pos1 + 16, pos2 - pos1 - 16) '计算文件的长度
            StartTime = Timer() '保存开始下载的时间
            ProgssBar.Max = FileSizeByte '设置进度条
            FileSize = FormatNumber(FileSizeByte / 1024, 2) '以KB表示
            ShowInfo "本次下载的文件共" + CStr(FileSize) + "KB..."
        End If
    End If
    '从服务器响应返回的数据查找下载文件的起始位置
    If FileHeaderLen = 0 Then
        For i = 0 To UBound(ByteData()) - 3
            If ByteData(i) = 13 And ByteData(i + 1) = 10 And ByteData(i + 2) = 13 And ByteData(i + 3) = 10 Then
                StartPos = i + 4 '将文件头的长度保存下来
                FileHeaderLen = StartPos
                Exit For
            End If
            'DoEvents 
        Next i
    End If
    FileSizeHaveDown = bytesTotal + FileSizeHaveDown - FileHeaderLen     
    '已下载文件长度，需减去响应的文件头长度
    dblDownloadSpeed = FormatNumber(FormatNumber(FileSizeHaveDown / 1024, 2) / (FormatNumber((Timer() - StartTime), 4)), 2)  '计算下载速率 KB/S
    If dblDownloadSpeed <> 0 Then  '计算剩余下载的时间
        sRestTime = GetRestTime(CLng((FileSize - (FileSizeHaveDown) / 1024) / dblDownloadSpeed)) '此过程略，可以删除此段代码
        labRestTime.Caption = "剩余时间：º" + sRestTime
        labRestTime.Refresh
    End If
    labDownloadSpeed.Caption = CStr(dblDownloadSpeed) + " kb/s"
    labDownloadSpeed.Refresh
    ProgssBar.Value = FileSizeHaveDown
    '写数据
    Fnum = FreeFile()
    Open SaveFileName For Binary Lock Write As #Fnum
    If LOF(Fnum) > 0 Then
        Seek #Fnum, LOF(Fnum) + 1
    End If
    If StartPos > 0 Then
        For i = StartPos To UBound(ByteData())
            Put #Fnum, , ByteData(i)
        Next i
    Else 
        Put #Fnum, , ByteData()
    End If
    Close #Fnum 
    If Err Then
        lblProcessResult.Caption = lblProcessResult.Caption & vbCrLf & 获取数据出错：" & Err.Description
        lblProcessResult.Refresh
    End If
End Sub
参考一下

[帝企鹅已被占用]

楼上看到过，自己没试试。

[liguicd]

[Quote=引用 1 楼 patrickkong 的回复:]
vb冒是不能。
等高手。
[/Quote]
...

[帝企鹅已被占用]

那看阿贵的

[kingwoo98]

路过，学习下