利用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 + "Aclearcase/" target="_blank" >ccept: */*" + 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

原文转自：http://www.ltesting.net