ajregistrybrowser.~pas

是不是天天看見MS的注冊表看膩了

unit ajRegistryBrowser;


interface

uses
  Forms, Windows, Controls, ExtCtrls, ComCtrls, StdCtrls, Classes, Buttons,
  SysUtils, ImgList, Registry, Menus, ajRecentKeys,  ajAlterMenu;     

type
  TajBrowserException = class(Exception);

type
  TajRegPathManager = class(TObject)
  private
    fRootHKEY     : HKEY;
    fRootHKEYText : string;
    fFullPath     : string;
    fSubPath      : string;
  protected
    procedure SetfFullPath  (Value : string);
  public
    property  RootHKEY      : HKEY      read fRootHKEY;
    property  RootHKEYText  : string    read fRootHKEYText;
    property  FullPath      : string    read fFullPath  write SetfFullPath;
    property  SubPath       : string    read fSubPath;
  end;

type
  TfrmRegBrowser = class(TForm)
    Bevel1          : TBevel;
    Bevel2          : TBevel;
    btnAddGuid      : TSpeedButton;
    btnBookmark     : TSpeedButton;
    btnCancel       : TSpeedButton;
    btnRefresh      : TSpeedButton;
    btnUpdate       : TSpeedButton;
    edRegPath       : TEdit;
    imButtons       : TImageList;
    imTreeView      : TImageList;
    lvPopupMenu     : TPopupMenu;
    lvRegistry      : TListView;
    MainMenu        : TMainMenu;
    mnuAddGUID      : TMenuItem;
    mnuBinary       : TMenuItem;
    mnuBookmarks    : TMenuItem;
    mnuDeleteValue  : TMenuItem;
    mnuDWORD        : TMenuItem;
    mnuEditValue    : TMenuItem;
    mnuExit         : TMenuItem;
    mnuNewValue     : TMenuItem;
    mnuOptions      : TMenuItem;
    mnuPopAddKey    : TMenuItem;
    mnuPopBookmark  : TMenuItem;
    mnuRefresh      : TMenuItem;
    mnuRegistry     : TMenuItem;
    mnuString       : TMenuItem;
    mnuUpdate       : TMenuItem;
    mnuView         : TMenuItem;
    mnuXPMenu       : TMenuItem;
    N1              : TMenuItem;
    N2              : TMenuItem;
    N4              : TMenuItem;
    pnBack          : TPanel;
    pnRegPath       : TPanel;
    pnToolbar       : TPanel;
    Splitter        : TSplitter;
    StatusBar       : TStatusBar;
    tvPopupMenu     : TPopupMenu;
    tvRegistry      : TTreeView;
    N3: TMenuItem;
    procedure FormCreate            (Sender : TObject);
    procedure FormShow              (Sender : TObject);
    procedure FormClose             (Sender : TObject; var Action : TCloseAction);
    procedure FormDestroy           (Sender : TObject);
    procedure mnuAddGUIDClick       (Sender : TObject);
    procedure mnuAddKeyClick        (Sender : TObject);
    procedure mnuBookmarkClick      (Sender : TObject);
    procedure mnuDeleteKeyClick     (Sender : TObject);
    procedure mnuDeleteValueClick   (Sender : TObject);    
    procedure mnuExitClick          (Sender : TObject);
    procedure mnuRefreshClick       (Sender : TObject);
    procedure mnuUpdateClick        (Sender : TObject);
    procedure mnuXPMenuClick        (Sender : TObject);
    procedure tvRegistryChange      (Sender : TObject; Node : TTreeNode);
    procedure tvRegistryExpanding   (Sender : TObject; Node : TTreeNode; var AllowExpansion : boolean);
    procedure tvRegistryMouseDown   (Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer);
    procedure lvPopupMenuPopup      (Sender : TObject);
  private
    { Private declarations }
    fajAlterMenu      : TajAlterMenu;
    fajRecentKeys     : TajRecentKeys;
    fRegPathManager   : TajRegPathManager;
    fIsPropertyEditor : boolean;
  protected
    procedure SetfIsPropertyEditor  (Value : boolean);
    procedure AddListNames          (SubPath : string; List : TStringList);
    procedure AddTreeNodes          (Node : TTreeNode; List : TStrings);
    procedure GetRegKeyValueNames   (SubPath : string);
    procedure GetRegKeyNames        (SubPath : string; Node : TTreeNode);
    procedure RecentKeyClick        (KeyName : string);
    function  GetRegistryPath       : string;
    procedure SetRegistryPath       (Value : string);
    procedure SetBookmarkControls   (Tag : integer);
    procedure DeleteBranchRoot      (HKEYText : string);
    procedure AddKey                (FullPath : string);
    procedure DeleteKey             (FullPath : string);
    procedure DeleteValue           (KeyValue : string);    
  public
    { Public declarations }
    function  GoToBookmark          (FullPath : string) : boolean;
    property  IsPropertyEditor  : boolean   read fIsPropertyEditor  write SetfIsPropertyEditor;
    property  RegistryPath      : string    read GetRegistryPath    write SetRegistryPath;
  end;

var
  frmRegBrowser : TfrmRegBrowser;

implementation

{$R *.DFM}

{$IFDEF VER140}   // Delphi6
  {$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}

uses
  Graphics, CommCtrl, Dialogs, ComObj, ActiveX, ajRegistry;

