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

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie: KMP (Programy mladých programátorů)

Program: Find.pas
Soubor exe: Find.exe

Náhrada príkazu find pre operačný systém DOS. Prehľadáva disk aby našiel umiestnenie zadaného súboru. Výsledok zapíše do textového súboru. Obsahuje prepínače. Ak sa nezadá žiaden prepínač zobrazí sa help programu.

/s - ukladaj do zadaneho suboru
/f - hladaj subor
/d - hladaj v adresari
{ 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.