基于HTTP協議用WinSock實現任意文件下載
2024-07-21 02:16:02
供稿：網友
http協議是文本格式通訊，下載文件是二進制數據，怎樣處理好兩種格式，而不受vb獨斷專行的unicode轉換影響，本代碼提供了一個示例。
option explicit
private strurl as string
private mstrfilename as string, mlngfilenum as long
private mlngfilelen as long, mlngcurbyte as long
private mblnonlylen as boolean, mblnputstart as boolean
private sub form_load()
strurl = text1.text '準備下載的文件url
mstrfilename = text2.text '下載文件在本存放的位置與文件名
label1.caption = "文件總字節:0"
label2.caption = "已下載字節:0"
command1.caption = "開始下載"
command2.caption = "取得長度"
end sub
private sub command1_click()
mblnonlylen = false
downfile
end sub
private sub command2_click()
mblnonlylen = true
label1.caption = "文件總字節:0"
downfile
end sub
private sub downfile()
mblnputstart = false
label2.caption = "已下載字節:0"
command1.enabled = false
command2.enabled = false
with winsock1
if .state <> sckclosed then .close
.protocol = scktcpprotocol
.remotehost = "article.tianyaclub.com"
.remoteport = 80
.connect
end with
end sub
private sub winsock1_connect()
dim s as string
s = "get " + strurl + " http/1.0" + vbcrlf
s = s + "accept: */*" + vbcrlf
s = s & "pragma: no-cache" & vbcrlf
s = s & "cache-control: no-cache" & vbcrlf
s = s & "connection: close" & vbcrlf & vbcrlf
s = s + vbcrlf
winsock1.senddata s
end sub
private sub closeall()
if winsock1.state <> sckclosed then winsock1.close
close #mlngfilenum
command1.enabled = true
command2.enabled = true
end sub
private sub winsock1_dataarrival(byval bytestotal as long)
dim revdata() as byte
dim a() as byte, b() as string, c() as string
dim s as string, i as long, k as long
on error goto fail
if mblnputstart = false then
winsock1.peekdata revdata, vbarray or vbbyte
k = instrb(1, revdata, chrb(13) & chrb(10) & chrb(13) & chrb(10))
if k > 0 then
winsock1.getdata revdata, vbarray or vbbyte
a = leftb(revdata, k - 1)
revdata = midb(revdata, k + 4)
s = strconv(a, vbunicode)
b = split(s, vbcrlf)
if instr(1, b(0), "200 ok", vbtextcompare) = 0 then goto fail
for i = 1 to ubound(b)
c = split(b(i), ": ")
select case c(0)
case "content-length"
mlngfilelen = clng(c(1))
label1.caption = "文件總字節:" & mlngfilelen
if mblnonlylen then
closeall
exit sub
end if
end select
next
mblnputstart = true
mlngcurbyte = ubound(revdata) + 1
mlngfilenum = freefile
open mstrfilename for binary as #mlngfilenum
else
exit sub
end if
else
winsock1.getdata revdata, vbarray or vbbyte
mlngcurbyte = mlngcurbyte + bytestotal
end if
put #mlngfilenum, , revdata
label2.caption = "已下載字節:" & mlngcurbyte
if mlngcurbyte = mlngfilelen then
closeall
msgbox "下載成功！"
end if
exit sub
fail:
closeall
msgbox "網絡傳輸錯誤，文件下載失敗！"
end sub
