-
Мне в программе нужно удалить папку с файлами. Процедура которую приведу ниже при вызове в конкретном месте программы приводит к странному эффекту - при просмотре фаром папка не пропадает но войти в неё невозможно - фар выдаёт "Access denied", но если выйти из программы - то папка наконец пропадает. Пробовал вместо вызова этой процедуры удалить папку (в этот момент) фаром - получается, т.е. реально ничто в папке удалению не мешает. Вроде выходит что проблема в процедуре, но не могу понять какая.. Взгляните, пожалуйста!
На то, что в процедуре отсутствует контроль ошибок прошу внимание не обращать, т.к. похоже дело не в этом раз фаром всё удаляется..
procedure DeleteFolder(const aFolder: String); var Found: TSearchRec; begin Found.Name := '';
if FindFirst(aFolder + '\*.*', faAnyFile, Found) = 0 then begin // Пройдем по всем файлам и папкам repeat if (Found.Name <> '.') and (Found.Name <> '..') then if (Found.Attr and faDirectory) <> 0 then // Удалим вложенную папку - рекурсия DeleteFolder ( aFolder + '\' + Found.Name ) else // Удалим файл DeleteFile ( aFolder + '\' + Found.Name ); until FindNext(Found) <> 0;
FindClose(Found); end;
if DirectoryExists(aFolder) then RemoveDir ( aFolder ); // Удалим саму папку end; // of TDBTools.DeleteFolder
-
TDirectory.Delete
-
при вызове в конкретном месте программы
в этом конкретном месте программы каррентдир процесса мешает удалению папки.
-
А еще надо исключить возможность утечки памяти:
if FindFirst... then try repeat ... until FindNext... finally FindClose... end
-
TDirectory.Delete
Сорри, забыл указать, что работаю на Delphi 2007, так что это для меня не вариант.. А в чём, любопытно, преимущество этой функции?
в этом конкретном месте программы каррентдир процесса мешает удалению папки.
Удаляемая папка лежит далеко в стороне от процесса.. Не текущая. Так что вопрос пока в силе ((
Всем спасибо за ответы!
-
D5, проблем не обнаружено. Просмотрел Total Commander-ом. Кстати как просматривается "удаленная" папка проводником. Мало вероятно, но не исключено, что это что-то с Far-ом. Давно юзаю TC.
-
> Кстати как просматривается "удаленная" папка проводником???
-
не исключено, что это что-то с Far-ом
Проводник тоже выдаёт "Access denied"
-
Повторюсь - после закрытия программы папка таки пропадает
-
можно до утра мечтать про единорогов и камлать на процедуры, которые "действуют по особому" только "в конкретных местах программы"
но утром все равно обнаружится, что в программе есть оупендиалог с выключенной ofNoChangeDir и все дело было в текущем каталоге процесса, который и мешал удалению папки.
-
The RemoveDirectory function marks a directory for deletion on close. Therefore, the directory is not removed until the last handle to the directory is closed.
To recursively delete the files in a directory, use the SHFileOperation function.
-
с выключенной ofNoChangeDir и все дело было в текущем каталоге процесса, который и мешал удалению папкино если б что-то блокировало, тоя ведь и фаром удалить бы не смог, так? И похоже дело всё в процедуре, так как (хорошая новость!) я таки нашёл в инете нармально работающую аналогичную, но проблема в том, что я так и не понял пока в чём там ключевое отличие и зачем там атрибуты файлов меняются. Привожу текст полностью, может вам удастся увидеть:
function FullRemoveDir(Dir: string; DeleteAllFilesAndFolders,
StopIfNotAllDeleted, RemoveRoot: boolean): Boolean;
var
i: Integer;
SRec: TSearchRec;
FN: string;
begin
Result := False;
if not DirectoryExists(Dir) then
exit;
Result := True;
Dir := IncludeTrailingBackslash(Dir);
i := FindFirst(Dir + '*', faAnyFile, SRec);
try
while i = 0 do
begin
FN := Dir + SRec.Name;
if SRec.Attr = faDirectory then
begin
if (SRec.Name <> '') and (SRec.Name <> '.') and (SRec.Name <> '..') then
begin
if DeleteAllFilesAndFolders then
FileSetAttr(FN, faArchive);
Result := FullRemoveDir(FN, DeleteAllFilesAndFolders,
StopIfNotAllDeleted, True);
if not Result and StopIfNotAllDeleted then
exit;
end;
end
else begin
if DeleteAllFilesAndFolders then
FileSetAttr(FN, faArchive);
Result := SysUtils.DeleteFile(FN);
if not Result and StopIfNotAllDeleted then
exit;
end;
i := FindNext(SRec);
end;
finally
SysUtils.FindClose(SRec);
end;
if not Result then
exit;
if RemoveRoot then if not RemoveDir(Dir) then
Result := false;
end;
-
The RemoveDirectory function marks a directory for deletion on close
Я использую RemoveDir - другую функцию.
-
-
Перед вызовом в проблемном месте вставить
ShowMessage(GetCurrentDir);
-
Открываем исходник и видим: Хм.. А в дельфийском хелпе ни намёка на то, что удаление может быть отложено.. Спасибо! Но прикол в том, что приведённая выше работающая функция использует ту же самую RemoveDir Но там она удаляет всё сразу.
Перед вызовом в проблемном месте вставить ShowMessage(GetCurrentDir); Выдаёт папку экзешника, которая далеко в стороне, разве что на одном диске.
-
> Хм..
тебеж написали где нужно брать инфу по винде... FILE_ATTRIBUTE_ARCHIVE - A file or directory that is an archive file or a directory. Applications use this attribute to mark files for backup or removal.
-
Закоментировал в приведённой выше работающей функции строчки, меняющие атрибуты - всё равно работает, собака.. Видимо, в данном случае дело всё-таки не в атрибутах..
-
А так?
procedure DeleteFolder(const aFolder: String); var Found: TSearchRec; begin Found.Name := '';
if FindFirst(aFolder + '\*.*', faAnyFile, Found) = 0 then begin // Пройдем по всем файлам и папкам repeat if (Found.Name <> '.') and (Found.Name <> '..') then if (Found.Attr and faDirectory) <> 0 then // Удалим вложенную папку - рекурсия DeleteFolder ( aFolder + '\' + Found.Name ) else // Удалим файл DeleteFile ( aFolder + '\' + Found.Name ); until FindNext(Found) <> 0;
end; FindClose(Found);
if DirectoryExists(aFolder) then RemoveDir ( aFolder ); // Удалим саму папку end; // of TDBTools.DeleteFolder
(FindClose(Found) должен быть после условного блока, а не внутри его).
-
> (FindClose(Found) должен быть после условного блока, а не внутри его). не должен, при не найденности/ошибке FindFirst не возвращает хендла, закрывать нечего.
|