Програмно меняем Delphi's Tool list?

Previous  Top  Next

    
 

 

 

Code:

//**  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;

 

©Drkb::00041

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php