TAD Lista Ordenada
Ejemplo de uso - Explorador de directorios
El siguiente programa muestra un listado con el nombre, fecha y tamaño de todos los ficheros consistentes con un filtro que pertenecen a un determinado directorio y a todos los sus subdirectorios, y permite ordenar esa lista de acuerdo a distintos criterios (nombre, tamaño y fecha).
El programa pide el directorio inicial y el filtro. El filtro se proporciona con la misma sintaxis que el comando dir de MS-DOS. Para obtener la información sobre los ficheros se utilizan subprogramas y tipos de datos pertenecientes a la unidad dos de Turbo-Pascal, consulte la ayuda de Turbo-Pascal si desea conocer la forma de usarlos.
Un directorio consta de una lista de archivos, los cuales pueden ser a su vez directorios o ficheros. Por lo tanto, en el programa un directorio se representará mediante una lista de elementos que son variables dinámicas de tipo TArchivo, el cual es un registro que contiene campos para almacenar la información asociada a un fichero (nombre, fecha y tamaño) y a un directorio (nombre y lista de archivos).
Ya que una directorio puede contener subdirectorios, realmente la estructura representada se corresponde más con un arbol que con un lista. Debido a ello, los subprogramas LeeDirectorio, EscribeDirectorio, DestruyeDirectorio y CambiaOrden se utilizan de manera recursiva.
Al utilizar el programa se debe tener cuidado ya que es posible que al proporcionar un directorio o filtro demasiado genérico (por ejemplo, directorio "c:" y filtro "*.*") el número de ficheros sea tan grande que se agote la memoria disponible.
Puede descargar una copia del programa pulsando aquí.
{$F+}
program ejemplo2(input,output);
{ Se puede elegir entre cualquiera de las dos implementaciones,
lista1 o lista2, el resultado deberia ser el mismo. }
uses lista2, dos, crt;
type
TCadena = string[200];
{ Utilizaremos la palabra Archivo para referirnos a un fichero o a un
directorio (un contenedor de archivos) }
TTipoArchivo = (aFichero,aDirectorio);
{ Los ficheros se caraterizan por su nombre, fecha y tamaño, y los
directorios por su nombre y la lista de archivos que pertenecen a él }
TArchivo = record
Nombre : string[12];
case Tipo: TTipoArchivo of
aFichero : (Fecha: LongInt; Tamano: LongInt);
aDirectorio : (Lista: TListaOrd)
end;
PArchivo = ^TArchivo;
{ Al comparar un fichero con un directorio, se ha elegido que el
directorio sea siempre mayor. Al comparar dos directorios en la
ordenación por fecha o tamaño, el resultado es, en realidad, el
de la comparación por nombre. }
function OrdenNombre(Elem1,Elem2: pointer) : boolean;
begin
if PArchivo(Elem1)^.Tipo <> PArchivo(Elem2)^.Tipo then
OrdenNombre := PArchivo(Elem1)^.Tipo <= PArchivo(Elem2)^.Tipo
else
OrdenNombre := PArchivo(Elem1)^.Nombre <= PArchivo(Elem2)^.Nombre
end;
function OrdenFecha(Elem1,Elem2: pointer) : boolean;
begin
if PArchivo(Elem1)^.Tipo <> PArchivo(Elem2)^.Tipo then
OrdenFecha := PArchivo(Elem1)^.Tipo <= PArchivo(Elem2)^.Tipo
else
if PArchivo(Elem1)^.Tipo = aDirectorio then
OrdenFecha := PArchivo(Elem1)^.Nombre <= PArchivo(Elem2)^.Nombre
else
OrdenFecha := PArchivo(Elem1)^.Fecha <= PArchivo(Elem2)^.Fecha
end;
function OrdenTamano(Elem1,Elem2: pointer) : boolean;
begin
if PArchivo(Elem1)^.Tipo <> PArchivo(Elem2)^.Tipo then
OrdenTamano := PArchivo(Elem1)^.Tipo <= PArchivo(Elem2)^.Tipo
else
if PArchivo(Elem1)^.Tipo = aDirectorio then
OrdenTamano := PArchivo(Elem1)^.Nombre <= PArchivo(Elem2)^.Nombre
else
OrdenTamano := PArchivo(Elem1)^.Tamano <= PArchivo(Elem2)^.Tamano
end;
procedure EscribeArchivo(Archivo: TArchivo; Ultimo: boolean);
{ Escribe la información asociada a un archivo (nombre si es un directorio,
nombre, tamaño y fecha si es un fichero). Ultimo es cierto si el archivo
es el último del directorio (se utiliza para mejorar la presentación). }
var
DiaHora : DateTime; { tipo de datos definido en la unidad dos }
Ch : char;
begin
if Ultimo then write(output,#192) else write(output,#195);
if Archivo.Tipo = aDirectorio then
writeln(output,#196,'[',Archivo.Nombre,']')
else
begin
{ Se ha ha elegido un formato basado en columnas }
write(output,#196,' ',Archivo.Nombre,' ':14-Length(Archivo.Nombre));
write(output,Archivo.Tamano:12,' bytes ');
{ UnpackTime esta definido en la unidad dos }
UnpackTime(Archivo.Fecha,DiaHora);
writeln(output,DiaHora.Day:2,'/',DiaHora.Month:2,'/',DiaHora.Year,' ',
DiaHora.Hour:2,':',DiaHora.Min:2,':',DiaHora.Sec:2)
end
end;
procedure EscribeDirectorio(L: TListaOrd; Espaciado: TCadena; var Lin: integer);
{ Escribe la lista de archivos (almacenada en L) asociada a un directorio.
Si entre los archivos existen directorios, tambien se escriben utilizando
recursividad. Espaciado y Lin se utilizan para mejorar la presentación. }
var
Archivo : PArchivo;
Ch : char;
begin
{ Se recorre la lista }
IrAInicio(L);
Archivo := PArchivo(ElemActual(L));
while Archivo <> nil do
begin
Lin := Lin+1;
IrASiguiente(L);
{ Se escribe el archivo }
write(output,Espaciado);
EscribeArchivo(Archivo^,ElemActual(L) = nil);
{ Se hace una pausa cada 20 lineas }
if Lin mod 20 = 19 then Ch := ReadKey;
{ Si es un directorio, se escribe su contenido a continuación }
if Archivo^.Tipo = aDirectorio then
if ElemActual(L) = nil then
EscribeDirectorio(Archivo^.Lista,Espaciado+' ',Lin)
else
EscribeDirectorio(Archivo^.Lista,Espaciado+#179+' ',Lin);
Archivo := PArchivo(ElemActual(L))
end
end;
procedure LeeDirectorio(var L: TListaOrd; Dir,Filtro: TCadena; Orden: TFuncComp);
{ Este procedimiento inicializa la lista L y almacena en ella todos los
ficheros que pertenecen al directorio cuya ruta esta dada por Dir y
concuerdan con el filtro Filtro, junto con todos los subdirectorios
de Dir que contengan al menos un fichero que concuerde con el filtro.
El orden de la lista viene dado por la funcion Orden. }
var
Fich : SearchRec; { El tipo SearchRec se define en la unidad dos }
Archivo : PArchivo;
begin
Inicializar(L,Orden);
{ Lectura de ficheros - Los subprogramas FindFirst y FindNext, y su modo
de uso se definen en la unidad dos }
FindFirst(Dir+'\'+Filtro,Archive,Fich);
while DosError = 0 do
begin
new(Archivo);
Archivo^.Nombre := Fich.Name;
Archivo^.Tipo := aFichero;
Archivo^.Fecha := Fich.Time;
Archivo^.Tamano := Fich.Size;
Insertar(L,Archivo);
FindNext(Fich)
end;
{ Lectura de subdirectorios }
FindFirst(Dir+'\*.*',Directory,Fich);
while DosError = 0 do
begin
{ Los subdirectorios "." y ".." representan al directorio actual y al
directorio padre, respectivamente. No son directorios reales, si se
procesaran darian lugar a una recursión infinita }
if (Fich.Attr = Directory) and (Fich.Name <> '.') and (Fich.Name <> '..') then
begin
new(Archivo);
Archivo^.Nombre := Fich.Name;
Archivo^.Tipo := aDirectorio;
{ Parecería lógico llamar ahora recursivamente a LeeDirectorio
para rellenar Archivo^.Lista con los ficheros del subdirectorio,
pero debido a que FindFirst y FindNext estan definidos de forma que
sólo se puede leer un directorio a la vez, esas llamadas se
posponen hasta haber terminado de leer el directorio actual }
Insertar(L,Archivo)
end;
FindNext(Fich)
end;
{ Lectura recursiva de subdirectorios }
IrAInicio(L);
Archivo := PArchivo(ElemActual(L));
while Archivo <> nil do
begin
if Archivo^.Tipo = aDirectorio then
begin
{ Llamada recursiva }
LeeDirectorio(Archivo^.Lista,Dir+'\'+Archivo^.Nombre,Filtro,Orden);
{ Si el directorio esta vacio, lo borramos }
IrAInicio(Archivo^.Lista);
if ElemActual(Archivo^.Lista) = nil then
Borrar(L) { Nota: Al borrar se pasa al elemento siguiente }
else
IrASiguiente(L)
end
else
IrASiguiente(L);
Archivo := PArchivo(ElemActual(L))
end
end;
procedure DestruyeDirectorio(var L: TListaOrd);
{ Destruye las variables dinámicas creadas para almacenar los datos de
la lista. Ya que dentro de esos datos puede haber otras listas (si
representan a subdirectorios), se realizarán llamadas recursivas para
destruirlas también }
var Archivo : PArchivo;
begin
IrAInicio(L);
Archivo := PArchivo(ElemActual(L));
while Archivo <> nil do
begin
if Archivo^.Tipo = aDirectorio then DestruyeDirectorio(Archivo^.Lista);
dispose(Archivo);
IrASiguiente(L);
Archivo := PArchivo(ElemActual(L))
end;
{ Por último, se borra la memoria interna usada por la lista }
Destruir(L);
end;
procedure CambiaOrden(var L: TListaOrd; Orden: TFuncComp);
{ Se cambia el orden de la lista. Debido a que pueden existir datos que
contengan otras listas (en el caso de subdirectorios), se llama
recursivamente a CambiaOrden sobre ellas }
var Archivo : PArchivo;
begin
Reordenar(L,Orden);
IrAInicio(L);
Archivo := PArchivo(ElemActual(L));
while Archivo <> nil do
begin
if Archivo^.Tipo = aDirectorio then CambiaOrden(Archivo^.Lista,Orden);
IrASiguiente(L);
Archivo := PArchivo(ElemActual(L))
end
end;
var
Dir,Filtro : TCadena;
Lista : TListaOrd;
Opcion : char;
Lin : integer;
begin
ClrScr; { Borrado de pantalla }
{ Se pide el directorio inicial y el filtro que se aplica }
write(output,'Directorio inicial: ');
readln(input,Dir);
write(output,'Filtro: ');
readln(input,Filtro);
{ Se crea la lista de archivos: Ficheros que cumplan el filtro y
subdirectorios que contengan algún fichero que cumpla el filtro.
Esta lista no va a cambiar (excepto por la ordenación) en el
resto de la ejecución del programa. }
LeeDirectorio(Lista,Dir,Filtro,OrdenNombre);
repeat
writeln(output,'[',Dir,']');
Lin := 0;
EscribeDirectorio(Lista,'',Lin);
writeln(output,'[S]: Salir. Reordenar por [N]: Nombre [F]: Fecha [T]: Tamaño');
write(output,'Escoja opcion: ');
Opcion := ReadKey; { ReadKey está definida en la unidad crt }
case Opcion of
'n','N': CambiaOrden(Lista,OrdenNombre);
'f','F': CambiaOrden(Lista,OrdenFecha);
't','T': CambiaOrden(Lista,OrdenTamano)
end
until Opcion in ['s','S'];
{ Se destruye la lista y las posibles sublistas }
DestruyeDirectorio(Lista)
end.