苏拉玛 散布谣言:基于HTTP协议用WinSock实现任意文件下载
来源:百度文库 编辑:九乡新闻网 时间:2024/05/22 02:24:28
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
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
基于HTTP协议用WinSock实现任意文件下载
基于HTTP的QQ协议之我所见
winsock
Http协议
基于Linux系统的边界网关协议的设计与实现-1
【高速下载】文件夹虚拟硬盘分区 1.0 | 让任意文件夹变成硬盘分区 | 单文件工具_软件...
http协议简介
HTTP协议报文格式
文件保密协议
新技术使分子计算机实现任意演算
PPT中实现任意图形随意旋转
Office2003实现PDF文件转Word文档 - PDF,电子书,下载,TXT,chm...
++++++++++任意文件隐藏在一张图片里
把任意文件隐藏在一张图片
把任意文件隐藏在图片里
无敌删除命令,任意删除文件
用迅雷下载BT种子文件
struts2实现文件上传
免费好用的硬盘分区软件下载:增大缩小|合并删除任意分区(无损)-亿度软件下载
用批处理实现文件备份器V2.3(1)
用VB实现图形文件的批量转换
深入理解HTTP协议(转)
HTTP协议的头信息详解------1
下载方式: 鼠标右键"目标另存为"方式下载. 下载不了的文件,可以尝试用迅雷