home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
15a
/
murutil.zip
/
LISTER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-05-28
|
8KB
|
319 lines
PROGRAM LISTER;
{ This Turbo Pascal program reads an input file and generates a
listing file suitable for printing.
The input/listing files may be specified in the command line,
as in: "LISTER LISTER.PAS LISTER.LIS"
or: "LISTER LISTER.PAS".
If the input/listing files are not specified in the command line,
the program asks for them.
TAB codes are expanded, assuming standard a tab setting every eight
spaces.
Other non-printing codes are converted to "^" characters.
Program by Harry M. Murphy, 22 February 1986.
Updated by H.M.M. on 28 May 1986. }
CONST
MXLINE = 55;
TYPE
DATESTRING = STRING[28];
FILESPEC = STRING[65];
LINESTRING = STRING[80];
TIMESTRING = STRING[6];
VAR
CLOCK: TIMESTRING;
INP: TEXT[2048];
INPNAME: FILESPEC;
INPLINE: LINESTRING;
NLINE: INTEGER;
NPAGE: INTEGER;
OUT: TEXT[2048];
OUTLINE: LINESTRING;
OUTNAME: FILESPEC;
TITLE: STRING[60];
TODAY: DATESTRING;
FUNCTION DATE: DATESTRING;
{ This function returns today's date as a DateString of up
to 28 bytes, such as: "Tuesday, 18 February 1986".
Note: TYPE DATESTRING = STRING[28];
Procedure adapted from the Turbo Pascal date example by
Harry M. Murphy, 18 February 1986. }
TYPE
REGPAK = RECORD
AX,BX,CX,DX,BP,SI,DI,DS,ES,FL: INTEGER
END;
VAR
ID,IM,IW,IY,JC,JD,JM,JY: INTEGER;
REG: REGPAK;
DAY: STRING[2];
DTE: DATESTRING;
YEAR: STRING[4];
BEGIN
WITH REG DO
BEGIN
AX:=$2A00;
MSDOS(REG);
IY:=CX;
IM:=HI(DX);
ID:=LO(DX)
END;
JY:=IY; JM:=IM-2;
IF JM < 1 THEN BEGIN JM:=JM+12; JY:=JY-1 END;
JC:=JY DIV 100; JD:=JY-100*JC;
IW:=((ID+42+(13*JM-1) DIV 5 +JD+JD DIV 4+JC DIV 4-2*JC) MOD 7);
CASE IW OF
0: DTE:='Sunday, ';
1: DTE:='Monday, ';
2: DTE:='Tuesday, ';
3: DTE:='Wednesday, ';
4: DTE:='Thursday, ';
5: DTE:='Friday, ';
6: DTE:='Saturday, '
END { CASE };
STR(ID:2,DAY); STR(IY:4,YEAR);
CASE IM OF
1: DTE:=DTE+DAY+' January '+YEAR;
2: DTE:=DTE+DAY+' February '+YEAR;
3: DTE:=DTE+DAY+' March '+YEAR;
4: DTE:=DTE+DAY+' April '+YEAR;
5: DTE:=DTE+DAY+' May '+YEAR;
6: DTE:=DTE+DAY+' June '+YEAR;
7: DTE:=DTE+DAY+' July '+YEAR;
8: DTE:=DTE+DAY+' August '+YEAR;
9: DTE:=DTE+DAY+' September '+YEAR;
10: DTE:=DTE+DAY+' October '+YEAR;
11: DTE:=DTE+DAY+' November '+YEAR;
12: DTE:=DTE+DAY+' December '+YEAR
END { CASE };
DATE:=DTE
END {Function DATE};
PROCEDURE FILTER(VAR LINE1, LINE2: LINESTRING);
{ This procedure "filters" non-printing ASCII characters from LINE1 to
LINE2 by translating tab codes to equivalent spaces and the remainder
to "^" characters.
Note: TYPE LINESTRING = STRING[80];
Procedure by Harry M. Murphy, 22 February 1986. }
VAR
CH: CHAR;
K, KT, L, LL: 1..80;
BEGIN
LL:=LENGTH(LINE1);
K:=0;
L:=0;
WHILE (L<LL) AND (K<80) DO
BEGIN
K:=K+1;
L:=L+1;
CH:=LINE1[L];
IF (CH>CHR(31)) AND (CH<CHR(127))
THEN
LINE2[K]:=CH
ELSE
IF CH=CHR(9)
THEN
BEGIN
LINE2[K]:=' ';
KT:=((K+7) DIV 8)*8;
IF KT>80 THEN KT:=80;
WHILE K<KT DO
BEGIN
K:=K+1;
LINE2[K]:=' '
END
END
ELSE
LINE2[K]:='^'
END;
LINE2[0]:=CHR(K)
END {Procedure FILTER};
PROCEDURE GETINPFIL(VAR INPNAME: FILESPEC);
{ This file gets an input file, either as the first parameter
on the command line or by requesting it from the user.
Procedure by Harry M. Murphy, 22 February 1986. }
VAR
L: INTEGER;
BEGIN
IF PARAMCOUNT = 0
THEN
BEGIN
WRITE('Input file: ');
READLN(INPNAME)
END
ELSE
INPNAME:=PARAMSTR(1);
FOR L:=1 TO LENGTH(INPNAME) DO INPNAME[L]:=UPCASE(INPNAME[L]);
ASSIGN(INP,INPNAME);
{$I-} RESET(INP); {$I+}
IF IORESULT <> 0
THEN
BEGIN
CLOSE(INP);
WRITELN('ERROR! Can''t find file ',INPNAME,'!');
HALT
END;
END {Procedure GETINPFIL};
PROCEDURE GETOUTFIL(VAR OUTNAME: FILESPEC);
{ This file gets an output file, either as the second parameter
on the command line or by requesting it from the user.
Procedure by Harry M. Murphy, 22 February 1986. }
VAR
L: INTEGER;
BEGIN
IF PARAMCOUNT < 2
THEN
BEGIN
WRITE('Output file: ');
READLN(OUTNAME)
END
ELSE
OUTNAME:=PARAMSTR(2);
FOR L:=1 TO LENGTH(OUTNAME) DO OUTNAME[L]:=UPCASE(OUTNAME[L]);
ASSIGN(OUT,OUTNAME);
{$I-} REWRITE(OUT); {$I-}
IF IORESULT <> 0
THEN
BEGIN
CLOSE(OUT);
WRITELN('ERROR! Can''t open ',OUTNAME,'!');
HALT
END
END {Procedure GETOUTFIL};
PROCEDURE STRIPATH(VAR NAME: FILESPEC);
{ This procedure strips away any leading pathname in the file
specification, NAME.
Procedure by Harry M. Murphy, 22 February 1986. }
VAR
L: INTEGER;
BEGIN
L:=LENGTH(NAME);
IF L > 0
THEN
BEGIN
WHILE (NAME[L]<>'\') AND (L>1) DO L:=L-1;
IF NAME[L]='\' THEN DELETE(NAME,1,L)
END
END {Procedure STRIPATH};
FUNCTION TIME: TIMESTRING;
{ This function returns the current clock time as a TimeString
of 6 bytes, such as: "19:05h".
Note: TYPE TIMESTRING = STRING[6];
Procedure adapted from the Turbo Pascal date example by
Harry M. Murphy, 19 February 1986. }
TYPE
REGPAK = RECORD
AX,BX,CX,DX,BP,SI,DI,DS,ES,FL: INTEGER
END;
VAR
H,M,S,T: INTEGER;
HR: STRING[2];
MN: STRING[2];
REG: REGPAK;
BEGIN
WITH REG DO
BEGIN
AX:=$2C00;
MSDOS(REG);
H:=HI(CX);
M:=LO(CX);
S:=HI(DX);
T:=LO(DX)
END;
IF T > 50 THEN S:=S+1;
IF S > 30 THEN M:=M+1;
IF M = 60
THEN
BEGIN
H:=H+1;
M:=0;
IF H = 24 THEN H:=0
END;
STR(H:2,HR);
STR(M:2,MN);
IF MN[1]=' ' THEN MN[1]:='0';
TIME:=HR+':'+MN+'h'
END {Function TIME};
BEGIN {Program LISTER}
CLOCK:=TIME;
TODAY:=DATE;
LOWVIDEO;
GETINPFIL(INPNAME);
GETOUTFIL(OUTNAME);
WRITELN(' Reading: ',INPNAME);
WRITELN(' Writing: ',OUTNAME);
STRIPATH(INPNAME);
TITLE:='File: '+INPNAME+' '+TIME+', '+TODAY+'.';
NLINE:=MXLINE;
NPAGE:=0;
WHILE NOT EOF(INP) DO
BEGIN
IF NLINE=MXLINE
THEN
BEGIN
WRITELN(OUT,CHR(12));
NPAGE:=NPAGE+1;
WRITELN(OUT,'Page',NPAGE:4,'. ',TITLE);
WRITELN(OUT);
NLINE:=0
END;
READLN(INP,INPLINE);
FILTER(INPLINE,OUTLINE);
WRITELN(OUT,OUTLINE);
NLINE:=NLINE+1
END;
CLOSE(INP);
IF (OUTNAME='PRN') AND (NLINE>0) THEN WRITELN(OUT,CHR(12));
CLOSE(OUT);
WRITELN(OUTNAME,' is ',NPAGE,' pages long.')
END.