home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ADC_TP3.ZIP / GETFIL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-01  |  9.3 KB  |  304 lines
  1. {$C-}
  2. {
  3.       G E T F I L E . P A S
  4.   written by Neil J. Rubenking
  5.  
  6.  
  7. This program demonstrates the use of FIND_FIRST and FIND_NEXT, contained
  8. in GETFILE.LIB.  You can enter a "template" (e.g., "*.COM", "BASIC*.*",
  9. "FILE????.CHK") and a set of file attributes, and get back a list of
  10. all the files matching the template and the attributes.
  11.  
  12. "Ordinary" files will be found along with those with special attributes.
  13. If you specify [E]xclusive, only those files with EXACTLY the attributes
  14. you selected will be shown.  Thus, if your DOS disk is in drive A, you
  15. might ask for "a:*.*" with attributes "RHS" and [E]xclusive, and you
  16. would get the IBMBIOS.COM and IBMDOS.COM.
  17.  
  18. }
  19. PROGRAM get_file;
  20. TYPE
  21.   filename_type = STRING[64];
  22.   regpack = RECORD
  23.               ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer;
  24.             END;
  25.  
  26. {!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!
  27. separate the following code out into  G E T F I L E . L I B
  28. !?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!}
  29.   {
  30.   GETFILE consists of a set of three procedures based on a variable-type
  31.   BUFFER-TYPE, which is the exact "shape" of the information returned by
  32.   DOS function calls $4E (Find First matching file) and $4F (Find Next).
  33.  
  34.   SetDTA is called by Find_First to Set the Data Transfer Area to the Buffer.
  35.  
  36.   Find_First takes as input the file attribute and name-template of the file
  37.   required and returns the actual attribute found, the first matching name,
  38.   and an error code.
  39.  
  40.   Find_Next takes no input, but the buffer must be initialized by Find_First.
  41.   The output of Find_Next is the same as that of Find_First.
  42.  
  43.   Any program that calls GETFILE must also include the standard type definitions
  44.   for "filename_type" and "regPack".
  45.  
  46.   }
  47.  
  48.  
  49. TYPE
  50.   buffer_type = RECORD
  51.                   reserved : ARRAY[1..21] OF Byte;
  52.                   attribute : Byte;
  53.                   time, date, FileSizeLo, FileSizeHi : Integer;
  54.                   name : STRING[13];
  55.                 END;
  56. VAR
  57.   filename : filename_type;
  58.   buffer : buffer_type;
  59.   attribute : Byte;
  60.  
  61.  
  62.   PROCEDURE SetDTA(VAR buff);
  63.   VAR
  64.     registers : regpack;
  65.   BEGIN
  66.     WITH registers DO
  67.       BEGIN
  68.         AX := $1A SHL 8;
  69.         DS := Seg(buff);
  70.         DX := Ofs(buff);
  71.         MsDos(registers);
  72.       END;
  73.   END;
  74.  
  75.  
  76.   PROCEDURE Find_Next(VAR att : Byte; VAR filename : filename_type;
  77.                       VAR Next_error : Byte);
  78.   VAR
  79.     registers : regpack;
  80.     carry_flag : Integer;
  81.     N : Byte;
  82.   BEGIN
  83.     FillChar(buffer.name, SizeOf(buffer.name), 0);
  84.     WITH registers DO
  85.       BEGIN
  86.         AX := $4F SHL 8;
  87.         MsDos(registers);
  88.         att := buffer.attribute;
  89.         carry_flag := 1 AND Flags;
  90.         filename := '             ';
  91.         IF carry_flag = 1 THEN
  92.           Next_error := AX AND $00FF
  93.         ELSE
  94.           BEGIN
  95.             Next_error := 0;
  96.             FOR N := 0 TO 12 DO FileName[N+1] := buffer.name[N];
  97.           END;
  98.       END;                    {with}
  99.     att := buffer.attribute;
  100.   END;
  101.  
  102.  
  103.   PROCEDURE Find_First(VAR att : Byte;
  104.                        VAR filename : filename_type;
  105.                        VAR error_code : Byte);
  106.  
  107.   VAR
  108.     registers : regpack;
  109.     carry_flag : Integer;
  110.     mask, N : Byte;
  111.  
  112.   BEGIN
  113.     SetDTA(buffer);
  114.     filename[Length(filename)+1] := Chr(0);
  115.     FillChar(buffer.name, SizeOf(buffer.name), 0);
  116.     WITH registers DO
  117.       BEGIN
  118.         AX := $4E SHL 8;
  119.         CX := att;
  120.         DS := Seg(filename);
  121.         DX := Ofs(filename)+1;
  122.         MsDos(registers);
  123.         att := buffer.attribute;
  124.         { If there was an error set the error code and don't do
  125.         anything else. }
  126.  
  127.         carry_flag := 1 AND Flags;
  128.         IF carry_flag = 1 THEN
  129.           BEGIN
  130.             error_code := AX AND $00FF;
  131.           END
  132.         ELSE
  133.           BEGIN
  134.             error_code := 0;
  135.             filename := '             ';
  136.             FOR N := 0 TO 12 DO FileName[N+1] := buffer.name[N];
  137.           END;
  138.       END;                    {with}
  139.   END;
  140. {!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!
  141.   end of   G E T F I L E . L I B
  142. !?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!!?!?!?!?!?!}
  143.  
  144. TYPE
  145.   AttString = STRING[6];
  146.   CharSet = SET OF Char;
  147. CONST
  148.   AttChars : charset = ['R', 'H', 'S', 'V', 'D', 'A', 'Q'];
  149. VAR
  150.   att, choice, dummy : Char;
  151.   row, N : Byte;
  152.   atts : AttString;
  153.   okay : Boolean;
  154.   error,
  155.   attribyte,
  156.   OldAttribute : Byte;
  157.   chars : set of char;
  158.  
  159.   FUNCTION convert(attribute : Byte) : AttString;
  160.   VAR
  161.     temp : attString;
  162.   BEGIN
  163.     temp := '      ';
  164.     IF attribute AND 1 = 1 THEN temp[1] := 'R';
  165.     IF attribute AND 2 = 2 THEN temp[2] := 'H';
  166.     IF attribute AND 4 = 4 THEN temp[3] := 'S';
  167.     IF attribute AND 8 = 8 THEN temp[4] := 'V';
  168.     IF attribute AND 16 = 16 THEN temp[5] := 'D';
  169.     IF attribute AND 32 = 32 THEN temp[6] := 'A';
  170.     convert := temp;
  171.   END;
  172.  
  173.  
  174.   FUNCTION UnConvert(atts : attString) : Byte;
  175.   VAR
  176.     temp : Byte;
  177.   BEGIN
  178.     temp := 0;
  179.     IF Pos('R', atts) <> 0 THEN temp := temp+1;
  180.     IF Pos('H', atts) <> 0 THEN temp := temp+2;
  181.     IF Pos('S', atts) <> 0 THEN temp := temp+4;
  182.     IF Pos('V', atts) <> 0 THEN temp := temp+8;
  183.     IF Pos('D', atts) <> 0 THEN temp := temp+16;
  184.     IF Pos('A', atts) <> 0 THEN temp := temp+32;
  185.     UnConvert := temp;
  186.   END;
  187.  
  188.  
  189.  
  190. BEGIN       { main program }
  191.   ClrScr;
  192.   FOR row := 1 TO 24 DO
  193.     BEGIN
  194.       GoToXY(40, row);
  195.       Write(#186);
  196.     END;
  197.   REPEAT
  198.     Window(1, 1, 39, 25);
  199.     ClrScr;
  200.     WriteLn('Enter the template for files sought.');
  201.     WriteLn('It can contain "wildcard" characters');
  202.     WriteLn('"*" and "?".');
  203.     ReadLn(filename);
  204.     WriteLn('Enter the attribute(s) to seek:');
  205.     WriteLn('[R]ead-only, [H]idden, [S]ystem, ');
  206.     WriteLn('[V]olume-label, [D]irectory, [A]rchive');
  207.     WriteLn('or [Q]uit.');
  208.     okay := true;
  209.     FillChar(chars,SizeOf(chars),0);
  210.     chars := ['R','H','S','V','D','A','Q',#13];
  211.     atts := '';
  212.     repeat
  213.       repeat until keypressed;
  214.       read(Kbd,Choice);
  215.       choice := UpCase(choice);
  216.       IF choice in chars THEN
  217.         BEGIN
  218.           IF choice = 'Q' THEN okay := false
  219.             ELSE
  220.               BEGIN
  221.                 IF choice <> #13 THEN
  222.                   BEGIN
  223.                     write(choice);
  224.                     atts := atts + choice;
  225.                     chars := chars - [choice];
  226.                   END;
  227.               END;
  228.         END;
  229.     until (choice = #13) or (not okay) or (chars = ['Q',#13]);
  230.     attribyte := unConvert(atts);
  231.     writeln; writeLn('attribute byte is ',attribyte);
  232.     IF Okay THEN
  233.       BEGIN
  234.         WriteLn; WriteLn;
  235.         WriteLn('[E]xclusive or [I]nclusive?');
  236.         WriteLn('(i.e., show ONLY files with');
  237.         WriteLn('exactly the specified attributes');
  238.         WriteLn('or all "normal" files plus those');
  239.         WriteLn('with the specified attributes).');
  240.         WriteLn('  NOTE: specify [E] if you just');
  241.         WriteLn('  want the [V]olume label.');
  242.         REPEAT
  243.           REPEAT UNTIL KeyPressed;
  244.           Read(Kbd,choice);
  245.           choice := UpCase(choice);
  246.         UNTIL choice IN ['E', 'I'];
  247.         WriteLn(choice);
  248.         Window(41, 1, 80, 25);
  249.         ClrScr;
  250.         OldAttribute := attribyte;
  251.  
  252.         { Step one--Find the First file matching our criteria.}
  253.  
  254.         Find_First(attribyte, filename, error);
  255.         IF error = 0 THEN
  256.           BEGIN
  257.  
  258.             { If we asked for [E]xclusive choices, we want to
  259.             screen out any files that do not have exactly the
  260.             same attributes as our request.  However, we don't
  261.             care whether or not the ARCHIVE bit is set.  Thus
  262.             the condition "if attribyte MOD 32 = OldAttribute}
  263.             IF choice = 'E' THEN
  264.               BEGIN
  265.  
  266.                 IF attribyte MOD 32 = OldAttribute THEN
  267.                   WriteLn(filename, '   ', convert(attribyte));
  268.               END
  269.             ELSE WriteLn(filename, '   ', convert(attribyte));
  270.  
  271.             {Now we repeat Find_Next until it DOESN't Find a Next--
  272.             that is, until error <> 0  }
  273.  
  274.             REPEAT
  275.               Find_Next(attribyte, filename, error);
  276.               IF error = 0 THEN
  277.                 BEGIN
  278.                   IF choice = 'E' THEN
  279.                     BEGIN
  280.                       IF attribyte MOD 32 = OldAttribute THEN
  281.                         WriteLn(filename, '   ', convert(attribyte));
  282.                     END
  283.                   ELSE WriteLn(filename, '   ', convert(attribyte));
  284.                   IF WhereY >= 24 THEN              {-----------------}
  285.                     BEGIN                           { Stop when screen}
  286.                       WriteLn('Press a key...');    { gets full.      }
  287.                       REPEAT UNTIL KeyPressed;      {-----------------}
  288.                       read(Kbd,dummy);
  289.                       ClrScr;
  290.                     END;
  291.                 END;
  292.             UNTIL error <> 0;
  293.             WriteLn('Press a key . . .');
  294.             REPEAT UNTIL KeyPressed;
  295.             read(Kbd,dummy);
  296.             ClrScr;
  297.           END;
  298.       END;
  299.   UNTIL attribyte = 0;
  300.   Window(1, 1, 80, 25);
  301.   ClrScr;
  302. END.
  303.  
  304.