XGM Forum
Сайт - Статьи - Проекты - Ресурсы - Блоги

Форуме в режиме ТОЛЬКО ЧТЕНИЕ. Вы можете задать вопросы в Q/A на сайте, либо создать свой проект или ресурс.
Вернуться   XGM Forum > Общение> Трактир
Ник
Пароль
Войти через VK в один клик
Сайт использует только имя.

Ответ
 
Омега

offline
Опыт: 12,033
Активность:
[Delphi] Очистка каталога
Нужна процедура\функция, для полного очищения каталога, даже если в нем лежат так же еще папки, в которых тоже файлы, а возможно и еще папки...
Делфи до такой степени не шарю, что бы самому написать. Понять и переправить-то смогу.
В интернетах нашел с пол-дюжины сорсов, которые:
а) не работают
б) не удаляют вообще ничего, даже просто файлы с корня указанной директории, если в ней есть хоть 1 папка (если папок нет - то удаляет оставшиеся файлы)
Самый удачный вариант нашел:
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;
Он работает по схеме "б".
Нужно: поправить, что бы удалял вообще все, по указанному пути.
Старый 23.02.2010, 09:32
HGL
Phased out.
offline
Опыт: 25,976
Активность:
набросал по-быстрому... как бы чисто теоретически работать должно, но с файловыми системами у меня вообще туго + там иногда бывают сбои... но попробуй, вдруг внезапно заработает :D
Код:
procedure cleandir(dir:string);
 var sr:tsearchrec;
begin
try
 if findfirst (dir+'\*',faAnyFile,sr) =0 then
 repeat
  if (sr.Attr and faDirectory)=faDirectory 
   then begin if (sr.name<>'..')and(sr.Name<>'.') then 
    cleandir(dir+'\'+sr.name) end
   else deletefile(dir+'\'+sr.name);
 until findnext(sr)<>0;                     
 rmdir(dir);
except
 on e:EInOutError do begin
  //сюда можно какой-нибудь вывод ошибки например ^_^
 end;
end;
end;
Старый 24.02.2010, 21:46
Омега

offline
Опыт: 12,033
Активность:
rmdir(dir) убрал, ибо крашится из-за нее, да и не обязательно удалять саму папку.
Работает получше хваленого текста из псота #1.
tldr, спасибо, да.
Старый 24.02.2010, 23:11
Ответ

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы можете скачивать файлы

BB-коды Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход



Часовой пояс GMT +3, время: 23:47.