home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBCS / DEMOS / INPATH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  2.1 KB  |  75 lines
  1. uses
  2.   crt, dos, eco_lib
  3.  
  4.   ;
  5.  
  6. const
  7.   display    : boolean = false;
  8.   withgoto   : boolean =  true;
  9.   witherrlev : boolean = false;
  10.  
  11.  
  12.  
  13.   function __getpath(var fname : string) : boolean;
  14.   { returns the full path and filename for a filename if the file  }
  15.   { is found in the path. }
  16.   var
  17.     found         : boolean;
  18.     homedir,
  19.     extractedpath :  string;
  20.     i, j, len     :    byte;
  21.  
  22.   begin
  23.     homedir := __normfil(fname);
  24.     if __existfil(homedir) then begin
  25.       fname := homedir; __getpath := true; exit;
  26.     end;
  27.     j := 1; len := length(_dospath);
  28.     repeat
  29.       extractedpath := '';
  30.       inc(j); i := j - 1; 
  31.       while (_dospath[j] <> ';') and (j < len) do inc(j); inc(j);
  32.       extractedpath := __normfil(__backapp(copy(_dospath, i, j-i-1)));
  33.       found := __existfil(__normfil(extractedpath + fname));
  34.       if display then writeln(__slashfil(extractedpath + fname));
  35.       if found then fname := __slashfil(extractedpath + fname);
  36.     until (found) or (j >= len) or (i >= len);
  37.     __getpath := found;
  38.   end;
  39.  
  40.  
  41.  
  42. var
  43.   k    :   word;
  44.   nam,
  45.   st   : string;
  46.  
  47. begin
  48.   display := __inparams('/d', k);
  49.   withgoto := __inparams('/goto', k) or __inparams('/g', k);
  50.   witherrlev := __inparams('/err', k);
  51.   if __inparams('/?', k) then begin
  52.     writeln(__progname);
  53.     writeln('  /d          ::  display findings.');
  54.     writeln('  /g  /goto   ::  goto directory where found.');
  55.     writeln('  /err        ::  end on errorlevel 1 when found.');
  56.     writeln('Version 1.01 by Floor A.C. Naaijkens for');
  57.     writeln('UltiHouse Software / The ECO Group.');
  58.     writeln('FAX/BBS: x31,13,638709 - b300-57600 V32b/42b/HST/MNP');
  59.   end;
  60.   for k := 1 to paramcount do begin
  61.     st := paramstr(k);
  62.     if st[1] <> '/' then begin
  63.       if __getpath(st) then begin
  64.         if display then __write(wherex, wherey-1, 0, 7, st) else
  65.           __write(wherex, wherey, 0, 7, st);
  66.         if withgoto then begin
  67.           chdir(__backrem(__extractpath(__normfil(st))))
  68.         end;
  69.         if witherrlev then halt(1);
  70.       end;
  71.     end;
  72.   end;
  73.   halt(0);
  74. end.
  75.