home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PASTOOLS.ZIP / QDL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-03-28  |  4.4 KB  |  178 lines
  1. Program QDL ;
  2. {$I-,U-,C-}
  3.  
  4. TYPE
  5.   registers = record
  6.                 ax, bx, cx, dx, bp, si, di, ds, es, flags : integer;
  7.               end;
  8.  
  9.   char80arr = array [1..80] of char;
  10.   string80 = string[80];
  11.  
  12. VAR
  13.   DTA : array [1..43] of byte;
  14.   DTAseg, DTAofs,
  15.   setDTAseg, setDTAofs,
  16.   error, i, j, option : integer;
  17.   regs : registers;
  18.   buffer, namr : string80;
  19.   mask : char80arr;
  20.  
  21. PROCEDURE SetDTA (segment, offset : integer; var error : integer);
  22.   BEGIN
  23.     regs.ax := $1A00;
  24.     regs.ds := segment;
  25.     regs.dx := offset;
  26.     MSDos (regs);
  27.     error := regs.ax AND $FF;
  28.   END;
  29.  
  30. PROCEDURE GetCurrentDTA (var segment, offset : integer;
  31.                          var error : integer);
  32.   BEGIN
  33.     regs.ax := $2F00;
  34.     MSDos (regs);
  35.     segment := regs.es;
  36.     offset := regs.bx;
  37.     error := regs.ax AND $FF;
  38.   END;
  39.  
  40. PROCEDURE GetOption (var option : integer);
  41.   VAR
  42.     ch : char;
  43.   BEGIN
  44.     ch := '?';
  45.     option := 1;
  46.     While (ch = '?') Do
  47.       BEGIN
  48.         Write('File option to use. [?] for list:');
  49.         Readln(ch);
  50.         Writeln;
  51.         Case (ch) of
  52.           '1' : option := 1;
  53.           '2' : option := 7;
  54.           '3' : option := 8;
  55.           '4' : option := 16;
  56.           '5' : option := 22;
  57.           '6' : option := 31;
  58.           '?' : BEGIN
  59.                   Writeln('File options are:');
  60.                   Writeln;
  61.                   Writeln('[1] for standard files [default]');
  62.                   Writeln('[2] for system or hidden files');
  63.                   Writeln('[3] for volume label');
  64.                   Writeln('[4] for directories');
  65.                   Writeln('[5] for directories, hidden, system,or standard files');
  66.                   Writeln('[6] same as [5] but includes volume label');
  67.                   Writeln;
  68.                 END;
  69.               else option := 1;
  70.            END;
  71.         END;
  72.   END;
  73.  
  74. PROCEDURE GetFirst (mask : char80arr; var namr : string80;
  75.                     segment, offset : integer; option : integer;
  76.                     var error : integer);
  77.  
  78.   VAR
  79.     i : integer;
  80.   BEGIN
  81.     error := 0;
  82.     regs.ax := $4E00;
  83.     regs.ds := seg(mask);
  84.     regs.dx := ofs(mask);
  85.     regs.cx := option;
  86.     MSDos (regs);
  87.     error := regs.ax AND $FF;
  88.     i := 1;
  89.     Repeat
  90.       namr[i] := chr(mem[segment : offset + 29 + i]);
  91.       i := i + 1;
  92.     Until (not(namr[i-1] in [' '..'~']));
  93.     namr[0] := chr(i-1);
  94.   END;
  95.  
  96. PROCEDURE GetNextEntry (var namr : string80;
  97.                             segment, offset : integer;
  98.                             option : integer;
  99.                         var error : integer);
  100.   VAR
  101.     i : integer;
  102.   BEGIN
  103.     error := 0;
  104.     regs.ax := $4F00;
  105.     regs.cx := option;
  106.     MSDos (regs);
  107.     error := regs.ax AND $FF;
  108.     i := 1;
  109.     Repeat
  110.       namr[i] := chr(mem[segment : offset + 29 + i]);
  111.       i := i + 1;
  112.     Until (not(namr[i-1] in [' '..'~']));
  113.     namr[0] := chr(i-1);
  114.  END;
  115.  
  116.  
  117. BEGIN
  118.   For i := 1 to 21 Do DTA[i] := 0;
  119.   For i := 1 to 80 Do
  120.     BEGIN
  121.       mask[i] := chr(0);
  122.       namr[i] := chr(0);
  123.     END;
  124.   namr[0] := chr(0);
  125.   Writeln('QDL version 2.00A');
  126.   Writeln;
  127.   GetCurrentDTA (DTAseg, DTAofs, error);
  128.   If (error <>0) then
  129.     BEGIN
  130.       Writeln('Unable to get current DTA');
  131.       Writeln('Program aborting');
  132.       Halt;
  133.     END;
  134.   setDTAseg := seg(DTA);
  135.   setDTAofs := ofs(DTA);
  136.   SetDTA (setDTAseg, setDTAofs, error);
  137.   If (error <>0) then
  138.     BEGIN
  139.       Writeln('Cannot reset DTA');
  140.       Writeln('Program aborting');
  141.       Halt;
  142.     END;
  143.   error := 0;
  144.   buffer[0] := chr(0);
  145.   GetOption(option);
  146.   If (option <> 8) then
  147.     BEGIN
  148.       Writeln('File mask:');
  149.       Readln(buffer);
  150.       Writeln;
  151.     END;
  152.   If (length (buffer) = 0) then buffer := '????????.???';
  153.   For i := 1 to length(buffer) Do mask[i] := buffer[i];
  154.   GetFirst(mask, namr, setDTAseg, setDTAofs, option, error);
  155.   If (error = 0) then
  156.     BEGIN
  157.       If (option <> 8) then
  158.         BEGIN
  159.           Writeln('Directory of : ',buffer);
  160.           Writeln;
  161.         END;
  162.       Writeln (namr);
  163.     End
  164.   else If (option = 8) then
  165.     Writeln('Volume label not found.')
  166.   else
  167.     Writeln('File ''', buffer, ''' not found.');
  168.   While (error = 0) Do
  169.     BEGIN
  170.       GetNextEntry (namr, setDTAseg, setDTAofs, option, error);
  171.       If (error = 0) then Writeln (namr);
  172.     END;
  173.   SetDTA (DTAseg, DTAofs, error);
  174. END.
  175.  
  176.  
  177.  
  178. t╞a&áæ