Delphi - Felesleges állományok eltávolítása az Intéző segítségével

forráskód letöltése
Létrehozunk egy új menüpontot a Windows Intézőjének azon gyorsmenüjéhez, mely akkor jelenik meg, ha a felhasználó egy mappán kattint jobb gombbal. Az új menüpont választásával elindul egy saját alkalmazásunk, mely törli azokat az állományokat, melyek nem szükségesek egy-egy Delphi-s projekt továbbításához, így csak a szükséges forráskód marad.
Ahhoz, hogy az új menü létrejöjjön, a Windows Intézőben futtassa le egyszer a mellékelt példaprogramot.
A programunk indulásakor meghívjuk a PopupMenuReg eljárásunkat, mely elvégzi az új menüpont létrehozását.
begin
  PopupMenuReg;
Ha alkalmazásunk kap paramétert induláskor, akkor végezzük el a szükséges állományok keresését és törlését. A kapott paraméter az a mappa lesz, melyben a keresést végezni kell. E művelethez létrehozunk egy ScanDirectory nevű eljárást, melynek első paraméterében azt a mappát kell megadnunk melyben a keresést végezni kell, míg másodikként a törlendő állományokat kiterjesztését.
  if ParamCount>0 then begin
    dir:=ParamStr(1);
    ScanDirectory(dir, '*.~*');
    ScanDirectory(dir, '*.dof');
    ScanDirectory(dir, '*.dcu');
    ...
  end;
end.
Az új menüpont létrehozása úgy történik, hogy a Windows regisztrációs adatbázisban a HKEY_CLASSES_ROOT főkulcs alá a Directory\shell kulcs alá kell létrehoznunk egy újat, melyben megadhatjuk, hogy mi legyen a megjelenő menüpont felirata és a kiválasztásakor melyik alkalmazás induljon el.
procedure PopupMenuReg;
begin
  with TRegistry.Create do begin
    RootKey:=HKEY_CLASSES_ROOT;
    OpenKey('Directory\shell\clean', true);
    WriteString('', 'Felesleges Delphi állományok törlése');
    CloseKey;
    OpenKey('Directory\shell\clean\command', true);
    WriteString('', ParamStr(0)+' "%1"');
    CloseKey;
    Free;
  end;
end;
A ScanDirectory a megadott mappában az összes állományt ellenőrizi, hogy megfelel-e a keresési feltételnek.
procedure ScanDirectory(const dir, filemask: string);
var
  sr: TSearchRec;
begin
  ChDir(dir);
  if FindFirst(filemask, faAnyFile, sr)=0 then begin
    repeat
      if (sr.Name<>'.') and (sr.Name<>'..') then begin
Akkor ha egy mappát talál a keresés, akkor rekurzív módon ismét a ScanDirectory függvény kerül meghívásra, annak érdekében hogy a kiválasztott mappán belül lévő állományok is törlésre kerüljenek.
        if (sr.Attr and faDirectory)=faDirectory then begin
          ScanDirectory(sr.Name, filemask);
        end else begin
Találat esetén a DeleteFile hívásával végezzük el az állomány törlését.
          SysUtils.DeleteFile(sr.Name);
        end;
      end;
    until FindNext(sr)<>0;
  end;
  SysUtils.FindClose(sr);
  Chdir('..');
end;