利用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 =
"剩余时间:o"
+ 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
参考一下
联系客服