jvregistrytreeview.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvRegistryTreeView.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Th鰎nqvist [peter3 at sourceforge dot net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  A treeview that displays the keys from the registry

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvRegistryTreeview.pas,v 1.25 2005/02/17 10:20:46 marquardt Exp $

unit JvRegistryTreeView;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, SysUtils, Classes, Graphics, Controls, Forms,
  ComCtrls, Registry, ImgList,
  JvComponent, JvTypes;

type

  TJvRegistryTreeView = class(TJvCustomTreeView)
  private
    FRegistryKeys: TJvRegKeys;
    FInternalImages: TImageList;
    FListView: TCustomListView;
    FRootCaption: string;
    FDefaultCaption: string;
    FDefaultNoValue: string;
    FReg: TRegistry;
    procedure SetDefaultCaption(Value: string);
    procedure SetDefaultNoValue(Value: string);
    procedure SetRootCaption(Value: string);
    procedure SetRegistryKeys(Value: TJvRegKeys);
    procedure BuildTree;
    function FillListView(Node: TTreeNode): Boolean;
    procedure SetDefaultImages;
    function GetCurrentPath: string;
    function GetShortPath: string;
    function GetCurrentKey: HKEY;
    function GetShowHint: Boolean;
    procedure SetShowHint(Value: Boolean);
    procedure OpenRegistry(Node: TTreeNode);
    procedure CloseRegistry;
    function FindChildNode(ParentNode: TTreeNode;
      const Name: string): TTreeNode;
  protected
    procedure RefreshSubTrees(ANode: TTreeNode; Key, OldKey: string; Level: Integer); virtual;
    function CanCollapse(Node: TTreeNode): Boolean; override;
    function CanExpand(Node: TTreeNode): Boolean; override;
    procedure Change(Node: TTreeNode); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function SaveKey(const Filename: string): Boolean;
    function LoadKey(const Filename: string): Boolean;
    procedure RefreshNode(Node: TTreeNode);
    function AddKey(ParentNode: TTreeNode; const KeyName: string): TTreeNode;
    function AddStringValue(ParentNode: TTreeNode; const Name, Value: string): TTreeNode;
    function AddBinaryValue(ParentNode: TTreeNode; const Name: string; var Buf; BufSize: Integer): TTreeNode;
    function AddDWORDValue(ParentNode: TTreeNode; const Name: string; Value: DWORD): TTreeNode;
    property CurrentPath: string read GetCurrentPath;
    property ShortPath: string read GetShortPath;
    property CurrentKey: HKEY read GetCurrentKey;
    property Items stored False;
  published
    property Align;
    property Color;
    property BorderStyle;
    property Font;
    property ParentFont;
    property ParentShowHint;
    property ShowButtons;
    property ShowHint: Boolean read GetShowHint write SetShowHint;
    property ShowLines;
    property ShowRoot;
    property ReadOnly default True;
    property RightClickSelect;
    property Indent;
    property HideSelection;
    property RegistryKeys: TJvRegKeys read FRegistryKeys write SetRegistryKeys default
      [hkCurrentUser, hkLocalMachine];
    property ListView: TCustomListView read FListView write FListView;
    property RootCaption: string read FRootCaption write SetRootCaption;
    property DefaultCaption: string read FDefaultCaption write SetDefaultCaption;
    property DefaultNoValueCaption: string read FDefaultNoValue write SetDefaultNoValue;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnDragDrop;
    property OnStartDock;
    property OnEndDock;
    property OnDockDrop;
    property OnEditing;
    property OnEdited;
    property OnExpanding;
    property OnExpanded;
    property OnCollapsing;
    property OnCollapsed;
    property OnChanging;
    property OnChange;
    property OnCompare;
    //PRY 2002.06.04
    {$IFDEF COMPILER6_UP}
    property OnAddition;
    {$ENDIF COMPILER6_UP}
    // PRY END
    property OnDeletion;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvRegistryTreeview.pas,v $';
    Revision: '$Revision: 1.25 $';
    Date: '$Date: 2005/02/17 10:20:46 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  JvResources;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvRegistryTreeView.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvRegistryTreeView.res}
{$ENDIF UNIX}

const
  imMyPC = 0;
  imClosed = 1;
  imOpen = 2;
  imText = 3;
  imBin = 4;

type
  TRegistryAccessProtected = class(TRegistry);
  TListViewAccessProtected = class(TCustomListView);

function SetRootKey(Reg: TRegistry; Node: TTreeNode): Boolean;
var
  TmpNode: TTreeNode;
begin
  Result := False;
  if Node <> nil then
  begin
    TmpNode := Node;
    while TmpNode <> nil do
    begin
      if Longint(TmpNode.Data) < 0 then
      begin
        Reg.RootKey := Longint(TmpNode.Data);
        Result := True;
        Break;
      end;
      TmpNode := TmpNode.Parent;
    end;
  end;
end;

function FixupPath(Key: string): string;
begin
  if Key = '' then
    Result := '\'
  else
  if AnsiLastChar(Key) <> '\' then
    Result := Key + '\'
  else
    Result := Key;
  if Length(Result) > 1 then
    if (Result[1] = '\') and (Result[2] = '\') then
      Result := Copy(Result, 2, Length(Result));
end;

function GetFullPath(ANode: TTreeNode): string;
var
  TmpNode: TTreeNode;
begin
  Result := '';
  if ANode = nil then
    Exit;
  TmpNode := ANode;
  while TmpNode <> nil do
  begin
    Result := TmpNode.Text + '\' + Result;
    TmpNode := TmpNode.Parent;
  end;
  if (Result <> '') and (AnsiLastChar(Result) = '\') then
    SetLength(Result, Length(Result) - 1);
end;

function GetKeyPath(ANode: TTreeNode): string;
var
  TmpNode: TTreeNode;
begin
  Result := '';
  if ANode = nil then
    Exit;
  TmpNode := ANode;
  while (TmpNode.Parent <> nil) and (TmpNode.Parent.Parent <> nil) do
  begin
    Result := TmpNode.Text + '\' + Result;
    TmpNode := TmpNode.Parent;
  end;
  if (Length(Result) > 0) and (Result[1] <> '\') then
    Result := '\' + Result;
end;

{
function GetPreviousKey(Key: string): string;
var
  I: Integer;
begin
  Result := Key;
  if (Result = '') or (Result = '\') then Exit;
  for I := Length(Result) - 1 downto 1 do
    if Result[I] = '\' then
    begin
      Result := Copy(Result,1,I - 1);
      Exit;
    end;
end;

function StripChars(Str: string; Ch: Char): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(Str) do
  begin
    if Str[I] = Ch then Continue;
    AppendStr(Result,str[I]);
  end;
end;
}

function BufToStr(Buffer: array of Byte; BufSize: Integer): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to BufSize - 1 do
    Result := Result + ' ' + IntToHex(Buffer[I], 2);
end;

function RegTypes(AType: Integer): string;
const
  StrTypes : array [0..10] of PChar =
   ('REG_NONE', 'REG_SZ', 'REG_EXPAND_SZ', 'REG_BINARY', 'REG_DWORD',
    'REG_DWORD_BIG_ENDIAN', 'REG_LINK', 'REG_MULTI_SZ', 'REG_RESOURCE_LIST',
    'REG_FULL_RESOURCE_DESCRIPTOR', 'REG_RESOURCE_REQUIREMENTS_LIST');
begin
  if (AType >= 0) and (AType <= High(StrTypes)) then
    Result := StrTypes[AType]
  else
    Result := 'UNKNOWN';
end;

//=== { TJvRegistryTreeView } ================================================

constructor TJvRegistryTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRegistryKeys := [hkCurrentUser, hkLocalMachine];
  FRootCaption := RsMyComputer;
  FDefaultCaption := RsDefaultCaption;
  FDefaultNoValue := RsDefaultNoValue;
  SetDefaultImages;
end;

destructor TJvRegistryTreeView.Destroy;
begin
  if Assigned(FListView) and (TListViewAccessProtected(FListView).SmallImages = FInternalImages) then
    TListViewAccessProtected(FListView).SmallImages := nil;
  if Assigned(FInternalImages) then
    FInternalImages.Free;
  inherited Destroy;
end;

function TJvRegistryTreeView.GetCurrentPath: string;
begin
  Result := GetFullPath(Selected);
end;

function TJvRegistryTreeView.GetShortPath: string;
begin
  Result := GetKeyPath(Selected);
end;

function TJvRegistryTreeView.GetCurrentKey: HKEY;
begin
  OpenRegistry(Selected);
  Result := TRegistryAccessProtected(FReg).GetKey(ShortPath);
  CloseRegistry;
end;

function TJvRegistryTreeView.GetShowHint: Boolean;
begin
  Result := inherited ShowHint;
end;

procedure TJvRegistryTreeView.SetShowHint(Value: Boolean);
begin
  if inherited ShowHint <> Value then
  begin
    inherited ShowHint := Value;
    Items.Clear; // AV's in ComCtrl32.dll without this
    RecreateWnd;
  end;
end;

procedure TJvRegistryTreeView.SetDefaultImages;
begin
  if not Assigned(FInternalImages) then
    FInternalImages := TImageList.CreateSize(16, 16);
  if FInternalImages.Count = 0 then
  begin
    FInternalImages.GetInstRes(HInstance, rtBitmap, 'JvRegistryTreeViewMYCOMPUTER', 16, [], clFuchsia);
    FInternalImages.GetInstRes(HInstance, rtBitmap, 'JvRegistryTreeViewCLOSEDFOLDER', 16, [], clFuchsia);
    FInternalImages.GetInstRes(HInstance, rtBitmap, 'JvRegistryTreeViewOPENFOLDER', 16, [], clFuchsia);
    FInternalImages.GetInstRes(HInstance, rtBitmap, 'JvRegistryTreeViewTEXTIMAGE', 16, [], clFuchsia);
    FInternalImages.GetInstRes(HInstance, rtBitmap, 'JvRegistryTreeViewBINIMAGE', 16, [], clFuchsia);
  end;
  Images := FInternalImages;
end;

procedure TJvRegistryTreeView.RefreshSubTrees(ANode: TTreeNode; Key, OldKey: string; Level: Integer);
var
  AStrings: TStringList;
  I: Integer;
  NewNode: TTreeNode;
  AKey: string;
begin
  AKey := FixupPath(OldKey);
  if FReg.OpenKeyReadOnly(Key) and FReg.HasSubKeys then
  begin
    ANode.HasChildren := True;
    Dec(Level);
    if Level = 1 then
    begin
      AStrings := TStringList.Create;
      try
        FReg.GetKeyNames(AStrings);
        for I := 0 to AStrings.Count - 1 do
        begin
          if AStrings[I] = '' then
            AStrings[I] := Format('%.04d', [I]);
          NewNode := Items.AddChild(ANode, AStrings[I]);
          NewNode.ImageIndex := imClosed;
          NewNode.SelectedIndex := imOpen;
          RefreshSubTrees(NewNode, AStrings[I], AKey + Key, Level);
        end;
      finally
        AStrings.Free;
      end;
    end;
  end;
  FReg.OpenKeyReadOnly(AKey);
end;

function TJvRegistryTreeView.FillListView(Node: TTreeNode): Boolean;
var
  I, J: Integer;
  TmpItem: TListItem;
  S, T: string;
  DefaultSet: Boolean;
  Info: TRegKeyInfo;
  D: array of Byte;
  DataType: Cardinal;
  Len, Len1: Cardinal;