FTPDeleteTree

Търся пример за рекурсивно изтриване на директория със всичките и поддиректории и файлове чрез използване на стандартните FTP функции от WinInet библиотеката. Естествено на VB ;-)
Благодаря предварително на всички отзовали се.

чети и дишай по-леко

leleee
abe tova ne ti prepora4vam da se zahva6ta6 s nego, ne 4e e nevazmojno, no dosta 6te triabva da si igrae6, a ne se i se6tam za barz na4in da sglobi6 FTPdir darvo. Taka, 4e 6te triabva da obhojda6 i da bar6e6 nared kvoto nameri6 vatre, mojde da stane, no ti triabva dobre optimiziran cikal. A moje i da stigne6 do problem s permissionite. Atak, 4e problema si e slojen i to edinstveno 6te se svede do edin algoritam. Az bih go sazdal parvo da razboti, a posle da go ogledam i optimiziram derzai, ako ima vaprosti po slu4aia pi6i!

Ето какво имам аз за бърсане на файлове от локален диск.

'~~~DelTree.cls



Option Explicit



Private mstrPath As String



Public Property Let Path(ByVal strPath As String)

  mstrPath = strPath

End Property



Public Sub Delete()

  

  RecurseTree mstrPath

End Sub



Private Sub RecurseTree(CurrentPath As String)



  Dim intN As Integer

  Dim intDirectory As Integer

  Dim strFileName As String

  Dim strDirectoryList() As String

  

  If Right(CurrentPath, 1) <> "\" _

  Then CurrentPath = CurrentPath & "\"

  

  strFileName = Dir(CurrentPath & "*.*", vbHidden)

  Do While strFileName <> ""

    SetAttr CurrentPath & strFileName, vbReadOnly = False

    SetAttr CurrentPath & strFileName, vbHidden = False

    Kill CurrentPath & strFileName

    strFileName = Dir

  Loop

  

  strFileName = LCase(Dir(CurrentPath, vbDirectory))

  Do While strFileName <> ""

    If strFileName <> "." _

    And strFileName <> ".." Then

      If GetAttr(CurrentPath & strFileName) _

      And vbDirectory Then

        intDirectory = intDirectory + 1

        ReDim Preserve strDirectoryList(intDirectory)

        strDirectoryList(intDirectory) = CurrentPath & strFileName

      End If

    End If

    strFileName = Dir

    DoEvents

  Loop

  

  For intN = 1 To intDirectory

    RecurseTree strDirectoryList(intN) & "\"

    RmDir strDirectoryList(intN)

  Next intN

  

End Sub





'~~~frmMain



Private Sub cmdGo_Click()

  DelTree.Path = "c:\temp"

  DelTree.Delete

End Sub








Не знам дали става за FTP, и какви промени трябва да се направят за да работи с FTP, но поне е някакъв алгоритъм, който дори работи...



10х



----------------------------------

помислих, хареса ми, помислих пак...

bravo na Shtirlitc tova 6te svar6i rabota s malki promeni

А дано да свърши работа. ;о) ... но аз предлагам преди да се пусне в краен вариант, да се пробва вместо с:

Kill CurrentPath & strFileName

да се пише:

Print CurrentPath & strFileName

за да не става сакатлък.

----------------------------------
помислих, хареса ми, помислих пак...

ednata mi rabota e kato sysadmi i s mail serveri i FTP-tata moje da se kaje, 4e imam opit. Zna4i moga da si predstava za kakvo stava vapros, no na VB nikoga ne sam pisal ni6to za FTP, no si mislia, 4e algoritama na Shtirlitc naistina 6te ba4ka, no triabva da se promeniat dosta ne6ta imaiki predvid strukturata na i komandite FTP. Tam ne moje6 s obiknovennite funkcii za pretarsvane na dir vav VB da raboti6, no moje da se pomisli, sa6to iskah da popitam dali niama niakade gotova kontrola za tova, bi oprostilo mnogo ne6tata, no ako ima6 vreme nai-dobre si ia napravi. Az taka se zapalih i bez pri4ina si napisah POP3 mail server, gotov e ba4ka za mail klient i za telnet i raboti samo s WinSock32, no si be6e iako cakane, misleh da mu zaka4a baza na Access i da napravia i SMTP, no me razmarzia zada4kata mi se vijda interesna i ako si stignal do niakade i si zabil, moje6 da prati6 ne6to i da pomislime vsi4kite, pak vse 6te go izmislime

