Обновлено: 01 декабря, 2018

Удаление файлов, пустых каталогов, каталогов со всем содержимым в Delphi

Удаление файла

Для удаления файлов в Delphi так же предусмотрена специальная процедура DeleteFile. В качестве параметра, передаваемого в функцию, выступает строка типа PChar, указывающая имя файла, который нужно удалить.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if DeleteFile('c:\2.txt') then
    ShowMessage('Файл успешно удален!')
  else
    ShowMessage('Ошибка! Вот ее код: '+IntToStr(GetLastError));
end; 

Удаление файла в корзину

uses ShellAPI;
 
function DeleteFileWithUndo( sFileName : string ) : boolean;
var fos : TSHFileOpStruct;
begin
  sFileName:= sFileName+#0;
  FillChar( fos, SizeOf( fos ), 0 );
  with fos do
  begin
    wFunc  := FO_DELETE;
    pFrom  := PChar( sFileName );
    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
  end;
  Result := ( 0 = ShFileOperation( fos ) );
end;

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

Чтобы удалить пустую директорию с помощью Delphi достаточно обратиться к функции RemoveDir.

function RemoveDir(const Dir: string): Boolean;

Эта функция возвращает True если директория, указанная в единственном параметре, передаваемом в функцию, успешно удалена, в противном случае функция возвратит False. Часто возникает необходимость удалить непустую папку, содержащую не только файлы, но и другие вложенные папки. Для этого была написана пользовательская функция, удаляющая папку со всеми файлами и поддиректориями. Вот она:

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; 

А сейчас пример использования этой функции:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if MyRemoveDir('C:testDir') then ShowMessage('Директория успешно удалена')
  else ShowMessage('Не получается удалить директорию');
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;

(10 оценок, среднее: 5,00 из 5)

Загрузка...