home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 17
/
CD_ASCQ_17_101194.iso
/
vrac
/
pln101.zip
/
PLN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-09-15
|
3KB
|
129 lines
PROGRAM EnumerateLinesInFile;
USES Dos;
CONST
ProgDesc = 'PLN - Free DOS utility: number text file lines sequentially.';
Author = 'v1.01: September 15, 1994. (c) 1994 by David Daniel Anderson - Reign Ware.';
PROCEDURE showhelp (problem:byte);
{---- If any *foreseen* errors arise,
give a little help and exit (relatively) peacefully. ----}
CONST
Usage = 'Usage: PLN infile outfile [/r (remove numbers)]';
VAR
message : STRING[79];
BEGIN
writeln;
IF problem > 0 THEN BEGIN
CASE problem OF
3 : message:= 'Insufficient number of parameters.';
4 : message:= 'Non-numeric found at the beginning of a line in the "infile" - aborting.';
5 : message:= 'The "outfile" already exists. Rename or delete it.';
6 : message:= 'The "infile" was not found. Please try again.';
7 : message:= 'Error opening or closing a file.';
ELSE message:= 'Undefined error.'
END;
writeln (#7, 'Error encountered:'); writeln (message); writeln;
END;
writeln (usage);
halt (problem);
END;
FUNCTION fileexists (filename:STRING):boolean;
VAR
attr : word;
f : FILE;
BEGIN
assign (f, filename);
getfattr (f, attr);
fileexists:= ( DOSerror = 0);
END;
PROCEDURE PutNumb (VAR ifile, ofile:text);
VAR
cline : STRING;
number : longint;
BEGIN
number:= 0;
REPEAT
ReadLn (ifile, cline);
number:= Succ (number);
WriteLn (ofile, number:6, #58#32, cline);
UNTIL EoF (ifile) ;
END;
PROCEDURE RmvNumb (VAR ifile, ofile:text);
VAR
cline : STRING;
lnumb : longint;
valerr : integer;
BEGIN
REPEAT
ReadLn (ifile, cline);
val (copy (cline, 1, 6), lnumb, valerr);
IF valerr <> 0 THEN BEGIN
close (ifile);
close (ofile);
erase (ofile);
showhelp (4);
END
ELSE
WriteLn (ofile, copy (cline, 9, length (cline) - 8));
UNTIL Eof (ifile) ;
END;
PROCEDURE GetParms(VAR fn1, fn2 :PathStr; VAR rmv :Boolean);
VAR
PStr, RParm : String;
BEGIN
writeln;
writeln (progdesc);
writeln (author);
PStr:= STRING(ptr (prefixseg, $0080)^);
IF (Length (PStr) = 0) OR
(Pos ('?', PStr) > 0) OR
(Pos ('*', PStr) > 0) THEN showhelp (0);
IF ParamCount < 2 THEN showhelp (3);
fn1:= ParamStr (1);
fn2:= ParamStr (2);
IF NOT fileexists (fn1) THEN showhelp (6);
IF fileexists (fn2) THEN showhelp (5);
IF ParamCount > 2 THEN BEGIN
RParm:= ParamStr (3);
rmv:= UpCase (RParm[2]) = 'R'
END
ELSE rmv:= FALSE;
Writeln;
Writeln ('Infile = ', fn1);
Writeln ('Outfile = ', fn2);
Writeln ('Removing numbers = ', rmv);
END;
VAR
fname1, fname2 : PathStr;
infile, outfile : Text;
remove : Boolean;
BEGIN
GetParms(fname1,fname2,remove);
{$i-}
Assign (infile, fname1); Reset (infile);
IF IOResult <> 0 THEN showhelp (7);
Assign (outfile, fname2); Rewrite (outfile);
IF IOResult <> 0 THEN showhelp (7);
{$i+}
IF remove THEN RmvNumb (infile, outfile)
ELSE PutNumb (infile, outfile);
Close (infile);
Close (outfile);
Writeln;
Writeln ('Successful completion!');
END.