home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PASCAL.ZIP / TXTFIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-20  |  38.3 KB  |  1,047 lines
  1.   {$P128}
  2.   {$V-}
  3.   {$C-}
  4.  
  5. PROGRAM txtfind(Output);
  6.  
  7.     {*************************************************************************}
  8.     {*         Copyright (c) Kim Kokkonen, TurboPower Software, 1985         *}
  9.     {*  Released to the public domain for personal, non-commercial use only  *}
  10.     {*************************************************************************}
  11.  
  12.     {.F-}
  13.     {
  14.     searches a group of files for a text string.
  15.     type TXTFIND alone to get help screens.
  16.  
  17.     requires Turbo Pascal version 3.0 to compile.
  18.     heap/stack size sets limit on depth of subdirectory searching allowed.
  19.     compile with max heap= A000.
  20.     program does not check for heap-stack collision, but
  21.       Turbo run-time library will complain if that happens.
  22.     there is a tradeoff between number of files in a given directory
  23.       vs. the maximum depth of subdirectory checking.
  24.     currently each level of subdirectory eats about 16K of RAM, on the heap.
  25.     written 8/29/85, Kim Kokkonen, 408-378-3672.
  26.  
  27.     FEATURES:
  28.       fast Knuth-Morris-Pratt search algorithm.
  29.       match pattern up to 255 characters may include any ASCII character
  30.         except #13, #10 and #26 (which are filtered out during read-in).
  31.       1024 character input lines with segmentation (not truncation)
  32.         for longer lines.
  33.       automatic but selectable exclusion of binary files.
  34.       quiet and verbose modes.
  35.       built-in WordStar filter and end of line sensing.
  36.       general purpose recursive file finder (up to 256 files per directory).
  37.       optionally specify a list of files to search.
  38.       redirectable output.
  39.     }
  40.     {.F+}
  41.  
  42.   CONST
  43.     maxfiles = 256;           {max number of files searched in a given directory}
  44.     maxavoids = 32;           {max number of file extensions to avoid}
  45.     optionchar = '-';         {character which prefixes options on command line}
  46.     endstr = #0;
  47.     esc = '\';
  48.     lspace = 's';
  49.     ltab = 't';
  50.     lbackspace = 'b';
  51.     ascii = '#';
  52.     BufLen = 2048;            {buffer size for input reads - keep buflen>=2*linlen}
  53.     linlen = 1024;            {maximum unbroken line length}
  54.     ncrlinlen = 1022;         {linlen-2}
  55.     maxlink = 255;            {maximum number of failure links in an flink array}
  56.  
  57.   TYPE
  58.     drivename = STRING[2];
  59.     filename = STRING[12];
  60.     pathname = STRING[64];
  61.     longstring = STRING[255];
  62.     farray = RECORD
  63.                num : Integer;
  64.                arr : ARRAY[1..maxfiles] OF pathname;
  65.              END;
  66.     register = RECORD
  67.                  CASE Integer OF
  68.                    1: (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
  69.                    2: (al, ah, bl, bh, cl, ch, dl, dh : Byte);
  70.                END;
  71.     dtarec = RECORD
  72.                dosnext : ARRAY[1..21] OF Byte;
  73.                attr : Byte;
  74.                ftime, fdate, flsize, fhsize : Integer;
  75.                fullname : ARRAY[1..13] OF Char;
  76.              END;
  77.     avoidset = ARRAY[1..maxavoids] OF STRING[3];
  78.     buffer = ARRAY[1..buflen] OF Byte;
  79.     line = ARRAY[-1..linlen] OF Char;
  80.     pathstring = STRING[64];
  81.     flinkarray = ARRAY[1..maxlink] OF Byte;
  82.  
  83.   VAR
  84.     reg : register;
  85.     listfilename, startpath : pathname;
  86.     matchpattern : longstring;
  87.     matchlen : Byte ABSOLUTE matchpattern;
  88.     avoidextension : avoidset;
  89.     avoidnum : Integer;
  90.     wordmask : Byte;
  91.     readexclude, recursive, verbose, lineoutput, uselistfile,
  92.     wordstar, casesens, printheader : Boolean;
  93.     dta : dtarec;
  94.     tstart, tstop, grandbytes, grandtotal, grandmatch : Real;
  95.     buf : buffer;
  96.     flink : flinkarray;
  97.  
  98.   PROCEDURE dohalt(exitcode : Integer);
  99.       {-halt}
  100.     BEGIN
  101.       Halt(exitcode);
  102.     END;                      {dohalt}
  103.  
  104.   FUNCTION fileexists(s : pathname; attr : Integer) : Boolean;
  105.       {-determine whether a file exists with the specified attribute}
  106.     BEGIN
  107.       reg.ah := $4E;
  108.       s[Length(s)+1] := #0;
  109.       reg.ds := Seg(s);
  110.       reg.dx := Ofs(s[1]);
  111.       reg.cx := attr;
  112.       MsDos(reg);
  113.       fileexists := ((reg.flags AND 1) = 0) AND ((dta.attr AND 31) = attr);
  114.     END;                      {fileexists}
  115.  
  116.   PROCEDURE parsepath(VAR start : pathname;
  117.                       VAR dname : drivename;
  118.                       VAR pname : pathname;
  119.                       VAR fname : filename);
  120.       {-parse a full (perhaps incomplete) pathname into component parts}
  121.     VAR
  122.       i : Integer;
  123.     BEGIN
  124.       {get drive name}
  125.       i := Pos(':', start);
  126.       IF i = 0 THEN BEGIN
  127.         dname := '';
  128.         pname := start;
  129.       END ELSE BEGIN
  130.         dname := Copy(start, 1, i);
  131.         pname := Copy(start, i+1, 64);
  132.       END;
  133.  
  134.       {see if wildcard specified}
  135.       i := Pos('*', start)+Pos('?', start);
  136.  
  137.       {separate out filename and pathname}
  138.       IF (i = 0) AND (fileexists(start, 16) OR (pname = '\')) THEN BEGIN
  139.         {start specifies a subdirectory}
  140.         IF pname <> '\' THEN pname := pname+'\';
  141.         fname := '*.*';
  142.       END ELSE BEGIN
  143.         {parse out filename on end}
  144.         i := Length(pname);
  145.         WHILE (i > 0) AND NOT(pname[i] IN [':', '\', '/']) DO i := i-1;
  146.         fname := Copy(pname, i+1, 63);
  147.         pname := Copy(pname, 1, i);
  148.       END;
  149.     END;                      {parsepath}
  150.  
  151.   FUNCTION stupcase(s : longstring) : longstring;
  152.       {-return the uppercase of a string}
  153.     VAR
  154.       i : Byte;
  155.     BEGIN
  156.       FOR i := 1 TO Length(s) DO s[i] := UpCase(s[i]);
  157.       stupcase := s;
  158.     END;                      {stupcase}
  159.  
  160.   FUNCTION breakpressed : Boolean;
  161.       {-true if Break key has been pressed}
  162.       {-note that keypressed function executes int 23 if ^C has been pressed}
  163.     VAR
  164.       c : Char;
  165.       breakdown : Boolean;
  166.     BEGIN
  167.       {check current state}
  168.       breakdown := False;
  169.       WHILE KeyPressed AND NOT(breakdown) DO BEGIN
  170.         Read(Kbd, c);
  171.         IF c = ^C THEN breakdown := True;
  172.       END;
  173.       breakpressed := breakdown;
  174.     END;                      {breakpressed}
  175.  
  176.   PROCEDURE breakhalt;
  177.       {-executed when break is detected}
  178.       {-exit with return code 1}
  179.     BEGIN
  180.       INLINE(
  181.         {exit with a return code of 1}
  182.         $B8/$01/$4C/          {mov ax,4c01}
  183.         $CD/$21               {int 21}
  184.         );
  185.     END;                      {breakhalt}
  186.  
  187.   PROCEDURE setbreak;
  188.       {-set the ctrl-break address to a process exit handler}
  189.     BEGIN
  190.       reg.ax := $2523;
  191.       reg.ds := CSeg;
  192.       reg.dx := Ofs(breakhalt);
  193.       MsDos(reg);
  194.     END;                      {setbreak}
  195.  
  196.   PROCEDURE setoptions;
  197.       {-read command line and set up options and defaults}
  198.     VAR
  199.       i : Integer;
  200.       c : Char;
  201.       haltsoon, gotmatch : Boolean;
  202.       param : longstring;
  203.  
  204.     PROCEDURE writehelp;
  205.       VAR
  206.         ch : Char;
  207.       BEGIN
  208.         WriteLn('    IMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM;');
  209.         WriteLn('    :          TXTFIND - Finds text strings in a group of files        :');
  210.         WriteLn('    :               Copyright (c) 1985, TurboPower Software            :');
  211.         WriteLn('    :                written by Kim Kokkonen, (408)378-3672            :');
  212.         WriteLn('    :  Released to the public domain for personal, non-commercial use  :');
  213.         WriteLn('    HMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM<');
  214.         WriteLn;
  215.         WriteLn('Usage:  TXTFIND [options] MatchString [output redirection]');
  216.         WriteLn;
  217.         WriteLn('TXTFIND is used to search a set of files for a specified text string. It is');
  218.         WriteLn('designed specifically for use with text files but will work half-heartedly');
  219.         WriteLn('with binary files. Each carriage-return delimited text line is limited to 1024');
  220.         WriteLn('characters. Lines longer than this will be broken into multiple segments, but');
  221.         WriteLn('no text will be lost. Any given match must occur within a single line.');
  222.         WriteLn;
  223.         WriteLn('The MatchString contains the text which TXTFIND tries to find. It must always');
  224.         WriteLn('be specified on the command line. It may not contain blank space or carriage');
  225.         WriteLn('returns. Use the special symbols below to insert unprintable characters into');
  226.         WriteLn('MatchString. The search string is limited to 255 characters, although in');
  227.         WriteLn('practice it is limited by the DOS command line. By default, TXTFIND does all');
  228.         WriteLn('matching in uppercase (it is not case-sensitive), and it applies a high-bit');
  229.         WriteLn('filter so that it works with WordStar files. These may be changed via options');
  230.         WriteLn('below.');
  231.         WriteLn;
  232.         Write('press any key to continue (Q to quit)....'); Read(Kbd, ch);
  233.         IF UpCase(ch) = 'Q' THEN dohalt(2);
  234.         WriteLn;
  235.         WriteLn;
  236.         WriteLn;
  237.         WriteLn('If no options are specified, the search will cover all files in the current');
  238.         WriteLn('directory and drive. Options below allow you to specify selected files, start');
  239.         WriteLn('in any directory or drive, or search all subdirectories of the start');
  240.         WriteLn('directory. TXTFIND is limited to 256 files per directory.');
  241.         WriteLn;
  242.         WriteLn('Because TXTFIND is not designed for binary files, it can automatically exclude');
  243.         WriteLn('certain file types from its search. You can exclude extensions by using an');
  244.         WriteLn('optional "exclude" file named TXTFIND.EXC. TXTFIND automatically looks in the');
  245.         WriteLn('current directory and the root directory of the default drive for this file.');
  246.         WriteLn('If it finds one of these, it will read it. Each line of TXTFIND.EXC should');
  247.         WriteLn('hold one extension to be excluded from searching. The TXTFIND.EXC file');
  248.         WriteLn('provided with this software automatically excludes files with extensions of');
  249.         WriteLn('COM, EXE, OBJ, WKS, and BIN.');
  250.         WriteLn;
  251.         WriteLn('For each string that TXTFIND matches, it will write out the filename and line');
  252.         WriteLn('number of the match, followed by the matching line. TXTFIND writes to the');
  253.         WriteLn('standard output, so these results can be redirected to a file, to the printer');
  254.         WriteLn('or through a MORE filter as desired.');
  255.         WriteLn;
  256.         WriteLn;
  257.         WriteLn;
  258.         WriteLn;
  259.         Write('press any key to continue (Q to quit)....'); Read(Kbd, ch);
  260.         IF UpCase(ch) = 'Q' THEN dohalt(2);
  261.         WriteLn;
  262.         WriteLn;
  263.         WriteLn('Options:');
  264.         WriteLn;
  265.         WriteLn('    -S Pathname  Start search on specified drive and path, or with specified');
  266.         WriteLn('                 files matched. Full DOS wildcards and shorthand supported.');
  267.         WriteLn('    -R           Recursive search. Search down all subdirectories found.');
  268.         WriteLn('    -F ListFile  Search only those files named in ListFile. Files should');
  269.         WriteLn('                 be listed one per line, and may include pathname.');
  270.         WriteLn('    -G           Search for Graphics characters (turn off WordStar Filter).');
  271.         WriteLn('    -C           Make Case significant in searching.');
  272.         WriteLn('    -H           Do not print Header lines (line # and file name) with match.');
  273.         WriteLn('    -T           Do not print matched Text lines.');
  274.         WriteLn('    -Q           Quiet output mode. Normally TXTFIND keeps a status line');
  275.         WriteLn('                 running during its search. This status line shows the current');
  276.         WriteLn('                 file and line number as well as the number of matches found.');
  277.         WriteLn('                 This status always goes to the screen and is never');
  278.         WriteLn('                 redirected. -Q mode turns this status line off.');
  279.         WriteLn('    -N           No exclusions are made, that is, the file TXTFIND.EXC is not');
  280.         WriteLn('                 read.');
  281.         WriteLn;
  282.         WriteLn('Special Characters:');
  283.         WriteLn('    \s  space        \t  tab        \\  backslash        \b  backspace');
  284.         WriteLn('    #nnn any ASCII character nnn (3 digits or terminated with non-numeral)');
  285.         WriteLn;
  286.         Write('press any key to continue (Q to quit)....'); Read(Kbd, ch);
  287.         IF UpCase(ch) = 'Q' THEN dohalt(2);
  288.         WriteLn;
  289.         WriteLn;
  290.         WriteLn;
  291.         WriteLn('Examples:');
  292.         WriteLn;
  293.         WriteLn('    TXTFIND stupcase');
  294.         WriteLn('      will search all non-excluded files in the current directory for the');
  295.         WriteLn('      string "stupcase". Case will not be significant.');
  296.         WriteLn;
  297.         WriteLn('    TXTFIND -R stupcase >stupcase.dat');
  298.         WriteLn('      will search all non-excluded files in the current directory and all of');
  299.         WriteLn('      its subdirectories for "stupcase". Results are written to STUPCASE.DAT.');
  300.         WriteLn;
  301.         WriteLn('    TXTFIND -S c:\pascal\*.pas -R stupcase');
  302.         WriteLn('      looks at all files with extension .PAS starting in the \pascal directory');
  303.         WriteLn('      and working down.');
  304.         WriteLn;
  305.         WriteLn('    TXTFIND -S a:graph.p -C GraphBackground');
  306.         WriteLn('      looks only at one file, graph.p, for the word "GraphBackground". Case is');
  307.         WriteLn('      significant in making the match.');
  308.         WriteLn;
  309.         WriteLn('    TXTFIND -S \*.DOC -R Now\sis\sthe\stime\sfor\sall >lpt1');
  310.         WriteLn('      looks at all DOC files on the current drive for the string "Now is the');
  311.         WriteLn('      time for all", and sends its results to LPT1.');
  312.         dohalt(2);
  313.       END;                    {writehelp}
  314.  
  315.     PROCEDURE doerror(message : longstring);
  316.         {-display an error message}
  317.       BEGIN
  318.         WriteLn(Con, message);
  319.         haltsoon := True;
  320.       END;                    {doerror}
  321.  
  322.     FUNCTION getccl(arg : longstring; i : Integer; VAR s : longstring) : Boolean;
  323.         {-expand a character class starting at position i of arg into a string s}
  324.         {return true if successful}
  325.  
  326.       PROCEDURE dodash(delim : Char; VAR arg : longstring; VAR i : Integer; VAR s : longstring);
  327.           {-expand the innards of the character class, including dashes}
  328.           {stop when endc is found}
  329.           {return a string s with the expansion}
  330.         VAR
  331.           c : Char;
  332.           j : Integer;
  333.  
  334.         PROCEDURE addstr(c : Char; VAR j : Integer; VAR s : longstring);
  335.             {-append a character c onto string s and increment position}
  336.           BEGIN
  337.             j := j+1;
  338.             s[j] := c;
  339.           END;                {addstr}
  340.  
  341.         PROCEDURE addcode(VAR arg : longstring; VAR i, j : Integer; VAR s : longstring);
  342.             {-interpret an ASCII character code}
  343.           VAR
  344.             npos, code, cval : Integer;
  345.             numstring : STRING[3];
  346.           BEGIN
  347.             npos := 0; numstring := '';
  348.             WHILE (arg[i+npos] IN ['0'..'9']) AND (npos <= 2) DO BEGIN
  349.               numstring := numstring+arg[i+npos];
  350.               npos := npos+1;
  351.             END;
  352.             Val(numstring, cval, code);
  353.             IF (code = 0) AND (cval >= 0) AND (cval < 254) THEN BEGIN
  354.               {add the char to the set string}
  355.               addstr(Chr(cval), j, s);
  356.               i := i+npos-1;
  357.             END ELSE BEGIN
  358.               {illegal character, just interpret literally}
  359.               WriteLn('WARNING: ASCII character ', Copy(arg, i-1, npos+1), ' not interpreted');
  360.               addstr(ascii, j, s);
  361.               i := i-1;
  362.             END;
  363.           END;                {addcode}
  364.  
  365.         BEGIN                 {dodash}
  366.           j := 0;
  367.           WHILE (arg[i] <> delim) AND (arg[i] <> endstr) DO BEGIN
  368.             c := arg[i];
  369.             IF (c = esc) THEN BEGIN
  370.               IF (arg[i+1] <> endstr) THEN BEGIN
  371.                 i := i+1;
  372.                 c := arg[i];
  373.                 {replace the special characters}
  374.                 IF (c = lspace) THEN addstr(#32, j, s)
  375.                 ELSE IF (c = ltab) THEN addstr(#9, j, s)
  376.                 ELSE IF (c = lbackspace) THEN addstr(#8, j, s)
  377.                 ELSE
  378.                   {add escaped character}
  379.                   addstr(c, j, s);
  380.               END ELSE
  381.                 {escape must be the character}
  382.                 addstr(esc, j, s);
  383.             END ELSE IF c = ascii THEN BEGIN
  384.               IF (arg[i+1] <> endstr) AND (arg[i+1] IN ['0'..'9']) THEN BEGIN
  385.                 i := i+1;
  386.                 addcode(arg, i, j, s);
  387.               END ELSE
  388.                 {ascii must be the character}
  389.                 addstr(c, j, s);
  390.             END ELSE
  391.               {literal character}
  392.               addstr(c, j, s);
  393.             i := i+1;
  394.           END;
  395.           s[0] := Chr(j);
  396.         END;                  {dodash}
  397.  
  398.       BEGIN                   {getccl}
  399.         {expand the character class}
  400.         dodash(endstr, arg, i, s);
  401.         getccl := (arg[i] = endstr);
  402.       END;                    {getccl}
  403.  
  404.     PROCEDURE buildpattern(inpat : longstring; VAR flink : flinkarray);
  405.         {-build failure link array for KMP pattern matching}
  406.       VAR
  407.         len : Byte ABSOLUTE inpat;
  408.         i, j : Byte;
  409.       BEGIN
  410.         {pass through outpat to build the failure link automaton}
  411.         flink[1] := 0; i := 2;
  412.         WHILE i <= len DO BEGIN
  413.           j := flink[i-1];
  414.           WHILE (j <> 0) AND (inpat[j] <> inpat[i-1]) DO j := flink[j];
  415.           flink[i] := j+1;
  416.           i := i+1;
  417.         END;
  418.       END;                    {buildpattern}
  419.  
  420.     PROCEDURE getexcludes;
  421.         {-find and read the TXTFIND.EXC file}
  422.       CONST
  423.         {files searched for excludes, add more if you like}
  424.         name1 : pathname = 'TXTFIND.EXC';
  425.         name2 : pathname = '\TXTFIND.EXC';
  426.  
  427.       PROCEDURE readexclude(name : pathname);
  428.           {-open and read the exclude file}
  429.         VAR
  430.           f : Text;
  431.           l : STRING[4];
  432.         BEGIN
  433.           IF verbose THEN
  434.             Write(Con, 'reading exclude file ', name);
  435.           Assign(f, name);
  436.           Reset(f);
  437.           WHILE NOT(EoF(f)) DO BEGIN
  438.             ReadLn(f, l);
  439.             IF l <> '' THEN BEGIN
  440.               IF l[1] = '.' THEN
  441.                 l := stupcase(Copy(l, 2, 3))
  442.               ELSE
  443.                 l := stupcase(Copy(l, 1, 3));
  444.               avoidnum := avoidnum+1;
  445.               avoidextension[avoidnum] := l;
  446.             END;
  447.           END;
  448.           Close(f);
  449.         END;                  {readexclude}
  450.  
  451.       BEGIN
  452.         IF fileexists(name1, 0) THEN readexclude(name1)
  453.         ELSE IF fileexists(name2, 0) THEN readexclude(name2)
  454.         ELSE IF verbose THEN BEGIN
  455.           WriteLn(Con, 'WARNING: exclude file not found....');
  456.           WriteLn(Con);
  457.         END;
  458.       END;                    {getexcludes}
  459.  
  460.     BEGIN
  461.       {get options}
  462.       IF ParamCount = 0 THEN
  463.         writehelp
  464.       ELSE BEGIN
  465.         WriteLn(Con);
  466.         {get default directory and disk}
  467.         GetDir(0, startpath);
  468.         {set default flags}
  469.         verbose := True;
  470.         wordstar := True;
  471.         casesens := False;
  472.         readexclude := True;
  473.         uselistfile := False;
  474.         avoidnum := 0;
  475.         haltsoon := False;
  476.         gotmatch := False;
  477.         recursive := False;
  478.         printheader := True;
  479.         lineoutput := True;
  480.         grandtotal := 0.0;
  481.         grandmatch := 0.0;
  482.         grandbytes := 0.0;
  483.         i := 1;
  484.         WHILE i <= ParamCount DO BEGIN
  485.           {analyze options}
  486.           param := ParamStr(i);
  487.           IF param[1] = optionchar THEN BEGIN
  488.             {an option}
  489.             IF Length(param) = 2 THEN BEGIN
  490.               c := UpCase(param[2]);
  491.               CASE c OF
  492.                 'R' : recursive := True;
  493.                 'Q' : verbose := False;
  494.                 'G' : wordstar := False;
  495.                 'C' : casesens := True;
  496.                 'N' : readexclude := False;
  497.                 'H' : printheader := False;
  498.                 'T' : lineoutput := False;
  499.                 'S' : BEGIN   {new start path follows}
  500.                         i := i+1;
  501.                         IF i <= ParamCount THEN
  502.                           startpath := stupcase(ParamStr(i))
  503.                         ELSE
  504.                           doerror('New start path not found....');
  505.                       END;
  506.                 'F' : BEGIN
  507.                         uselistfile := True;
  508.                         i := i+1;
  509.                         IF i <= ParamCount THEN
  510.                           listfilename := stupcase(ParamStr(i))
  511.                         ELSE
  512.                           doerror('ListFile name not found....');
  513.                       END;
  514.               END;
  515.             END ELSE
  516.               doerror('Unrecognized command option....'+ParamStr(i));
  517.           END ELSE BEGIN
  518.             {the match pattern}
  519.             IF NOT(gotmatch) THEN BEGIN
  520.               param := ParamStr(i)+endstr;
  521.               IF NOT(getccl(param, 1, matchpattern)) THEN
  522.                 doerror('Error during expansion of match string....')
  523.               ELSE
  524.                 {build the automaton}
  525.                 buildpattern(matchpattern, flink);
  526.               gotmatch := True;
  527.             END ELSE
  528.               doerror('More than one match pattern specified....'+ParamStr(i));
  529.           END;
  530.           i := i+1;
  531.         END;
  532.         IF NOT(gotmatch) THEN
  533.           doerror('No match pattern found....')
  534.         ELSE IF NOT(casesens) THEN
  535.           matchpattern := stupcase(matchpattern);
  536.         IF wordstar THEN wordmask := 127 ELSE wordmask := 255;
  537.         IF haltsoon THEN BEGIN
  538.           WriteLn(Con, 'Type TXTFIND for help....');
  539.           dohalt(2);
  540.         END;
  541.         IF uselistfile THEN BEGIN
  542.           recursive := False;
  543.           readexclude := False;
  544.         END;
  545.         IF readexclude THEN getexcludes;
  546.       END;
  547.     END;                      {setoptions}
  548.  
  549.   PROCEDURE setdta(VAR dta : dtarec);
  550.       {-set new DTA address}
  551.     BEGIN
  552.       reg.ah := $1A;
  553.       reg.ds := Seg(dta);
  554.       reg.dx := Ofs(dta);
  555.       MsDos(reg);
  556.     END;                      {setdta}
  557.  
  558.   PROCEDURE scantext(startpath : pathname);
  559.       {-get all files in pathname, scan them and output matches}
  560.       {-called recursively in recursive mode}
  561.     VAR
  562.       files : farray;
  563.       dname : drivename;
  564.       pname, usepath : pathname;
  565.       fname : filename;
  566.       filnum : Integer;
  567.       bufpos, bufcount : Integer;
  568.       endoffile : Boolean;
  569.  
  570.     PROCEDURE getfiles(attr : Integer; takeall : Boolean;
  571.                        VAR files : farray;
  572.                        VAR startpath : pathname);
  573.         {-return the files in the files array}
  574.       VAR
  575.         tempname, tempext : filename;
  576.  
  577.       PROCEDURE parsedta(VAR name, ext : filename);
  578.           {-return a name and extension from a DTA}
  579.         VAR
  580.           i : Byte;
  581.           tempname : filename;
  582.         BEGIN
  583.           i := 1;
  584.           WHILE dta.fullname[i] <> #0 DO i := i+1;
  585.           Move(dta.fullname, tempname[1], i-1);
  586.           tempname[0] := Chr(i-1);
  587.           i := Pos('.', tempname);
  588.           IF i = 0 THEN BEGIN
  589.             name := tempname;
  590.             ext := '';
  591.           END ELSE BEGIN
  592.             name := Copy(tempname, 1, i);
  593.             ext := Copy(tempname, i+1, 3);
  594.           END;
  595.         END;                  {parsedta}
  596.  
  597.       FUNCTION getfirst(attr : Integer; VAR startpath : pathname; VAR name, ext : filename) : Boolean;
  598.           {-return true and a name if first file is found}
  599.         VAR
  600.           foundone : Boolean;
  601.         BEGIN
  602.           reg.ah := $4E;
  603.           reg.ds := Seg(startpath);
  604.           reg.dx := Ofs(startpath[1]);
  605.           reg.cx := attr;
  606.           MsDos(reg);
  607.           foundone := ((reg.flags AND 1) = 0) AND ((dta.attr AND 16) = (attr AND 16));
  608.           IF foundone THEN
  609.             {scan the DTA for the file name and extension}
  610.             parsedta(name, ext);
  611.           getfirst := foundone;
  612.         END;                  {getfirst}
  613.  
  614.       FUNCTION getnext(VAR name, ext : filename) : Boolean;
  615.           {-return true and a name if another file is found}
  616.         VAR
  617.           foundone : Boolean;
  618.         BEGIN
  619.           reg.ah := $4F;
  620.           reg.ds := Seg(dta);
  621.           reg.dx := Ofs(dta);
  622.           MsDos(reg);
  623.           foundone := ((reg.flags AND 1) = 0) AND ((dta.attr AND 16) = (attr AND 16));
  624.           IF foundone THEN
  625.             {scan the DTA for the file name and extension}
  626.             parsedta(name, ext);
  627.           getnext := foundone;
  628.         END;                  {getnext}
  629.  
  630.       FUNCTION goodext(VAR ext : filename) : Boolean;
  631.           {-return true if ext is not one to avoid}
  632.         LABEL 1;
  633.         VAR
  634.           i : Integer;
  635.         BEGIN
  636.           goodext := True;
  637.           FOR i := 1 TO avoidnum DO
  638.             IF ext = avoidextension[i] THEN BEGIN
  639.               goodext := False;
  640.               GOTO 1;
  641.             END;
  642. 1:        
  643.         END;                  {goodext}
  644.  
  645.       PROCEDURE getlistoffiles;
  646.           {-open and read the listfile, check for file existence}
  647.         VAR
  648.           lfile : Text;
  649.           l : pathname;
  650.         BEGIN
  651.           IF fileexists(listfilename, 0) THEN BEGIN
  652.             Assign(lfile, listfilename);
  653.             Reset(lfile);
  654.             WITH files DO BEGIN
  655.               num := 0;
  656.               WHILE NOT(EoF(lfile)) DO BEGIN
  657.                 ReadLn(lfile, l);
  658.                 IF fileexists(l, 0) THEN BEGIN
  659.                   IF num < maxfiles THEN BEGIN
  660.                     num := num+1;
  661.                     arr[num] := l;
  662.                   END ELSE
  663.                     WriteLn(Con, 'Warning: exceeded file capacity. ignoring ', l);
  664.                 END ELSE
  665.                   WriteLn(Con, 'Warning: file ', l, ' not found. proceeding....');
  666.               END;
  667.             END;
  668.             Close(lfile);
  669.           END ELSE BEGIN
  670.             WriteLn(Con, 'ListFile ', listfilename, ' not found....');
  671.             Halt(2);
  672.           END;
  673.         END;                  {getlistoffiles}
  674.  
  675.  
  676.       BEGIN
  677.         IF uselistfile THEN
  678.           getlistoffiles
  679.         ELSE BEGIN
  680.           WITH files DO BEGIN
  681.             startpath[Length(startpath)+1] := #0;
  682.             num := 0;
  683.             IF getfirst(attr, startpath, tempname, tempext) THEN
  684.               REPEAT
  685.                 IF (takeall OR goodext(tempext)) AND
  686.                 (tempname <> '.') AND (tempname <> '..') THEN BEGIN
  687.                   num := num+1;
  688.                   arr[num] := tempname+tempext;
  689.                 END;
  690.               UNTIL (num = maxfiles) OR NOT(getnext(tempname, tempext));
  691.           END;
  692.         END;
  693.       END;                    {getfiles}
  694.  
  695.     PROCEDURE openfile(fname : pathstring; access : Integer; VAR handle, errcode : Integer);
  696.         {-open a file for reading and return the handle}
  697.       BEGIN
  698.         fname := fname+#0;
  699.         reg.ds := Seg(fname[1]); reg.dx := Ofs(fname[1]);
  700.         reg.ax := $3D00 OR access;
  701.         MsDos(reg);
  702.         IF (reg.flags AND 1) = 1 THEN
  703.           errcode := reg.ax
  704.         ELSE BEGIN
  705.           handle := reg.ax;
  706.           errcode := 0;
  707.         END;
  708.       END;                    {openfile}
  709.  
  710.     PROCEDURE closefile(handle : Integer);
  711.         {-close a file opened by openfile}
  712.       BEGIN
  713.         reg.bx := handle;
  714.         reg.ax := $3E00;
  715.         MsDos(reg);
  716.         IF (reg.flags AND 1) = 1 THEN BEGIN
  717.           WriteLn('problem closing file....');
  718.           dohalt(2);
  719.         END;
  720.       END;                    {closefile}
  721.  
  722.     PROCEDURE writeline(handle : Integer; VAR l : line);
  723.         {-send a long line to the specified file or device with a CR/LF at end}
  724.       VAR
  725.         len : Integer ABSOLUTE l;
  726.       BEGIN
  727.         l[len+1] := #13;
  728.         l[len+2] := #10;
  729.         reg.bx := handle;
  730.         reg.cx := len+2;
  731.         reg.ds := Seg(l[1]);
  732.         reg.dx := Ofs(l[1]);
  733.         reg.ax := $4000;
  734.         MsDos(reg);
  735.         IF (reg.flags AND 1) = 1 THEN BEGIN
  736.           WriteLn(Con);
  737.           WriteLn(Con, 'ERROR during write....');
  738.           dohalt(2);
  739.         END;
  740.       END;                    {writeline}
  741.  
  742.     PROCEDURE readline(inhandle : Integer; VAR l : line);
  743.         {-read a long line}
  744.       VAR
  745.         c : Byte;
  746.         gotline : Boolean;
  747.         len : Integer ABSOLUTE l;
  748.         bufstart, lstart, tmp : Integer;
  749.  
  750.       PROCEDURE BlockRead(inhandle : Integer; VAR b : buffer; VAR count : Integer);
  751.           {-read a chunk of characters from the specified handle}
  752.         BEGIN
  753.           reg.bx := inhandle;
  754.           reg.cx := BufLen;
  755.           reg.ds := Seg(b[1]);
  756.           reg.dx := Ofs(b[1]);
  757.           reg.ax := $3F00;
  758.           MsDos(reg);
  759.           count := reg.ax;
  760.         END;                  {blockread}
  761.  
  762.       BEGIN
  763.         len := 0; gotline := False; bufstart := bufpos; lstart := 1;
  764.         REPEAT
  765.           IF (bufpos > bufcount) THEN BEGIN
  766.             {get a new buffer full}
  767.             BlockRead(inhandle, buf, bufcount);
  768.             endoffile := (bufcount = 0);
  769.             gotline := endoffile;
  770.             IF NOT(endoffile) THEN BEGIN
  771.               IF buf[1] = 10 THEN BEGIN
  772.                 {skip over the line feed}
  773.                 bufpos := 2;
  774.                 bufstart := 2;
  775.               END ELSE BEGIN
  776.                 bufpos := 1;
  777.                 bufstart := 1;
  778.               END;
  779.               grandbytes := grandbytes+bufcount;
  780.             END;
  781.           END;
  782.           WHILE (bufpos <= bufcount) AND NOT(gotline) DO BEGIN
  783.             IF wordstar THEN BEGIN
  784.               {apply wordstar .DOC filter}
  785.               c := buf[bufpos] AND wordmask;
  786.               IF c = 30 THEN c := 32
  787.               ELSE IF c = 31 THEN c := 45;
  788.               buf[bufpos] := c;
  789.             END ELSE
  790.               c := buf[bufpos];
  791.             IF (c = 13) OR (c = 26) THEN BEGIN
  792.               {end of line and perhaps end of file}
  793.               endoffile := (c = 26); gotline := True;
  794.               tmp := bufpos-bufstart; len := len+tmp;
  795.               Move(buf[bufstart], l[lstart], tmp);
  796.               bufpos := bufpos+1;
  797.               {skip over the linefeed following #13}
  798.               IF (bufpos <= bufcount) THEN IF buf[bufpos] = 10 THEN bufpos := bufpos+1;
  799.             END ELSE BEGIN
  800.               IF len+bufpos-bufstart < ncrlinlen THEN BEGIN
  801.                 {almost all cycles pass through here}
  802.                 bufpos := bufpos+1;
  803.               END ELSE BEGIN
  804.                 {line too long, break it, don't increment bufpos}
  805.                 gotline := True;
  806.                 tmp := bufpos-bufstart; len := len+tmp;
  807.                 Move(buf[bufstart], l[lstart], tmp);
  808.               END;
  809.             END;
  810.           END;
  811.           IF NOT(gotline) THEN BEGIN
  812.             {end of buffer without finishing line}
  813.             tmp := bufpos-bufstart; len := len+tmp;
  814.             Move(buf[bufstart], l[lstart], tmp);
  815.             lstart := bufpos-bufstart+1;
  816.             {exit when file does not end with ^Z}
  817.             IF endoffile THEN gotline := True;
  818.           END;
  819.         UNTIL gotline;
  820.       END;                    {readline}
  821.  
  822.     PROCEDURE matchup(VAR fname : pathname);
  823.         {-scan the file fname looking for the matchpattern}
  824.       VAR
  825.         usepath : pathname;
  826.         handle : Integer;
  827.         lcount, mcount : Integer;
  828.         l : line;
  829.         errcode : Integer;
  830.  
  831.       FUNCTION linematch(VAR l : line) : Boolean;
  832.           {-return true if line matches matchpattern}
  833.         VAR
  834.           start, stop : Integer;
  835.           len : Integer ABSOLUTE l;
  836.           matched : Boolean;
  837.           l1 : line;
  838.  
  839.         PROCEDURE longupcase(VAR s, s1 : line);
  840.             {-return uppercase value of string, special version for long lines}
  841.           VAR
  842.             i : Integer;
  843.             len : Integer ABSOLUTE s;
  844.             len1 : Integer ABSOLUTE s1;
  845.           BEGIN
  846.             FOR i := 1 TO len DO s1[i] := UpCase(s[i]);
  847.             len1 := len;
  848.           END;                {longupcase}
  849.  
  850.         PROCEDURE copyof(VAR s, s1 : line);
  851.             {-return copy of string, special version for long lines}
  852.           VAR
  853.             i : Integer;
  854.             len : Integer ABSOLUTE s;
  855.           BEGIN
  856.             FOR i := -1 TO len DO s1[i] := s[i];
  857.           END;                {copyof}
  858.  
  859.         FUNCTION kmpscan(VAR l : line; start : Integer;
  860.                          VAR stop : Integer) : Boolean;
  861.             {-scan the line for a match, return true if found}
  862.             {-start at position start in l}
  863.             {-return stop as the next unmatched position after the last matched position}
  864.           VAR
  865.             len : Integer ABSOLUTE l;
  866.             i, j : Integer;
  867.             c : Char;
  868.             unmatched : Boolean;
  869.           BEGIN
  870.             i := start; j := 1; unmatched := True;
  871.             WHILE (i <= len) AND unmatched DO BEGIN
  872.               c := l[i];
  873.               WHILE (j <> 0) AND (matchpattern[j] <> c) DO j := flink[j];
  874.               IF j = matchlen THEN unmatched := False ELSE j := j+1;
  875.               i := i+1;
  876.             END;
  877.             stop := i;
  878.             kmpscan := NOT(unmatched);
  879.           END;                {kmpscan}
  880.  
  881.         BEGIN
  882.           {apply filter}
  883.           IF NOT(casesens) THEN
  884.             longupcase(l, l1)
  885.           ELSE
  886.             copyof(l, l1);
  887.  
  888.           {scan the line for matches}
  889.           start := 1;
  890.           matched := False;
  891.           WHILE start <= len DO BEGIN
  892.             matched := kmpscan(l1, start, stop);
  893.             IF matched THEN
  894.               {force exit}
  895.               stop := len+1;
  896.             start := stop;
  897.           END;
  898.           linematch := matched;
  899.         END;                  {linematch}
  900.  
  901.       PROCEDURE writeoutput(VAR l : line; lcount : Integer; VAR usepath : pathname);
  902.           {-write output for selected lines}
  903.         VAR
  904.           outline : longstring;
  905.           lstring : filename;
  906.  
  907.         PROCEDURE putl(VAR l : longstring);
  908.             {-send a short line to the standard output}
  909.           VAR
  910.             len : Byte ABSOLUTE l;
  911.             tlen : Byte;
  912.           BEGIN
  913.             tlen := len+2;
  914.             l[len+1] := #13;
  915.             l[tlen] := #10;
  916.             reg.bx := 1;
  917.             reg.cx := tlen;
  918.             reg.ds := Seg(l[1]);
  919.             reg.dx := Ofs(l[1]);
  920.             reg.ah := $40;
  921.             MsDos(reg);
  922.             IF (reg.flags AND 1) = 1 THEN BEGIN
  923.               WriteLn('ERROR: cannot write to output device....');
  924.               dohalt(2);
  925.             END;
  926.             IF reg.ax <> tlen THEN BEGIN
  927.               WriteLn('ERROR: disk full....');
  928.               dohalt(2);
  929.             END;
  930.           END;                {putl}
  931.  
  932.         BEGIN
  933.           IF verbose THEN BEGIN
  934.             GoToXY(1, WhereY); ClrEol;
  935.           END;
  936.           IF printheader THEN BEGIN
  937.             Str(lcount:7, lstring);
  938.             outline := '['+lstring+'] '+usepath;
  939.             putl(outline);
  940.           END;
  941.           IF lineoutput THEN BEGIN
  942.             writeline(1, l);
  943.             outline := '';
  944.             putl(outline);
  945.           END;
  946.           mcount := mcount+1;
  947.           IF verbose THEN Write(Con, lcount:8, mcount:8, '  ', usepath);
  948.         END;                  {writeoutput}
  949.  
  950.       BEGIN
  951.         IF uselistfile THEN
  952.           usepath := fname+#0
  953.         ELSE
  954.           usepath := dname+pname+fname+#0;
  955.         openfile(usepath, 0, handle, errcode);
  956.  
  957.         IF errcode = 0 THEN BEGIN
  958.           {ready to read and match file}
  959.           lcount := 0; mcount := 0;
  960.           bufpos := 1; bufcount := 0; endoffile := False;
  961.           IF verbose THEN
  962.             Write(Con, lcount:8, mcount:8, '  ', usepath);
  963.           WHILE NOT(endoffile) DO BEGIN
  964.             readline(handle, l);
  965.             IF breakpressed THEN BEGIN
  966.               closefile(handle);
  967.               dohalt(1);
  968.             END;
  969.             lcount := lcount+1;
  970.             IF verbose AND ((lcount MOD 16) = 0) THEN BEGIN
  971.               GoToXY(1, WhereY);
  972.               Write(Con, lcount:8);
  973.             END;
  974.             IF linematch(l) THEN writeoutput(l, lcount, usepath);
  975.           END;
  976.           grandtotal := grandtotal+lcount;
  977.           grandmatch := grandmatch+mcount;
  978.           closefile(handle);
  979.           IF verbose THEN BEGIN
  980.             GoToXY(1, WhereY); ClrEol;
  981.           END;
  982.         END ELSE BEGIN
  983.           WriteLn(Con);
  984.           WriteLn(Con, 'PROGRAM ERROR in Matchup: file ', fname, ' not found');
  985.         END;
  986.       END;                    {matchup}
  987.  
  988.     BEGIN
  989.       {get a list of all normal, readonly, hidden matching files in startpath}
  990.       parsepath(startpath, dname, pname, fname);
  991.       usepath := dname+pname+fname;
  992.       IF verbose AND NOT(uselistfile) THEN BEGIN
  993.         GoToXY(1, WhereY); ClrEol;
  994.         Write(Con, 'Reading directory of ', usepath);
  995.       END;
  996.       getfiles(3, False, files, usepath);
  997.       IF verbose THEN BEGIN
  998.         GoToXY(1, WhereY); ClrEol;
  999.       END;
  1000.  
  1001.       {check each file for match pattern}
  1002.       FOR filnum := 1 TO files.num DO matchup(files.arr[filnum]);
  1003.  
  1004.       {look at subdirectories}
  1005.       IF recursive THEN BEGIN
  1006.         {get all subdirectories}
  1007.         usepath := dname+pname+'*.*';
  1008.         getfiles(19, True, files, usepath);
  1009.         {look in the subdirectories}
  1010.         FOR filnum := 1 TO files.num DO BEGIN
  1011.           {build a pathname to the subdirectory}
  1012.           usepath := dname+pname+files.arr[filnum]+'\'+fname;
  1013.           {call recursively}
  1014.           scantext(usepath);
  1015.         END;
  1016.       END;
  1017.     END;                      {scantext}
  1018.  
  1019.   PROCEDURE time(VAR sec : Real);
  1020.       {-return time of day in seconds since midnight}
  1021.     BEGIN
  1022.       reg.ah := $2C;
  1023.       MsDos(reg);
  1024.       sec := 1.0*(reg.dh+60.0*(reg.cl+60.0*reg.ch)+reg.dl/100.0);
  1025.     END;                      {time}
  1026.  
  1027.   PROCEDURE writeresults;
  1028.     BEGIN
  1029.       WriteLn(Con, 'lines:   ', grandtotal:7:0);
  1030.       WriteLn(Con, 'matches: ', grandmatch:7:0);
  1031.       WriteLn(Con, 'bytes:   ', grandbytes:7:0);
  1032.       IF tstop-tstart > 0 THEN BEGIN
  1033.         WriteLn(Con, 'line rate: ', (grandtotal/(tstop-tstart)):5:1, ' lines/sec');
  1034.         WriteLn(Con, 'byte rate: ', (grandbytes/(tstop-tstart)):5:0, ' bytes/sec');
  1035.       END;
  1036.     END;                      {writeresults}
  1037.  
  1038.   BEGIN
  1039.     setdta(dta);
  1040.     setoptions;
  1041.     setbreak;
  1042.     time(tstart);
  1043.     scantext(startpath);
  1044.     time(tstop);
  1045.     writeresults;
  1046.   END.
  1047.