home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ADC_TP3.ZIP / FILELIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-01  |  9.5 KB  |  298 lines
  1. {$G512,P1,D-}
  2. Program FILELIST;
  3.  
  4. (****************************************************************************)
  5. (*  This program is a DOS FILTER.  It will list a text file to the standard *)
  6. (*  output device with a heading on each page.  Each file selected by the   *)
  7. (*  DOS DIR command will be printed.  [See FILELIST.DOC]                    *)
  8. (*                                                                          *)
  9. (*  Sample invocation:  A>DIR C:\LANG\PASCAL\*.PAS | FILELIST > PRN <cr>    *)
  10. (*                                                                          *)
  11. (*  DIR may specify any disk and any path.  Source disk of files must       *)
  12. (*  remain present for listing by filter program.                           *)
  13. (*                                                                          *)
  14. (*  Any file may be aborted with an 'Esc' and the next file will then       *)
  15. (*  begin.  The entire procedure may be aborted with a ^E.                  *)
  16. (*                                                                          *)
  17. (*                                                                          *)
  18. (*  Written by: Russell J. Wintner [74736,2255] 22-Jul-85                   *)
  19. (*                                                                          *)
  20. (****************************************************************************)
  21.  
  22. Type
  23.   S12       = String[12];
  24.   S80       = String[80];
  25.   S243      = String[243];
  26.   RegisterSet=Record Case Integer Of
  27.                 1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  28.                 2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  29.               End;
  30.   Time=Record
  31.          Hours,Min,Sec,Hundreths: Byte;
  32.        End;
  33.   DOW=(Sun,Mon,Tue,Wed,Thu,Fri,Sat);
  34.   Date=Record
  35.          Month,Day: Byte;
  36.          Year: Integer;
  37.          DayOfWeek: DOW;
  38.        End;
  39.   String2=String[2];
  40.  
  41. Var
  42.   L1, L2          : String[255];
  43.   RevTime         : String[7];
  44.   RevDate         : String[18];
  45.   Filvar1         : Text;
  46.   Filname         : S12;
  47.   FilnameP        : S12;
  48.   Path            : S243;
  49.   S               : String[1];
  50.   C               : Char;
  51.   X,X1,X2         : Integer;
  52.   Regs            : RegisterSet;
  53.   T1              : Time;
  54.   D1              : Date;
  55.   AP              : String2;
  56.  
  57. Const
  58.   DayName: Array [DOW] Of String[9]=
  59.     ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  60.   MonName: Array [1..12] Of String[9]=
  61.     ('January','February','March','April','May','June','July',
  62.      'August','September','October','November','December');
  63.  
  64. (****************************************************************************)
  65. (* Function removes spaces in file name taken from DIR listing.             *)
  66. (****************************************************************************)
  67.  
  68. Function ParseOutSpc(StrVar : S12) : S12;
  69.   Var
  70.     Str2 : S12;
  71.   begin
  72.     Str2 := '';
  73.     for X := 1 to Length(StrVar) do
  74.       if copy(StrVar,X,1)<>' ' then
  75.         Str2 := Str2 + copy(StrVar,X,1);
  76.     ParseOutSpc := Str2;
  77.   end;
  78.  
  79. (****************************************************************************)
  80. (* Date and Time functions to get system date and time.                     *)
  81. (****************************************************************************)
  82.  
  83. Procedure GetTime(Var T:Time);
  84.   Begin
  85.     With Regs,T Do
  86.      Begin
  87.        AH:=$2C;
  88.        MsDos(Regs);
  89.        Hours:=CH;
  90.        Min:=CL;
  91.        Sec:=DH;
  92.        Hundreths:=DL;
  93.       End;
  94.     End;
  95.  
  96. Procedure GetDate(Var D:Date);
  97.   Begin
  98.     With Regs,D Do
  99.      Begin
  100.        AH:=$2A;
  101.        MsDos(Regs);
  102.        Month:=DH;
  103.        Day:=DL;
  104.        Year:=CX;
  105.        DayOfWeek:=DOW(AL);
  106.       End;
  107.     End;
  108.  
  109. Function V2(I:Integer):String2;
  110.   Begin
  111.     V2:=Chr(48+I Div 10)+Chr(48+I Mod 10);
  112.   End;
  113.  
  114.  
  115. (****************************************************************************)
  116. (*  This procedure updates the screen with the current date and time and    *)
  117. (*  posts the name of the file that is being listed with its path.          *)
  118. (****************************************************************************)
  119.  
  120. Procedure UpDateScr;
  121.   Var
  122.     X     : Integer;
  123.   begin
  124.     GetTime(T1);       {Get system date and time}
  125.     GetDate(D1);
  126.     AP:='am';
  127.     With T1 Do
  128.       begin
  129.         If Hours>11 Then AP:='pm';   {Convert time to standard from military}
  130.         Hours:=Hours Mod 12;
  131.         If Hours=0 Then Hours:=12;
  132.       end;
  133.     ClrScr;
  134.     GotoXY(1,1);
  135.     With D1 Do Write(Con,'  ',DayName[DayOfWeek],', ',MonName[Month],' ',
  136.       V2(Day),', ',Year);
  137.     GotoXY(72,1);
  138.     With T1 Do Write(Con,V2(Hours),':',V2(Min),AP);
  139.     If Length(Path)>79 then X:=1 else X:=(79-(Length(Path)+6)) div 2;
  140.     GotoXY(X,9);
  141.     Writeln(Con,'Path: ',Path);
  142.     X:=(79-(Length(FilnameP)+6)) div 2;
  143.     GotoXY(X,14);
  144.     Writeln(Con,'File: ',FilnameP);
  145.   end;
  146.  
  147.  
  148. (****************************************************************************)
  149. (*  This procedure puts a sign-off message of user's choice on the screen.  *)
  150. (****************************************************************************)
  151.  
  152. Procedure SignOff(Msg : S80);
  153.   Var
  154.     X : Integer;
  155.   begin
  156.     GetTime(T1);       {Get system date and time}
  157.     GetDate(D1);
  158.     AP:='am';
  159.     With T1 Do
  160.       begin
  161.         If Hours>11 Then AP:='pm';   {Convert time to standard from military}
  162.         Hours:=Hours Mod 12;
  163.         If Hours=0 Then Hours:=12;
  164.       end;
  165.     ClrScr;
  166.     GotoXY(1,1);
  167.     With D1 Do Write(Con,'  ',DayName[DayOfWeek],', ',MonName[Month],' ',
  168.       V2(Day),', ',Year);
  169.     GotoXY(72,1);
  170.     With T1 Do Write(Con,V2(Hours),':',V2(Min),AP);
  171.     X:=(79-(Length(Msg))) div 2;
  172.     GotoXY(X,13);
  173.     Writeln(Con,Msg);
  174.     GotoXY(1,24);
  175.   end;
  176.  
  177. (****************************************************************************)
  178. (*  This is the procedure that will list the file.  Note that the HEADING   *)
  179. (*  procedure is internal to this procedure and that both make use of the   *)
  180. (*  global variables defined in the program declaration part.               *)
  181. (****************************************************************************)
  182.  
  183. Procedure Listfile(var Filname : S12);
  184.  
  185. Var
  186.   LineCnt,
  187.   Page            : Integer;
  188.   AbortFileFlag   : Boolean;
  189.  
  190. Const
  191.   PgLen = 63;  {Maximum lines per page (63 leaves a 3 line bottom margin.}
  192.   FF    = ^L;  {Form Feed}
  193.  
  194. Procedure Heading;
  195. Var
  196.   PathToPrint : S243;
  197. begin
  198.   Page := Page + 1;
  199.   Writeln(FF);
  200.   Writeln;
  201.   Writeln;
  202.   X := 6 + Length(Path) + Length(FilnameP);
  203.   If X>70 then begin         {If path name is too long, don't print it}
  204.     X := 6 + Length(FilnameP);
  205.     PathToPrint := '';
  206.   end else PathToPrint := Path;
  207.   Write('File: ',PathToPrint,FilnameP);
  208.   Repeat
  209.     Write(' ');
  210.     X := X + 1;
  211.   until X=71;
  212.   Writeln('Page:',Page:3);
  213.   Writeln('Last Revised: ',RevDate,' at ',RevTime);
  214.   Writeln;
  215.   LineCnt := 6;
  216. end;
  217.  
  218. Procedure ListAbort;
  219.   Var
  220.     C        : Char;
  221.   begin
  222.     Read(Kbd,C);
  223.     if (C=^[) and (not KeyPressed) then AbortFileFlag:= True else
  224.       if C=^E then begin   {*** TOTAL PROGRAM ABORT ***}
  225.         Write(FF);
  226.         SignOff('User Aborted');
  227.         Halt;
  228.       end;
  229.   end;
  230.  
  231. begin
  232.   AbortFileFlag := False;
  233.   Assign(Filvar1,Path+Filname);  {Open and reset file}
  234.   Reset(Filvar1);
  235.   LineCnt := PgLen+1;       {Require heading by setting LineCnt beyond max}
  236.   Page := 0;                {Reset page number}
  237.   While (not Eof(Filvar1)) and (not AbortFileFlag) do begin
  238.     If LineCnt>=PgLen then Heading;
  239.     Readln(Filvar1,L1);
  240.     Writeln(L1);
  241.     LineCnt := LineCnt + 1;
  242.     If KeyPressed then ListAbort;
  243.   end;
  244.   Close(Filvar1);          {Close file}
  245.   if odd(Page) then writeln(FF);  {issue FF to keep first page of next file
  246.                                    on inside page of bi-fold paper.}
  247. end;
  248.  
  249. (****************************************************************************)
  250. (*  End of Procedure LISTFILE                                               *)
  251. (****************************************************************************)
  252.  
  253. Begin
  254.  
  255. {Main program =>  As a DOS filter, input comes from the listing of the DIR
  256.                   command.  Look for line that has the word 'Directory' and
  257.                   steal from it the path.  Then skip down to the individual
  258.                   files listed and grab the names, one at a time, and list
  259.                   them.  Repeat until the last line of the directory listing
  260.                   is found.}
  261.  
  262.   L2 := 'Directory';
  263.   Repeat
  264.     Readln(L1);
  265.   Until 0<>Pos(L2,L1);  {quit when word 'Directory' found in line just read}
  266.  
  267.   X := 0;               {Steal path string}
  268.   S := Copy(L1,16,1);
  269.   Path := '';
  270.   While (S>#$20) and (S<#$7F) do begin
  271.     Path := Path + S;
  272.     X := X + 1;
  273.     S := Copy(L1,16+X,1);
  274.   end;
  275.  If '\'<>Copy(Path,Length(Path),1) then Path := Path + '\';
  276.  
  277.   Readln(L1);
  278.   While Pos('File',L2)=0 do
  279.     begin
  280.       Readln(L2);
  281.       If Pos(' File',L2)=0 then begin
  282.         Filname := Copy(L2,1,8) + '.' + Copy(L2,10,3);
  283.         RevTime := Copy(L2,34,6) + 'm';
  284.         Val(ParseOutSpc(Copy(L2,24,2)),X1,X);
  285.         Val(Copy(L2,27,2),X2,X);
  286.         RevDate := MonName[X1]+' '+V2(X2)+', 19'+Copy(L2,30,2);
  287.         FilnameP := ParseOutSpc(Filname); {Get rid of spaces inside file name}
  288.         If FilnameP='.' then begin
  289.           SignOff('No files found.');
  290.           Halt;
  291.         end;
  292.         UpDateScr;
  293.         Listfile(Filname);
  294.       end;
  295.     end;
  296.   SignOff('Job Complete');
  297. end. {Program: FILELIST}
  298.