Tova namerih sred moite primeri deto sam sabiral otvsiakade, tova e edin dosta dobar FTP klient na VB, pra6tam celia kod na programkata, ne e mnogo prigledno za tova koa iska6 moga da ti ia mail-na s vse formata i vsi4ko ako te interesuva!
Mislia, 4e ot nego moje da se vidi s VB kak se raboti s FTP protkola, po Default se opitva da se vrazva na 127.0.0.1 kadeto ne misla, 4e 6te si runal FTP osobenno na port 1001, osven tova mu lipsva indentifikacia, no vse pak e primer4e, neznam razgledai go dano da ti pomogne s 4ast ot soursa:

Option Explicit

Dim SrcPath As String

Dim DstPath As String

Dim IsReceived As Boolean



Private Sub SendFile()

    Dim BufFile As String

    Dim LnFile As Long

    Dim nLoop As Long

    Dim nRemain As Long

    Dim Cn As Long

    

    On Error GoTo GLocal:

    LnFile = FileLen(SrcPath)

    If LnFile > 8192 Then

        nLoop = Fix(LnFile / 8192)

        

        nRemain = LnFile Mod 8192

    Else

        nLoop = 0

        nRemain = LnFile

    End If

    

    If LnFile = 0 Then

        MsgBox "Ivalid Source File", vbCritical, "Client Message"

        Exit Sub

    End If

    

    Open SrcPath For Binary As #1

    If nLoop > 0 Then

        For Cn = 1 To nLoop

            BufFile = String(8192, " ")

            Get #1, , BufFile

            WskClient.SendData BufFile

            IsReceived = False

            lbByteSend.Caption = "Bytes Sent: " & Cn * 81092 & " Of " & LnFile

            lbByteSend.Refresh

            While IsReceived = False

                DoEvents

            Wend

        Next

        If nRemain > 0 Then

            BufFile = String(nRemain, " ")

            Get #1, , BufFile

            WskClient.SendData BufFile

            IsReceived = False

            lbByteSend.Caption = "Bytes Sent: " & LnFile & " Of " & LnFile

            lbByteSend.Refresh

            While IsReceived = False

                DoEvents

            Wend

        End If

    Else

        BufFile = String(nRemain, " ")

        Get #1, , BufFile

        WskClient.SendData BufFile

        IsReceived = False

        While IsReceived = False

            DoEvents

        Wend

    End If

    WskClient.SendData "Msg_Eof_"    'end of file tag

    Close #1

    Exit Sub

GLocal:

    MsgBox Err.Description

    

End Sub

Private Sub ConnectToServer()

        'connecting to localhost

        'if you want to connect to another

        'client replace IP address with

        'remote computer name

        On Error Resume Next

        WskClient.Connect "127.0.0.1", 1001

        If Err <> 0 Then

            WskClient.Close

        End If

End Sub

Private Sub Command1_Click()

    ConnectToServer

End Sub



Private Sub Command3_Click()

    On Error GoTo GLocal

    If SrcPath = "" Then

        MsgBox "Select File To Transfer!!!", vbInformation, "TFTPClient Message"

        Exit Sub

    End If

    lbFileSend.Caption = SrcPath

    'send to server the remote path

    WskClient.SendData "Msg_Dst_" & DstPath

    Exit Sub

    

GLocal:

    MsgBox Err.Description

    Resume Next

    

End Sub



Private Sub Dir1_Change()

    File1.Path = Dir1.Path

End Sub



Private Sub Drive1_Change()

    Dir1.Path = Left(Drive1.Drive, 2) & "\"

End Sub



