bfdownload.ctl

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

        Exit Function
    End If
    If Len(m_文件名) > 0 Then
        If Dir$(m_文件名) > " " Then
            Select Case m_覆盖现有
            Case "失败"
                m_文件名 = ""
                文件号 = 0
                m_状态说明 = "目标文件已经存在！"
                当前状态 = "下载失败"
                创建目标文件 = False
                Exit Function
            Case "覆盖"
                Kill m_文件名
            Case "询问"
                With CDialog
                    .DialogTitle = "目标文件已经存在,请重新指定下载后的文件名！"
                    .FileName = m_文件名
                    If Len(m_文件扩展名) = 0 Then
                        .Filter = ""
                    Else
                        .Filter = m_文件类型 & " *." & m_文件扩展名 & "|*." & m_文件扩展名
                    End If
                    .CancelError = True
                    .ShowSave
                    m_文件名 = .FileName
                    文件名分析 m_文件名, m_文件路径, m_文件主名, m_文件扩展名, m_文件类型
                End With
            Case "自动重命名"
                重复文件序号 = 1
                Do While (Dir$(m_文件路径 & m_文件主名 & "[" & 重复文件序号 & "]" & "." & m_文件扩展名) > " ")
                    重复文件序号 = 重复文件序号 + 1
                Loop
                m_文件名 = m_文件路径 & m_文件主名 & "[" & 重复文件序号 & "]" & "." & m_文件扩展名
                文件名分析 文件名, m_文件路径, m_文件主名, m_文件扩展名, m_文件类型
            End Select
        End If
        文件号 = FreeFile()
        Open m_文件名 For Binary Access Write As #文件号
        m_状态说明 = "创建目标文件成功"
        当前状态 = "创建目标文件成功"
        创建目标文件 = True
    End If
    Exit Function
CW:
    #If 调试 = True Then
        Stop
    #End If
    
    Select Case Err.Number
    Case 32755
        m_状态说明 = "在选择保存目标文件时，用户取消了操作"
    Case Else
        m_状态说明 = Error(Err.Number)
    End Select
    Err.Clear
    文件号 = 0
    m_文件名 = ""
    当前状态 = "空闲"
    创建目标文件 = False
End Function

Public Sub 文件名分析(字符串 As String, 路径 As String, 主名 As String, 扩展名 As String, 类型 As String)
    Dim L As Long, S As String, i As Integer
    For L = Len(字符串) To 1 Step -1
        S = Mid(字符串, L, 1)
        Select Case i
        Case 0
            Select Case S
            Case "."
                i = 1
            Case "\", "/"
                路径 = Left(字符串, L)
                Exit For
            Case Else
                扩展名 = S & 扩展名
            End Select
        Case 1
            Select Case S
            Case "\", "/"
                路径 = Left(字符串, L)
                Exit For
            Case Else
                主名 = S & 主名
            End Select
        End Select
    Next
    If i = 0 Then
        主名 = 扩展名
        扩展名 = ""
    End If
    Select Case UCase(扩展名)
    Case ""
        类型 = ""
    Case "TXT"
        类型 = "文本文件"
    Case "DOC"
        类型 = "Word文档"
    Case "BMP", "JPG", "GIF", "TIF", "PNG", "TGA"
        类型 = "图片文件"
    Case "WAV", "MP3"
        类型 = "视频文件"
    Case "AVI", "MPG", "MP4", "MPEG", "RM", "RMVB"
        类型 = "视频文件"
    Case "RAR", "ZIP"
        类型 = "压缩文件"
    Case "HTM", "HTML", "ASP", "ASPX", "PHP", "JSP"
        类型 = "网页文件"
    Case "EXE"
        类型 = "应用程序"
    Case Else
        类型 = ""
    End Select
End Sub

