unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Registry, ComCtrls;

type
  TForm1 = class(TForm)
    keys: TTreeView;
    values: TListView;
    procedure FormCreate(Sender: TObject);
    procedure keysExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure keysChange(Sender: TObject; Node: TTreeNode);
  private
    { Private declarations }
    procedure CheckSubKeys(item: TTreeNode);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//Функция возвращает дексриптор корневого ключа реестра для ветки,
//который принадлежит элемент дерева item
function GetRootKey(item: TTreeNode): HKEY;
var
  temp: TTreeNode;
begin
  temp := item;
  while temp.Parent <> nil do
    temp := temp.Parent;
  GetRootKey := HKEY(temp.Data);
end;

//Функция путь ключа реестра, соответствующего заданному элементу (item)
//дерева. В путь не включается название корневого ключа
function GetKeyPath(item: TTreeNode): String;
var
  temp: TTreeNode;
  path: String;
begin
  temp := item;
  while temp.Parent <> nil do
  begin
    path := temp.Text + '\' + path;
    temp := temp.Parent;
  end;
  GetKeyPath := path;
end;

procedure TForm1.CheckSubKeys(item: TTreeNode);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create();
  //Проверка, есть ли в ключе реестра вложенные ключи
  reg.RootKey := GetRootKey(item);
  if reg.OpenKeyReadOnly(GetKeyPath(item)) then
  begin
    if reg.HasSubKeys() then
    begin
      //Добавляем фиктивный элемент (чтобы показывался "+" для
      //разворачивания ключа). Одновременно помечаем фиктивный элемент
      keys.Items.AddChild(item, '').Data := Pointer(-1);
    end;
    reg.CloseKey();
  end;
  reg.Free();
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  item: TTreeNode;
begin
  //Формирование списка корневых разделов реестра
  item := keys.Items.AddChild(nil, 'HKEY_CLASSES_ROOT');
  item.Data := Pointer(HKEY_CLASSES_ROOT);
  CheckSubKeys(item);

  item := keys.Items.AddChild(nil, 'HKEY_CURRENT_USER');
  item.Data := Pointer(HKEY_CURRENT_USER);
  CheckSubKeys(item);

  item := keys.Items.AddChild(nil, 'HKEY_LOCAL_MACHINE');
  item.Data := Pointer(HKEY_LOCAL_MACHINE);
  CheckSubKeys(item);

  item := keys.Items.AddChild(nil, 'HKEY_USERS');
  item.Data := Pointer(HKEY_USERS);
  CheckSubKeys(item);

  item := keys.Items.AddChild(nil, 'HKEY_CURRENT_CONFIG');
  item.Data := Pointer(HKEY_CURRENT_CONFIG);
  CheckSubKeys(item);
end;

procedure TForm1.keysExpanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  reg: TRegistry;
  subkeys: TStrings;
  i: Integer;
begin
  if Integer(Node.getFirstChild.Data) <> -1 then
    //Список подключей ранее был зачитан
    Exit;
  Node.DeleteChildren(); //Удаление фиктивного элемента дерева
  reg := TRegistry.Create();
  //Загрузка списка подключей выбранного ключа
  reg.RootKey := GetRootKey(Node);
  if reg.OpenKey(GetKeyPath(Node), False) then
  begin
    //Получение списка подключей
    subkeys := TStringList.Create();
    reg.GetKeyNames(subkeys);
    for i := 0 to subkeys.Count - 1 do
    begin
      //Добавление элемента для дочернего ключа (не забываем
      //проверять подключей у каждого дочернего ключа)
      CheckSubKeys(keys.Items.AddChild(Node, subkeys[i]));
    end;
    subkeys.Free();
    reg.CloseKey();
  end;
  reg.Free();
end;


procedure TForm1.keysChange(Sender: TObject; Node: TTreeNode);
var
  reg: TRegistry;
  valueItem: TListItem;
  item: TTreeNode;
  valueNames: TStrings;
  i: Integer;
begin
  item := keys.Selected;
  if item <> nil then
  begin
    //Зачитаем содержимое выбранного ключа в ListView (values)
    values.Clear;
    reg := TRegistry.Create();
    reg.RootKey := GetRootKey(item);
    if reg.OpenKeyReadOnly(GetKeyPath(item)) then
    begin
      valueNames := TStringList.Create();
      //Получение списка названий параметров
      reg.GetValueNames(valueNames);
      //Добавление каждого параметра в список
      for i := 0 to valueNames.Count - 1 do
      begin
        valueItem := values.Items.Add();
        if valueNames[i] = '' then
          valueItem.Caption := '<По умолчанию>'
        else
          valueItem.Caption := valueNames[i];

        //Получение типа и значения параметра
        case reg.GetDataType(valueNames[i]) of
          rdUnknown:
            valueItem.SubItems.Add('Неизвестно');
          rdString, rdExpandString:
            begin
              valueItem.SubItems.Add('Строка');
              valueItem.SubItems.Add(reg.ReadString(valueNames[i]));
            end;
          rdInteger:
            begin
              valueItem.SubItems.Add('Число');
              valueItem.SubItems.Add(IntToStr(reg.ReadInteger(valueNames[i])));
            end;
          rdBinary:
            valueItem.SubItems.Add('Двоичные данные');
        end;
      end;
      valueNames.Free();
      reg.CloseKey();
    end;

    reg.Free();
  end;
end;

end.
