Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 197. - čistíme složku s projektem

Jan Šindelář 24.8.2005

Dnešní tip se ani tak nebude týkat programování aplikací pro jiné uživatele, ale vytvoříme si jednoduchý pomocný program, který využijeme přímo při programování. Naprogramujeme si rozšíření shellu pro smazání přebytečných souborů ve složce s projektem.

Jistě dobře víte, že při tvorbě aplikace se ve složce s projektem vytvoří řada souborů, o kterých možná ani nevíte, k čemu jsou dobré. Mohou to být jednak některé konfigurační soubory pro příslušný projekt a zejména také soubory dočasné, jejichž přípona je uvozena tildou (~).

Než pošlete hotový projekt například kamarádovi, bylo by dobré tento "balast" odstranit. K tomuto účelu si vytvoříme jednoduché rozšíření shellu, které toto vyčištění provede automaticky. Po kliknutí pravým tlačítkem na složku s Projektem se otevře obvyklé kontextové menu, kde najdeme novou položku, po jejíž aktivaci se složka promaže od zbytečností. Náš dnešní program tedy jednak zařídí toto přidání funkce do kontextového menu příslušným zápisem do registru a pak se také samozřejmě postará o promazání samotné.

Program má tedy dvě části. První funkce Reg provede záznam do registrů v části HKEY_CLASSES_ROOT, což bude mít za následek to, že v kontextovém menu najdeme novou položku pro vyčištění složky projektu. Druhá funkce ScanDirectory pak prohledá rekurzivně, tedy včetně vnořených složek, danou složku a vymaže ty soubory, které jsme specifikovali pomocí masky.


program Project1;
{$APPTYPE CONSOLE}
uses
  SysUtils, Registry, WinTypes, FileCtrl;
var
  dir: string;
const
  DirExtensionKey = `Directory\shell\clean`;
  SubKey = `\command`;
procedure PerformAction(const dir, fname: string);
begin
  if not SysUtils.DeleteFile(dir + fname) then
  begin
  end;
end;
procedure ScanDirectory(const dir, filemask: string);
var
  SearchRec: TSearchRec;
begin
  if not DirectoryExists(dir) then
  begin
    MessageBox(0, `Složka nenalezena`, ``, mb_ok);
    Halt;
  end;
  if dir <> `` then ChDir(dir);
  if True then
  begin
    if FindFirst(`*.*`, faDirectory, SearchRec) = 0 then
      repeat
        if (SearchRec.Name <> `.`) and (SearchRec.Name <> `..`) and
          ((SearchRec.Attr and faDirectory) = faDirectory) then
          ScanDirectory(SearchRec.Name, filemask);
      until (FindNext(SearchRec) <> 0);
    SysUtils.FindClose(SearchRec);
  end;
  if FindFirst(filemask, faAnyFile, SearchRec) = 0 then
    repeat
      if (SearchRec.Name <> `.`) and (SearchRec.Name <> `..`) and
        ((SearchRec.Attr and faDirectory) = 0) then
        PerformAction(``, SearchRec.Name);
    until (FindNext(SearchRec) <> 0);
  SysUtils.FindClose(SearchRec);
  Chdir(`..`);
end;
procedure Reg;
var
  reg: TRegistry;
begin
  try
    reg := TRegistry.Create;
  except
    Exit;
  end;
  if True then
    with reg do
    begin
      RootKey := HKEY_CLASSES_ROOT;
      OpenKey(DirExtensionkey, True);
      WriteString(``, `Vyčistit Del&phi projekt`);
      CloseKey;
      OpenKey(DirExtensionkey + SubKey, True);
      WriteString(``, ParamStr(0) + ` "%1"`);
      CloseKey;
    end
  else
    with reg do
    begin
      RootKey := HKEY_CLASSES_ROOT;
      DeleteKey(DirExtensionkey);
      CloseKey;
    end;
  reg.Free;
end;
begin
  Reg;
  if ParamCount > 0 then dir := ParamStr(1)
  else Exit;
  ScanDirectory(dir, `*.dcu`);
  ScanDirectory(dir, `*.~*`);
end.



Jak vidíte, celý projekt je vytvořen jako konzolová aplikace. Nebude mít žádný výstup ani vstup (kromě spouštěcího parametru), takže můžete dokonce použít i "trik" z jednoho z nedávných dílů seriálu a řádek {$APPTYPE CONSOLE} úplně odstranit. V takovém případě se vše provede zcela "potichu" a neproblikne ani prázdné konzolové okno. Hotový program by bylo dobré uložit například do složky Windows.

Hlavní část programu je pak již velmi přímočará a jasná. Nejprve dojde k zaregistrování rozšíření, poté je zjištěna z parametrů příkazové řádky cílová složka a na ní je posléze puštěna funkce ScanDirectory. Jak vidíte, v naší ukázce mažeme soubory DCU a také dočasné záložní soubory s tildou. Nic vám pochopitelně nebrání upravit si tento seznam souborů podle libosti.

Program samotný opět berte jako polotovar hodný opracování. I když v této podobě funguje docela dobře, jistě by se slušelo nějakým způsobem vyřešit i situaci, kdy soubor nejde smazat a nebo další případné neobvyklé stavy. Může rovněž vadit rekurzivní procházení vnořených složek, což velmi snadno vypnete upravením příslušné podmínky. Ve své podstatě je ale program univerzální, můžete jej upravit pro řadu jiných funkcí a tím pádem se z něj stane něco víc než jen pomůcka pro Delphi programátory.