Vitus_Bering Цитата: Подскажите, пож-та, код, который бы удалял все пустые папки на диске.
Можно уточнить, у вас собственно проблема в том, чтобы рекурсивно пройтись по дереву?
Или как одну пустую папку удалить?...
вот для удаления одной папки:
//Deletes an empty subdirectory.
procedure RmDir(S: string);
Далее пример программы, рекурсивного обхода по дереву каталогов,
проверки пустая папки или нет и, если пустая - то удаление её - [more]
Консольная программа. сохраните на диск под именем EmptyDirList.dpr
Код: 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.
