Substitute find directive for operating system DOS

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Category: KMP (Club of young programmers)

Program: Find.pas
File exe: Find.exe

Substitute find directive for operating system DOS. Scouts around disk and find location file. Result write to text file. Contain switches. If program don't have any switch then write help.

/s - save to file
/f - find file
/d - find in directory
{ 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.