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