vb winsock 下载大文件问题

sushy001 2010-10-24 06:57:25
我有一段代码是这样的。
因为我要下载文件,而且是大文件,并且需要自动获得文件名。
如 http://www.sohu.com/aaa/download.asp?id=5
实际上文件名是 搜狐拼音.rar (从 filename中获得)
但是我在修改 Winsock1_DataArrival 时,老是修改不正确。

请大家能否给我补充一个完整的 Winsock1_DataArrival ?
并且用数组接收变量,并保存到文件中。

Private Sub Command1_Click()
Winsock1.RemoteHost = "www.baidu.com" '设置连接的网址
Winsock1.RemotePort = 80 '设置要连接的远程端口号
Winsock1.Connect '返回与远程计算机的连接。
End Sub

Private Sub Winsock1_Connect()

Dim strCommand As String
Dim strWebPage As String

'当一个 Connect 操作完成时发生
'On Error Resume Next
strWebPage = "http://www.baidu.com/index.html" '要下载的文件
strCommand = "GET " + strWebPage + " HTTP/1.0" + vbCrLf ''GET 为FTP命令 取得文件
strCommand = strCommand + "Accept: */*" + vbCrLf '这句可以不要
strCommand = strCommand + "Accept: text/html" + vbCrLf '这句可以不要
strCommand = strCommand + vbCrLf '记住一定要加上vbCrLf
'Debug.Print strCommand '注:你可以用Debug.Print strCommand 来查看一下格式
Winsock1.SendData strCommand '给远程计算机发送数据
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) '取得数据时产生该事件
On Error Resume Next '在错误处理程序结束后,恢复原有的运行
Dim webData As String
Winsock1.GetData webData, vbString '检取当前的数据块
Text1.Text = Text4.Text + webData
End Sub
...全文
263 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
Qiaodows 2012-02-18
  • 打赏
  • 举报
回复
不懂耶...
sushy001 2010-10-25
  • 打赏
  • 举报
回复
我到处找,找了如下代码,但在 Winsock1_DataArrival 中,如何分离header和正文部分,并从header中提取相关信息呢?
因为下载回来的是byte类型,而header是文本,应该是 String 类型,如何将这两部分分开呢?

谢谢,其他问题基本上东拼西凑的都搞定了。



Private Sub WinSockCconnect()

Dim i As Integer
i = InStr(8, FileUrl, "/")
FileHost = Mid(FileUrl, 8, i - 8)
Text5.Text = FileHost
Winsock1.RemoteHost = FileHost '设置连接的网址
Winsock1.RemotePort = 80 '设置要连接的远程端口号
Winsock1.Connect '返回与远程计算机的连接。
End Sub

Private Sub Winsock1_Connect()

Dim strCommand As String



'当一个 Connect 操作完成时发生
On Error Resume Next
DisEnableControl '相关控件失效
strCommand = "GET " + FileUrl + " HTTP/1.0" + vbCrLf ''GET 为FTP命令 取得文件
strCommand = strCommand + "Accept: */*" + vbCrLf '这句可以不要
strCommand = strCommand + "Referer: " + RefererUrl + vbCrLf '这句可以不要
strCommand = strCommand + "Accept-Language: zh-cn" + vbCrLf '这句可以不要
strCommand = strCommand + "Accept-Encoding: gzip, deflate" + vbCrLf '这句可以不要
strCommand = strCommand + "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 2.0.50727)" + vbCrLf '这句可以不要
strCommand = strCommand + "Host: " + FileHost + vbCrLf '这句可以不要
strCommand = strCommand + "Connection: Keep-Alive" + vbCrLf '这句可以不要
strCommand = strCommand + vbCrLf '记住一定要加上vbCrLf
'Debug.Print strCommand '注:你可以用Debug.Print strCommand 来查看一下格式
Winsock1.SendData strCommand '给远程计算机发送数据
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) '取得数据时产生该事件
'On Error Resume Next '在错误处理程序结束后,恢复原有的运行
'Dim webData As String
'Winsock1.GetData webData, vbString '检取当前的数据块
'Text4.Text = Text4.Text + webData
Dim HeaderReceived As Boolean '定义header是否接收完成
Dim strData As Variant '定义接收的字符串
Dim intBreakePosition As Integer '定义header结束的位置
Dim strHttpResponse As Variant '定义下载的内容
Dim vHeaders As Variant '定义header数组
Dim vHeader As Variant '定义header中的每一行
Dim ContentLength As Long
Dim FileTotalLenght As Long '文件正文总长度
Dim SaveFileName As String '保存文件名,如 a.rar
Dim SaveFileLoad As String '保存文件路径 如 c:\data\a.rar
Dim DownloadedBytes As Integer '已经接收文件正文的长度
Dim mintFile As Long '打开文件