Private Sub File1_Click()

    SrcPath = File1.Path

    If Right(SrcPath, 1) <> "\" Then

        SrcPath = SrcPath & "\"

    End If

    SrcPath = SrcPath & File1.FileName

    'default destination path

    'if client and server are running on

    'the same machine

    Text1.Text = "C:\" & File1.FileName

    'to prevent overwrite source destination file

    'when client and server are running on

    'the same machine

    If Text1.Text = SrcPath Then

        Text1.Text = "C:\TFTPFile." & Right(File1.FileName, 3)

    End If

    lbFileSend.Caption = SrcPath

End Sub



Private Sub Form_Load()

    WskClient.Protocol = sckTCPProtocol

    

End Sub



Private Sub Text1_Change()

    DstPath = Text1.Text

End Sub



Private Sub WskClient_Close()

    lblInfo.Caption = "Not Connected..."

    WskClient.Close

End Sub



Private Sub WskClient_Connect()

    lblInfo.Caption = "I'm Connected"

End Sub



Private Sub WskClient_DataArrival(ByVal bytesTotal As Long)

    Dim recBuffer As String

    

    WskClient.GetData recBuffer

    

    Select Case Left(recBuffer, 7)

    Case "Msg_Rec"  'Block Received

        IsReceived = True

    Case "Msg_OkS"  'Ok you can begin to send file

        SendFile

    Case "Msg_Res"  'resent bad block

        'implement this case

    Case "Msg_Err"  'error

        'implement this case

    End Select

End Sub



Private Sub WskClient_Error(ByVal Number As Integer, Description As String, _

    ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, _

    ByVal HelpContext As Long, CancelDisplay As Boolean)

    If Number <> 0 Then

        lblInfo.Caption = "Not Connected"

    End If

End Sub



Private Sub WskClient_SendComplete()

'    WskClient.SendData "Msg_Eof_"    'end of file tag



End Sub



Private Sub WskClient_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)

'    DoEvents

'    lbByteSend.Caption = "Bytes Sent: " & bytesSent & " Of " & bytesRemaining

'    lbByteSend.Refresh

    

End Sub

(Редакция: Добавени тагове на кода, за да не се размества. Щирлиц)

Благодаря за мненията.
Проблемът беше, че бях затрупан с работа и нямах възможност да експериментирам дълго време, затова и търсех готово решение.
Работата с FTP е отчайващо проста, като естествено функциите за работа с файлове през FTP са подобни на тези с локалните файлове. Съответно изтриването на дърво се решава най-лесно с рекурсия - точно както работи и примера на уважаемия Щирлиц.
Ако някой се интересува, ще публикувам код.
Благодаря още веднъж.

чети и дишай по-леко

ne mi se e nalagalo za sega da pravia ni6to za FTP, no ako moje6 sloji koda, za da e polezen na horata, koito vlizat v kluba i razglejdat forumi za VB kakto vseki uvajava6t sebe si forum, kato povdignem niakakva tem, da predlagame re6enie nezavisimo kolko e prosto re6enieto vse pak nikoi ne se e rodil nau4en nali! Ina4e i forumite niama6e da gi ima
leka i plodotvorna ot mene

ОК, ето и код. Примера е извадка от готовото приложение, затова има много обработки на грешки и прочее. Съответно пък не съм извадил декларациите на АПИ функциите, които в случая не са интересни.

Private Function FTPDeleteFilesAndFolders(hConnection As Long, FolderName As String) As Integer

'INPUT:

'  Long - handle to FTP connection

'  String - name of folder to delete

'OUTPUT:

'  integer - ERROR ID

' 0 "no errors"

' 1 "ERROR FindFirst"

' 2 "ERROR Can`t delete file"

' 3 "ERROR InternetFindNextFile"

' 4 "ERROR Can`t delete file"

