рекурсивное удаление директории

аналог

rmdir /s /q или rm -rf

function DeleteDirectoryEx(DirectoryName: string): boolean;
// адаптирована функция DeleteDirectory из модуля fileutil, спасибо Павлу Дмитруку
var
  FileInfo: TSearchRec;
  CurSrcDir: String;
  CurFilename: String;
begin
  Result:=false;
  CurSrcDir:=CleanAndExpandDirectory(DirectoryName);
  try
         if FindFirstUTF8(CurSrcDir+GetAllFilesMask,faAnyFile,FileInfo)=0 then
         begin
           repeat
             if (FileInfo.Name<>'.') and (FileInfo.Name<>'..') and (FileInfo.Name<>'') then
             begin
               CurFilename:=CurSrcDir+FileInfo.Name;
               if (FileInfo.Attr and faReadOnly)>0 then
                 FileSetAttrUTF8(CurFilename, FileInfo.Attr-faReadOnly);
               if (FileInfo.Attr and faDirectory)>0 then
               begin
                 if not DeleteDirectoryEx(CurFilename) then exit;
               end
               else
               begin
                 if not DeleteFileUTF8(CurFilename) then exit;
               end;
             end;
           until FindNextUTF8(FileInfo)<>0;
         end;
         FindCloseUTF8(FileInfo);
         if (not RemoveDirUTF8(DirectoryName)) then
           begin
             exit;
             Result:=true;
           end;
  except
    Result:=false;
  end;
end;
Поделиться
Отправить
 385   2019   free pascal   lazarus