PROGRAM LOCALIZA;

{A+,S+,B-,E+,N+} {$M 16384, 000000, 50000}

USES CRT,DOS;

TYPE
  CADENA80 = STRING[80];
  CADENA15 = STRING[15];

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;

  PTRDTA  = ^SEARCHREC;


VAR
  I,J            : INTEGER;
  ESPECBUSQUEDA  : CADENA80;
  DIRECTORIOINIC : CADENA80;
  BUFFERBUSQ     : SEARCHREC;
  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); { obtener el indicador de d¡a de la sem. }
            NUMERODIA := AL;     { en AL. }
            IF BISIESTO THEN     { Corregir para a¤os bisiesto }
              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;

(**********************************************************)

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('<DIR>',TEMP,14)   { Decirle al mundo qu‚ es un subdir. }
        END
      ELSE
        { Esta sentencia compuesta separa el nombre del fichero y su }
        { extensi¢n, y convierte el tama¤o en una cadena. No se }
        { inserta una cifra de tama¤o en Temp para los subdirectorios. }
        BEGIN
          POSPUNTO := POS('.',NOMBREFICHERO);
          IF POSPUNTO > 0 THEN  { El nombre del fichero tiene extensi¢n }
            CADTRABAJO := COPY(NOMBREFICHERO,1,POSPUNTO-1) +
              COPY(BLANCOS,1,9-POSPUNTO) + '.' +
              COPY(NOMBREFICHERO,POSPUNTO+1,LENGTH(NOMBREFICHERO)-POSPUNTO)
          ELSE
            CADTRABAJO := NOMBREFICHERO + COPY(BLANCOS,1,8-LENGTH(NOMBREFICHERO)) + '.';
          INSERT(CADTRABAJO,TEMP,1);
          STR(TAMFICHERO:7,CADTRABAJO);
          INSERT(CADTRABAJO,TEMP,15)
        END;
      WITH FECHA DO
        BEGIN
          { Esta sentencia une las tres cifras independientes para }
          { el mes, el dia, y el a¤o, en una cadena.}
          IF MES < 10 THEN INSERT('0',CADENAFECHA,1);
          IF DIA < 10 THEN INSERT('0',CADENAFECHA,4);
          INSERT(CADENAFECHA,TEMP,24);
        END;
      INSERT(HORA.CADHORA,TEMP,34); { Finalmente, insertar la hora }
    END;
  DELETE(TEMP,42,LENGTH(TEMP)-42);
  DIRACADENA := TEMP
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 BUSCARDIRECTORIO(DIRECTORIO,ESPECBUSQUEDA : STRING);

VAR
  SIGUIENTEDIRECTORIO : STRING;
  DIRECTORIOTEMP      : STRING;
  DTAACTUAL           : SEARCHREC;
  DIRACTUAL           : REGDIR;
  REGS                : REGISTERS;


{>>>>PresenDatos<<<<}
{ Presenta los datos del fichero y la v¡a de acceso completa }

                (*********************)

PROCEDURE PRESENDATOS(DIRECTORIO : STRING; DIRACTUAL : REGDIR);

VAR
  TEMP : STRING;

BEGIN
  TEMP := DIRACADENA(DIRACTUAL);
  DELETE(TEMP,1,13);
  WRITE(TEMP,DIRECTORIO);
  IF DIRECTORIO <> '\' THEN WRITE('\');
  WRITELN(DIRACTUAL.NOMBREFICHERO)
END;



BEGIN
  { En primer lugar buscamos subdirectorios. Si se encuentra alguno, }
  { hacemos una llamada recursiva para buscar en ‚l tambi‚n. }

  { Suprimir barras innecesarias si buscamos la ra¡z: }
  IF DIRECTORIO = '\' THEN
    DIRECTORIOTEMP := DIRECTORIO + '*.*'
  ELSE
    DIRECTORIOTEMP := DIRECTORIO + '\*.*';

  { Hacer la llamada a FIND FIRST para los directorios: }

  FINDFIRST(DIRECTORIOTEMP,$10,DTAACTUAL);


  { Aqu¡ hay un peque¤o truco. Si tenemos alguna indicaci¢n de que   }
  { hay al menos un subdirectorio m s adentro del directorio actual, }
  { (no aparecen los c¢digos de error 2 ¢ 18) debemos buscar en ‚l   }
  { haciendo una llamada recursiva a BuscarDirectorio. Continuamos   }
  { con esta estrategia hasta que ya no queden m s subdirectorios    }
  { por explorar. }
  WHILE (DOSERROR <> 2) AND (DOSERROR <> 18) DO
    BEGIN
      IF  ((DTAACTUAL.ATTR AND $10) = $10)   { Si es un directorio }
      AND (DTAACTUAL.NAME[1] <> '.') THEN    { y no '.' o '..' }
        BEGIN
          { A¤adimos una barra para separar las secciones de la v¡a }
          { de acceso si no estamos buscando en el directorio ra¡z: }
          IF DIRECTORIO <> '\' THEN SIGUIENTEDIRECTORIO := DIRECTORIO + '\'
            ELSE SIGUIENTEDIRECTORIO := DIRECTORIO;

          { Se comienza con el nombre del directorio actual, y se   }
          { copia el nombre del directorio encotrado desde el DTA   }
          { al final de la cadena del directorio actual. Luego se   }
          { pasa la nueva v¡a de acceso a la siguiente llamada   }
          { recursiva a BuscarDirectorio. }
          SIGUIENTEDIRECTORIO := SIGUIENTEDIRECTORIO + DTAACTUAL.NAME;

          { El procedimiento se llama a s¡ mismo. }
          BUSCARDIRECTORIO(SIGUIENTEDIRECTORIO,ESPECBUSQUEDA)

        END;
       FINDNEXT(DTAACTUAL)  { Buscamos m s... }
    END;

  { Ahora podemos buscar ficheros, una vez que hemos acabado con     }
  { los directorios. Esto es conceptualmente simple, ya que no       }
  { involucra recursividad. Combinamos la v¡a acceso y el especi- }
  { ficador en una sola cadena y hacemos la llamada a FIND FIRST: }

  { Suprimir barras innecesarias para buscar en el directorio ra¡z: }
  IF DIRECTORIO <> '\' THEN
    DIRECTORIOTEMP := DIRECTORIO + '\' + ESPECBUSQUEDA
  ELSE DIRECTORIOTEMP := DIRECTORIO + ESPECBUSQUEDA;

  { Hacer la llamada a FIND FIRST: }
  FINDFIRST(DIRECTORIOTEMP,$07,DTAACTUAL);

  IF DOSERROR = 3 THEN       { v¡a de acceso err¢nea }
    WRITELN('v¡a de acceso no encontrada; compruebe los datos.')

  { Si encontramos en el directorio actual algo que coincida con el espe- }
  { cificador, se a¤ade con el formato adecuado a una cadena y se presenta }
  ELSE IF (DOSERROR = 2) OR (DOSERROR = 18) THEN
    { Cadena nula: directorio vacio }
  ELSE
    BEGIN
      DTAADIR(DIRACTUAL);      { Convertir a formato DIR.. }
      PRESENDATOS(DIRECTORIO,DIRACTUAL);     { Presentar informaci¢n }

      IF DOSERROR <> 18 THEN { Existen m s ficheros... }
        REPEAT
          FINDNEXT(DTAACTUAL);
          IF DOSERROR <> 18 THEN  { Existen m s entradas }
            BEGIN
              DTAADIR(DIRACTUAL); { Convertir a formato DIR }
              PRESENDATOS(DIRECTORIO,DIRACTUAL)  { Presentar informaci¢n }
            END
        UNTIL (DOSERROR = 18) OR (DOSERROR = 2)  { No hay m s ficheros }
    END
END;

(**********************************************************)

BEGIN
  WINDOW(3,5,78,24);
  CLRSCR;
  {vemos el modo de v¡deo para tener en cuenta los colores}
  IF MODOVIDEOACTUAL='M' THEN BEGIN
                              COLOR1:=WHITE;
                              COLOR2:=WHITE;
                              COLOR3:=WHITE
                              END
  ELSE BEGIN
           COLOR1:=YELLOW;
           COLOR2:=LIGHTRED;
           COLOR3:=LIGHTGREEN
       END;

  TEXTBACKGROUND(LIGHTBLUE);
  TEXTCOLOR(COLOR1);
  IF PARAMCOUNT = 0 THEN
    BEGIN
      TEXTCOLOR(COLOR3);
      WRITELN(' EVALUACION V:1.00 "EMILIO SAHUQUILLO & JULIO MARTINEZ"');
      TEXTCOLOR(COLOR1);
      WRITELN;
      WRITELN(' Esta opci¢n busca en el disco de trabajo todos los  ');
      WRITELN(' ficheros que concuerdan con un determinado especificador,');
      WRITELN(' examinando todos los subidirectorios necesarios.');
      WRITELN(' Dado s¢lo el especificador, se presentar  la v¡a ');
      WRITELN(' de acceso completa de cualquier fichero que se considere');
      WRITELN(' adecuado.');
      TEXTCOLOR(COLOR2);
      WRITELN(' SINTAXIS DE LLAMADA:');
      WRITELN(' <especificador de fichero>');
      TEXTCOLOR(COLOR1);
      WRITELN;
      TEXTCOLOR(COLOR2);
      WRITELN(' Por ejemplo : ');
      TEXTCOLOR(COLOR1);
      WRITELN(' para encontrar todos los ficheros de texto ');
      WRITELN(' (que terminan en .TXT) deberemos introducir:');
      WRITELN;
      WRITELN(' *.TXT');
      WRITELN;
      WRITELN(' y se mostrar  la v¡a de acceso completa de  ');
      WRITELN(' cualquier fichero con la extensi¢n .TXT.')
    END
  ELSE
    BEGIN
      WRITELN;
      ESPECBUSQUEDA := PARAMSTR(1);
      { Si no se da especificador se buscar  en todo el disco: }
      IF POS('\',ESPECBUSQUEDA) = 0 THEN
        BUSCARDIRECTORIO('\',ESPECBUSQUEDA)
      ELSE
        BEGIN
          { Se separa el especificador de la v¡a de acceso: }
          I := LENGTH(ESPECBUSQUEDA);
          WHILE ESPECBUSQUEDA[I] <> '\' DO I := PRED(I);
          DIRECTORIOINIC := COPY(ESPECBUSQUEDA,1,I-1);
          DELETE(ESPECBUSQUEDA,1,I);
          BUSCARDIRECTORIO(DIRECTORIOINIC,ESPECBUSQUEDA)
        END
    END;
TEXTBACKGROUND(BLACK);
TEXTCOLOR(WHITE);
LOWVIDEO
END.