home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / DIRSRCH.ZIP / DIRSRCH.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  3.9 KB  |  125 lines
  1. {$v-}
  2.  
  3.  program dirsrch;
  4. { This program will search a directory for a matching file name
  5.   and then print out it along with its size and attribute byte.
  6.   Other information is available in the record `dta_def'. Using
  7.   the same techniques, if the entry is a directory, it could be
  8.   saved and then searched recursively.
  9.  
  10.          Jim Holtman
  11.          35 Dogwood Trail
  12.          Randolph, NJ 07869
  13.          (201) 361-3395
  14. }
  15.  
  16.     type
  17.        regset = record
  18.           ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  19.           end;
  20.        fname = array[1..80] of char;
  21.        str80 = string[80];
  22.        dta_def = record
  23.           filler : array[1..21] of byte;
  24.           attribute : byte;
  25.           file_time : integer;
  26.           file_date : integer;
  27.           file_size : array[1..2] of integer;
  28.           file_name : fname;
  29.           end;
  30.  
  31.     const
  32.        carry = 1;
  33.        directory = $10;
  34.  
  35.     var
  36.        pattern : string[40];
  37.  
  38.     procedure recurse;
  39.  
  40.        var
  41.           dta : dta_def;
  42.           param : regset;
  43.           s_string : string[70];
  44.           r1,r2 : real;
  45.           dta_save : array[1..2] of integer;
  46.  
  47.        function pack_name(var a1;
  48.             size : integer) : str80;
  49.  
  50.           var
  51.              i : integer;
  52.              b : str80;
  53.              a : array[1..1000] of char absolute a1;
  54.  
  55.           begin
  56.              i := 1;
  57.              b := '';
  58.              while (a[i]<>chr(0)) and (i <= size) do begin
  59.                 b := b+a[i];
  60.                 i := i+1;
  61.                 end;
  62.              pack_name := b;
  63.              end;
  64.  
  65.        begin
  66.           writeln('entering RECURSE');
  67.           with param,dta do begin
  68.              ax := $2F00;          {get DTA}
  69.              msdos(param);
  70.              dta_save[1] := es;
  71.              dta_save[2] := bx;
  72.              ax := $1A00;          {set DTA}
  73.              ds := seg(dta);
  74.              dx := ofs(dta);
  75.              msdos(param);
  76.              ds := seg(pattern[1]);
  77.              dx := ofs(pattern[1]);
  78.              ax := $4E00;          {find 1st}
  79.              cx := $FF;
  80.              msdos(param);
  81.              while (flags and carry) = 0 do begin
  82.                 s_string := pack_name(file_name,sizeof(file_name));
  83.                 if ((attribute and directory) <> 0) and (s_string <> '.') and (
  84.                      s_string <> '..') then begin
  85.                    writeln('decending to ',s_string);
  86.                    s_string := s_string+chr(0);
  87.                    ax := $3B00;    {CHDIR}
  88.                    ds := seg(s_string[1]);
  89.                    dx := ofs(s_string[1]);
  90.                    msdos(param);
  91.                    recurse;
  92.                    writeln('going back');
  93.                    ax := $3B00;    {go back}
  94.                    s_string := '..'#0;
  95.                    ds := seg(s_string[1]);
  96.                    dx := ofs(s_string[1]);
  97.                    msdos(param);
  98.                    end
  99.                 else begin
  100.                    r1 := file_size[1];
  101.                    r2 := file_size[2];
  102.                    if r1 < 0 then r1 := r1+65536.0;
  103.                                    {take care of extension of}
  104.                    if r2 < 0 then r2 := r2+65536.0;
  105.                                    {data into the sign bit}
  106.                    writeln(s_string,'':(16-length(s_string)),(r2*65536.0+r1):8:
  107.                         0, attribute:6);
  108.                    end;
  109.                 ax := $4F00;       {get next}
  110.                 msdos(param);
  111.                 end;
  112.              ax := $1A00;          {set DTA}
  113.              ds := dta_save[1];
  114.              dx := dta_save[2];
  115.              msdos(param);
  116.              end;
  117.           end;
  118.  
  119.     begin
  120.        write('Pattern to search for - ');
  121.        readln(pattern);
  122.        pattern := pattern+chr(0);
  123.        recurse;
  124.        end.
  125.