Удалить не пустой каталого

[Иллидан]

Необходимо удалить каталог со всеми его подкаталогами и фаилами, а Дельфи вроде умеет удалять только пустые каталоги. Какой функцией воспользоваться?

[Никки]

Функции наверное нет! Нужно используя функцию поиска файлов находить все файлы и удалять из поочереди, а потом удалять все вложенные каталоги, а потом и эту папку саму!! Я думаю что только так, но сам не делал, думаю у меня бы это заняло целый день!

[SunKnight]

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;

Пример использования:
FullRemoveDir('C:\a', true, true, true);
// Полное удаление папки C:\a со всем её содержимым,
// и с последующим удалением самой c:\a

Пример позаимствован, откуда нескажу ,а то модеры обвинят меня в пропаганде левых сайтов!

[pu4koff]

Сообщение от SunKnight

Пример позаимствован, откуда нескажу ,а то модеры обвинят меня в пропаганде левых сайтов!

теперь товарищи с неуказанного сайта могут обвинить тебя в нарушении авторских прав

[Иллидан]

Спасибо, но твоя функция не удаляет, если в папке есть вложенные папки!

[SunKnight]

function MyRemoveDir(sDir : string) : Boolean;
var
  iIndex: Integer;
  SearchRec: TSearchRec;
  sFileName: string;
begin
  Result := False;
  sDir := sDir + '\*.*';
  iIndex := FindFirst(sDir, faAnyFile, SearchRec);

  while iIndex = 0 do
  begin
    sFileName := ExtractFileDir(sDir)+'\'+SearchRec.name;
    if SearchRec.Attr = faDirectory then
    begin
      if (SearchRec.name <> '' ) and (SearchRec.name <> '.') and
      (SearchRec.name <> '..') then
        MyRemoveDir(sFileName);
    end
    else
    begin
      if SearchRec.Attr <> faArchive then
        FileSetAttr(sFileName, faArchive);
      if not DeleteFile(sFileName) then
        ShowMessage('Could NOT delete ' + sFileName);
    end;
    iIndex := FindNext(SearchRec);
  end;

  FindClose(SearchRec);
  RemoveDir(ExtractFileDir(sDir));
  Result := True;
end;

- глубоко извеняюсь за первый неудачный пример, этот пашит.

[BanDit]

Можно еще так:

  //сначала надо очистить папку, потом удалить
 procedure RemoveAll(path: string);
var
  sr: TSearchRec;
begin
  if FindFirst(path + '\*.*', faAnyFile, sr) = 0 then
  begin
    repeat
      if sr.Attr and faDirectory = 0 then
      begin
        DeleteFile(path + '\' + sr.name);
      end
      else
      begin
        if pos('.', sr.name) <= 0 then
          RemoveAll(path + '\' + sr.name);
      end;
    until
      FindNext(sr) <> 0;
  end;
  FindClose(sr);
  RemoveDirectory(PChar(path));
end;


procedure TForm1.FormCreate(Sender: TObject);

var
   l: DWORD;
 begin
   l := GetWindowLong(Self.Handle, GWL_STYLE);
   l := l and not (WS_MINIMIZEBOX);
   l := l and not (WS_MAXIMIZEBOX);
   l := SetWindowLong(Self.Handle, GWL_STYLE, l);
 end;


procedure TForm1.Button1Click(Sender: TObject);

  var
  dir: string;
begin
  if SelectDirectory('Удаление каталога', 'D:\тексты', dir) then
    RemoveAll(dir);

end;

end.

[AnalogXP]

А так пойдет:

function DelDir(dir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_DELETE;
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
    pFrom  := PChar(dir + #0);
  end;
  Result := (0 = ShFileOperation(fos));
end;

[SunKnight]

uses ShellApi;

[SANTA_KLAUD]

А как удалить выбраный файл из каталога ? т.е в "файл лист бокс" отабражается список всех файлов в директории нужен код для кнопи
т.е выделяю мышью файл в списке жму кнопку удалить и всё