...Delphi Projekt Verzeichnisse aufräumen?
Autor: Daan de Haas
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.
printed from
www.swissdelphicenter.ch
developers knowledge base