Nájde umiestnenie súboru v systémovej premenej PATH

{ FARBYDOS.PAS              Copyright (c) TrSek alias Zdeno Sekerak }
{ Najde umiestnenie suboru %1 podla PATH                            }
{ vysledok ulozi do suboru %2 (default ff.dat)                      }
{ ERRORLEVEL  1-malo pamete                                         }
{             2-neviem najst PATH v nastaveni systemu               }
{                                                                   }
{ Datum:23.01.1998                             http://www.trsek.com }
 
{$M 31192,0,65360}
program find_file;
 
uses crt,dos;
 
var f: text;            { citame, pisem do suborov }
    DirInfo: SearchRec; { Ci Existuje subor }
    m_file: string;     { meno suboru, ktory hladam }
    s_path: string;     { ulozeny path v ktorom hladam }
    pom: string;        { devka string }
    out_file: string;   { vysledom odlozeny do suboru }
    i: integer;         { devka }
    err: integer;       { ak vznikla chyba }
 
procedure help;
begin
 WriteLn('Find File - najde v ktorom z PATH adresarov sa nachadza subor.');
 WriteLn('--------------------------------------------------------------');
 WriteLn('%1 - aky subor hladam');
 WriteLn('%2 - do akeho suboru cestu ak nasiel');
 WriteLn('                                             Software by TRSEK');
end;
 
function prikaz(s:string):integer;
begin
  SwapVectors;
  Exec(GetEnv('COMSPEC'), '/C '+s);
  SwapVectors;
  if doserror<>0 then prikaz:=2
                 else prikaz:=0;
end;
 
BEGIN
 
 if (paramcount > 0) then begin
    m_file := paramstr(1);
    out_file := ParamStr(2);
    if( out_file='' ) then out_file:='ff.dat';
   end
  else begin
   help;
   halt(1);
  end;
 
 { ak existuje out subor tak ho zmazem }
 FindFirst( out_file, AnyFile, DirInfo );
 if ( DosError=0) then err := prikaz('del '+out_file );
 { Zistim aky je PATH }
 err := prikaz('set > $$$.$$');
 if( err<>0 ) then halt(1);
 
 { Tak co nam poskytol ??? }
 Assign(f,'$$$.$$');
 ReSet(f);
 repeat
  ReadLn( f, s_path );
 until( pos('PATH',s_path) > 0) or ( eof(f) );
 Close(f);
 { upraceme }
 err := prikaz('del $$$.$$');
 
 { Nenasiel som nic, tak aspon hlada v aktualnom adresari }
 if ( pos('PATH',s_path) = 0 ) then s_path:='';
 s_path := copy( s_path, pos('=',s_path)+1, length(s_path) );
 pom:=s_path;
 
 { Hladame v ktorej ceste je nas subor }
 repeat
  i:=pos( ';',pom );
  if ( i=0 ) then s_path:=pom
             else begin
              s_path:=copy(pom,1,i-1);
              pom:=copy(pom,i+1,length(pom));
             end;
 
  FindFirst( s_path+'\'+m_file, AnyFile, DirInfo );
 until (( i=0 ) or ( DosError=0 ));
 
 { Nenasiel ideme prec }
 if( s_path='' ) then exit;
 
 { Toto je vysledok }
 Assign( f, out_file );
 ReWrite(f);
 WriteLn( f, s_path );
 Close(f);
 
END.      { Dovidenia }