(VB)FTP异步下载

@H_404_0@该方法不需要使用API及第三方控件

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

@H_404_0@步骤如下:

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

@H_404_0@

Option Explicit
'下载结果枚举
Public Enum DownloadResults
    eSUCCESS = 0            '下载成功
    eCONNECTERROR = 1       '连接<a href="/tag/cuowu/" target="_blank" class="keywords">错误</a>
    eTRANSFERERROR = 2      '数据传输<a href="/tag/cuowu/" target="_blank" class="keywords">错误</a>
    eWRITEERROR = 3         '保存本地<a href="/tag/cuowu/" target="_blank" class="keywords">错误</a>
    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,端口号,<a href="/tag/yonghuming/" target="_blank" class="keywords">用户名</a>,密码,下载的<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>及其路径
Dim FstrSaveFile As String      '下载的<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>保存在本地的<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>名及其路径
Dim FstrIdentifier As String    '下载标识
Dim FlngStart As Long           '开始下载时间
'下载<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>
'strURL        FTP 下载字符串,下载的<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>及其路径
'               形如  ftp://<a href="/tag/yonghuming/" target="_blank" class="keywords">用户名</a>:密码@FTP地址/目录/<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>
'strSaveFile    保存时的本地<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>名
'strIdentifier  下载标识,可以同时下载多个<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>,依据此字符串区别所下载的<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a>
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) '---- 传输<a href="/tag/cuowu/" target="_blank" class="keywords">错误</a>,下载失败
            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 <a href="/tag/Failed/" target="_blank" class="keywords">Failed</a> 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,Timer - FlngStart)
        End If
    End With
Errs_Exit:
    Exit Sub
Errs:
    If Err.Number = 7 Then '内存溢出
        RaiseEvent DownloadComplete(s,Timer - FlngStart)
    ElseIf Err.Number = 75 Then '打开<a href="/tag/wenjian/" target="_blank" class="keywords">文件</a><a href="/tag/cuowu/" target="_blank" class="keywords">错误</a>
        RaiseEvent DownloadComplete(s,Timer - FlngStart)
    Else
        RaiseEvent DownloadComplete(s,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,Timer - FlngStart)
End Sub
'中止下载
'strIdentifier 下载标识
Public Sub StopDown(ByVal strIdentifier As String)
    On Error GoTo Errs
    
    UserControl.CancelAsyncRead strIdentifier
    Exit Sub
Errs:
End Sub

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

@H_404_0@

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

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

@H_404_0@如果进行http下载，形如 http://文件连接

(VB)FTP异步下载

猜你在找的VB相关文章