请问各位高手，怎样在 VB编程实现Ftp删除包含有子文件夹的文件夹？回答者一律给分

Question

'我写的递归删除文件夹
Public Sub RemoveCurrentDirectory(ByVal CurrentDirectory As String)
    Dim Item As cDirItem
    Dim sAttr As String
    If Right(CurrentDirectory, 1) <> "/" Then CurrentDirectory = CurrentDirectory & "/"
    SetFTPDirectory CurrentDirectory
    Debug.Print "Current Directory: " & CurrentDirectory
    GetDirectoryListing "*.*"
    For Each Item In mDirCol
        If Item.Directory Then
               RemoveCurrentDirectory CurrentDirectory & Item.Filename
        Else
               DeleteFTPFile (CurrentDirectory & Item.Filename)
        End If
    Next
    Debug.Print "RemoveFTPDirectory=" & CurrentDirectory
    If Not RemoveFTPDirectory(CurrentDirectory) Then
         MsgBox szErrorMessage
          '当删除一个空文件夹时报错：
          '500 The process cannot access the file because it is   being used by  another process .
    End If
    
End Sub

Answer 1

我的clsFtp
Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
Private Const MAX_PATH = 260
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private 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 Type
Private 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 m_FtpOn As String
Private m_FtpHandle As Long
Private m_InterOpen As Long
Private m_OrgPath As String
Private m_CurDir As String
Option Explicit
Public Property Get InternetHandle() As Long
InternetHandle = m_InterOpen
End Property
Public Property Get FtpHandle() As Long
FtpHandle = m_FtpHandle
End Property
Public Property Let CurrentDir(ByVal vData As String)
If Not m_FtpHandle = 0 Then
FtpSetCurrentDirectory m_FtpHandle, vData
m_CurDir = vData
End If
End Property
Public Property Get CurrentDir() As String
CurrentDir = m_CurDir
End Property
Public Function PutFile(FileName As String, RemoteName As String) As Boolean
PutFile = FtpPutFile(m_FtpHandle, FileName, RemoteName, FTP_TRANSFER_TYPE_UNKNOWN, ByVal 0&)
End Function
Public Function RenameFile(OldName As String, NewName As String) As Boolean
RenameFile = FtpRenameFile(m_FtpHandle, OldName, NewName)
End Function
Public Function GetFile(FileName As String, RemoteName As String) As Boolean
GetFile = FtpGetFile(m_FtpHandle, FileName, RemoteName, False, 0, FTP_TRANSFER_TYPE_UNKNOWN, ByVal 0&)
End Function
Public Function DeleteFile(RemoteFile As String) As Boolean
DeleteFile = FtpDeleteFile(m_FtpHandle, RemoteFile)
End Function
Public Function RemoveDir(DirName As String) As Boolean
RemoveDir = FtpRemoveDirectory(m_FtpHandle, DirName)
End Function
Public Function CreateDir(DirName As String) As Boolean
CreateDir = FtpCreateDirectory(m_FtpHandle, DirName)
End Function
Public Function InternetCon(FtpServer As String, Login As String, Password As String, Passive As Boolean) As Boolean
Dim hConnection As Long, hOpen As Long, rc As Long, dwBack As Long
hOpen = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullChar, vbNullChar, 0)
hConnection = InternetConnect(hOpen, FtpServer, INTERNET_DEFAULT_FTP_PORT, Login, Password, INTERNET_SERVICE_FTP, IIf(Passive, INTERNET_FLAG_PASSIVE, 0), 0)
If Not hConnection = 0 Then
m_FtpOn = FtpServer
m_InterOpen = hOpen
m_FtpHandle = hConnection
m_OrgPath = String$(MAX_PATH, vbNullChar)
dwBack = MAX_PATH
rc = FtpGetCurrentDirectory(hConnection, m_OrgPath, dwBack)
m_CurDir = Left$(m_OrgPath, dwBack)
End If
End Function
Public Sub InternetDisCon()
InternetCloseHandle m_FtpHandle
InternetCloseHandle m_InterOpen
End Sub
Public Sub EnumFiles(FileNames() As String)
Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
Dim FileNum As Long, tmpStr() As String
pData.cFileName = String(MAX_PATH, 0)
hFind = FtpFindFirstFile(m_FtpHandle, "*.*", pData, 0, 0)
If Not hFind = 0 Then
ReDim Preserve FileNames(FileNum)
tmpStr = Split(pData.cFileName, vbNullChar)
FileNames(FileNum) = tmpStr(0)
FileNum = FileNum + 1
pData.cFileName = String(MAX_PATH, vbNullChar)
lRet = InternetFindNextFile(hFind, pData)
Do Until lRet = 0
ReDim Preserve FileNames(FileNum)
tmpStr = Split(pData.cFileName, vbNullChar)
FileNames(FileNum) = tmpStr(0)
FileNum = FileNum + 1
pData.cFileName = String(MAX_PATH, vbNullChar)
lRet = InternetFindNextFile(hFind, pData)
Loop
InternetCloseHandle hFind
End If
End Sub
Public Function ShowError() As String
Dim lErr As Long, sErr As String, lenBuf As Long
sErr = String(MAX_PATH, 0)
lenBuf = MAX_PATH
InternetGetLastResponseInfo lErr, sErr, lenBuf
sErr = Left$(sErr, lenBuf)
ShowError = sErr
End Function