Public Function 创建文件夹(文件夹路径 As String) As Boolean
    Dim 文件系统对象 As Object, 路径分段指针 As Integer
    
    On Error GoTo CW:
    
    Set 文件系统对象 = CreateObject("Scripting.FileSystemObject")
    
    For 路径分段指针 = 1 To Len(文件夹路径)
        Select Case Mid(文件夹路径, 路径分段指针, 1)
        Case "\"
            If 文件系统对象.FolderExists(Left(文件夹路径, 路径分段指针)) = False Then
                文件系统对象.CreateFolder (Left(文件夹路径, 路径分段指针))
            End If
        End Select
    Next
    
    Set 文件系统对象 = Nothing
    
    创建文件夹 = True
    Exit Function
CW:
    #If 调试 = True Then
        Stop
    #End If
    
    创建文件夹 = False
End Function

Private Function 获取文件信息() As Boolean
On Error GoTo Ge
Dim sHeader As String
Dim blnreturn As Boolean

Ine.URL = m_下载地址
Ine.Execute , "GET"
'RaiseEvent StatusChange("Initiating Connection.")
m_状态说明 = "开始连接"
当前状态 = "开始连接"
While Ine.StillExecuting
    DoEvents
Wend

m_状态说明 = "获取文件信息"
当前状态 = "获取文件信息"

If 取消 Then GoTo Cc

sHeader = Ine.GetHeader()
Select Case Mid$(sHeader, 10, 3)
Case 401
    #If 调试 = True Then
        Stop
    #End If
    
    m_字节总数 = 0
    m_状态说明 = "访问被拒绝，下载结束！"
    当前状态 = "下载失败"
    Ine.Cancel
    获取文件信息 = False
    Exit Function
Case 403
    #If 调试 = True Then
        Stop
    #End If
    
    m_字节总数 = 0
    m_状态说明 = "访问被拒绝，下载结束！"
    当前状态 = "下载失败"
    Ine.Cancel
    获取文件信息 = False
    Exit Function
Case 404
    #If 调试 = True Then
        Stop
    #End If
    
    m_字节总数 = 0
    m_状态说明 = "网站有错误，文件不能创建！"
    当前状态 = "下载失败"
    Ine.Cancel
    获取文件信息 = False
    Exit Function
End Select

If 取消 Then GoTo Cc

'If Mid$(aheader, 6, 3) = "1.1" Then a_Resume = True

m_字节总数 = CLng(Ine.GetHeader("Content-Length"))
m_状态说明 = "成功获取文件信息！"
当前状态 = "成功获取文件信息"
'Ine.Cancel
获取文件信息 = True
Exit Function

Ge:
    #If 调试 = True Then
        Stop
        Resume
    #End If
    
    m_字节总数 = 0
    m_状态说明 = "读取文件头错误！"
    当前状态 = "下载失败"
    Ine.Cancel
    获取文件信息 = False
    Exit Function

Cc:
    #If 调试 = True Then
        Stop
        Resume
    #End If
    
    m_字节总数 = 0
    m_状态说明 = "任务被取消"
    当前状态 = "空闲"
    Ine.Cancel
    获取文件信息 = False
    Exit Function
End Function

'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,1,2,
Public Property Get 文件名() As String
Attribute 文件名.VB_MemberFlags = "400"
    文件名 = 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=13,1,2,
Public Property Get 文件路径() As String
Attribute 文件路径.VB_MemberFlags = "400"
    文件路径 = 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=13,1,2,
Public Property Get 文件主名() As String
Attribute 文件主名.VB_MemberFlags = "400"
    文件主名 = 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=13,1,2,
Public Property Get 文件扩展名() As String
Attribute 文件扩展名.VB_MemberFlags = "400"
    文件扩展名 = 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=13,1,2,
Public Property Get 文件类型() As String
Attribute 文件类型.VB_MemberFlags = "400"
    文件类型 = 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=13,1,2,
Public Property Get 综合信息() As String
Attribute 综合信息.VB_MemberFlags = "400"
    '综合信息 = m_综合信息
    综合信息 = m_当前状态 & vbCrLf & m_状态说明 & vbCrLf & "字节总数：" & m_字节总数 & vbCrLf & "已经下载：" & m_读取字节 & vbCrLf & "下载进度：" & m_下载进度 & vbCrLf & "下载速度：" & m_下载速度 & vbCrLf & "剩余时间：" & m_剩余时间 & vbCrLf & "下载到：" & 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