home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / pln101.zip / PLN.PAS < prev    next >
Pascal/Delphi Source File  |  1994-09-15  |  3KB  |  129 lines
  1. PROGRAM EnumerateLinesInFile;
  2. USES Dos;
  3. CONST
  4.   ProgDesc = 'PLN - Free DOS utility: number text file lines sequentially.';
  5.   Author   = 'v1.01: September 15, 1994. (c) 1994 by David Daniel Anderson - Reign Ware.';
  6.  
  7. PROCEDURE showhelp (problem:byte);
  8. {---- If any *foreseen* errors arise,
  9.         give a little help and exit (relatively) peacefully. ----}
  10. CONST
  11.   Usage    = 'Usage: PLN infile outfile [/r (remove numbers)]';
  12. VAR
  13.   message : STRING[79];
  14. BEGIN
  15.   writeln;
  16.   IF problem > 0 THEN BEGIN
  17.     CASE problem OF
  18.       3 : message:= 'Insufficient number of parameters.';
  19.       4 : message:= 'Non-numeric found at the beginning of a line in the "infile" - aborting.';
  20.       5 : message:= 'The "outfile" already exists.  Rename or delete it.';
  21.       6 : message:= 'The "infile" was not found.  Please try again.';
  22.       7 : message:= 'Error opening or closing a file.';
  23.      ELSE message:= 'Undefined error.'
  24.     END;
  25.     writeln (#7, 'Error encountered:'); writeln (message); writeln;
  26.   END;
  27.   writeln (usage);
  28.   halt (problem);
  29. END;
  30.  
  31. FUNCTION fileexists (filename:STRING):boolean;
  32. VAR
  33.   attr : word;
  34.   f    : FILE;
  35. BEGIN
  36.   assign (f, filename);
  37.   getfattr (f, attr);
  38.   fileexists:= ( DOSerror = 0);
  39. END;
  40.  
  41. PROCEDURE PutNumb (VAR ifile, ofile:text);
  42. VAR
  43.   cline  : STRING;
  44.   number : longint;
  45. BEGIN
  46.   number:= 0;
  47.   REPEAT
  48.     ReadLn (ifile, cline);
  49.     number:= Succ (number);
  50.     WriteLn (ofile, number:6, #58#32, cline);
  51.   UNTIL EoF (ifile) ;
  52. END;
  53.  
  54. PROCEDURE RmvNumb (VAR ifile, ofile:text);
  55. VAR
  56.   cline  : STRING;
  57.   lnumb  : longint;
  58.   valerr : integer;
  59. BEGIN
  60.   REPEAT
  61.     ReadLn (ifile, cline);
  62.     val (copy (cline, 1, 6), lnumb, valerr);
  63.     IF valerr <> 0 THEN BEGIN
  64.       close (ifile);
  65.       close (ofile);
  66.       erase (ofile);
  67.       showhelp (4);
  68.     END
  69.     ELSE
  70.       WriteLn (ofile, copy (cline, 9, length (cline) - 8));
  71.   UNTIL Eof (ifile) ;
  72. END;
  73.  
  74. PROCEDURE GetParms(VAR fn1, fn2 :PathStr; VAR rmv :Boolean);
  75. VAR
  76.   PStr, RParm : String;
  77. BEGIN
  78.   writeln;
  79.   writeln (progdesc);
  80.   writeln (author);
  81.  
  82.   PStr:= STRING(ptr (prefixseg, $0080)^);
  83.   IF (Length (PStr) = 0) OR
  84.       (Pos ('?', PStr) > 0) OR
  85.       (Pos ('*', PStr) > 0) THEN showhelp (0);
  86.  
  87.   IF ParamCount < 2 THEN showhelp (3);
  88.   fn1:= ParamStr (1);
  89.   fn2:= ParamStr (2);
  90.  
  91.   IF NOT fileexists (fn1) THEN showhelp (6);
  92.   IF fileexists (fn2) THEN showhelp (5);
  93.  
  94.   IF ParamCount > 2 THEN BEGIN
  95.     RParm:= ParamStr (3);
  96.     rmv:= UpCase (RParm[2]) = 'R'
  97.   END
  98.   ELSE rmv:= FALSE;
  99.  
  100.   Writeln;
  101.   Writeln ('Infile           = ', fn1);
  102.   Writeln ('Outfile          = ', fn2);
  103.   Writeln ('Removing numbers = ', rmv);
  104. END;
  105.  
  106. VAR
  107.   fname1, fname2  : PathStr;
  108.   infile, outfile : Text;
  109.   remove          : Boolean;
  110.  
  111. BEGIN
  112.   GetParms(fname1,fname2,remove);
  113.  
  114. {$i-}
  115.   Assign (infile, fname1);  Reset (infile);
  116.     IF IOResult <> 0 THEN showhelp (7);
  117.   Assign (outfile, fname2); Rewrite (outfile);
  118.     IF IOResult <> 0 THEN showhelp (7);
  119. {$i+}
  120.  
  121.   IF remove THEN RmvNumb (infile, outfile)
  122.             ELSE PutNumb (infile, outfile);
  123.  
  124.   Close (infile);
  125.   Close (outfile);
  126.   Writeln;
  127.   Writeln ('Successful completion!');
  128. END.
  129.