const

  {................................................................................................}

  cNumRegValType  = 11; // Number of type supported.
  cRegValTypeLookUp : array[0..pred(cNumRegValType)] of record
    Description : string;
    Value       : DWORD;
  end = ((Description : 'REG_NONE';                       Value : REG_NONE),
         (Description : 'REG_SZ';                         Value : REG_SZ),
         (Description : 'REG_EXPAND_SZ';                  Value : REG_EXPAND_SZ),
         (Description : 'REG_BINARY';                     Value : REG_BINARY),
         (Description : 'REG_DWORD';                      Value : REG_DWORD),
         (Description : 'REG_DWORD_BIG_ENDIAN';           Value : REG_DWORD_BIG_ENDIAN),
         (Description : 'REG_LINK';                       Value : REG_LINK),
         (Description : 'REG_MULTI_SZ';                   Value : REG_MULTI_SZ),
         (Description : 'REG_RESOURCE_LIST';              Value : REG_RESOURCE_LIST),
         (Description : 'REG_FULL_RESOURCE_DESCRIPTOR';   Value : REG_FULL_RESOURCE_DESCRIPTOR),
         (Description : 'REG_RESOURCE_REQUIREMENTS_LIST'; Value : REG_RESOURCE_REQUIREMENTS_LIST));

  cMyRegistry     = 0;
  cClosedPage     = 1;
  cOpenPage       = 2;
  cClosedBook     = 3;
  cOpenBook       = 4;
  cDateValue      = 5;
  cStringValue    = 6;
  cBinaryValue    = 7;
  cAddBookmark    = 10;
  cRemoveBookmark = 11;

type
  TajRegReadWrite = (tRegRead, tRegWrite);



function FileTimeToDateTime(FileTime : TFileTime) : TDateTime;
// Convert FileTime to TDateTime.
var
  SystemTime  : TSystemTime;
begin
  FileTimeToLocalFileTime(FileTime, FileTime);
  FileTimeToSystemTime(FileTime, SystemTime);
  Result  := SystemTimeToDateTime(SystemTime);
end; {FileTimeToDateTime}


procedure RegSubMenuSettings(Menu : TMenuItem; RegPath : string; ReadWrite : TajRegReadWrite);
var
  lp1   : integer;
  Name  : string;
begin
  with TRegistry.Create do begin
    try
      RootKey := cRegHKEY;
      if OpenKey(RegPath, ReadWrite = tRegWrite) then begin
        for lp1 := 0 to pred(Menu.Count) do begin
          if (Menu.Items[lp1].Count > 0) then
            RegSubMenuSettings(Menu.Items[lp1], RegPath, ReadWrite)
          else begin
            Name  := StripHotKey(Menu.Items[lp1].Caption);
            if (Name <> '-') then begin
              if (ReadWrite = tRegRead) then begin
                if ValueExists(Name) then begin
                  if (Menu.Items[lp1].Checked <> ReadBool(Name)) then
                    Menu.Items[lp1].Click;
                end; {if}
              end else
                WriteBool(Name, Menu.Items[lp1].Checked);
            end; {if}
          end; {if}
        end; {for}
        CloseKey;
      end; {if}
    finally;
      Free;
    end; {try}
  end; {with}
end; {RegSubMenuSettings}


function GetNodePath(Node : TTreeNode) : string;
// Iterate from the node to the root building up the path string.
begin
  Result  := Node.Text;
  while (Node.Level > 1) do begin
    Node    := Node.Parent;
    Result  := Node.Text + '\' + Result;
  end; {while}
end; {GetNodePath}


procedure SetNodeImages(Node : TTreeNode; HasChildren : boolean);
begin
  if HasChildren then begin
    Node.HasChildren    := true;
    Node.ImageIndex     := cClosedBook;
    Node.SelectedIndex  := cOpenBook;
  end else begin
    Node.ImageIndex     := cClosedPage;
    Node.SelectedIndex  := cOpenPage;
  end; {if}
end; {SetNodeImages}


procedure TajRegPathManager.SetfFullPath(Value : string);
var
  KeyText   : string;
  DelimPos  : integer;
begin
  if (fFullPath <> Value) then begin
    fFullPath := Value;
    DelimPos  := Pos('\', fFullPath);
    if (DelimPos > 0) then begin
      KeyText   := Copy(fFullPath, 1, pred(DelimPos));
      fSubPath  := Copy(fFullPath, succ(DelimPos), Length(fFullPath) - DelimPos);
    end else begin
      KeyText   := fFullPath;
      fSubPath  := '';
    end; {if}

    if (fRootHKEYText <> KeyText) then begin
      fRootHKEYText := KeyText;
      fRootHKEY     := HKEYTextToHKEY(fRootHKEYText);
    end; {if}

  end; {if}
end; {SetfFullPath}


procedure TfrmRegBrowser.FormCreate(Sender : TObject);
var
  lp1           : integer;
  Node1, Node2  : TTreeNode;
begin
//  Width   := 632;
//  Height  := 376;

  btnBookmark.Tag                 := cAddBookmark;                        // Initialize bookmark Tags.
  mnuPopBookmark.Tag              := cAddBookmark;

  IsPropertyEditor                := false;                               // Not a property editor - might be later.

  pnBack.DoubleBuffered           := true;                                // Stop some of the flicker.
  pnRegPath.DoubleBuffered        := true;
  edRegPath.DoubleBuffered        := true;

  fajAlterMenu                    := TajAlterMenu.Create(Self);
  fajRecentKeys                   := TajRecentKeys.Create(mnuBookmarks, fajAlterMenu, cRegRegistryBrowser);  // Add bookmark support.
  fajRecentKeys.OnRecentKeyClick  := RecentKeyClick;                      // Connect the event handler.

  fRegPathManager                 := TajRegPathManager.Create;            // Create the path manager.

  tvRegistry.Items.BeginUpdate;                                           // Add the default nodes ...
  Node1             := tvRegistry.Items.Add(nil, 'и