Pascal/Turbo Pascal - Códe DIR RECURSIVO

se han quitado comentarios ( máximo mensaje 10000 caracteres) para mas
detalles mirar 6 enlaces mas abajo en este mismo foro.

uses crt,SysUtils;

Var Info : TSearchRec;
Fich_Dir:text;

Path_Puntos:char;
Path_Barra:char;
Path_comodin:String;
Path_Unidad:string;
Path_Directorio:string;
Path_Raiz:string;
Path_Total:string;
Path_Total_Sin:string;

Path_Tmp:string;
Path_Sig:string;
unalinea:string;
XAnterior,XActual:integer;
Busqueda:string;

aa,bb,cc:integer;


function Num2Cad4 (num:integer):string[4];

var _4digitos:string[4];
cnt:byte;
begin
str (num:4,_4digitos);
Num2Cad4:=_4digitos;
end;


var
Ant_OrigenDir:integer;
OrigenDir:integer;
ActualDir:integer;
ActualFil:integer;
temp:integer;

function DIR (Xpath: String; Attr: LongInt;Var Info:TSearchRec ):LongInt;
begin

append(Fich_Dir);

If FindFirst (Xpath ,255 ,Info)=0 then
begin // A

Repeat With Info do
begin // B

if (Attr and faDirectory ) = faDirectory then
begin // C
if ( Name[1]<>'.') then
begin // D
inc(ActualDir);
Write(Fich_Dir,'[',Num2Cad4(OrigenDir),'][',Num2Cad4(ActualDir),']');
Write(Fich_Dir,' DIR ');
Writeln(Fich_Dir,' ', Name);

end; // D
end; // C


end;{ B }
delay(0);
Until FindNext(info)<>0;
end; { A }
FindClose(Info);
Close(Fich_Dir);

end;

function Busca_Sig_Dir(var unalinea:string; Anterior, Actual:integer ):string;
var
CadNum1,Cadnum2:string[4];
error:word;
Tipo_DIR:char;
Nombre:string;
begin
Busca_Sig_Dir:='';


Tipo_DIR:=unalinea[14];
cadNum1:=unalinea[2]+unalinea[3]+unalinea[4]+unalinea[5] ;
cadNum2:=unalinea[8]+unalinea[9]+unalinea[10]+unalinea[11];
val (cadNum1 , XAnterior, error); // y convertimos
val (cadNum2 , XActual , error);
Nombre := Copy( Unalinea , 19 , length( Unalinea ) );


if (Tipo_DIR='D' ) then
if XActual=Actual then Busca_Sig_Dir:=Nombre;
end;


function Sigiente_RutayDir( Anterior, Actual:integer ):string ;
begin

Sigiente_RutayDir:='';
reset (Fich_Dir);
while not eof(Fich_Dir)do
begin
readln(Fich_Dir,unalinea);
Busqueda:=Busca_Sig_Dir (unalinea,Anterior,Actual);
if (Busqueda<>'') then
begin
Sigiente_RutayDir:=Busqueda;
break ;
end;

end;
close (Fich_Dir);
end;

procedure muestra_INFO;
begin
writeln('--------- INFO -----------');
writeln('Nivel:',OrigenDir);
writeln('Directorios:',ActualDir);
writeln( 'Nant:',XAnterior, ' Nact:' ,XActual);
writeln('--------------------------');

end;

function IRD (Xpath: String; Attr: LongInt;Var Info:TSearchRec;
var Path_Total_sin:string ):LongInt;
begin
If FindFirst (Xpath ,255 ,Info)=0 then
begin // A

Repeat With Info do
begin // B

if ( Name[1]<>'.') then
begin
textcolor(14);
write(Path_Total_sin);
textcolor(13);
Writeln( Name);
textcolor(7);
delay(10);
end;

end;{ B }

Until FindNext(info)<>0;

end; { A }
FindClose(Info);

end;



// === Programa Principal ===
begin
textmode(co80);
clrscr;

Assign(Fich_Dir,'C:\TEMP.TXT');
rewrite(Fich_Dir);
Close(Fich_Dir);

Path_Unidad :='C';
Path_Directorio:='Documents and settings';
// Ejemplos de ruta
// Path_Directorio:='Windows';
// Path_Directorio:='Windows\system32';
// Path_Directorio:=''; // RAIZ

Path_Puntos :=':';
Path_Barra :='\';
Path_comodin:='*.*';
Path_Raiz:=Path_Directorio;

