Umiestnenie súboru www.TrSek.com/pas/ff.pas{ 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);