Dim databyte()
ReDim databyte(bytesTotal)


On Error Resume Next

Winsock1.GetData strData, vbArray + vbByte, bytesTotal

strHttpResponse = strHttpResponse & strData '已经下载的数据,包含header
DownloadedBytes = DownloadedBytes + bytesTotal '已经下载的数据量 包含 header
Text5.Text = strHttpResponse

If Not HeaderReceived Then '如果头文件没有结束
intBreakePosition = InStr(1, strHttpResponse, vbCrLf & vbCrLf) '找头文件结束点
If intBreakePosition Then '如果找到了头文件结束点
HeaderReceived = True '头文件结束
DownloadedBytes = DownloadedBytes - intBreakePosition - 3 '正式文件长度
vHeaders = Split(Left(strHttpResponse, intBreakePosition - 1), vbCrLf) '将头文件每行分割成一个数组

'接下来分析是200 302 404

If InStr(1, vHeaders(0), "404") Then
Winsock1.Close
MsgBox "文件地址错误!", vbInformation
Exit Sub

ElseIf InStr(1, vHeaders(0), "302") Then

For Each vHeader In vHeaders
If InStr(1, vHeader, "Location:") Then
FileUrl = Mid(vHeader, InStr(1, vHeader, " ") + 1)
Text5.Text = FileUrl
Exit For
End If
Next
Winsock1.Close

Text5.Text = FileUrl

WinSockCconnect '重定向后再次链接

ElseIf InStr(1, vHeaders(0), "200") Then
For Each vHeader In vHeaders
If InStr(1, vHeader, "Content-Length") Then
ContentLength = CLng(Mid(vHeader, InStr(1, vHeader, " ") + 1))
FileTotalLenght = CInt(ContentLength / 1024) & " KB" '获取文件长度
ElseIf InStr(1, vHeader, "filename=") Then
SaveFileName = Mid(vHeader, InStr(1, vHeader, "filename=") + 9) '获取文件名
End If
Next

If SaveFileName <> "" Then
SaveFileLoad = VB.App.Path & "\data\" & SaveFileName
Else
SaveFileLoad = VB.App.Path & "\data\" & "error.txt"
End If

strData = Mid(strData, intBreakePosition + 4)


Open SaveFileLoad For Binary Access Write As #mintFile '打开文件

End If
End If
'Else
'If ContentLength > 0 Then
'lvItem(Index).SubItems(2) = CInt(DownloadedBytes / (ContentLength / 100)) & "%"
'lvItem(Index).SubItems(4) = CInt(DownloadedBytes / 1024) & " KB"
'Else
'lvItem(Index).SubItems(4) = CInt(DownloadedBytes / 1024) & " KB"
'End If
End If

Put #mintFile, , strData '写入要保存的文件中

If DownloadedBytes >= ContentLength Then
Close #mintFile
Winsock1.Close
MsgBox "下载完成!", vbInformation
EnableControl
End If
End Sub










咸清 2010-10-24
  • 打赏
  • 举报
回复
ReDim GotDat(0 To bytesTotal - 1)
If FileNum = 0 Then
FileNum = FreeFile
On Error Resume Next
If FileLen(FilePath) > 0 Then Kill FilePath
Open FilePath For Binary As #FileNum
End If
End If

Winsock1.GetData GotDat, vbArray + vbByte
Put #FileNum, , GotDat
'代码示例~

1,502

社区成员

发帖
与我相关
我的任务
社区描述
VB 网络编程
社区管理员
  • 网络编程
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