Процедура удаляет папку со всеми файлами и подпапками.
procedure DELE (fd: string); var s: searchrec; f: file; delf,delfiles: string;
function STAT (fd: string): string; var s: searchrec; begin stat:=''; findfirst(fd,anyfile,s); if doserror<>0 then exit; if s.attr=VolumeID then findnext(s); if doserror<>0 then exit; if (s.attr>=16)and(s.attr<=23) or (s.attr>=48)and(s.attr<=55) then stat:='D' else stat:='F'; end;
begin if stat(fd)='F' then begin assign(f,fd); setfattr(f,0); erase(f) end; if stat(fd)='D' then begin delfiles:=fd+'\*.*'; findfirst(delfiles,anyfile,s); while doserror=0 do begin delf:=fd+'\'+s.name; if (s.name<>'.')and(s.name<>'..')and(s.name<>'') then begin if stat(delf)='F' then dele(delf); if stat(delf)='D' then begin {$I-}rmdir(delf);{$I+} if ioresult=5 then dele(delf) end; end; findnext(s); end; rmdir(fd); end; end;
На TP работает, а вот на FPC как-то криво работает. Что-то удаляет,а что-то нет. Если указать просто пустой каталог, то даже его не удаляет. В чем проблема?