第一步，建立工程，引用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
