vb源码吧 关注:51贴子:79
  • 4回复贴,共1

发个下载器的源码,非原创

只看楼主收藏回复

防偷窥


1楼2013-06-23 21:54回复
    Private Sub StartDownLoad(ByVal Geturl As String)
    Dim spo%, filename$
    Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(App.Path & "\download") Then Set f = fso.CreateFolder(App.Path & "\download")
    spo = InStrRev(Geturl, "/")
    filename = Right(Geturl, Len(Geturl) - spo) '获取文件名
    text2.Text = App.Path & "\download\" & filename
    Inet1.Execute Geturl, "get" '开始下载
    End Sub Private Sub Inet1_StateChanged(ByVal State As Integer)
    'State = 12 时,用 GetChunk 方法检索服务器的响应。
    Dim vtData() As Byte
    Select Case State
    Case icHostResolvingHost
    label3.Caption = "正在查询所指定的主机的 IP 地址"
    Case icHostResolved
    label3.Caption = "成功地找到所指定的主机的 IP 地址"
    Case icConnecting
    label3.Caption = "正在与主机连接"
    Case icConnected
    label3.Caption = "已与主机连接成功"
    Case icRequesting
    label3.Caption = "正在向主机发送请求"
    Case icRequestSent
    label3.Caption = "发送请求已成功"
    Case icReceivingResponse
    label3.Caption = "在接收主机的响应"
    Case icResponseReceived
    label3.Caption = "成功地接收到主机的响应"
    Case icDisconnecting
    label3.Caption = "正在解除与主机的连接"
    Case icDisconnected
    label3.Caption = "已成功地与主机解除了连接"
    Case icError
    label3.Caption = "与主机通讯时出现了错误"
    '出现错误时,返回 ResponseCode 和 ResponseInfo。
    vtData = Inet1.ResponseCode & ":" & Inet1.ResponseInfo
    Case icResponseCompleted ' 12
    Dim bDone As Boolean: bDone = False
    '取得第一个块。
    vtData() = Inet1.GetChunk(1024, 1)
    DoEvents
    Open text2.Text For Binary Access Write As #1 '设置保存路径文件后开始保存
    '获取下载文件长度
    If Len(Inet1.GetHeader("Content-Length")) > 0 Then ProgressBar1.Max = CLng(Inet1.GetHeader("Content-Length"))
    '循环分块下载
    Do While Not bDone
    Put #1, Loc(1) + 1, vtData()
    vtData() = Inet1.GetChunk(1024, 1)
    DoEvents
    ProgressBar1.Value = Loc(1) '设置进度条长度
    If Loc(1) >= ProgressBar1.Max Then bDone = True
    Loop
    Close #1
    MsgBox "下载完成,请检验download目录里的文件是否完整!", vbInformation, "通知"
    End Select
    End Sub


    2楼2013-06-23 21:55
    回复
      顶楼主,支持楼主无私的奉献


      4楼2013-06-23 23:10
      回复
        界面怎么设计!


        来自Android客户端5楼2013-07-21 20:10
        收起回复