Столкнулся с тем, что если удалять директорию с помощью стандартной функции RemoveDir библиотеки Indy, то непустые директории не удаляются. Немного поискав, наткнулся на почти готовое решение на форуме. Суть в том, что удалять директории нужно рекурсивно, и начиная с конца списка.
Применив этот код в своем примере напрямую, я столкнулся с ошибкой – “Already Connected”. И действительно, при рекурсии, если подключаться в самой процедуре, Connect к FTP серверу получается несколько раз. Когда я вынес подключение вовне, а рекурсия работала с одним подключением – всё встало на свои места. Вот код, который у меня получился и работал корректно на тестах.
Сам вызов будет следующим
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
procedure TVisualFrame_PSFTPClient.RemoveClick(Sender: TObject); var dir: string; begin if ListView.Selected=nil then Exit; case Application.MessageBox('Вы действительно хотите удалить выбранный элемент?' + #13#10 + '(элемент будет удален навсегда)', 'Вопрос системы', MB_YESNO + MB_ICONQUESTION) of IDYES: begin dir:=CurrentDir+'/'+ListView.Selected.Caption; //ShowMessage(dir); DeleteDir(dir); end; IDNO: begin ShowMessage('Вы не выбрали ни один элемент'); Exit; end; end; |
Всего получилось 3 процедуры
|
1 2 3 4 |
// Deleting from FTP Server procedure DeleteDir(dir:string); procedure DeleteFTPdirCore(dir: string); procedure DeleteFTPdirCore2(dir: string); // 2nd variant |
Для начала рассмотрим так сказать ядро удаления…
Простой и компактный код (взял с форума)
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
procedure TVisualFrame_PSFTPClient.DeleteFTPdirCore(dir:string); var DL: TStringList; i: Integer; begin DL:=TStringList.Create; IdFTP.ChangeDir(Dir); IdFTP.List(DL, '', false); for i:=0 to DL.Count-1 do begin if IdFTP.Size(dl.Strings[i])=-1 then DeleteFTPdirCore(dl.Strings[i]) //Рекурсия else IdFTP.Delete(dl.Strings[i]); //иначе удаляем файл end; IdFTP.ChangeDirUp; IdFTP.RemoveDir(Dir); DL.Free; end; |
Другой вариант удаления
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 |
procedure TVisualFrame_PSFTPClient.DeleteFTPdirCore2(dir:string); var DL: TStringList; L,FTPDL:TStringList; i: integer; begin Application.ProcessMessages; DL:=TStringList.Create; //DirectoriesList L:=TStringList.Create; //ItemType FTPDL:=TStringList.Create; // NamesList idFTP.ChangeDir(Dir); idFTP.List(DL); // Typing - what is dir and what is file for i:=0 to DL.Count-1 do begin FTPDL.Add(idFTP.DirectoryListing[i].FileName); if idFTP.DirectoryListing[i].ItemType = ditDirectory then L.Add('d') else L.Add('f'); end; for i:=DL.Count-1 downto 0 do begin if (L[i]='d') then begin if (FTPDL[i]<> '.') and (FTPDL[i]<> '..') then begin DeleteFTPdirCore2(FTPDL[i]); // <<<Recursion end; end else begin idFTP.Delete(FTPDL[i]); end; end; idFTP.ChangeDirUp; idFTP.RemoveDir(Dir); FTPDL.Destroy; DL.Destroy; L.Destroy; end; |
Теперь встроим это ядро в процедуру, которая подключает компонент idFTP к FTP серверу
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 |
procedure TVisualFrame_PSFTPClient.DeleteDir(dir:string); begin with idFTP do begin Host:=FTPConnectionParams.Host;// 'localhost'; //FTP-сервер Port:=FTPConnectionParams.Port;// 22; //порт ФТП сервера Username:=FTPConnectionParams.Username;// 'Логин'; Password:=FTPConnectionParams.Password;// 'Пароль'; end; try idFTP.Connect; try // Main Code here <<<<< try if IdFTP.Connected then DeleteFTPdirCore2(dir); finally idFTP.Disconnect; end; except //Other exceptions on E: EIdException do begin raise Exception.Create(E.ClassName+' An network error occurred during communication: ' +#13#10+#13#10+E.Message); end; on E: Exception do begin raise Exception.Create(E.ClassName+' An unknown error occurred during communication: ' +#13#10+#13#10+E.Message); end; end; except // Catching Connection Exceptions on E: EIdException do begin raise Exception.Create(E.ClassName+' An network error occurred while trying to connect: ' +#13#10+#13#10+E.Message); end; on E: Exception do begin raise Exception.Create(E.ClassName+'An unknown error occurred while trying to connect: ' +#13#10+#13#10+E.Message); end; end; UpdateCurrentDir; // <<< Вспомогательная процедура - из моего примера - обновляет ListView end; |
Вспомогательные процедуры
|
1 2 3 4 5 6 7 8 9 10 |
procedure TVisualFrame_PSFTPClient.UpdateCurrentDir; begin FillFilesOnServer; ListView.Items.Count:=FilesOnServer.Count; ListView.UpdateItems(0,FilesOnServer.Count-1); ListView.Repaint; ListView.Refresh; end; |
И ещё одна – получает список файлов на сервере
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 |
//------------Список файлов с сервера procedure TVisualFrame_PSFTPClient.FillFilesOnServer; var I: integer; tempstring: string; begin with idFTP do begin Host:=FTPConnectionParams.Host;// 'localhost'; //FTP-сервер Port:=FTPConnectionParams.Port;// 22; //порт ФТП сервера Username:=FTPConnectionParams.Username;// 'Логин'; Password:=FTPConnectionParams.Password;// 'Пароль'; end; try idFTP.Connect; try try if IdFTP.Connected then begin //ОСНОВНАЯ РАБОТА ЗДЕСЬ with idFTP do begin // Создаем директорию и меняем её //MakeDir(CurrentDir); ChangeDir(CurrentDir); // ShowMessage(RetrieveCurrentDir); List; // <<Собираем список папок и файлов //Загружаем его в StringLists... FilesOnServer.Clear; IsFolderList.Clear; for i := 0 to IdFTP.DirectoryListing.Count-1 do begin if (IdFTP.DirectoryListing[i].FileName='.') or (IdFTP.DirectoryListing[i].FileName='..') then Continue else // Пропускаем, если видим эти точки... begin FilesOnServer.Add(IdFTP.DirectoryListing[i].FileName); if IdFTP.DirectoryListing[i].ItemType=ditFile then IsFolderList.Add( '0' ) else //if IdFTP.DirectoryListing[i].ItemType=ditDirectory then IsFolderList.Add( '1' ); end; end; end; end; finally idFTP.Disconnect; end; except //Other exceptions on E: EIdException do begin raise Exception.Create(E.ClassName+' An network error occurred during communication: ' +#13#10+#13#10+E.Message); end; on E: Exception do begin raise Exception.Create(E.ClassName+' An unknown error occurred during communication: ' +#13#10+#13#10+E.Message); end; end; except // Catching Connection Exceptions on E: EIdException do begin raise Exception.Create(E.ClassName+' An network error occurred while trying to connect: ' +#13#10+#13#10+E.Message); end; on E: Exception do begin raise Exception.Create(E.ClassName+'An unknown error occurred while trying to connect: ' +#13#10+#13#10+E.Message); end; end; end; |