FTP传文件，能否整个目录下的所有文件都传到本地？

Question

FtpGetFile好象只能过来一个，我给他一个文件夹名称，他就不行了，说找不到文件？我要把整个FTP虚拟目录下的都弄过来该怎么做啊？

Answer 1

只有自己写代码递归了，采用树的先序遍历算法。Public function ftpGetFolder(ByVal strFolder as string)
如果没有strFolder文件夹，使用FtpCreateDirectory创建
使用FtpGetFile对取文件夹下文件（使用List列出文件）
在List文件夹循环中递归调用ftpGetFolder(子文件夹)
End Function

Answer 2

你那个遍历，我该如何进行找下一个文件的动作？最好有原码，我急用，解决问题利马给分
________________________________________________________________'使用FtpFindFirstFile、InternetFindNextFile可找到所有文件/文件夹，如下函数用于此：
'其中有些类型/变量篇幅所限没申明，简单说明如下：
'WIN32_FIND_DATA Windows API中一类型，你可使用VB Add-ins找到该定义
'zlhwndConnection:  使用InternetConnect返回的连接句柄'Purpose     :  Returns an array of files matching the sFilter string
'Inputs      :  [sFilter]                       Returns only files matching this criteria
'               [bReturnDirectories]            If False will search the files for the matching string,
'                                               else the array will return the matching directories.
'Outputs     :  asMatching                      A 1 based 1d string array.
'Notes       :
'Revisions   :
'Assumptions :Function GetMatchingFiles(ByRef asMatching() As String, Optional sFilter = "*.*", Optional bReturnDirectories As Boolean = False) As Boolean
    Dim pData As WIN32_FIND_DATA, lhwndFind As Long, lRet As Long, lMatching As Long, sThisFile As String
    Const FILE_ATTRIBUTE_READONLY = &H1, FILE_ATTRIBUTE_HIDDEN = &H2, FILE_ATTRIBUTE_SYSTEM = &H4
    Const FILE_ATTRIBUTE_DIRECTORY = &H10, FILE_ATTRIBUTE_ARCHIVE = &H20, FILE_ATTRIBUTE_NORMAL = &H80
    Const FILE_ATTRIBUTE_TEMPORARY = &H100, FILE_ATTRIBUTE_COMPRESSED = &H800, FILE_ATTRIBUTE_OFFLINE = &H1000
    
    On Error GoTo ErrFailed
    'Create a buffer
    pData.cFileName = String(MAX_PATH, 0)
    lRet = 1
    Erase asMatching
    
    'Find the first file
    lhwndFind = FtpFindFirstFile(zlhwndConnection, sFilter, pData, INTERNET_FLAG_RELOAD, 0)
    GetMatchingFiles = (lhwndFind <> 0)
    
    If lhwndFind Then
        Do
            If lRet > 0 And CBool(pData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = bReturnDirectories Then
                sThisFile = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
                'Store the the filename
                lMatching = lMatching + 1
                If lMatching = 1 Then
                    ReDim asMatching(1 To lMatching)
                Else
                    ReDim Preserve asMatching(1 To lMatching)
                End If
                asMatching(lMatching) = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
            ElseIf lRet = 0 Then
                'No more matching files
                Exit Do
            End If
            'Find the next file
            lRet = InternetFindNextFile(lhwndFind, pData)
        Loop
    End If
    'Close the search
    Call InternetCloseHandle(lhwndFind)
    
    Exit FunctionErrFailed:
    'Store details of the error
    If Err.Number Then
        zsLastError = Err.Description
        zlLastErrNumber = Err.Number
    Else
        'DLL error
        zStoreError Err.LastDllError
    End If
    GetMatchingFiles = False
    On Error GoTo 0
End Function'调用示例：
GetMatchingFiles arSubFolders, 文件夹过滤表达式, True  'arFLDs目录下子文件夹数组
GetMatchingFiles arFiles, 文件过滤表达式, False 'arFiles目录下文件数组我这里有完整的FTP用API封装好的类，不过篇幅所限没写出，仅仅写出你需要的函数。

Answer 3

'如果需要，我将该类的类代码提供给你：
Option Explicit
Option Compare TextPrivate Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
'Default for FTP servers
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000
'Use FTP connections
Private Const INTERNET_FLAG_PASSIVE = &H8000000
'Use registry configuration
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
'Direct to net
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
'Via a named proxy
Private Const INTERNET_OPEN_TYPE_PROXY = 3
'Prevent using java/script/INS
Private Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
Private Const MAX_PATH = 260Private Const MAXDWORD = &HFFFFPrivate Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End TypePrivate Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End TypePrivate Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long
Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hConnect As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByRef dwContext As Long) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPrivate zsAgent As String, zsServerName As String, zsLoginName As String, zsPassword As String
Private zbPassiveConnection As Boolean
Private zlhwndConnection As Long, zlhOpen As Long
Private zsLastError As String, zlLastErrNumber As Long

