Upravena verzia www

{ REDFOX.PAS                                Copyright (c) Roman Mik }
{ 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.                                }
{ Upravena verzia http://www.trsek.com/cover/benkovic/find          }
{                                                                   }
{ Datum:24.07.2008                             http://www.trsek.com }
 
{$I-}
uses crt,dos;
var
 priznak             : string;
 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;
    mazac:string;
    F:file;
 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(t,v_adresary+'\'+DirInfo.Name);
    if priznak='' then
    Writeln(v_adresary+'\'+DirInfo.Name)
    else
    Begin
    mazac:=v_adresary+'\'+DirInfo.Name;
    assign(F,mazac);
    {$I-}
    Reset(F);
    {$I+}
    if IOResult <> 0 then
    Writeln('Cannot find ', mazac)
    else
    begin
    Close(F);
    Erase(F);
    Writeln(v_adresary+'\'+DirInfo.Name+'  <- zmazane');
    End;
    End;
    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] [/e]');
  Writeln('/s ukladaj do zadaneho suboru');
  Writeln('/f hladaj subor ');
  Writeln('/d hladaj v adresari');
  Writeln('/e zmaze subor');
  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);
   if paramstr(pom)='/e' then priznak:=paramstr(pom);
  end;
 if subor=''   then subor:='*.*';
 if hladane='' then hladane:=povod_adresar;
 if nazov=''   then nazov:='find';
 if priznak='' then priznak:='';
 assign(t,nazov);
 rewrite(t);
 close(t);
 hladaj(hladane);
 Writeln;
 Writeln('Pocet najdenych :',pocet_najdenych);
 Writeln('koniec');
 chdir(povod_adresar);
 readkey;
end.