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.
没有相关教程
|