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.