PROGRAM ESPACIO; {A+,S+,B-,E+,N+} {$M 16384, 000000, 50000} USES CRT,DOS; CONST ORDENPORNOMBRE = TRUE; ORDENPORFECHA = FALSE; TYPE CADENA80 = STRING[80]; CADENA15 = STRING[15]; PTRDTA = ^SEARCHREC; REGHORA = RECORD COMPHORA : WORD; { formato comprimido Dos } CADHORA : CADENA80; PM : BOOLEAN; HORAS,MINUTOS,SEGUNDOS,CENTESIMAS : INTEGER END; REGFECHA = RECORD FECHACOMP : WORD; CADENALARGAFECHA : CADENA80; CADENAFECHA : CADENA80; AGNO,MES,DIA : INTEGER; DIASEMANA : INTEGER END; PTRDIR = ^REGDIR; REGDIR = RECORD NOMBREFICHERO : CADENA15; ATRIB : BYTE; TAMFICHERO : LONGINT; HORA : REGHORA; FECHA : REGFECHA; ANTERIOR : PTRDIR; SIGUIENTE : PTRDIR; END; VAR PARAMS : BYTE; ESPACTOMADO : REAL; VAARRIBA : PTRDIR; VAABAJO : PTRDIR; ACTUAL : PTRDIR; ESPECFICHERO : CADENA80; CADTRABAJO : CADENA80; ORDENADO : BOOLEAN; ESPECORDEN : BOOLEAN; ASCEN : BOOLEAN; I : INTEGER; COLOR1 : BYTE; COLOR2 : BYTE; COLOR3 : BYTE; (**********************************************************) FUNCTION MODOVIDEOACTUAL : CHAR; VAR REGS : REGISTERS; BEGIN FILLCHAR(REGS,SIZEOF(REGS),0); REGS.AH:=$0F; INTR($10,REGS); CASE REGS.AL OF 1..6 : MODOVIDEOACTUAL := 'C'; {CGA} 7 : MODOVIDEOACTUAL := 'M'; {monocromo} 8..10 : MODOVIDEOACTUAL := 'P'; {PCjr} 13..16 : MODOVIDEOACTUAL := 'E' {EGA} END END; (**********************************************************) FUNCTION CALCDIASEMANA(AGNO,MES,DIA : INTEGER) : INTEGER; VAR SALVARFECHA,FECHATRABAJO : REGISTERS; NUMERODIA : INTEGER; BISIESTO : BOOLEAN; CONST DAYARRAY : ARRAY[1..12] OF INTEGER = (31,28,31,30,31,30,31,31,30,31,30,31); BEGIN BISIESTO := FALSE; IF (MES = 2) AND ((AGNO MOD 4)=0) AND (DIA = 29) THEN BISIESTO := TRUE; IF (NOT BISIESTO) AND (DIA > DAYARRAY[MES]) THEN CALCDIASEMANA := -1 ELSE BEGIN FECHATRABAJO.AH := $2B; SALVARFECHA.AH := $2A; { salva la fecha en registros } MSDOS(SALVARFECHA); WITH FECHATRABAJO DO BEGIN CX := AGNO; { hace el reloj igual a la fecha introducida } DH := MES; DL := DIA; MSDOS(FECHATRABAJO); AH := $2A; { leer de nuevo la fecha para } MSDOS(FECHATRABAJO); { obtene el indicador de la sem. } NUMERODIA := AL; { en AL. } IF BISIESTO THEN { corregir para a¤os bisiestos } IF NUMERODIA = 0 THEN NUMERODIA := 6 ELSE NUMERODIA := PRED(NUMERODIA); CALCDIASEMANA := NUMERODIA END; SALVARFECHA.AH := $2B; { reponer la fecha actual } MSDOS(SALVARFECHA); END END; (**********************************************************) PROCEDURE CALCFECHA(VAR FECHAACTUAL : REGFECHA); TYPE CADENA9 = STRING[9]; CONST MESES : ARRAY [1..12] OF CADENA9 = ('ENERO','FEBRERO','MARZO','ABRIL','MAYO','JUNIO','JULIO', 'AGOSTO','SEPTIEMBRE','OCTUBRE','NOVIEMBRE','DICIEMBRE'); DIAS : ARRAY [0..6] OF CADENA9 = ('DOMINGO','LUNES','MARTES','MI‚RCOLES', 'JUEVES','VIERNES','S BADO'); VAR TEMP1 : CADENA80; BEGIN WITH FECHAACTUAL DO BEGIN DIASEMANA := CALCDIASEMANA(AGNO,MES,DIA); STR(MES,CADENAFECHA); STR(DIA,TEMP1); CADENAFECHA := CADENAFECHA + '/' + TEMP1; CADENALARGAFECHA := DIAS[DIASEMANA] + ', '; CADENALARGAFECHA := CADENALARGAFECHA + MESES[MES] + ' ' + TEMP1 + ', '; STR(AGNO,TEMP1); CADENALARGAFECHA := CADENALARGAFECHA + TEMP1; CADENAFECHA := CADENAFECHA + '/' + COPY(TEMP1,3,2); FECHACOMP := (AGNO - 1980) * 512 + (MES * 32) + DIA END END; (**********************************************************) PROCEDURE CALCHORA(VAR HORAACTUAL : REGHORA); TYPE CADENA5 = STRING[5]; VAR TEMP1,TEMP2 : CADENA5; AMPM : CHAR; I : INTEGER; BEGIN WITH HORAACTUAL DO BEGIN I := HORAS; IF HORAS = 0 THEN I := 12; { "0" horas = 12AM } IF HORAS > 12 THEN I := HORAS - 12; IF HORAS > 11 THEN AMPM := 'P' ELSE AMPM := 'A'; STR(I:2,TEMP1); STR(MINUTOS,TEMP2); IF LENGTH(TEMP2) < 2 THEN TEMP2 := '0' + TEMP2; CADHORA := TEMP1 + ':' + TEMP2 + AMPM; COMPHORA := (HORAS SHL 11) OR (MINUTOS SHL 5) OR (SEGUNDOS SHR 1) END END; (**********************************************************) PROCEDURE DTAADIR(VAR REGSALIDA : REGDIR); VAR DATODT : DATETIME; { importado de la unidad dos } I : INTEGER; REGINT : SEARCHREC; { idem } REGCOMP : REGISTERS; { idem } DTAACTUAL : PTRDTA; BEGIN REGCOMP.AX := $2F00; { localizar posici¢n actual del DTA } MSDOS(REGCOMP); WITH REGCOMP DO DTAACTUAL := PTR(ES,BX); REGINT := DTAACTUAL^; UNPACKTIME(REGINT.TIME,DATODT); WITH REGSALIDA DO { extraer y reformatear los datos } BEGIN NOMBREFICHERO:= REGINT.NAME; { extraer nombre de fichero } ATRIB := REGINT.ATTR; { extraer el campo de atributoS } WITH HORA DO { desarrollar la hora comprimida } BEGIN COMPHORA := REGINT.TIME SHR 16; HORAS := DATODT.HOUR; MINUTOS := DATODT.MIN; SEGUNDOS := DATODT.SEC; CENTESIMAS := 0; END; CALCHORA(HORA); { llenar los otros campos } WITH FECHA DO { desarrollar la fecha comprimida } BEGIN FECHACOMP := REGINT.TIME AND $0000FFFF; DIA := DATODT.DAY; MES := DATODT.MONTH; AGNO := DATODT.YEAR; END; CALCFECHA(FECHA); { llenar los otros campos } TAMFICHERO := REGINT.SIZE; SIGUIENTE := NIL; { inicializar el puntero "SIGUIENTE" } ANTERIOR := NIL; { inicializar el puntero "ANTERIOR" } END END; { DTAADIR } (**********************************************************) PROCEDURE TOMARDIR(ESPECFICHERO : CADENA80; ORDENADO : BOOLEAN; ORDENPORNOMBRE : BOOLEAN; VAR ASCEN : PTRDIR; VAR DESCEN : PTRDIR); TYPE CADENA9 = STRING[9]; VAR I : INTEGER; ERROR : INTEGER; REGS : REGISTERS; NUESTRODTA : SEARCHREC; RAIZ : PTRDIR; ACTUAL : PTRDIR; ULTIMO : PTRDIR; ALMAC : PTRDIR; POSICIONENC : BOOLEAN; (**********************************************************) FUNCTION DESPUESDE(ENTRADIZ,ENTRADDER : PTRDIR) : BOOLEAN; BEGIN IF ENTRADIZ^.FECHA.FECHACOMP > ENTRADDER^.FECHA.FECHACOMP THEN DESPUESDE := TRUE ELSE IF (ENTRADIZ^.FECHA.FECHACOMP = ENTRADDER^.FECHA.FECHACOMP) AND (ENTRADIZ^.HORA.COMPHORA > ENTRADDER^.HORA.COMPHORA) THEN DESPUESDE := TRUE ELSE DESPUESDE := FALSE END; (**********************************************************) PROCEDURE ANADIRPORFINAL(VAR ALMAC,DESCEN : PTRDIR); BEGIN DESCEN^.SIGUIENTE := ALMAC; { a¤adir registro al final de la lista } DESCEN^.SIGUIENTE^.ANTERIOR := DESCEN; { inic. puntero inverso } DESCEN := DESCEN^.SIGUIENTE; { hacer REG. SIGUIENTE el ACTUAL } END; (*********************) BEGIN { TOMARDIR } FINDFIRST(ESPECFICHERO,$16,NUESTRODTA); { llamada a dos, FIND FIRST dos } ERROR := DOSERROR; IF ERROR = 2 THEN { no hay ficheros que coincidan con el espec. } BEGIN ASCEN := NIL; { los dos punteros de la lista a NIL } DESCEN := NIL END ELSE { al menos se encontr¢ un fichero } BEGIN NEW(RAIZ); { crear un registro para el primero encontrado } DTAADIR(RAIZ^); { convertirlo a formato DIR } ACTUAL := RAIZ; { el registro ACTUAL es ahora el RAIZ } DESCEN := RAIZ; { y tambi‚n el £ltimo registro de la lista } IF ERROR <> 18 THEN REPEAT FINDNEXT(NUESTRODTA); { hacer llamada a dos: FIND NEXT } ERROR := DOSERROR; IF ERROR <> 18 THEN { existen m s entradas } BEGIN NEW(ALMAC); { crear registro con un puntero temporal } DTAADIR(ALMAC^); { convertir a formato DIR } { las listas ordenada y no ordenadas se forman de forma diferente} { si estamos formando una lista ordenada deberemos buscar en ella} { cada entrada con el fin de localizar el lugar donde ubicarla. Para} { las listas no ordenadas solamente tenemos que a¤adir el nuevo ele-} { mento al final de la lista y hacer que el siguiente sea el actual} IF ORDENADO THEN BEGIN ACTUAL := RAIZ; { recorrer lista para encontrar punto de inter‚s} REPEAT IF ORDENPORNOMBRE THEN IF ACTUAL^.NOMBREFICHERO > ALMAC^.NOMBREFICHERO THEN POSICIONENC := TRUE ELSE POSICIONENC := FALSE ELSE { para ordenar lista por hora/fecha } IF DESPUESDE(ACTUAL,ALMAC) THEN POSICIONENC := TRUE ELSE POSICIONENC := FALSE; IF NOT POSICIONENC THEN ACTUAL := ACTUAL^.SIGUIENTE; { pasar al siguiente } UNTIL (ACTUAL = NIL) OR POSICIONENC; { cuando se encuentra la posici¢n, es necesario insertar } { el registro en la lista antes de ACTUAL^-- } { esto se hace de forma diferente si ACTUALT^ est } { al final de la lista. (ACTUAL = RAIZ)} IF POSICIONENC THEN { insertar al principio... } BEGIN { ...o en medio } { NOTA: no cambiar el orden de asignaci¢n } { de punteros en la siguiente sentencia } { IF/THEN/ELSE } IF ACTUAL = RAIZ THEN { insertar al principio } BEGIN ALMAC^.SIGUIENTE := RAIZ; ACTUAL^.ANTERIOR := ALMAC; RAIZ := ALMAC; END ELSE { insertar en medio: } BEGIN ALMAC^.SIGUIENTE := ACTUAL; ALMAC^.ANTERIOR := ACTUAL^.ANTERIOR; ACTUAL^.ANTERIOR^.SIGUIENTE := ALMAC; ACTUAL^.ANTERIOR := ALMAC END END ELSE { el nuevo registro pertenece al final de la lista } ANADIRPORFINAL(ALMAC,DESCEN) END ELSE { si no hay que ordenar a¤adimos al final de la lista: } ANADIRPORFINAL(ALMAC,DESCEN) END UNTIL ERROR = 18; ASCEN := RAIZ END END; {TOMARDIR} (**********************************************************) FUNCTION DIRACADENA(DIRENT : REGDIR) : STRING; CONST BLANCOS = ' '; VAR TEMP,CADTRABAJO : CADENA80; POSPUNTO : INTEGER; BEGIN WITH DIRENT DO BEGIN TEMP := ' '; {si la entrada tiene atributo de directorio, formato diferente: } IF (ATRIB AND $10) <> 0 THEN { el BIT 4 es el ATRIB. de direct. } BEGIN INSERT(NOMBREFICHERO,TEMP,1); { no hay extens. en nombres de subdir. } INSERT('