ErrorDeSintaxis

Pequeños fragmentos de código fuente en distintos lenguajes de programación, agrupados por categorías.

Puedes buscar entre los fuentes existentes, o aportar los tuyos.

Pascal: Borrar ficheros

Borrar todos los ficheros de un directorio y sus subdirectorios

Lenguaje: Pascal (compilador: Turbo Pascal 7)

Categoría: Ficheros

(* Fuente procedente de ErrorDeSintaxis.es *)
(* Borrar todos los ficheros de un directorio *)
(*  y sus subdirectorios *)
(* Lenguaje: Pascal *)
(* Compilador: Turbo Pascal 7 *)
(* Nivel: Intermedio *)
(* Disponible desde 17/07/2011 *)
(* Aportado por Nacho *)
(* Autor original: Steve Rogers *)
(* Web original: http://www.kd5col.info/swag/FILES/0061.PAS.html *)

{
  Erase is the proper procedure to delete one file. Here's a program I
  wrote a while back that does the same thin DELTREE does. Look it over
  and see if it helps get you started. BTW, I modified this a bit to
  remove commercial lib refs so there may be a syntax bug or two...
 
  RFD.PAS - Copyright 1991 Steve Rogers
  Released to public domain since DOS6 has DelTree... :)
}
 
{$m 16384,0,8192}
{$i-}
 
uses
  crt,dos;
 
{-----------------------}
function rfd(const s : pathstr) : boolean;
var
  f : file;
  d : searchrec;
  temp : boolean;
 
begin
  writeln('Removing '+s+'\');
 
  findfirst(s+'\*.*',anyfile-directory,d);
  if (doserror=0) then begin
 
    { Use DOS to get rid of the lion's share of files }
    swapvectors;
    exec(getenv('COMSPEC'),'echo y|del '+s+'\*.* >nul');
    swapvectors;
 
    { Now get the stragglers }
    findfirst(s+'\*.*',anyfile-directory,d);
    while (doserror=0) do begin
      assign(f,s+'\'+d.name);
      setfattr(f,archive);
      erase(f);
      findnext(d);
    end;
  end;
 
  { Now process the subs }
  findfirst(s+'\*.*',directory,d);
  while (doserror=0) do begin
    if (d.attr and directory = directory) and (d.name[1]<>'.') then
      temp:= rfd(s+'\'+d.name);
    findnext(d);
  end;
 
  rmdir(s);
  rfd:= (ioresult=0);
end;
 
{-----------------------}
begin
  clrscr;
  writeln('RFD - Remove Full Directory  Copyright 1991 Steve Rogers');
 
  if (paramcount<1) then
    writeln('Syntax is: RFD <directory>')
  else begin
    if rfd(paramstr(1)) then
      writeln(paramstr(1)+' removed. All files and subs deleted.')
    else
      writeln('Unable to find or remove '+paramstr(1));
  end;
end.