' 5 "ERROR Can`t delete folder"



     Dim Item As String                 'found folder name

     Dim lstX As New Collection         'sub-folder list

     Dim bResult As Integer             'internal result carrier

     Dim bNext As Integer               'used for counting sub-folders in list

     Dim hFind As Long                  'handle for FtpFindFirstFile

     Dim nLastError As Long             'Last error number

     Dim sFilename As String            'name of file for deleteing

     Dim pData As WIN32_FIND_DATA       'FtpFindFirstFile data structure

     Dim bRet As Boolean                'used in FtpFindFirstFile loop

   

     bResult = 0

     RemoteChDir FolderName

     hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)

     nLastError = Err.LastDllError

     If hFind = 0 Then

        If (nLastError <> ERROR_NO_MORE_FILES) Then

          bResult = 1 ' "ERROR FindFirst"

        End If

        RemoteChDir ".."

        FTPDeleteFilesAndFolders = bResult

        Exit Function

     End If

     

     sFilename = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)

     If (pData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then

        lstX.Add sFilename

     Else

        If FtpDeleteFile(hConnection, sFilename) = False Then

          FTPDeleteFilesAndFolders = 2 ' "ERROR Can`t delete file"

          InternetCloseHandle (hFind)

          Exit Function

        End If

     End If

     



     Do

        pData.cFileName = String(MAX_PATH, 0)

        bRet = InternetFindNextFile(hFind, pData)

        If Not bRet Then

            nLastError = Err.LastDllError

            If nLastError = ERROR_NO_MORE_FILES Then

                Exit Do

            Else

                FTPDeleteFilesAndFolders = 3 ' "ERROR InternetFindNextFile"

                InternetCloseHandle (hFind)

                Exit Function

            End If

        Else

            sFilename = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)

            If (pData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then

              lstX.Add sFilename

            Else

              If FtpDeleteFile(hConnection, sFilename) = False Then

                 bResult = 4 ' "ERROR Can`t delete file"

              End If

            End If

        End If

    Loop

    InternetCloseHandle (hFind)

     bNext = 0

     On Error Resume Next

       bNext = lstX.Count

     On Error GoTo 0

     If bNext > 0 Then

       For bNext = 1 To lstX.Count

         Item = lstX.Item(bNext)

         bResult = FTPDeleteFilesAndFolders(hConnection, Item)

         If FtpRemoveDirectory(hConnection, Item) = False Then

            bResult = 5 ' "ERROR Can`t delete folder"

         End If

       Next

       Set lstX = Nothing

     End If

     RemoteChDir ".."

     FTPDeleteFilesAndFolders = bResult

End Function



Public Function DeleteDirectory(Directory As String) As Boolean

'INPUT: String

' Local or full path to the directory, including its name

'OUTPUT: Boolean

' TRUE - success

' FALSE - failure

'IMPORTANT: after finishing with success the default direcory is parent to the input string

'IMPORTANT: can`t delete main (root) folder



On Error GoTo vberrorhandler



     Dim Elements                ' for separated folder names in to input string

     Dim LastPathPart As String  ' for name of directory to delete

    

    If mlConnection = 0 Then

        Err.Raise errNotConnectedToSite, "CGFTP::GetDirectoryList", ERRNOCONNECTION

    End If



    Directory = Replace(Directory, "\", "/")

    If Right(Directory, 1) = "/" Then

        Directory = Left(Directory, Len(Directory) - 1)

    End If

    Elements = Split(Directory, "/")

    If UBound(Elements) = -1 Then

        LastPathPart = Directory

    Else

        LastPathPart = Elements(UBound(Elements))

    End If



    If Len(Directory) > 0 Then

        RemoteChDir Directory

        RemoteChDir ".."

        FTPDeleteFilesAndFolders mlConnection, Directory

        If FtpRemoveDirectory(mlConnection, LastPathPart) = False Then

           DeleteDirectory = False

           Err.Raise Err.Number, "cFTP::DeleteDirectory", Err.Description

        'else

        '   DeleteDirectory = true

            ' SUCCESS

        End If

    End If

 

    

Exit Function

vberrorhandler:

    

    Err.Raise Err.Number, "cFTP::GetDirectoryList", Err.Description

End Function

чети и дишай по-леко