home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / kline100.zip / KLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1994-08-28  |  9KB  |  260 lines
  1. PROGRAM remove_line;
  2. USES dos;
  3. CONST
  4.   progdesc = 'KLine v1.00 - Free DOS utility: Kills lines which contain a specified string.';
  5.   author   = 'Released: August 28, 1994. (c) 1994 by David Daniel Anderson - Reign Ware.';
  6.  
  7. PROCEDURE showhelp (problem :byte);
  8. {----
  9.  If any *foreseen* errors arise, we are sent here,
  10.   to give a little help and exit (relatively) peacefully
  11. ----}
  12. CONST
  13.   usage    = 'Usage:  KLine text_file(s) "offending string" [/c (case sensitive)]';
  14. VAR
  15.   message : STRING[79];
  16. BEGIN
  17.   writeln;
  18.   IF (problem > 0) THEN BEGIN
  19.     CASE (problem) OF
  20.       1 : message:='Command line contains improper parameters.';
  21.       2 : message:='Deletion string not properly delimited.';
  22.       3 : message:='No files found.  First parameter must be a valid file specification.';
  23.       6 : message:='You cannot just specify a path, add "*.*" or "\*.*" for all files.';
  24.       7 : message:='Error opening, closing, or renaming a file.  Original may be renamed!'
  25.       ELSE  message:='Unknown error.'
  26.     END;
  27.     writeln (#7);
  28.     writeln ('Error encountered:'); writeln (message);
  29.   END;
  30.   writeln (usage);
  31.   halt (problem);
  32. END;
  33.  
  34. PROCEDURE iocheck (iores :byte);
  35. BEGIN
  36.   IF (iores <> 0) THEN showhelp (7);
  37. END;
  38.  
  39. FUNCTION ConvertToUpper (w :STRING) : STRING;
  40. VAR
  41.    cp  :Integer;        {The position of the character to change.}
  42. BEGIN
  43.   FOR cp:=1 TO Length (w) DO
  44.     w[cp]:=UpCase (w[cp]);
  45.   ConvertToUpper:=w;
  46. END;
  47.  
  48. FUNCTION nameof (fn :STRING):STRING;
  49. BEGIN
  50.   IF (pos ('.', fn) > 0) THEN
  51.     nameof:=copy (fn, 1, (pos ('.', fn)-1))
  52.   ELSE
  53.     nameof:=fn;
  54. END;
  55.  
  56. FUNCTION extof (fn :STRING):STRING;
  57. BEGIN
  58.   IF (pos ('.', fn) > 0) THEN
  59.     extof:=copy (fn, pos ('.', fn), length (fn))
  60.   ELSE
  61.     extof:='';
  62. END;
  63.  
  64. PROCEDURE getparams (pstring :STRING; VAR fpath :pathstr; VAR kline :STRING; VAR case_s :boolean);
  65. VAR
  66.   cmdline :STRING;
  67.   ffound  :boolean;  { has first filename been found? }
  68.   counter :byte;
  69. BEGIN
  70.   cmdline:=pstring;
  71.   ffound:=FALSE;
  72.   counter:=0;
  73.   fpath:='';
  74.   kline:='';
  75.   case_s:=FALSE;
  76.   inc (counter);
  77.   WHILE (counter < (length (cmdline)+1)) DO BEGIN
  78.     CASE (cmdline[counter]) OF
  79.       #32     : inc (counter);
  80.       '"'     : BEGIN
  81.                   IF (kline <> '') THEN showhelp (2);
  82.                   inc (counter);
  83.                   WHILE ((counter < (length (cmdline)+1)) AND
  84.                       (cmdline[counter] <> '"')) DO BEGIN
  85.                     kline:=kline+cmdline[counter];
  86.                     inc (counter);
  87.                   END;
  88.                   IF (cmdline[counter] <> '"') THEN
  89.                     showhelp (2)
  90.                   ELSE
  91.                     inc (counter);
  92.                 END;
  93.       '/','-' : BEGIN
  94.                   IF (counter < length (cmdline)) THEN BEGIN
  95.                     inc (counter);
  96.                     CASE (cmdline[counter]) OF
  97.                       '?', 'H', 'h' : showhelp (0);
  98.                       's', 'S'      : case_s:=TRUE;
  99.                       'i', 'I'      : case_s:=FALSE;
  100.                       ELSE
  101.                         showhelp (1)
  102.                     END;
  103.                   END;
  104.                   WHILE ((counter < (length (cmdline)+1)) AND
  105.                       (cmdline[counter] <> #32)) DO inc (counter);
  106.                 END;
  107.       ELSE      IF (NOT ffound) THEN BEGIN
  108.                   ffound:=TRUE;
  109.                   WHILE ((counter < (length (cmdline)+1)) AND
  110.                       (cmdline[counter] <> #32)) DO BEGIN
  111.                     fpath:=fpath+cmdline[counter];
  112.                     inc (counter);
  113.                   END;
  114.                 END
  115.                 ELSE
  116.                   showhelp (1)
  117.     END;
  118.   END;
  119.   IF (kline = '') THEN showhelp (2);
  120.   IF (fpath = '') THEN showhelp (1);
  121. END;
  122.  
  123. PROCEDURE openfiles (VAR file_in, file_out :text; name1, name2 :STRING);
  124. BEGIN
  125.   assign (file_in, name1);
  126.   reset (file_in);           iocheck (ioresult);
  127.   assign (file_out, name2);
  128.   rewrite (file_out);        iocheck (ioresult);
  129. END;
  130.  
  131. PROCEDURE swapnames (VAR file1, file2 :text; name1, name2 :pathstr);
  132. VAR
  133.   dir1, dir2 : dirstr;
  134.   fn1, fn2   : namestr;
  135.   ext1, ext2 : extstr;
  136. BEGIN
  137.   fsplit (fexpand (name1), dir1, fn1, ext1);
  138.   fsplit (fexpand (name2), dir2, fn2, ext2);
  139.   rename (file1, dir1+fn1+'.swp');  iocheck (ioresult);
  140.   rename (file2, dir2+fn2+ext1);    iocheck (ioresult);
  141.   rename (file1, dir1+fn1+ext2);    iocheck (ioresult);
  142. END;
  143.  
  144. PROCEDURE makenewfile (VAR file1, file2 :text; badline :STRING; case_s :boolean);
  145. VAR
  146.   c_line :STRING;
  147.   t_line :STRING;
  148. BEGIN
  149.   IF (NOT case_s) THEN
  150.     badline:=converttoupper (badline);
  151.   WHILE (NOT eof (file1)) DO BEGIN
  152.     readln (file1, c_line);
  153.     IF (NOT case_s) THEN t_line:=converttoupper (c_line)
  154.     ELSE t_line:=c_line;
  155.     IF (pos (badline, t_line) = 0) THEN
  156.       writeln (file2, c_line);
  157.   END;
  158. END;
  159.  
  160. {---- TYPEs, CONSTs and VARs for "main" program ----}
  161. TYPE
  162.   link = ^node;
  163.   node = RECORD
  164.            name : STRING[8];
  165.            next : link;
  166.          END;
  167. VAR
  168.   dirinfo    : searchrec; { contains filespec info.    }
  169.   inpath     : pathstr;   { source file path,          }
  170.   outdir,
  171.   indir      : dirstr;    {             directory,     }
  172.   fname,
  173.   outname,
  174.   inname     : namestr;   {             name,          }
  175.   outext,
  176.   inext      : extstr;    {             extension.     }
  177.   ifn, ofn   : pathstr;   { Source/ Dest/ Temp FileName, including dir }
  178.   infile, outfile : text; { files read from/ written to                }
  179.   numdone    : word;      { numdone is number of files processed       }
  180.   kline      : STRING;
  181.   case_sens  : boolean;
  182. {----
  183.   The boolean var "done" and pointers (type of 'link') of "anchor" and
  184.    "chain" are used to cope with a bothersome quirk of DOS (I think),
  185.    which allows "findnext" to find files more than once (under certain
  186.    circumstances).  This quirk seems to be due to the order of the file
  187.    names in the FAT, which is altered when a file is written to disk and
  188.    then renamed.
  189. ----}
  190.   done      : boolean;
  191.   anchor, chain : link;
  192.  
  193. {---- BEGIN the "main" program ----}
  194. BEGIN
  195.   writeln (progdesc);
  196.   writeln (author);
  197. {----
  198.   Initialize some variables.
  199.   The user must pass a filename specification, and must also pass
  200.   a quote (") delimited string to indicate the lines to delete.
  201.   The original file is renamed to original_name.bak, and the output
  202.   file will have the exact same name as the original file.
  203. ----}
  204.   IF (NOT (paramcount IN [2..3])) THEN showhelp (0);
  205.   numdone:=0;
  206.   new (anchor);
  207.   anchor^.name:='';
  208.   anchor^.next:=NIL;
  209.  
  210. {---- Get file specifications ----}
  211.   getparams (STRING(ptr (prefixseg, $0080)^), inpath, kline, case_sens);
  212.   fsplit (fexpand (inpath), indir, inname, inext);
  213.   IF (inname = '') THEN showhelp (6);
  214.   findfirst (inpath, archive, dirinfo);
  215.   IF (doserror <> 0) THEN showhelp (3);
  216.   writeln;
  217.   writeln ('Specified string:');
  218.   writeln (kline);
  219.  
  220. {---- Okay, let's go! ----}
  221.   WHILE (doserror = 0) DO BEGIN
  222.     done:=false;                      { initialize for each "new" file found }
  223.     ifn:=indir+dirinfo.name;
  224.     fname:=nameof (dirinfo.name);
  225.     IF (extof (dirinfo.name) = '.bak') THEN done:=TRUE;
  226.     chain:=anchor;                { check if file was processed file already }
  227.     WHILE ((chain^.next <> NIL) AND (NOT done)) DO
  228.       IF (chain^.name = fname) THEN done:=true
  229.       ELSE chain:=chain^.next;
  230.  
  231. {---- Only process if not processed before ----}
  232.     IF (NOT done) THEN BEGIN
  233.       inc (numdone);
  234.       new (chain);
  235.       chain^.name:=fname;            { add current name to beginning of list }
  236.       chain^.next:=anchor;
  237.       anchor:=chain;
  238.  
  239. {---- Process the file! ----}
  240.       ofn:=indir+fname+'.bak';
  241.       write ('Removing lines from ', ifn); {tell user file is being processed}
  242.       openfiles (infile, outfile, ifn, ofn);
  243.       makenewfile (infile, outfile, kline, case_sens);
  244.       writeln (', done!');           { tell user this file has been processed}
  245.  
  246. {---- Close files, then find next file to process ----}
  247.       close (infile);     iocheck (ioresult);
  248.       close (outfile);    iocheck (ioresult);
  249.       swapnames (infile, outfile, ifn, ofn);
  250.     END;
  251.     findnext (dirinfo);
  252.   END;     { now loop back with name of next file to process }
  253.   REPEAT   { dispose of pointers - not necessary at end, but good practice }
  254.     chain:=anchor^.next;
  255.     dispose (anchor);
  256.     anchor:=chain;
  257.   UNTIL (anchor = NIL) ;
  258.   writeln ('Processed ', numdone, ' file(s).');
  259. END.
  260.