Tips (1541)

Tip Bewertung (16):

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 Ausführen als
  Explorer-Erweiterung.
  Mit einem Rechtsklick auf ein Delphi Verzeichnis und
  einem Klick auf "Clean Delphi files" werden die Verzeichnisse "aufgeräumt".
}

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.