Програмно меняем 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 < F_ToolCount) 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) < 0 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 < 0) 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 < 0) 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 < 0) 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;
Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...