Автор: http://www.swissdelphicenter.ch

program Clean;

 { 
  The program registers as a explorer extension. 
  Use rightclick on a Delphiproject directory and choose Clean Delphi files. 
  Place the executable somewhere in program files and run once. 

  Dieses Program registriert sich beim Ausfuhren als 
  Explorer-Erweiterung. 
  Mit einem Rechtsklick auf ein Delphi Verzeichnis und 
  einem Klick auf "Clean Delphi files" werden die Verzeichnisse "aufgeraumt". 
}

 uses
   SysUtils, Registry, WinTypes, FileCtrl;

 var
   dir: string;

 const
   // HKEY_CLASSES_ROOT 
  DirExtensionKey = 'Directory\shell\clean';
   SubKey = '\command';

 procedure PerformAction(const dir, fname: string);
   // Set selected attributes for a file. 
begin
   if not SysUtils.DeleteFile(dir + fname) then
   begin
   end;
 end;

 procedure ScanDirectory(const dir, filemask: string);
   // Call performaction for every file which looks like filemask 
var
   SearchRec: TSearchRec;
 begin
   if not DirectoryExists(dir) then
   begin
     MessageBox(0, 'Directory not found', 'Clean', mb_ok);
     Halt;
   end;
   if dir <> '' then ChDir(dir);
   // Search subdirs ? 
  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;
   // Ennumerate all files in current directory 
  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);
   // Directory up 
  Chdir('..');
 end;

 procedure DoPopupReg;
 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('', 'Clean Del&phi files');
       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
   DoPopupReg;
   if ParamCount > 0 then dir := ParamStr(1)
   else
      Exit;
   ScanDirectory(dir, '*.dcu');
   ScanDirectory(dir, '*.~*');
   // You can add more files here 
end.