转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
Delphi快速读出注册表         ★★★★

Delphi快速读出注册表

作者:闵涛 文章来源:闵涛的学习笔记 点击数:691 更新时间:2009/4/23 18:42:43


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.


没有相关教程
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台