0 users online | 0 Guests and 0 Registered

»

ID #1006

Delphi Projekt Verzeichnisse aufräumen

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φ 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.

Tags: -

Related entries:

Last update: 2009-10-12 21:31
Author: Rolf Warnecke
Revision: 1.0

{writePrintMsgTag} {writeSend2FriendMsgTag} {writePDFTag}
Please rate this FAQ:

Average rating: 0 (0 Votes)

completely useless 1 2 3 4 5 most valuable

You can comment this FAQ

Most popular FAQs RSS

  1. Display Resolution change
    (30 views)
  2. Scanned a Picture
    (13 views)

Latest FAQs RSS

  1. Scanned a Picture
    (2010-11-19 06:01)
  2. Display Resolution change
    (2010-02-09 18:01)