bfdownload.ctl

VB源码HTTP下载控件,变量都用中文命名,英文不好的朋友也可以看懂！

End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,1,1,空闲
Public Property Get 当前状态() As String
    当前状态 = m_当前状态
End Property

Public Property Let 当前状态(ByVal New_当前状态 As String)
    If Ambient.UserMode = False Then Err.Raise 387
    'If Ambient.UserMode Then Err.Raise 382
    m_当前状态 = New_当前状态
    PropertyChanged "当前状态"
    RaiseEvent 状态改变
    DoEvents
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,1,1,
Public Property Get 状态说明() As String
    状态说明 = m_状态说明
End Property

Public Property Let 状态说明(ByVal New_状态说明 As String)
    If Ambient.UserMode = False Then Err.Raise 387
    'If Ambient.UserMode Then Err.Raise 382
    m_状态说明 = New_状态说明
    PropertyChanged "状态说明"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=8,0,0,4096
Public Property Get 缓冲字节() As Long
    缓冲字节 = m_缓冲字节
End Property

Public Property Let 缓冲字节(ByVal New_缓冲字节 As Long)
    m_缓冲字节 = New_缓冲字节
    PropertyChanged "缓冲字节"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,
Public Property Get 默认路径() As String
    默认路径 = m_默认路径
End Property

Public Property Let 默认路径(ByVal New_默认路径 As String)
    m_默认路径 = Trim(New_默认路径)
    If Right(m_默认路径, 1) <> "\" And Right(m_默认路径, 1) <> "/" Then m_默认路径 = m_默认路径 & "\"
    PropertyChanged "默认路径"
