vb使用自定义用户控件进行下载

(VB)FTP异步下载
该方法不需要使用API及第三方控件

这里使用的是VB的UserControl控件的AsyncRead方法

步骤如下:

1、添加一个用户控件，设置InvisibleAtRuntime属性为true，目的是运行时该控件不显示用户界面，就象Timer控件一样。

2、到自定义控件的代码窗口，添加如下代码

Option Explicit
'下载结果枚举
Public Enum DownloadResults
    eSUCCESS = 0            '下载成功
    eCONNECTERROR = 1       '连接错误
    eTRANSFERERROR = 2      '数据传输错误
    eWRITEERROR = 3         '保存本地错误
    eUserStop = 4           '中止
End Enum
'下载进度事件   Identifier-下载标识,RecvdBytes-已下载字节数,MaxBytes-总字节数,PassTimer-已用下载时间(秒)
Public Event DownloadProgress(Identifier As String, RecvdBytes As Long, MaxBytes As Long, PassTimer As Long)
'下载完成事件 Identifier-下载标识,ccDownloadResults-下载结果,PassTimer-已用下载时间(秒)
Public Event DownloadComplete(Identifier As String, Result As DownloadResults, PassTimer As Long)
Dim FstrURL As String           'FTP 下载字符串,含IP,端口号,用户名,密码,下载的文件及其路径
Dim FstrSaveFile As String      '下载的文件保存在本地的文件名及其路径
Dim FstrIdentifier As String    '下载标识
Dim FlngStart As Long           '开始下载时间
'下载文件
'strURL        FTP 下载字符串,含IP,端口号,用户名,密码,下载的文件及其路径
'               形如  ftp://用户名:密码@FTP地址/目录/文件
'strSaveFile    保存时的本地文件名
'strIdentifier  下载标识,可以同时下载多个文件,依据此字符串区别所下载的文件
Public Sub DownLoad(ByVal strURL As String, ByVal strSaveFile As String, ByVal strIdentifier As String)
    On Error GoTo ERRHAND
    FstrURL = strURL
    FstrSaveFile = strSaveFile
    FstrIdentifier = strIdentifier
    
    FlngStart = Timer
    
    UserControl.AsyncRead strURL, vbAsyncTypeByteArray, strIdentifier, vbAsyncReadForceUpdate
    
    Exit Sub
ERRHAND:
    RaiseEvent DownloadComplete(strIdentifier, eCONNECTERROR, Timer - FlngStart)
End Sub
Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
    On Error GoTo Errs
    Dim F()     As Byte
    Dim fn      As Long
    Dim sFile   As String
    Dim s       As String
   
    sFile = FstrSaveFile
    
    With AsyncProp
        s = .PropertyName
        If .BytesMax <> 0 Then
            If .BytesMax <> .BytesRead Then
                On Error Resume Next
                UserControl.CancelAsyncRead s
                RaiseEvent DownloadComplete(s, eTRANSFERERROR, Timer - FlngStart) '---- 传输错误,下载失败
            Else
                '//Call to DoEvents updates transfer status on frmMain
                '..for large files before file processing begins.
                DoEvents
                fn = FreeFile
                F = .Value
                Open sFile For Binary Access Write As #fn '--------- Open file for writing
                Put #fn, , F '-------------------------------------- Put downloaded data to file
                Close #fn
                Erase F '------------------------------------------- Purge Array
                fn = FileLen(sFile)
                If Dir$(sFile, 39) <> "" Then '--------------------- Verify write completed
                    RaiseEvent DownloadComplete(s, eSUCCESS, Timer - FlngStart)
                Else
                    On Error Resume Next
                    UserControl.CancelAsyncRead s
                    RaiseEvent DownloadComplete(s, eWRITEERROR, Timer - FlngStart) '--- Completed but failed to write to disk
                End If
            End If
        Else
            On Error Resume Next '---------------------------------- ReVive never connected to the file or server
            UserControl.CancelAsyncRead s
            RaiseEvent DownloadComplete(s, eCONNECTERROR, Timer - FlngStart)
        End If
    End With
Errs_Exit:
    Exit Sub
Errs:
    If Err.Number = 7 Then '内存溢出
        RaiseEvent DownloadComplete(s, eCONNECTERROR, Timer - FlngStart)
    ElseIf Err.Number = 75 Then '打开文件错误
        RaiseEvent DownloadComplete(s, eWRITEERROR, Timer - FlngStart)
    Else
        RaiseEvent DownloadComplete(s, eCONNECTERROR, Timer - FlngStart)
    End If
    
    Resume Errs_Exit
End Sub
Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
    On Error GoTo Errs
    
    With AsyncProp
        
        If .BytesMax <> 0 Then
            RaiseEvent DownloadProgress(.PropertyName, CLng(.BytesRead), CLng(.BytesMax), Timer - FlngStart)
        End If
    End With
    
    Exit Sub
Errs:
    RaiseEvent DownloadComplete(AsyncProp.PropertyName, eCONNECTERROR, Timer - FlngStart)
End Sub
'中止下载
'strIdentifier 下载标识
Public Sub StopDown(ByVal strIdentifier As String)
    On Error GoTo Errs    
    UserControl.CancelAsyncRead strIdentifier
    Exit Sub
Errs:
End Sub

3、测试。在一个FORM中放一个刚才定义的控件，放一个Label，放一个CommandButton，均取默认值，到FORM的代码窗口添加如下代码

Option Explicit
Private Sub Command1_Click()
    
    Call UserControl11.DownLoad("ftp://anonymous:kkk@ftp.microsoft.com/developr/visualstudio/sp3/full/vssp3_1.exe", "d:\test.rar", "abc")
    
End Sub
Private Sub UserControl11_DownloadComplete(Identifier As String, Result As DownloadResults, PassTimer As Long)
    
    Label1.Caption = "下载完成总共用时" & CStr(PassTimer) & "秒."
    
End Sub
Private Sub UserControl11_DownloadProgress(Identifier As String, RecvdBytes As Long, MaxBytes As Long, PassTimer As Long)
    Label1.Caption = "正在下载" & Format(RecvdBytes / MaxBytes, "0.00%")
    DoEvents
    
End Sub

可以参考MSDN中关于UserControl.AsyncRead方法的说明

该方法的缺点是不能上传文件，不能获取FTP上文件列表等。可以配合相关API函数进行操作

Views: 71