{ 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 }