program FQ;                                       { 8/31/87 }
(*--------------------------------------------------------------------
                                 FINDLQ.PAS
                                  VERSION 1.1
            Library Utility to find a string in squeezed or
                  ASCII file members of a library.

This bugger is slow, but it works!

future enhancements:
    allow printer enabling at the screen or directory level
    allow display of one line at a time from paused view mode
    allow wildcarding for all disk files?
    allow specifying a string to "find & read"--viewing the file does not
       begin until the section where the string is found
    read file into memory for forward / backward scrolling

fixes:
10/20/87  JF the [more]... prompt no longer appears when printing
          to printer or file and the version number no longer appears
          twice in the Help screen.  If pause has been disabled, the
          fill lines (blank lines) at the end of the file now obey the delay
          setting.  The delay intervals have been lengthened because
          I couldn't keep up with it while reading at slowest speed (8).

----------------------------------------------------------------------*)
{$V-,C-}
const
  version   = 'FINDLQ version 1.1';
  null      = #0;
  abort     = #3;
  bell      = #7;
  bksp      = #8;
  tab       = #9;
  lnfd      = #10;
  cr        = #13;
  esc       = #27;
  space     = ' ';
  conin     = 1;
type
  str12     = string[12];
  str16     = string[16];
  name      = string[14];
  longname  = string[25];
  filbuffer = array[0..127] of byte;
  line      = string[80];
  person    = string[27];
  long      = string[150];

var
  fnArray : array[1..99] of str12;
  curuser, L , register_A     :    byte;
  libfile:    file;
  libbuff:    filbuffer;
  libeof:     boolean;
  message:    name;
  buffer:     long;
  libsects,
  charcount,
  lastspace,
  bufpointer,
  width:      integer;
  caps:     boolean;
  ch,exitchar, bl, lf, bs     : char;
  fstr : str16;
  continue : char;
  lptr, a,lct,fullct, D : integer;
  pause, fileout, conout, finding, cancelled : boolean;
  upl, outl,
  inbuffer  : line;
  dev : text;
  lastarg : longname;

function match: boolean;
begin
match := (pos(fstr,upl) > 0) or not(finding);
end;

