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