Náhrada príkazu find pre operačný systém DOS

{ FIND.PAS                               Copyright (c) Jan Benkovic }
{ Nahrada prikazu find pre operacny system DOS. Prehladava disk     }
{ aby nasiel umiestnenie zadaneho suboru. Vysledok zapise do        }
{ textoveho suboru. Obsahuje prepinace. Ak sa nezada ziaden         }
{ prepinac zobrazi sa help programu.                                }
{                                                                   }
{ Datum:04.10.2001                             http://www.trsek.com }
 
{$I-}
uses crt,dos;
var
 hladane             : string;
 pom,Pocet_najdenych : longint;
 povod_adresar       : string;
 nazov,subor         : string;
 t                   : text;
 
procedure hladaj_subor(v_adresary:string);
var DirInfo : SearchRec;
    povod_adresar_1 : string;
 begin
  getdir(0,povod_adresar_1);
  chdir(v_adresary);
  FindFirst(subor, Anyfile, DirInfo);
  while DosError = 0 do
  begin
    assign(t,povod_adresar+'\'+nazov);
    append(t);
    inc(Pocet_najdenych);
    Writeln(v_adresary+'\'+DirInfo.Name);
    Writeln(t,v_adresary+'\'+DirInfo.Name);
    FindNext(DirInfo);
    close(t);
  end;
  chdir(povod_adresar_1);
 end;
 
procedure hladaj(cesta:string);
 var DirInfo: SearchRec;
 begin
  hladaj_subor(cesta);
  chdir(cesta);
  if IOResult <> 0 then Writeln(cesta+ ' Adresar je nepristupny')
  else
   begin
    FindFirst('*.*', Anyfile, DirInfo);
    while DosError = 0 do
       begin
        if (Dirinfo.Attr and Directory<>0) and (Dirinfo.Name<>'.') and (DirInfo.Name<>'..') then
         begin
          if cesta[length(cesta)]='\' then begin hladaj(cesta+Dirinfo.Name);end
          else begin hladaj(cesta+'\'+Dirinfo.Name);end;
          chdir(cesta);
         end;
        FindNext(DirInfo);
       end;
   end;
 end;
 
procedure help;
 begin
  Writeln('Program na prehladavanie disku : ');
  Writeln('Priklad : find [/s uklada] [/f subor] [/d adresar]');
  Writeln('/s ukladaj do zadaneho suboru');
  Writeln('/f hladaj subor ');
  Writeln('/d hladaj v adresari');
  Writeln('/? toto menu');
  Writeln;
  Writeln('Ak nezadas hodnoty za prepinacmi tak sa daju hodnoty DEFAULT.');
  Writeln('Aspon jeden z prepinacov musi byt zapnuty.');
  halt;
 end;
 
begin
 clrscr;
 getdir(0,povod_adresar);
 if paramcount=0 then begin Writeln('Chybaju VAM parametre !');help;halt;end;
 for pom:= 1 to paramcount do
  begin
   if (paramstr(pom)='/?') or (paramstr(pom)='help') then help;
   if paramstr(pom)='/f' then subor:=paramstr(pom+1);
   if paramstr(pom)='/d' then hladane:=paramstr(pom+1);
   if paramstr(pom)='/s' then nazov:=paramstr(pom+1);;
  end;
 if subor=''   then subor:='*.*';
 if hladane='' then hladane:=povod_adresar;
 if nazov=''   then nazov:='find';
 assign(t,nazov);
 rewrite(t);
 close(t);
 hladaj(hladane);
 Writeln;
 Writeln('Pocet najdenych :',pocet_najdenych);
 Writeln('koniec');
 chdir(povod_adresar);
 readkey;
end.