whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1548)

Database (90)
Files (137)
Forms (107)
Graphic (116)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

28 Visitors Online


 
...Clean up the Delphi Project Directories?
Autor: Daan de Haas
[ Print tip ]  

Tip Rating (15):  
     


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.


 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners