home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP4DIR.ZIP / TP4DIR.PAS
Encoding:
Pascal/Delphi Source File  |  1988-01-11  |  1.9 KB  |  84 lines
  1. PROGRAM TP4Dir;
  2.   USES
  3.     DOS;
  4.   VAR
  5.     Path : STRING;
  6.     SRec : SearchRec;
  7.   PROCEDURE PutLead(I:INTEGER);
  8.     BEGIN
  9.       IF (I>=10) THEN
  10.         WRITE(I:2)
  11.       ELSE
  12.         WRITE('0',I:1)
  13.   END;{of PutLead}
  14.   PROCEDURE PutDateTime(Dt:DateTime);
  15.     VAR
  16.       H : INTEGER;
  17.       Ch : CHAR;
  18.     BEGIN
  19.       WITH Dt DO
  20.         BEGIN
  21.           WRITE(Month:2,'-');
  22.           PutLead(Day);
  23.           WRITE('   ');
  24.           IF (Hour>=12) THEN
  25.             Ch:='p'
  26.           ELSE
  27.             Ch:='a';
  28.           H := Hour MOD 12;
  29.           IF (H=0) THEN
  30.             H := 12;
  31.           WRITE(H:2,':');
  32.           PutLead(Min);
  33.           WRITE(Ch);
  34.       END;{of WITH}
  35.   END;{of PutDateTime}
  36.   PROCEDURE PutName(Name:STRING);
  37.     VAR
  38.       DotPos : INTEGER;
  39.       Ext : STRING[3];
  40.     BEGIN
  41.       DotPos := Pos('.',Name);
  42.       IF (DotPos<>0) THEN
  43.         BEGIN
  44.           Ext := Copy(Name,DotPos+1,Length(Name)-DotPos);
  45.           Delete(Name,DotPos,1+Length(Name)-DotPos)
  46.         END{of IF}
  47.       ELSE
  48.         Ext:='';
  49.       WRITE(Name,' ':(10-Length(Name)),Ext,' ':(5-Length(Ext)))
  50.   END;{of PutName}
  51.   PROCEDURE PutSRec(SRec:SearchRec);
  52.     VAR
  53.       Dt : DateTime;
  54.     BEGIN
  55.       WITH SRec DO
  56.         BEGIN
  57.           PutName(Name);
  58.           IF ((Attr AND Directory)<>0) THEN
  59.             WRITE('  <DIR>')
  60.           ELSE
  61.             BEGIN
  62.               WRITE(Size:10,'   ');
  63.               UnpackTime(Time,Dt);
  64.               PutDateTime(Dt);
  65.           END;{of IF}
  66.           WRITELN;
  67.       END{of WITH}
  68.   END;{of PutSRec}
  69.   BEGIN
  70.     REPEAT
  71.       WRITE('Enter Path:');
  72.       READLN(Path);
  73.       IF (Path<>'') THEN
  74.         BEGIN
  75.           FindFirst(Path,AnyFile,SRec);
  76.           WHILE (DosError=0) DO
  77.             BEGIN
  78.               PutSRec(SRec);
  79.               FindNext(SRec)
  80.           END;{of WHILE}
  81.           WRITELN
  82.       END;{of IF}
  83.     UNTIL Path=''
  84.   END.