{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.

     This program demonstrates the use of FIND_FIRST and FIND_NEXT, contained
     in GETFILE.LIB.  You can enter a "template" (e.g., "*.COM", "BASIC*.*",
     "FILE????.CHK") and a set of file attributes, and get back a list of
     all the files matching the template and the attributes.

     "Ordinary" files will be found along with those with special attributes.
     If you specify [E]xclusive, only those files with EXACTLY the attributes
     you selected will be shown.  Thus, if your DOS disk is in drive A, you
     might ask for "a:*.*" with attributes "RHS" and [E]xclusive, and you
     would get the IBMBIOS.COM and IBMDOS.COM.

     For another use of GETFILE, see ALLFILES

}
program get_file;
{$I filename.typ}
{$I regpack.typ}
{$I getfile.lib}
type
  AttString = string[6];
  CharSet   = set of char;
const
  AttChars : charset = ['R','H','S','V','D','A','Q'];
var
  att, choice : char;
  row, N      : byte;
  atts        : AttString;
  okay        : boolean;
  attribyte,
  OldAttribute : byte;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
function convert(attribute:byte):AttString;
var
  temp : attString;
begin
  temp := '      ';
  if attribute and 1 = 1 then temp[1] := 'R';
  if attribute and 2 = 2 then temp[2] := 'H';
  if attribute and 4 = 4 then temp[3] := 'S';
  if attribute and 8 = 8 then temp[4] := 'V';
  if attribute and 16 = 16 then temp[5] := 'D';
  if attribute and 32 = 32 then temp[6] := 'A';
  convert := temp;
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
function UnConvert(atts : attString):byte;
var
  temp : byte;
begin
  temp := 0;
  if pos('R',atts) <> 0 then temp := temp + 1;
  if pos('H',atts) <> 0 then temp := temp + 2;
  if pos('S',atts) <> 0 then temp := temp + 4;
  if pos('V',atts) <> 0 then temp := temp + 8;
  if pos('D',atts) <> 0 then temp := temp + 16;
  if pos('A',atts) <> 0 then temp := temp + 32;
  UnConvert := temp;
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
begin
    for row := 1 to 24 do
      begin
        gotoXY(40,row);
        write('º');
      end;
    repeat
      window(1,1,39,25);
      ClrScr;
      WriteLn('Enter the template for files sought.');
      WriteLn('It can contain "wildcard" characters');
      WriteLn('"*" and "?".');
      ReadLn(filename);
      WriteLn('Enter the attribute(s) to seek:');
      WriteLn('[R]ead-only, [H]idden, [S]ystem, ');
      WriteLn('[V]olume-label, [D]irectory, [A]rchive');
      WriteLn('or [Q]uit.');
      repeat
        okay := true;                           {----------------------}
        GotoXY(1,WhereY);                       { This segment just    }
        read(atts);                             { makes sure that      }
        for N := 1 to length(atts) do           { the input is legit.  }
          begin                                 { If you use GETFILE   }
            atts[N] := UpCase(atts[N]);         { in your own programs,}
            if not (atts[N] in AttChars) then   { you will probably    }
              okay := false;                    { enter the attribute  }
          end;                                  { directly as a byte.  }
      until okay;                               {----------------------}
      attribyte := unConvert(atts);
      if attribyte <> 0 then
        begin
          WriteLn; WriteLn;
          WriteLn('[E]xclusive or [I]nclusive?');
          WriteLn('(i.e., show ONLY files with');
          WriteLn('exactly the specified attributes');
          WriteLn('or all "normal" files plus those');
          WriteLn('with the specified attributes).');
          WriteLn('  NOTE: specify [E] if you just');
          WriteLn('  want the [V]olume label.');
          repeat
            repeat until keypressed;
            read(choice);
            choice := UpCase(choice);
            writeLn(choice);
          until choice in ['E','I'];
          window(41,1,80,25);
          ClrScr;
          OldAttribute := attribyte;

{ Step one--Find the First file matching our criteria.}

          Find_First(attribyte,filename,error);
          if error = 0 then
            begin

              { If we asked for [E]xclusive choices, we want to
              screen out any files that do not have exactly the
              same attributes as our request.  However, we don't
              care whether or not the ARCHIVE bit is set.  Thus
              the condition "if attribyte MOD 32 = OldAttribute}

              if choice = 'E' then
                begin
                  if attribyte mod 32 = OldAttribute then
                     WriteLn(filename,'   ',convert(attribyte));
                end
              else WriteLn(filename,'   ',convert(attribyte));

    {Now we repeat Find_Next until it DOESN't Find a Next--
     that is, until error <> 0  }

              repeat
                Find_Next(attribyte,filename,error);
                if error = 0 then
                  begin
                    if choice = 'E' then
                      begin
                        if attribyte mod 32 = OldAttribute then
                           WriteLn(filename,'   ',convert(attribyte));
                      end
                    else WriteLn(filename,'   ',convert(attribyte));
                    if WhereY >= 24 then                {-----------------}
                      begin                             { Stop when screen}
                        WriteLn('Press a key...');      { gets full.      }
                        repeat until keypressed;        {-----------------}
                        ClrScr;
                      end;
                  end;
               until error <> 0;
               WriteLn('Press a key . . .');
               repeat until keypressed;
               ClrScr;
            end;
        end;
    until attribyte = 0;
    window(1,1,80,25);
ClrScr;
end.

     else error := 0;
    end;
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@