Answer 2

我也在写关于FTP的软件.
我实现的功能是把递归上传文件和文件夹.或者递归下载文件和文件夹.
但是删除还没有做..
盼望和你讨论.
另外.你是否实现了断点上传和断点下载?
还有.你是否实现了读取服务器上的文件夹的图标呢?

Answer 3

我也在开发FTP软件.
实现的功能是上传.下载递归文件夹.
还没有做删除.
另外.你是否实现了上传和下载的断点续传?
还有.你是否能实现得到FTP服务器上的文件或者文件夹的图标?(我虽然得到了文件和文件夹.但是图标没有得到)
谢谢.希望和你讨论这些..

Answer 4

我也很想学习这方面的知识请各位大侠给于一定的帮助
[email protected]

Answer 5

谢谢大家的饿讨论
经过测试这个问题我已经解决了  
如果大家有对Ftp讨论兴趣的话,请写信给我  [email protected]
代码如下'删除文件夹
Public Sub RemoveCurrentDirectory(ByVal CurrentDirectory As String)
    Dim Item As cDirItem
    Dim sAttr As String
    Dim sDirectory As String
    Dim sfatherDirectory As String
    
On Error GoTo ErrorHandler:
    If Right(CurrentDirectory, 1) <> "/" Then CurrentDirectory = CurrentDirectory & "/"
    SetFTPDirectory CurrentDirectory
    Debug.Print "Current Directory: " & CurrentDirectory
    GetDirectoryListing "*.*"
    For Each Item In mDirCol
        If Item.Directory Then
                RemoveCurrentDirectory CurrentDirectory & Item.Filename
        Else
                If Not DeleteFTPFile(CurrentDirectory & Item.Filename) Then
                    Exit Sub
                End If
        End If
    Next
    Debug.Print "RemoveFTPDirectory=" & CurrentDirectory
    
    '+++++++++++++++++++++++ sly  ++++++++++++++++++++++
    If CurrentDirectory = strCurrentftpDirectory Then
        If blStartup Then
            blStartup = False
            RemoveCurrentDirectory CurrentDirectory
        Else
'            sfatherDirectory = GetFatherDirectory(CurrentDirectory)
'            If sfatherDirectory <> "" Then
'                If SetFTPDirectory(sfatherDirectory) Then
'                    If Not RemoveFTPDirectory(CurrentDirectory) Then
'                        Debug.Print szErrorMessage
'                        RemoveCurrentDirectory CurrentDirectory
'                    End If
                    If IsEmptyDirectory(CurrentDirectory) Then
                        sfatherDirectory = GetFatherDirectory(CurrentDirectory)
                        If sfatherDirectory <> "" Then
                            If SetFTPDirectory(sfatherDirectory) Then
                                If Not RemoveFTPDirectory(CurrentDirectory) Then
                                    Exit Sub
                                End If
                            Else
                                Exit Sub
                            End If
                        End If
                    Else
                        RemoveCurrentDirectory CurrentDirectory
                    End If
'                End If
'            End If
            Exit Sub
        End If
    Else
'         sfatherDirectory = GetFatherDirectory(CurrentDirectory)
'         If sfatherDirectory <> "" Then
'            If SetFTPDirectory(sfatherDirectory) Then
'                If Not RemoveFTPDirectory(CurrentDirectory) Then
'                    Debug.Print szErrorMessage
'                    RemoveCurrentDirectory CurrentDirectory
'                End If
                If IsEmptyDirectory(CurrentDirectory) Then
                    sfatherDirectory = GetFatherDirectory(CurrentDirectory)
                    If sfatherDirectory <> "" Then
                        If SetFTPDirectory(sfatherDirectory) Then
                            If Not RemoveFTPDirectory(CurrentDirectory) Then
                                Exit Sub
                            End If
                        Else
                            Exit Sub
                        End If
                    End If
                Else
                    RemoveCurrentDirectory CurrentDirectory
                End If
'            End If
'         End If
    End If
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++Exit Sub
ErrorHandler:
    
End Sub