基于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