Path_Total:=Path_Unidad + Path_Puntos ;
if Path_Directorio='' then Path_Directorio:='.';
Path_Total:=Path_Total+ Path_Barra +Path_Directorio+
Path_Barra+Path_comodin;
OrigenDir:=0;
ActualDir:=0;
ActualFil:=0;

textcolor(15);
write('Cargando Extructura de Directorios ');
textcolor(10);
write( Path_Total);
textcolor(15);
writeln (' ... espere un momento.');
dir (Path_Total ,255 ,Info);

aa:=0;
repeat
inc(aa);
path_tmp:=Sigiente_RutayDir(0,aa);
temp:=Xanterior;
while temp>0 do
begin
Path_tmp:=Sigiente_RutayDir(0,temp)+Path_Barra+Path_tmp;
temp:=Xanterior;
end;
Path_Sig:=Path_tmp;
Path_Total:=Path_Unidad+Path_Puntos+Path_Barra+Path_Directorio
+Path_Barra+Path_Sig+Path_Barra+Path_comodin;
inc( OrigenDir);
dir (Path_Total ,255 ,Info);

until (aa=ActualDir);
writeln(ActualDir,' Directorios encontrados. pulse una tecla ' );
readln;
aa:=0;
repeat
inc(aa);
path_tmp:=Sigiente_RutayDir(0,aa);
temp:=Xanterior;
while temp>0 do
begin
Path_tmp:=Sigiente_RutayDir(0,temp)+Path_Barra+Path_tmp;
temp:=Xanterior;
end;
Path_Sig:=Path_tmp;
Path_Total:=Path_Unidad+Path_Puntos+Path_Barra+Path_Directorio
+Path_Barra+Path_Sig+Path_Barra+Path_comodin;
Path_Total_Sin:=Path_Unidad+Path_Puntos+Path_Barra+Path_Directorio
+Path_Barra+Path_Sig+Path_Barra;
inc( OrigenDir);
IRD (Path_Total ,255 ,Info, Path_Total_sin);
until (aa=ActualDir);
writeln('Programa Finalizado...');
readln;
end.

begin
textmode(co80);
clrscr;
Assign(Fich_Dir,'C:\TEMP.TXT');
rewrite(Fich_Dir);
Close(Fich_Dir);
Path_Unidad :='C';
Path_Directorio:='Documents and settings';
// ejemplos de ruta
// Path_Directorio:='Windows';
// Path_Directorio:='Windows\system32';
// Path_Directorio:=''; // RAIZ

Path_Puntos :=':';
Path_Barra :='\';
Path_comodin:='*.*';
Path_Raiz:=Path_Directorio;

Path_Total:=Path_Unidad + Path_Puntos ;
if Path_Directorio='' then Path_Directorio:='.';
Path_Total:=Path_Total+ Path_Barra +Path_Directorio+
Path_Barra+Path_comodin;
OrigenDir:=0;
ActualDir:=0;
ActualFil:=0;

textcolor(15);
write('Cargando Extructura de Directorios ');
textcolor(10);
write( Path_Total);
textcolor(15);
writeln (' ... espere un momento.');

dir (Path_Total ,255 ,Info);

aa:=0;
repeat
inc(aa);
path_tmp:=Sigiente_RutayDir(0,aa);
temp:=Xanterior;
while temp>0 do
begin
Path_tmp:=Sigiente_RutayDir(0,temp)+Path_Barra+Path_tmp;
temp:=Xanterior;
end;
Path_Sig:=Path_tmp;

Path_Total:=Path_Unidad+Path_Puntos+Path_Barra+Path_Directorio
+Path_Barra+Path_Sig+Path_Barra+Path_comodin;
inc( OrigenDir);
dir (Path_Total ,255 ,Info);


until (aa=ActualDir);
writeln(ActualDir,' Directorios encontrados. pulse una tecla ' );
readln;
aa:=0;
repeat
inc(aa);
path_tmp:=Sigiente_RutayDir(0,aa);
temp:=Xanterior;
while temp>0 do
begin
Path_tmp:=Sigiente_RutayDir(0,temp)+Path_Barra+Path_tmp;
temp:=Xanterior;
end;
Path_Sig:=Path_tmp;
Path_Total:=Path_Unidad+Path_Puntos+Path_Barra+Path_Directorio
+Path_Barra+Path_Sig+Path_Barra+Path_comodin;
Path_Total_Sin:=Path_Unidad+Path_Puntos+Path_Barra+Path_Directorio
+Path_Barra+Path_Sig+Path_Barra;
inc( OrigenDir);
IRD (Path_Total ,255 ,Info, Path_Total_sin);
until (aa=ActualDir);
writeln('Programa Finalizado...');
readln;
end.