Удаление папок

[russian-stalker]

Подскажите как удалить все пустые папки внутри папки до конца Иеархии?

[Serge_Bliznykov]

ну писал я когда-то такой код.
вот, пробуй:

program EmptyDirList;
{$APPTYPE CONSOLE}

uses SysUtils, Windows;

var
  IOCode        : integer;
  cDir0         : string;

function StrAnsiToOem(const S: AnsiString): AnsiString;
begin
  SetLength(Result, Length(S));
  AnsiToOemBuff(@S[1], @Result[1], Length(S));
end;

function FilesCountInScanDirectory( cDirName : string) : integer;
var
  lCountResult    : integer;
  SearchRec       : TSearchRec;
  isFound         : integer;
begin
  lCountResult := 0;
  isFound := FindFirst( cDirName+'\*.*', faAnyFile, SearchRec);
  while ( isFound = 0 ) do begin
     if (SearchRec.Attr and faDirectory)<>0 then begin
         if (Trim(SearchRec.Name)<>'.') and
              (Trim(SearchRec.Name)<>'..') then begin
           lCountResult := FilesCountInScanDirectory(
                             cDirName+'\'+SearchRec.Name) + lCountResult;
         end
       end
     else
       lCountResult := lCountResult + 1;
     isFound := FindNext(SearchRec)
  end;
  SysUtils.FindClose(SearchRec);
  Result := lCountResult;
  if lCountResult = 0 then begin
     WriteLn( 'NOW you can delete FOLDER - '+ strAnsiToOem(cDirName));
     {$I-}
     // убрать комментарий строки ниже, чтобы пустые папки УДАЛЯЛИСЬ!!!!!!
     //     RmDir(cDirName);  // ВНИМАНИЕ!! ПАПКИ УДАЛЯЮТСЯ данной командой!
     IOCode := IOResult;
     if IOCode <> 0 then
       WriteLn('Cannot remove directory ',strAnsiToOem(cDirName),' Error code:',IOCode)
     else
       WriteLn('Directory ', strAnsiToOem(cDirName), ' removed ');
     {$I+}
  end
end;

begin
  WriteLn('EmptyDirList v0.1 (c) Serge B_SA 2006');
  // директория, с которой нужно начинать просмотр дерева каталогов
  // можно брать, например, из командной строки cDir0 := ParamStr(1);
  cDir0 := 'C:\TESTIN2';
  // рекурсивно обойти дерово начиная с папки CDir0
  FilesCountInScanDirectory( cDir0 );
  WriteLn('Done.');
end.

[eoln]

Для одной ветки. Пойдём с конца, removedir позволяет удалять только пустые папки - этим и пользуемся

procedure TForm1.Button1Click(Sender: TObject);
var p:string;
begin
  P := 'c:\1\2\3\4\5';//конечный путь 
  if P[length(P)] <> '\' then P := P + '\';//добавим '\' если нету
  repeat
    P := ExtractFilePath(P);//вычислим родительскую папку
    Delete(P, length(P), 1)//удалим символ '\'
  until not removedir(P)
end;

[Stilet]

Стоит попробовать удачять через SHFileOperation

[russian-stalker]

Serge_Bliznykov, спасибо, работает