home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOL_INC.ZIP / GETFILES.INC < prev    next >
Encoding:
Text File  |  1988-01-29  |  3.9 KB  |  176 lines
  1.  
  2.  
  3. (*
  4.  * getfiles - file list processing library
  5.  *
  6.  * This module will change a wildcard list of files into a
  7.  * sorted file name list.
  8.  *
  9.  *)
  10.  
  11. const
  12.    maxnumfiles =  200;
  13.    null =         #0;
  14.  
  15. type
  16.    filestring =   string [64];
  17.    filearray =    array [1.. maxnumfiles] of filestring;
  18.  
  19.  
  20. var
  21.    filetable:     filearray;
  22.    filecount:     integer;
  23.  
  24.  
  25. (*
  26.  *
  27.  * sort a portion of a file table
  28.  *
  29.  *)
  30.  
  31.  
  32. procedure sorttable (var fdir:      filearray;
  33.                      first:         integer;
  34.                      last:          integer);
  35. var
  36.    i:             integer;
  37.    swapped:       boolean;
  38.    temp:          filestring;
  39.    
  40. begin
  41.  
  42.    repeat
  43.       swapped := false;
  44.  
  45.       for i := first to last - 1 do
  46.       begin
  47.  
  48.          if fdir [i]> fdir [i + 1] then
  49.          begin
  50.             temp := fdir [i];
  51.             fdir[i]:= fdir [i + 1];
  52.             fdir[i + 1]:= temp;
  53.             swapped := true;
  54.          end;
  55.       end;
  56.    until swapped = false;
  57. end;
  58.  
  59.  
  60. (*
  61.  *
  62.  * expand a comma-seperated wildcard list into
  63.  * a list of full pathnames.
  64.  * sort files going with each wildcard, but otherwise
  65.  * preserve file order
  66.  *
  67.  *)
  68.  
  69. procedure getfiles (patternlist:   filestring;
  70.                     var fdir:      filearray;
  71.                     var num:       integer);
  72. var
  73.    i:             integer;
  74.    cf:            byte;
  75.    onedir:        filestring;
  76.    listpos:       integer;
  77.    pattern:       filestring;
  78.    curdir:        filestring;
  79.    reg:           registers;
  80.    dta:           string[255];
  81.    c:             char;
  82.    prevnum:       integer;
  83.  
  84. begin
  85.    for i := 1 to length(patternlist) do
  86.       patternlist[i] := upcase(patternlist[i]);
  87.  
  88.    if patternlist = '-F' then   {filter standard input?}
  89.    begin
  90.       num := 1;         {make a fixed filelist instead of searching}
  91.       fdir[1] := '-F';
  92.       exit;
  93.    end;
  94.  
  95.    num := 0;
  96.    prevnum := 1;
  97.    listpos := 1;
  98.  
  99.    while listpos <= length (patternlist) do
  100.    begin
  101.       pattern := '';
  102.       c := patternlist [listpos];
  103.  
  104.       while (c <> ',') and (listpos <= length (patternlist)) do
  105.       begin
  106.          pattern := pattern + c;
  107.          listpos := succ(listpos);
  108.          c := patternlist [listpos];
  109.       end;
  110.  
  111.       listpos := succ(listpos);
  112.       curdir := pattern;
  113.  
  114.       while (length(curdir) > 0) and
  115.             (curdir [length(curdir)] <> '\') and
  116.             (curdir [length(curdir)] <> ':') do
  117.                curdir[0] := pred(curdir[0]);
  118.  
  119.       pattern := pattern + null;
  120.       reg.ax := $1a00;
  121.       reg.ds := seg (dta [1]);
  122.       reg.dx := ofs (dta [1]);
  123.       msdos(reg);              {set dta address}
  124.  
  125.       reg.ax := $4e00;
  126.       reg.cx := $21;  {match archive and read-only attributes}
  127.       reg.ds := seg (pattern [1]);
  128.       reg.dx := ofs (pattern [1]);
  129.       msdos(reg);              {find first matching file}
  130.  
  131.       cf := reg.flags and 1;
  132.  
  133.       while ((cf <> 1) and (num < maxnumfiles)) do
  134.       begin
  135.  
  136.          onedir := '';
  137.          i := 0;
  138.  
  139.          repeat
  140.             c := dta [31 + i];
  141.  
  142.             if c <> null then
  143.                onedir := onedir + c;
  144.  
  145.             i := i + 1;
  146.          until c = null;          {throw out the . and .. entries}
  147.  
  148.  
  149.          if onedir [1]<> '.' then
  150.          begin
  151.             num := num + 1;
  152.             fdir[num]:= curdir + onedir;
  153.          end;
  154.  
  155.          reg.ax := $4f00;
  156.          reg.ds := seg (dta [1]);
  157.          reg.dx := ofs (dta [1]);
  158.          msdos(reg);              {keep searching for next file}
  159.  
  160.          cf := reg.flags and 1;
  161.       end;
  162.  
  163.       sorttable(fdir, prevnum, num);
  164.                          {sort each part of list seperately}
  165.  
  166.       prevnum := num + 1;
  167.    end;
  168.  
  169.    if num >= maxnumfiles then
  170.    begin
  171.       writeln(con,'warning:  files in excess of ', maxnumfiles, ' ignored');
  172.    end;
  173. end;                     {getfiles}
  174.  
  175.  
  176.