Answer 4

'--------Agent
Property Get Agent() As String
    Agent = zsAgent
End PropertyProperty Let Agent(Value As String)
    zsAgent = Value
End Property
'--------Server Name
Property Get ServerName() As String
    ServerName = zsServerName
End PropertyProperty Let ServerName(Value As String)
    zsServerName = Value
End Property
'--------Login Name
Property Get LoginName() As String
    LoginName = zsLoginName
End PropertyProperty Let LoginName(Value As String)
    zsLoginName = Value
End Property
'--------Login Password
Property Get Password() As String
    Password = zsPassword
End PropertyProperty Let Password(Value As String)
    zsPassword = Value
End PropertyProperty Get CurDir() As String
    Dim sCurPath As String * MAX_PATH, lRetVal As Long
    
    'Get the current directory
    On Error Resume Next
    lRetVal = FtpGetCurrentDirectory(zlhwndConnection, sCurPath, MAX_PATH)
    CurDir = Left$(sCurPath, InStr(1, sCurPath, vbNullChar) - 1)
    If Right$(CurDir, 1) <> "/" Then
        CurDir = CurDir & "/"
    End If
End PropertyProperty Let CurDir(Value As String)
    'Change the current directory
    Call FtpSetCurrentDirectory(zlhwndConnection, Value)
End PropertyFunction DelDir(sDirectory As String) As Boolean
    'Remove a directory in the current directory
    DelDir = FtpRemoveDirectory(zlhwndConnection, sDirectory)
End Function
Function MakeDir(sPath As String) As Boolean
    'Create a new directory in the current directory
    On Error Resume Next
    
    MakeDir = FtpCreateDirectory(zlhwndConnection, sPath)
End Function
'Purpose   :    Uploads a file from to an FTP server.
'Inputs    :    sSourceFile             The path and name of the file to upload
'Outputs   :    Returns True on success
'Notes     :
'Revisions :Function UploadFile(sSourceFile As String, sDestFile As String) As Boolean
    'Upload a file to current directory
    On Error GoTo ErrFailed
    Dim bRet As Boolean
    
    bRet = FtpPutFile(zlhwndConnection, sSourceFile, zPathFileToFile(sDestFile), FTP_TRANSFER_TYPE_UNKNOWN, 0)
    UploadFile = bRet
    Exit Function
    
ErrFailed:
    'Store details of the error
    If Err.Number Then
        zsLastError = Err.Description
        zlLastErrNumber = Err.Number
    Else
        'DLL error
        zStoreError Err.LastDllError
    End If
    UploadFile = False
    On Error GoTo 0
End FunctionFunction RenameFile(sSourceFile As String, sNewName As String) As Boolean
    'Rename a file in current directory
    RenameFile = FtpRenameFile(zlhwndConnection, sSourceFile, sNewName)