End Property

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    m_下载地址 = m_def_下载地址
    m_保存地址 = m_def_保存地址
    m_字节总数 = m_def_字节总数
    m_下载速度 = m_def_下载速度
    m_读取字节 = m_def_读取字节
    m_覆盖现有 = m_def_覆盖现有
    m_剩余时间 = m_def_剩余时间
    m_下载进度 = m_def_下载进度
    m_当前状态 = m_def_当前状态
    m_状态说明 = m_def_状态说明
    m_缓冲字节 = m_def_缓冲字节
    m_默认路径 = m_def_默认路径
    m_文件名 = m_def_文件名
    m_文件路径 = m_def_文件路径
    m_文件主名 = m_def_文件主名
    m_文件扩展名 = m_def_文件扩展名
    m_文件类型 = m_def_文件类型
    m_综合信息 = m_def_综合信息
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    PBar.Orientation = PropBag.ReadProperty("Orientation", 0)
    PBar.Scrolling = PropBag.ReadProperty("Scrolling", 0)
    PBar.Appearance = PropBag.ReadProperty("Appearance", 1)
    PBar.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
    PBar.MousePointer = PropBag.ReadProperty("MousePointer", 0)
    PBar.ToolTipText = PropBag.ReadProperty("ToolTipText", "")
    m_下载地址 = PropBag.ReadProperty("下载地址", m_def_下载地址)
    m_保存地址 = PropBag.ReadProperty("保存地址", m_def_保存地址)
    m_字节总数 = PropBag.ReadProperty("字节总数", m_def_字节总数)
    m_下载速度 = PropBag.ReadProperty("下载速度", m_def_下载速度)
    m_读取字节 = PropBag.ReadProperty("读取字节", m_def_读取字节)
    m_覆盖现有 = PropBag.ReadProperty("覆盖现有", m_def_覆盖现有)
    m_剩余时间 = PropBag.ReadProperty("剩余时间", m_def_剩余时间)
    m_下载进度 = PropBag.ReadProperty("下载进度", m_def_下载进度)
    m_当前状态 = PropBag.ReadProperty("当前状态", m_def_当前状态)
    m_状态说明 = PropBag.ReadProperty("状态说明", m_def_状态说明)
    m_缓冲字节 = PropBag.ReadProperty("缓冲字节", m_def_缓冲字节)
    Ine.UserName = PropBag.ReadProperty("UserName", "")
    Ine.Password = PropBag.ReadProperty("Password", "")
    m_默认路径 = PropBag.ReadProperty("默认路径", m_def_默认路径)
    m_文件名 = PropBag.ReadProperty("文件名", m_def_文件名)
    m_文件路径 = PropBag.ReadProperty("文件路径", m_def_文件路径)
    m_文件主名 = PropBag.ReadProperty("文件主名", m_def_文件主名)
    m_文件扩展名 = PropBag.ReadProperty("文件扩展名", m_def_文件扩展名)
    m_文件类型 = PropBag.ReadProperty("文件类型", m_def_文件类型)
    m_综合信息 = PropBag.ReadProperty("综合信息", m_def_综合信息)
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("Orientation", PBar.Orientation, 0)
    Call PropBag.WriteProperty("Scrolling", PBar.Scrolling, 0)
    Call PropBag.WriteProperty("Appearance", PBar.Appearance, 1)
    Call PropBag.WriteProperty("BorderStyle", PBar.BorderStyle, 0)
    Call PropBag.WriteProperty("MousePointer", PBar.MousePointer, 0)
    Call PropBag.WriteProperty("ToolTipText", PBar.ToolTipText, "")
    Call PropBag.WriteProperty("下载地址", m_下载地址, m_def_下载地址)
    Call PropBag.WriteProperty("保存地址", m_保存地址, m_def_保存地址)
    Call PropBag.WriteProperty("字节总数", m_字节总数, m_def_字节总数)
    Call PropBag.WriteProperty("下载速度", m_下载速度, m_def_下载速度)
    Call PropBag.WriteProperty("读取字节", m_读取字节, m_def_读取字节)
    Call PropBag.WriteProperty("覆盖现有", m_覆盖现有, m_def_覆盖现有)
    Call PropBag.WriteProperty("剩余时间", m_剩余时间, m_def_剩余时间)
    Call PropBag.WriteProperty("下载进度", m_下载进度, m_def_下载进度)
    Call PropBag.WriteProperty("当前状态", m_当前状态, m_def_当前状态)
    Call PropBag.WriteProperty("状态说明", m_状态说明, m_def_状态说明)
    Call PropBag.WriteProperty("缓冲字节", m_缓冲字节, m_def_缓冲字节)
    Call PropBag.WriteProperty("UserName", Ine.UserName, "")
    Call PropBag.WriteProperty("Password", Ine.Password, "")
    Call PropBag.WriteProperty("默认路径", m_默认路径, m_def_默认路径)
    Call PropBag.WriteProperty("文件名", m_文件名, m_def_文件名)
    Call PropBag.WriteProperty("文件路径", m_文件路径, m_def_文件路径)
    Call PropBag.WriteProperty("文件主名", m_文件主名, m_def_文件主名)
    Call PropBag.WriteProperty("文件扩展名", m_文件扩展名, m_def_文件扩展名)
    Call PropBag.WriteProperty("文件类型", m_文件类型, m_def_文件类型)
    Call PropBag.WriteProperty("综合信息", m_综合信息, m_def_综合信息)
End Sub

'=========================================================================================================

'注意！不要删除或修改下列被注释的行！
'MemberInfo=0
Public Function 开始下载() As Boolean
    开始下载 = 下载
End Function

'注意！不要删除或修改下列被注释的行！
'MemberInfo=0
Public Function 暂停下载() As Boolean
    暂停 = True
End Function

'注意！不要删除或修改下列被注释的行！
'MemberInfo=0
Public Function 继续下载() As Boolean
    暂停 = False
End Function

'注意！不要删除或修改下列被注释的行！
'MemberInfo=0
Public Function 取消下载() As Boolean
    当前状态 = "取消下载"
    取消 = True
End Function

Private Sub 准备下载()
    取消 = False
    暂停 = False
    m_读取字节 = 0
    m_下载速度 = ""
    m_下载进度 = 0
    m_剩余时间 = ""
    m_文件名 = ""
    m_文件路径 = ""
    m_文件主名 = ""
    m_文件扩展名 = ""
    m_文件类型 = ""
    PBar.Value = 0
    下载时间 = 0
    累计时间 = 0
    开始日期 = Date
    开始时间 = Timer
End Sub

