Удаление пустых папок в подпапке

[artemavd]

Как удалить пустые папки (именно папки) в указанной папку, если путь до корнейвой папки я сам укажу? Нужно, чтобы удалились только пустые подпапки в указанной папке. Пните в ту сторону, где можно почитать конкретную литературу по этому вопросу

[DIgorevich]

ну, насколько я помню, RemoveDir удаляет только пустую папку

[Alex Cones]

FindFirst с аттрибутом faDirectory. Потом проводим поиск рекурсивно в найденной папке и если пуста - киляем её.

[Stilet]

а пройтись рекурсией по папкам и проверить из размер?

[artemavd]

Вот, пытаюсь сделать поиск. Но, не работает. Выдает ошибку, которая записана в ShowMessage и зависает, когда я указываю через SelectDirectory папку в которой надо искать пустые подпапки. Нужно, чтобы имена всех пустых папок вывелись в ListBox, а затем удалились.

[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
  // директория, с которой нужно начинать просмотр дерева каталогов
  // можно брать, например, из командной строки cDir0 := ParamStr(1);
  cDir0 := 'C:\TESTIN2';
  // рекурсивно обойти дерово начиная с папки CDir0
  FilesCountInScanDirectory( cDir0 );
  WriteLn('Done.');
end.

[artemavd]

Правильно ли я понял, что данный код переводится на Delphi так:

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
       ShowMessage('Cannot remove directory ',strAnsiToOem(cDirName),' Error code:',IOCode)
     else
       ShowMessage('Directory ', strAnsiToOem(cDirName), ' removed ');
     {$I+}
  end
end;

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

???

[Пепел Феникса]

artemavd, он и был на Делфи

[artemavd]

Переработал я видать уже . Не обращайте внимания. С 8 утра на работе до сих пор щас.

ругается на эту строчку

ShoeMessage( 'NOW you can delete FOLDER - '+ strAnsiToOem(cDirName));

пишет:
[Error] Unit1.pas(58): Undeclared identifier: 'strAnsiToOem'

[Stilet]

А как вам, господа, такой приемчик?:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    procedure FormCreate(Sender: TObject);
  private      e:string;
    { Private declarations }
    function finder(path:string):boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
          {$o-}
function TForm1.finder;
var i:integer;  s:TStringList;
begin      result:=false;
  ListBox1.Clear; s:=TStringList.Create;
  if SendMessage(ListBox1.Handle,LB_DIR,DDL_DIRECTORY or not DDL_ARCHIVE and not  DDL_DRIVES,
   integer(pchar(path+'*')))<>0 then begin
   result:=true;
   s.Text:=StringReplace(ListBox1.Items.Text,'[','',[rfreplaceall]);
   s.Text:=StringReplace(s.Text,']','',[rfreplaceall]);
   for i:=0 to s.Count-1 do begin
    if s[i]<>'..' then begin
     if not finder(path+s[i]+'\') then
      ListBox2.Items.Add(path+s[i]+'\');
    end;
   end;
  end;
  s.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

 finder('d:\1\');
end;

end.

Экзотично, зато работает )