End Function
Function Connect() As Boolean
    'Return a handle/Open an internet connection
    zlhOpen = InternetOpen(zsAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    'Connect to the FTP server
    If zbPassiveConnection Then
        zlhwndConnection = InternetConnect(zlhOpen, zsServerName, INTERNET_DEFAULT_FTP_PORT, zsLoginName, zsPassword, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
    Else
        zlhwndConnection = InternetConnect(zlhOpen, zsServerName, INTERNET_DEFAULT_FTP_PORT, zsLoginName, zsPassword, INTERNET_SERVICE_FTP, 0, 0)
    End If
    If zlhwndConnection Then
        Connect = True
    Else
        Connect = False
    End If
End FunctionSub Disconnect()
    On Error Resume Next
    
    'Close FTP connection
    InternetCloseHandle zlhwndConnection
    zlhwndConnection = 0
    'Close Internet connection
    InternetCloseHandle zlhOpen
    zlhOpen = 0'    Dim iRet As Integer
'    'Close FTP connection
'    iRet = InternetCloseHandle(zlhwndConnection)
'    zlhwndConnection = 0
'    MsgBox iRet
'
'    'Close Internet connection
'    iRet = InternetCloseHandle(zlhOpen)
'    zlhOpen = 0
'    MsgBox iRetEnd SubProperty Get FTPHwnd() As Long
    FTPHwnd = zlhwndConnection
End PropertyProperty Get InternetHwnd() As Long
    InternetHwnd = zlhOpen
End Property

Answer 5

'Purpose     :  Returns an array of files matching the sFilter string
'Inputs      :  [sFilter]                       Returns only files matching this criteria
'               [bReturnDirectories]            If False will search the files for the matching string,
'                                               else the array will return the matching directories.
'Outputs     :  asMatching                      A 1 based 1d string array.
'Notes       :
'Revisions   :
'Assumptions :Function GetMatchingFiles(ByRef asMatching() As String, Optional sFilter = "*.*", Optional bReturnDirectories As Boolean = False) As Boolean
    Dim pData As WIN32_FIND_DATA, lhwndFind As Long, lRet As Long, lMatching As Long, sThisFile As String
    Const FILE_ATTRIBUTE_READONLY = &H1, FILE_ATTRIBUTE_HIDDEN = &H2, FILE_ATTRIBUTE_SYSTEM = &H4
    Const FILE_ATTRIBUTE_DIRECTORY = &H10, FILE_ATTRIBUTE_ARCHIVE = &H20, FILE_ATTRIBUTE_NORMAL = &H80
    Const FILE_ATTRIBUTE_TEMPORARY = &H100, FILE_ATTRIBUTE_COMPRESSED = &H800, FILE_ATTRIBUTE_OFFLINE = &H1000
    
    On Error GoTo ErrFailed
    'Create a buffer
    pData.cFileName = String(MAX_PATH, 0)
    lRet = 1
    Erase asMatching
    
    'Find the first file
    lhwndFind = FtpFindFirstFile(zlhwndConnection, sFilter, pData, INTERNET_FLAG_RELOAD, 0)
    GetMatchingFiles = (lhwndFind <> 0)
    
    If lhwndFind Then
        Do
            If lRet > 0 And CBool(pData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = bReturnDirectories Then
                sThisFile = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
                'Store the the filename
                lMatching = lMatching + 1
                If lMatching = 1 Then
                    ReDim asMatching(1 To lMatching)
                Else
                    ReDim Preserve asMatching(1 To lMatching)
                End If
                asMatching(lMatching) = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
            ElseIf lRet = 0 Then
                'No more matching files
                Exit Do
            End If
            'Find the next file
            lRet = InternetFindNextFile(lhwndFind, pData)
        Loop
    End If
    'Close the search
    Call InternetCloseHandle(lhwndFind)
    
    Exit FunctionErrFailed:
    'Store details of the error
    If Err.Number Then
        zsLastError = Err.Description
        zlLastErrNumber = Err.Number
    Else
        'DLL error
        zStoreError Err.LastDllError
    End If
    GetMatchingFiles = False
    On Error GoTo 0
End Function
'Purpose   :    Downloads a file from an FTP server.
'Inputs    :    sGetFileName            The name of the file to download from the server
'               sSaveToPath             The path to save the file to.
'               [bOverwrite]            If True overwrites will overwrite a file that may exist
'                                       at sSaveToPath. If False will abort the download if a file
'                                       exists at sSaveToPath.
'Outputs   :    Returns True on success
'Notes     :
'Revisions :Function DownloadFile(sGetFileName As String, sSaveToPath As String, Optional bOverwrite As Boolean = True) As Boolean
    On Error GoTo ErrFailed
    If Len(Dir$(sSaveToPath)) > 0 And Len(sSaveToPath) > 0 Then
        'File already exists
        If bOverwrite Then
            'Delete existing file
            Kill sSaveToPath
        Else
            'Store an error message
            zsLastError = "File already exists at " & sSaveToPath
            zlLastErrNumber = vbObjectError + 1
            DownloadFile = False
            Exit Function
        End If
    End If
    'Retrieve the file, ignoring the cache
    DownloadFile = FtpGetFile(zlhwndConnection, sGetFileName, sSaveToPath, False, 0, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0)
    Exit FunctionErrFailed:
    'Store details of the error
    If Err.Number Then
        zsLastError = Err.Description
        zlLastErrNumber = Err.Number
    Else
        'DLL error
        zStoreError Err.LastDllError
    End If
    DownloadFile = False
    On Error GoTo 0
End FunctionFunction DeleteFile(sFileName As String) As Boolean
    'Delete the file from server
    DeleteFile = FtpDeleteFile(zlhwndConnection, sFileName)
End Function'Purpose   :    Convert a file and path to a path e.g. "C:\Windows\Win.ini" becomes "C:\Windows\"
'Inputs    :    sFilePathName               The path and file name to convert
'Outputs   :    Returns the file path
'Notes     :    Use of InstrRev would be quicker if using for VB programmersPrivate Function PathFileToPath(sFilePathName As String) As String
    Dim ThisChar As Long
    PathFileToPath = sFilePathName 'Default return value
    For ThisChar = 0 To Len(sFilePathName) - 1
        If Mid$(sFilePathName, Len(sFilePathName) - ThisChar, 1) = "\" Then
            PathFileToPath = Left$(sFilePathName, Len(sFilePathName) - ThisChar)
            Exit For
        End If
    Next
End Function
Private Sub Class_Initialize()
    zsAgent = "DocuMan"
    zbPassiveConnection = True
End SubProperty Get PassiveConnection() As Boolean
    PassiveConnection = zbPassiveConnection
End PropertyProperty Let PassiveConnection(Value As Boolean)
    zbPassiveConnection = Value
End Property

Answer 6

'Returns the error description of the last error that occured within this class
Property Get LastError() As String
    LastError = zsLastError
End Property'Returns the error number of the last error that occured within this class
Property Get LastErrorNumber() As Long
    LastErrorNumber = zlLastErrNumber
End Property'Purpose   :    Stores an error in private variables
'Inputs    :    lErrNumber              The error number (see the Err object or the return value from the API call)
'Outputs   :    Returns a descriptive error message
'Notes     :Private Sub zStoreError(lErrNumber As Long)
    Dim sErr As String, lenBuf As Long
    
    'Get the size of the required buffer
    Call InternetGetLastResponseInfo(lErrNumber, sErr, lenBuf)
    'Create a buffer
    sErr = String(lenBuf, 0)
    Call InternetGetLastResponseInfo(lErrNumber, sErr, lenBuf)
    'Store the last response error
    zsLastError = sErr
    zlLastErrNumber = lErrNumber
End Sub'Purpose   :    Convert a file and path to a file e.g. "C:\Windows\Win.ini" becomes "win.ini"
'Inputs    :    sFilePathName               The path and file name to convert
'Outputs   :    Returns the file name
'Notes     :    Use of InstrRev would be quicker if using for VB programmersPrivate Function zPathFileToFile(sFilePathName As String) As String
    Dim ThisChar As Long
    zPathFileToFile = sFilePathName 'Default return value
    ThisChar = InStrRev(sFilePathName, "\")
    zPathFileToFile = Right$(sFilePathName, Len(sFilePathName) - ThisChar)
'    For ThisChar = 0 To Len(sFilePathName) - 1
'        If Mid$(sFilePathName, Len(sFilePathName) - ThisChar, 1) = "\" Then
'            zPathFileToFile = Right$(sFilePathName, ThisChar)
'            Exit For
'        End If
'    Next
End Function

Answer 7

在进行处理前首先要进行连接操作：
        Set m_oFTP = New clsFTP '定义刚才这个类的一实例对象
        m_oFTP.LoginName = FTP帐号
        m_oFTP.Password = 密码
        m_oFTP.ServerName = FTP主机
        
        If Not m_oFTP.Connect() Then
            MsgBox "连接失败" & m_oFTP.LastError
            Exit Sub
        End If
        
        ......

Answer 8

谢谢你，你的类我还是不太会调用
比如我在Ftp服务器上有个Exe目录，我要它下我我本机指定目录下，
该如何调用GetMatchingFiles方法啊？

Answer 9

http://free.6to23.com/bd12121/vbftp.rar