unit1.pas

注册表分析系统附源码

{本源码是自由程序，你可以把它用在任何地方，但不允许以任何形式把它单独用作商业用途。

本人是一个普通的打工仔，为了给朋友们献上更好的源码和控件，我需要你的支持，如果你认为本程序对你有帮助，希望你寄任意你愿意数额的RMB给我以资鼓励和支持，如果你认为不值，也希望你寄一张PostCard或者一封Email对我予以支持。

深圳市福田区联合广场41楼恒星威电子有限公司GPS部 艾真保  收
518026

mailto:[e-mail]

HomePage:
  http://vip.6to23.com/aizb}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls{$IFDEF VER140},Variants, ExtCtrls{$ENDIF};

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    ListView1: TListView;
    ProgressBar1: TProgressBar;
    Splitter1: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure FormResize(Sender: TObject);
  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
uses Registry;
{$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'
  );

{ TForm1 }

procedure TForm1.ExpandSubNode(Node: TTreeNode; Info: HKEY; Index: Integer;
  bRoot: Boolean);
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;
  List:=TStringList.Create;
  try
    Reg.RootKey :=Info;
    GetKeyValue(Node,SubKey);
    if Reg.OpenKey(SubKey,False) then
    begin
      List.BeginUpdate;
      try
        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;
      finally
        List.EndUpdate;
      end;
    end;
    Reg.CloseKey;
  finally
    Reg.Free;
    List.Free;
  end;
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.FormCreate(Sender: TObject);
const MyComputer='我的电脑';
var
  i:Integer;
  RootNode,SubNode:TTreeNode;
begin
  TreeView1.Items.BeginUpdate;
  try
    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;
  finally
    TreeView1.Items.EndUpdate;
  end;
end;

procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var I,Prog,ProgOld,Count:integer;
begin
  if Node.Level=0 then Exit;
  if not TNodeMyInfo(Node.Data^).bVisitored then
  begin
    Screen.Cursor:=crHourGlass;
    TreeView1.Items.BeginUpdate;
    try
      ProgOld:=0;
      ProgressBar1.Position:=0;
      Count:=Node.Count;
      for i:=0 to Count-1 do
      begin
        ExpandSubNode(Node.Item[i],TNodeMyInfo(Node.Data^).Info,TNodeMyInfo(Node.data^).Index);
        Prog:=(i+1)*100 DIV Count;
        if Prog<>ProgOld then
        begin
          ProgressBar1.Position:=Prog;
          ProgOld:=Prog;
        end;
      end;
    finally
      TreeView1.Items.EndUpdate;
    end;
    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,j:integer;
  Item:TListItem;
  DataInfo:TRegDataInfo;
  Value:Variant;
  s:String;
  p:PByte;
  sName:String;
  sValue: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;
    List.BeginUpdate;
    try
      for i:=0 to List.Count-1 do
      begin
        Value:='未设键值';//  reg.read
        sName:=List.Strings[i];
        Reg.GetDataInfo(sName,DataInfo);
        case DataInfo.RegData of
          rdUnknown:
            Value:='Unknown';
          rdExpandString:
            Value:=Reg.ReadString(sName);
          rdBinary:
          begin
            GetMem(p,DataInfo.DataSize);
            Reg.ReadBinaryData(sName,p^,DataInfo.DataSize);
            sValue:='';
            For j:=0 to DataInfo.DataSize-1 do
            begin
              sValue:=sValue+IntToHex(Byte(p^),2);
              Inc(p);
            end;
            Value:=sValue;
          end;
          rdString:
            Value:=Reg.ReadString(sName);
          rdInteger:
            Value:=Reg.ReadInteger(sName);
        end;
        Value:=varToStr(Value);
        if sName='' then
          s:='(默认)'
        else
          s :=sName;
        Item:=ListView1.Items.Add;
        Item.Caption:=s;
        Item.SubItems.Add(Value);
      end;
    finally
      List.EndUpdate;
    end;
  end;
  Reg.CloseKey;
  Reg.Free;
  List.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  TreeView1.Width:=Width DIV 2;
end;

end.