Private Function 下载() As Boolean
Dim 字节数据() As Byte, SD As Single, JD As Single

    On Error GoTo CWB

    If 运行状态 Then Exit Function
    
    准备下载
    
    运行状态 = True
    
    If Len(m_下载地址) = 0 Then     '保存地址默认为:app.path\下载文件名
        m_状态说明 = "下载地址为空！"
        当前状态 = "下载失败"
        下载 = False
        运行状态 = False
        Exit Function
    End If
    
    If Not 获取文件信息 Then GoTo CWC
    
    If Not 创建目标文件 Then GoTo CWC
    
    On Error GoTo CWA
            
    
    Ine.URL = m_下载地址
    
    Do
        If 取消 Then
            Close #文件号
            If Len(m_文件名) > 0 And Dir$(m_文件名) > " " Then Kill m_文件名
            Ine.Cancel
            下载 = False
            准备下载
            m_状态说明 = "下载任务已经取消"
            当前状态 = "空闲"
            运行状态 = False
            Exit Function
        End If
        
        If 暂停 Then
            累计时间 = 累计时间 + DateDiff("D", 开始日期, Date) * 24 * 3600 + Timer - 开始时间
            当前状态 = "暂停"
            Do While 暂停 And Not 取消
                DoEvents
            Loop
            开始日期 = Date
            开始时间 = Timer
        End If
        
        字节数据 = Ine.GetChunk(m_缓冲字节, icByteArray)
        Put #文件号, , 字节数据
        
        m_读取字节 = m_读取字节 + UBound(字节数据) + 1
        下载时间 = 累计时间 + DateDiff("D", 开始日期, Date) * 24 * 3600 + Timer - 开始时间
        If 下载时间 > 0 Then SD = m_读取字节 / 下载时间
        Select Case SD
        Case Is < 1000
            m_下载速度 = Format(SD, "0") & "B/S"
        Case Is < 1000000
            m_下载速度 = Format(SD / 1000, "0.00") & "K/S"
        Case Is < 1000000000
            m_下载速度 = Format(SD / 1000000, "0.00") & "M/S"
        Case Else
            m_下载速度 = Format(SD / 1000000000, "0.00") & "G/S"
        End Select
        JD = m_读取字节 / m_字节总数
        m_下载进度 = Format(JD * 100, "0") & "%"
        If SD > 0 Then m_剩余时间 = Format((m_字节总数 - m_读取字节) / SD, "0") & "秒"
        PBar.Value = JD * 100
        PBar.ToolTipText = "已经下载：" & m_下载进度
        m_状态说明 = "接收到新数据"
        当前状态 = "正在下载"
        
        DoEvents
        
    Loop While UBound(字节数据, 1) > 0
    Close #文件号
    
    Ine.Cancel
    
    m_状态说明 = "下载完成"
    当前状态 = "空闲"
    
    运行状态 = False
    下载 = True
    Exit Function
CWA:
    #If 调试 = True Then
        Stop
        Resume
    #End If
    
    Close #文件号
    If Len(m_文件名) > 0 And Dir$(m_文件名) > " " Then Kill m_文件名
CWB:
    #If 调试 = True Then
        Stop
        Resume
    #End If
    
    m_状态说明 = Error(Err.Number)
    Err.Clear
CWC:
    #If 调试 = True Then
        Stop
        Resume
    #End If
    
    Ine.Cancel
    下载 = False
    运行状态 = False
    当前状态 = "下载失败"
End Function

Private Function 创建目标文件() As Boolean
    Dim 重复文件序号 As Long
    
    状态说明 = "创建目标文件"
    当前状态 = "创建目标文件"

    On Error GoTo CW:
    文件名分析 m_保存地址, m_文件路径, m_文件主名, m_文件扩展名, m_文件类型
    
    If Len(m_文件路径) = 0 Then
        m_文件路径 = m_默认路径
    End If
    
    If Len(m_文件主名) = 0 Then
        文件名分析 m_下载地址, "", m_文件主名, m_文件扩展名, m_文件类型
    End If
    
    m_文件名 = m_文件路径 & m_文件主名 & "." & m_文件扩展名
    
    If Not 创建文件夹(文件路径) Then
        m_文件名 = ""
        文件号 = 0
        m_状态说明 = "无法创建目标文件夹！"
        当前状态 = "下载失败"
        创建目标文件 = False