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 
|