Delphi快速读出注册表

file://不用再修改VCL.
file://结构定义的可能不是很好。

/////main.dfm
object Form1: TForm1
  Left = 192
  Top = 107
  Width = 544
  Height = 375
  Caption = '注册表'
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = '宋体'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 12
  object Splitter1: TSplitter
    Left = 209
    Top = 0
    Width = 3
    Height = 348
    Cursor = crHSplit
  end
  object TreeView1: TTreeView
    Left = 0
    Top = 0
    Width = 209
    Height = 348
    Align = alLeft
    Indent = 19
    TabOrder = 0
    OnChange = TreeView1Change
    OnExpanding = TreeView1Expanding
  end
  object ListView1: TListView
    Left = 212
    Top = 0
    Width = 324
    Height = 348
    Align = alClient
    Columns = <
      item
        AutoSize = True
        Caption = '名称'
      end
      item
        AutoSize = True
        Caption = '数据'
      end>
    TabOrder = 1
    ViewStyle = vsReport
  end
end
////////////////////////////////////////////////////////
file://main.pas

unit main;

interface

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

type
  TForm1 = class(TForm)
    Splitter1: TSplitter;
    TreeView1: TTreeView;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
  private
    procedure ExpandSubNode(Node:TTreeNode;Info:HKEY;Index:Integer;bRoot:Boolean=False);
    procedure GetKeyValue(Node: TTreeNode; var SubKey: String);
    { Private declarations }
  public
    { Public declarations }
  end;

type TNodeMyInfo=record
  bRootNode:Boolean;
  bVisitored:Boolean;
  Info:HKey;
  Index:Integer;
end;

type PNodeInfo=^TNodeMyInfo;

var
  Form1: TForm1;

implementation

{$R *.DFM}
const
  MaxNumber=5;
  RootValue:array [0..MaxNumber] of DWord=
  (
   HKEY_CLASSES_ROOT,
   HKEY_CURRENT_USER,
   HKEY_LOCAL_MACHINE,
   HKEY_USERS,
   HKEY_CURRENT_CONFIG,
   HKEY_DYN_DATA
  );
  RootKeyName :array [0..MaxNumber] of String=
  (
   'HKEY_CLASSES_ROOT',
   'HKEY_CURRENT_USER',
   'HKEY_LOCAL_MACHINE',
   'HKEY_USERS',
   'HKEY_CURRENT_CONFIG',
   'HKEY_DYN_DATA'
  );
procedure TForm1.FormCreate(Sender: TObject);
const MyComputer='我的电脑';
var
  i:Integer;
  RootNode,SubNode:TTreeNode;
begin
  RootNode:=TreeView1.Items.Add(nil,MyComputer);
  RootNode.ImageIndex :=1;
  for i:=0 to MaxNumber do
  begin
    SubNode:=TreeView1.Items.AddChild(RootNode,RootKeyName[i]);
    SubNode.ImageIndex:=1;
    ExpandSubNode(SubNode,RootValue[i],I,True);
  end;
end;

procedure TForm1.ExpandSubNode(Node:TTreeNode;Info:HKEY;Index:Integer;bRoot:Boolean=False);
var
  List:TStringList;
  SubKey:string;
  Reg:TRegistry;
  i:Integer;
  P:PNodeInfo;
  tempNode:TTreeNode;
begin
  New(P);
  P.bRootNode :=bRoot;
  P.Info :=Info;
  P.Index :=Index;
  P.bVisitored :=False;
  Node.Data:=P;
  Reg:=TRegistry.Create;
  file://case
  Reg.RootKey :=Info;
  List:=TStringList.Create;
  GetKeyValue(Node,SubKey);
  if Reg.OpenKey(SubKey,False) then
  begin
    Reg.GetKeyNames(List);
    List.Sort;
    for i:=0 to List.Count-1 do
    begin
      tempNode:=TreeView1.Items.AddChild(Node,List.Strings[i]);
      tempNode.ImageIndex :=1;
    end;
  end;
  Reg.CloseKey;
  Reg.Free;
  List.Free;
end;

procedure TForm1.GetKeyValue(Node:TTreeNode;var SubKey:String);
var ParentNode:TTreeNode;
begin
  if (Node.Level =0) or (Node.Level=1) then Exit;
  SubKey:='\'+Node.Text;
  ParentNode:=Node.Parent;
  while (ParentNode<>nil) and (ParentNode.Level<>1)  do
  begin
    SubKey:='\'+ParentNode.Text +SubKey;
    ParentNode:=ParentNode.Parent;
  end;
  SubKey:=SubKey+'\';
end;

procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var I:integer;
begin
  if Node.Level=0 then Exit;
  if not TNodeMyInfo(Node.Data^).bVisitored then
  begin
    Screen.Cursor:=crHourGlass;
    for i:=0 to Node.Count-1 do
       (Node.Item[i],TNodeMyInfo(Node.Data^).Info,TNodeMyInfo(Node.data^).Index);
    PNodeInfo(Node.Data).bVisitored:=True;
    Screen.Cursor:=crDefault;
  end;
end;

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
  Reg:TRegistry;
  SubString:String;
  List:TStringList;
  I:integer;
  Item:TListItem;
  DataInfo:TRegDataInfo;
  Value:Variant;
  P:String;
begin
  if Node.Level=0 then Exit;
  ListView1.Items.Clear;
  List:=TStringList.Create;
  Reg:=TRegistry.Create;
  Reg.RootKey:=TNodeMyInfo(Node.Data^).Info;
  GetKeyValue(Node,SubString);
  if Reg.OpenKey(SubString,False) then
  begin
    Reg.GetValueNames(List);
    List.Sort;
    for i:=0 to List.Count-1 do
    begin
      Value:='未设键值';  reg.read
      Reg.GetDataInfo(List.Strings[i],DataInfo);
      case DataInfo.RegData of
        rdUnknown:
          Value:='Unknown';
        rdExpandString:
          Value:=Reg.ReadString(List.Strings[i]);
        rdBinary:
        begin
          Value:=Reg.ReadBinaryData(List.Strings[i],P,DataInfo.DataSize);
          Value:=P;
        end;
        rdString:
          Value:=Reg.ReadString(List.Strings[i]);
        rdInteger:
          Value:=Reg.ReadInteger(List.Strings[i]);
      end;
      Value:=varToStr(Value);
      Item:=ListView1.Items.Add;
      if List.Strings[i]='' then
        Item.Caption:='(默认)'
      else
        Item.Caption :=List.Strings[i];
      Item.SubItems.Add(Value);
    end;
  end;
  Reg.CloseKey;
  Reg.Free;
  List.Free;
end;

end.

本文地址：http://com.8s8s.com/it/it6258.htm