第一步，建立工程，引用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
本文地址：http://com.8s8s.com/it/it20403.htm