procedure sendout(ch: char);
begin
if not (finding) then
   begin
        write(dev,ch);
        lptr := succ(lptr);
        if ch = cr then lptr := 0;
        if ch = tab then
          begin
           if (lptr mod 8) = 0 then                     {attempted fix}
             begin  write(' '); lptr := succ(lptr); end;
           repeat write (' '); lptr := succ(lptr); until (lptr mod 8) = 0 ;
          end;
    end
 else
  begin
  if (ch = tab) then
     begin
       outl := outl + ' '; upl := upl + ' ';
       repeat  outl := outl + ' '; upl := upl + ' ';
       until ((length(outl) mod 8) = 0);
     end else
  outl := outl + ch;
  if (ch = cr) or (ch = #$8D) or (length(outl) = 80) then
    begin
      upl := outl;
      if fstr = paramstr(2) then
        begin
          for a := 1 to length(upl) do
          upl[a] := upcase(outl[a]);
        end;
      if match then
        begin
          for a:= 1 to length(outl) do
          write(dev,outl[a]);
        end;
      outl := '';
      upl := '';
    end;
  end;
end;

procedure searchlib(infile: name; var result, libsects: integer);

{Library-file support adapted from DELIB.PAS
 by Bela Lubkin of Borland International.}

  var
    showbuff : longname;
    temp: name;
    dirlength, offset, firstsec, loop, chrpos: integer;



  begin
    firstsec := 0; libsects := 0;
    blockread(libfile, libbuff, 1);
    if libbuff[0] <> 0 then result := 1;
    loop := 1;
    while (result = 0) and (loop <= 11) do begin
  {step through libbuff from byte 1 to 11 until you encounter something other
     than a space (decimal 32) -- set result to 1 on first non-space }
      if libbuff[loop] <> 32 then result := 1;
      loop := loop + 1;
    end;
    result := result + libbuff[12] + libbuff[13];
    if result = 0 then begin
      dirlength := libbuff[14] + 256*libbuff[15];
      if dirlength = 0 then result := 1;
    end;
    if result = 0 then begin
      loop := 0;
      while (loop < 4*dirlength-1) and (result = 0) and (firstsec = 0) do begin
        loop := loop + 1;
        offset := 32*(loop mod 4);
        if offset = 0 then blockread(libfile, libbuff, 1);
  { the following line is commented out because with it the program would not }
  {  recognize any files beyond the first deleted library entry [joe fremer] }
  {      if libbuff[offset] <> 0 then result := 1
        else begin                                  }
        if libbuff[offset] = 0 then begin
          temp := '';
          for chrpos := 1 to 8 do
            if libbuff[offset + chrpos] <> 32 then
              temp := temp + chr(libbuff[offset + chrpos]);
          if libbuff[offset + 9] <> 32 then begin
            temp := temp + '.';
            for chrpos := 9 to 11 do
              if libbuff[offset + chrpos] <> 32 then
                temp := temp + chr(libbuff[offset + chrpos]);
          end;
          if  (infile = 'DIR') then fnArray[Loop] := temp;
             {begin
               showbuff := temp;
               while length(showbuff) < 15 do showbuff := showbuff + ' ';
               write(showbuff,':');
             end;}
          if infile = temp then begin
            firstsec := libbuff[offset+12] + 256*libbuff[offset+13];
            libsects := libbuff[offset+14] + 256*libbuff[offset+15];
            seek(libfile, firstsec);
          end;
        end;
      end;
      if infile = 'DIR' then result := 0;
    end;
  end;

procedure libassign(filename: longname; var result: integer);

  var
    infile: name;
    slash: integer;
    library: boolean;

  begin
    result := 0;
    slash := pos('/', filename);
    library := (slash > 0);
    if library then begin
      infile := copy(filename, slash + 1, length(filename) - slash);
      filename := copy(filename, 1, slash - 1);
      if pos('.', filename) = 0 then filename := filename + '.LBR';
    end;
    assign(libfile, filename);
    {$I-} reset(libfile) {$I+};
    result := IOresult;
    if result = 0 then
      if library then searchlib(infile, result, libsects)
      else libsects := filesize(libfile);
    libeof := (libsects = 0);
  end;

procedure libblockread(var fileblock: filbuffer);

  begin
    if libsects > 0 then blockread(libfile, fileblock, 1);
    libsects := libsects - 1;
    if libsects = 0 then libeof := true;
  end;


{$I fqtype.inc}
procedure Showarray;
{takes the array of member file names and outputs them, numbered, to the screen
  4 wide and 20 down}
var
DArray  : array[1..4,1..20] of str16;
m,n : byte;
G : string[2];

begin
fillchar(Darray,sizeof(DArray),0);
L := 1;
repeat
  m := (trunc(L div 20)+1) ;
  n := ((L-1) mod 20) + 1;
  if length(fnArray[L]) > 0 then
    begin
      Str(L:2,G);
      DArray[m,n] := G + ' ' + fnArray[L] + ' ';
      while length(DArray[m,n]) < 16 do DArray[m,n] := Darray[m,n] + ' ';
      L := succ(L);
    end else L := 100;
until (L=100) ;
L := 1;{`}
for n:= 1 to 20 do
  begin
    for m := 1 to 4 do
      begin
        if length(Darray[m,n]) > 0 then
        write(DArray[m,n],'  '); {1,1 2,1 3,1 4,1 5,1;  1,2  2,2  3,2  etc.}
        L := succ(L);
      end;
      writeln;
  end;  {for}
end;

{$I fqhelp.inc}

procedure parsefilename(parameter : longname; var fnm : longname);
var a , ubyte : integer;
user : string[2];

begin
a := pos(':',parameter);
if (a = 0) or (upcase(parameter[pred(a)]) in ['A'..'P'])  then
fnm := parameter else
begin
if parameter[pred(a)] in ['0'..'9'] then
   begin
   if (parameter[1] in ['0'..'9'] )
    then begin
            user := copy(parameter,1,a - 1);
            fnm := copy(parameter,succ(a),length(parameter) - a);
         end
    else
    if parameter[1] in ['A'..'P']
    then begin
             fnm := parameter[1] +
             copy(parameter,a,length(parameter) - pred(a));
             user := copy(parameter,2,a - 2);
         end;
   end;
   val(user,ubyte,a);
   {NOTE : the following lines must be commented out for MS-DOS use}
   curuser := bdos($20,$FF);
   bdos($20,ubyte);
end;
end;


var nw : boolean;
   ifn,fn : longname;
   result : integer;
   filnum : integer;
   outfile : name;

begin
fillchar(fnArray,sizeof(fnArray),0);
nw := false;
assign(dev,'CON:');
conout := true;
fileout := false;
cancelled := false;
fstr := '';
lastarg := '';
outfile := '';
curuser := 99;  {this way we can tell if the user number has changed}
writeln(version);
{paramstr and paramcount are for Turbo Pascal version 3.0 or greater}
if paramcount = 0 then Help;
lastarg := paramstr(paramcount);
if lastarg = 'P' then
   begin
     assign(dev,'LST:');
     conout := false;
   end;
if lastarg = 'F' then
   begin
     FILEOUT := TRUE;
     conout := false;
     write('Output file name: ');
     read(outfile);
     assign(dev,outfile);
     {$I+}
     rewrite(dev);
     {$I-}
     if ioresult <> 0 then begin
        write(' error: that file exists.'); halt;
        end;
   end;
parsefilename(paramstr(1),fn);
                {sets the user number if du: filespec is used}
if ((paramcount = 2) and (conout)) or (paramcount > 2) then
fstr := paramstr(2);

ifn := '';
if (pos('/',fn) = 0) and ((pos('.LBR',fn) = pos('.',fn)))
and (paramcount > 0 ) then
  begin
    ifn := '';
      filnum := 0;
      cancelled := false;
      writeln;
    repeat
      typefile(fn + '/DIR',nw);  {loads fnArray}
      if (fstr <> paramstr(2)) or (paramcount = 1) then
      BEGIN
      showarray;
      writeln;
      write('Enter number of file to read-->');
      repeat
        readln(ifn);
            if (ifn = '') then
               begin cancelled := true ;
                     result := 0;
               end
            else
               begin
                    val(ifn,filnum,result);
                    if (result <> 0) or (filnum > 80) then write(^G);
               end;
      until result = 0;
      ifn := fnArray[filnum];
      ifn := fn + '/' + ifn;
      writeln;
      if not(cancelled) then
        begin
             write('String to find: ');
             readln(fstr);
        end;
        if fstr = '' then finding := false else finding := true;
      END
      ELSE {there is a string-to-find on the command line}
      begin
          if keypressed then cancelled := true;
          finding := true;
          filnum := succ(filnum);
          if fnArray[filnum] = '' then cancelled := true else
            ifn := fn + '/' + fnArray[filnum];
      end;
      if not (cancelled) then typefile(ifn,nw);
    until cancelled ;
  end
else
begin
writeln;
if fstr = '' then
        begin
             write('String to find: ');
             readln(fstr);
        end;
if fstr = '' then finding := false else finding := true;
typefile(fn,nw);
end;
IF FILEOUT THEN begin
 if curuser < 99 then bdos($20,curuser);
CLOSE(DEV);
end;
END.