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

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

procedure TForm1.Button1Click(Sender: TObject);
var
lpFileOp: TSHFileOpStruct;
begin
FillChar(lpFileOp,SizeOf(lpFileOp),0);
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_DELETE;
lpFileOp.pFrom := PChar(Edit1.Text);
lpFileOp.fFlags := FOF_NOCONFIRMATION;
SHFileOperation(lpFileOp);
end;

*********************************************************************

Удаление подкаталогов рекурсивное - функция вызывает саму себя.
Флаг RemoveRoot указывает на необходимость удаления корня.
Содержимое корня очищается в любом случае.

function FullRemoveDir(Dir:string; RemoveRoot:boolean):Boolean;
var i:Integer;
SRec:TSearchRec;
FN:String;
begin
Result:= False;
if Dir = ?? then exit;
if not DirectoryExists(Dir) then exit;
Result:= True;
// Добавляем слэш в конце и задаем маску - "все файлы"
Dir:= IncludeTrailingBackslash(Dir) + ?*.*?;
i:= FindFirst(Dir, faAnyFile, SRec);
while i = 0 do
begin
// Получаем полный путь к файлу или директорию
FN:= ExtractFileDir(Dir)+??+SRec.Name;
// Если это директорий
if SRec.Attr = faDirectory then
begin
if (SRec.Name ?? ) and (SRec.Name ?.?) and (SRec.Name ?..?) then
// Рекурсивный вызов этой же функции с ключом удаления корня
FullRemoveDir(FN,True);
end
else
// Иначе удаляем файл
begin
if SRec.Attr faArchive then FileSetAttr(FN, faArchive);
// Если хотя бы один файл не удален - результат отрицательный, но операция продолжается до конца
if not DeleteFile(FN) then Result:= false;
end;
// Берем следующий файл или директорий
i:= FindNext(SRec);
end;
FindClose(SRec);

// Если необходимо удалить корень - удаляем
if RemoveRoot then
try
if not RemoveDir(Dir) then Result:= false;
except
Result:= false;
end;

end;

*******************************************************************

Как удалить каталог со всем содержимым

function DeleteDir(Dir  : string)  : boolean;
Var
Found  : integer;
SearchRec : TSearchRec;
begin
result:=false;
if IOResult<>0 then ;
ChDir(Dir);
if IOResult<>0 then begin
ShowMessage('Не могу войти в каталог: '+Dir); exit;
end;
Found := FindFirst('*.*', faAnyFile, SearchRec);
while Found = 0 do
begin
if (SearchRec.Name<>'.')and(SearchRec.Name<>'..') then
if (SearchRec.Attr and faDirectory)<>0 then begin
if not DeleteDir(SearchRec.Name) then exit;
end else
if not DeleteFile(SearchRec.Name) then begin
ShowMessage('Не могу удалить файл: '+SearchRec.Name);
exit;
end;
Found := FindNext(SearchRec);
end!
;
FindClose(SearchRec);
ChDir('..'); RmDir(Dir);
result:=IOResult=0;
end;

********************************************************************

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;

Для тех кто не очень дружит с функциями приведу пример ее использования. Например, в обработчике нажатия на кнопку напишите (где-нибудь повыше конечно же должна быть написана сама функция):

if not myremovedir('c:\mydir') then
showmessage('can not delete dir');

Если все пройдет нормально, то каталог будет удален, если нет, то появится сообщение. Данная функция удаляет также и скрытые и системные файлы.

******************************************************

procedure TForm1.Button1Click(Sender: TObject);
var
  DirInfo: TSearchRec;
  r: integer;
begin
  r := FindFirst('C:\Download\*.*', FaAnyfile, DirInfo);
  while r = 0 do
  begin
    if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
      (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
    if DeleteFile(pChar('C:\Download\'+DirInfo.Name))=false then
      ShowMessage('Unable to delete: C:\Download\'+DirInfo.Name);
    r := FindNext(DirInfo);
  end;
  SysUtils.FindClose(DirInfo);
  if RemoveDirectory('C:\Download\') = false then
    ShowMessage('Unable to delete directory: C:\Download\');
end;

Эта запись была добавлена в Суббота, 17 мая, 2008 - 16:17 В разделы Операционная система, Файловая система. Вы можете подписаться на получение новых комментариев RSS 2.0 feed. Both comments and pings are currently closed.