.NET开发

本类阅读TOP10

·NHibernate快速指南(翻译)
·vs.net 2005中文版下载地址收藏
·【小技巧】一个判断session是否过期的小技巧
·VB/ASP 调用 SQL Server 的存储过程
·?dos下编译.net程序找不到csc.exe文件
·通过Web Services上传和下载文件
·学习笔记(补)《.NET框架程序设计(修订版)》--目录
·VB.NET实现DirectDraw9 (2) 动画
·VB.NET实现DirectDraw9 (1) 托管的DDraw
·建站框架规范书之——文件命名

分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
基于HTTP协议用WinSock实现任意文件下载

作者:未知 来源:月光软件站 加入时间:2005-5-13 月光软件站

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




相关文章

相关软件