Delphi快速读出注册表 (转)

Delphi快速读出注册表 (转)[@more@]

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.

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/10752043/viewspace-988755/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/10752043/viewspace-988755/