Mega Code Archive
Programmaticly manage Delphis Tool list
<![CDATA[
Title: programmaticly manage Delphi's Tool list?
//** class to manage Delphi's Tool list
//**
//** if Delphi is running restart it to see changes
//*************************************************************
unit DelphiTool;
interface
uses
Windows, SysUtils, Registry, classes;
type
TDelphiVersion = ({dvD5,} dvD6);
EDelphiTool_AlreadyRegistered = class(Exception);
EDelphiTool_InvalidIndex = class(Exception);
TDelphiTool = class
private
F_Registry: TRegistry;
F_ToolCount: Integer;
F_ToolPath: string;
protected
function OpenKey(key: string; CanCreate: Boolean): Boolean;
public
constructor Create;
destructor Destroy; override;
procedure SetRootKey(root_key: HKEY);
procedure SetDelphiVersion(version: TDelphiVersion);
procedure Add(params, path, title, workingDir: string);
procedure Edit(toolIndex: Integer; params, path, title, workingDir: string);
procedure Delete(toolIndex: Integer);
function IndexOf(toolTitle: string): Integer;
function Count: Integer;
procedure ToolProperties(toolIndex: Integer;
out params, path, title, workingDir: string);
end;
implementation
{ TDelphiTool }
constructor TDelphiTool.Create;
begin
inherited;
SetDelphiVersion(dvD6);
F_Registry := TRegistry.Create;
end;
destructor TDelphiTool.Destroy;
begin
F_Registry.CloseKey;
F_Registry.Free;
inherited;
end;
function TDelphiTool.IndexOf(toolTitle: string): Integer;
var
found: boolean;
loop: integer;
Count: integer;
begin
Result := -1;
if OpenKey(F_ToolPath, True) then
begin
loop := 0;
found := False;
while (loop and not found do
begin
found := F_Registry.ReadString('Title' + IntToStr(loop)) = toolTitle;
if not found then Inc(loop);
end;
end;
if found then Result := loop;
end;
procedure TDelphiTool.SetRootKey(root_key: HKEY);
begin
F_Registry.RootKey := root_key;
end;
procedure TDelphiTool.Add(params, path, title, workingDir: string);
var
Count: integer;
suffix: string;
begin
if OpenKey(F_ToolPath, True) then
begin
try
if IndexOf(title) then
begin
Count := F_ToolCount;
suffix := IntToStr(Count);
Inc(Count);
F_registry.WriteString('Params' + suffix, params);
F_registry.WriteString('Path' + suffix, path);
F_registry.WriteString('Title' + suffix, title);
F_registry.WriteString('WorkingDir' + suffix, workingDir);
F_registry.WriteInteger('Count', Count);
F_ToolCount := Count;
end
else
raise EDelphiTool_AlreadyRegistered.Create('[Add]: Tool is already registered.');
finally
F_Registry.CloseKey;
end;
end
end;
function TDelphiTool.OpenKey(key: string; CanCreate: Boolean): Boolean;
begin
Result := F_Registry.OpenKey(key, CanCreate);
if F_Registry.ValueExists('Count') then F_ToolCount := F_Registry.ReadInteger('Count')
else
F_ToolCount := 0;
end;
procedure TDelphiTool.Edit(toolIndex: Integer; params, path, title, workingDir: string);
// if you don't want to change one property set to ''
var
suffix: string;
begin
if (toolIndex or (toolIndex = F_ToolCount) then
raise EDelphiTool_InvalidIndex.Create('[Edit]: Invalid index.')
else
begin
if OpenKey(F_ToolPath, True) then
begin
try
suffix := IntToStr(toolIndex);
if (params '') then
F_registry.WriteString('Params' + suffix, params);
if (path '') then
F_registry.WriteString('Path' + suffix, path);
if (title '') then
F_registry.WriteString('Title' + suffix, title);
if (workingDir '') then
F_registry.WriteString('WorkingDir' + suffix, workingDir);
finally
F_Registry.CloseKey;
end;
end
end;
end;
procedure TDelphiTool.Delete(toolIndex: Integer);
var
suffix, tmp_suffix: string;
i: integer;
begin
if (toolIndex or (toolIndex = F_ToolCount) then
raise EDelphiTool_InvalidIndex.Create('[Delete]: Invalid index.')
else
begin
if OpenKey(F_ToolPath, True) then
begin
try
suffix := IntToStr(toolIndex);
for i := toolIndex + 1 to F_ToolCount - 1 do
begin
tmp_suffix := IntToStr(i);
F_registry.WriteString('Params' + suffix,
F_registry.ReadString('Params' + tmp_suffix));
F_registry.WriteString('Path' + suffix,
F_registry.ReadString('Path' + tmp_suffix));
F_registry.WriteString('Title' + suffix,
F_registry.ReadString('Title' + tmp_suffix));
F_registry.WriteString('WorkingDir' + suffix,
F_registry.ReadString('WorkingDir' + tmp_suffix));
suffix := IntToStr(i);
end;
F_registry.DeleteValue('Params' + suffix);
F_registry.DeleteValue('Path' + suffix);
F_registry.DeleteValue('Title' + suffix);
F_registry.DeleteValue('WorkingDir' + suffix);
F_registry.WriteInteger('Count', F_ToolCount - 1);
Dec(F_ToolCount);
finally
F_Registry.CloseKey;
end;
end;
end;
end;
procedure TDelphiTool.SetDelphiVersion(version: TDelphiVersion);
//*************************************************************
// for versions other then D6 lookup the registry and add lines
// like below , also add dvDx entries to TDelphiVersion
begin
case version of
dvD6: F_ToolPath := '\Software\Borland\Delphi\6.0\Transfer';
//** don't have D5, just guessing, so check it in the registry
//** before uncommenting
// dvD5: F_ToolPath:= '\Software\Borland\Delphi\5.0\Transfer';
end;
end;
function TDelphiTool.Count: Integer;
begin
Result := F_ToolCount;
end;
procedure TDelphiTool.ToolProperties(toolIndex: Integer; out params, path,
title, workingDir: string);
var
suffix: string;
begin
if (toolIndex or (toolIndex = F_ToolCount) then
raise EDelphiTool_InvalidIndex.Create('[ToolProperties]: Invalid index.')
else
begin
if OpenKey(F_ToolPath, True) then
begin
try
suffix := IntToStr(toolIndex);
params := F_registry.ReadString('Params' + suffix);
path := F_registry.ReadString('Path' + suffix);
title := F_registry.ReadString('Title' + suffix);
workingDir := F_registry.ReadString('WorkingDir' + suffix);
finally
F_Registry.CloseKey;
end;
end
end;
end;
end.
//*******************************************************************
//** how to use it?
//*******************************************************************
unit Unit1;
interface
uses
Windows, {...}, DelphiTool;
//...
//...
//...
var
Form1: TForm1;
implementation
procedure TForm1.Button1Click(Sender: TObject);
begin
with TDelphiTool.Create do
try
// Delete(IndexOf('MyTool'));
Add('', Application.ExeName, 'MyTool', ExtractFilePath(Application.ExeName));
// Edit(IndexOf('MyTool'), '', '', 'MyTool But Edited', '');
finally
Free;
end;
end;
]]>