Delphi 操作注册表

对注册表的操作，Delphi提供了TRegistry类，它直接继承自TObject类。

 

引用单元：

uses
  Registry;

 

属性：

  RootKey属性

    指定当前操作的注册表主键 有如下5种：

    HKEY_CLASSES_ROOT

    HKEY_CURRENT_USER (默认)

    HKEY_LOCAL_MACHINE

    HKEY_USERS

    HKEY_CURRENT_CONFIG

 

方法：

    注：有些方法需要程序具有一定的权限才能使用；比如：LoadKey()方法 需要设置 'SeRestorePrivilege' 权限、SaveKey()方法 需要设置'SeBackupPrivilege'权限。具体使用参考LoadKey()方法的示例代码。

 

  CreateKey方法

  function CreateKey(const Key: String):Boolean;
  {
  功能：
    创建注册表项
    
  参数：
    Key		指定要创建的注册表的项
      
  返回值：
    创建成功返回True，失败返回False。出现错误时，将引发异常。
  
  注：Key可以是绝对名称或相对名称。绝对名称以反斜杠（\）开头，是根的子项。相对名称是当前项的子项。
  }

  Destroy方法

  destructor Destroy; override;
  {
  功能：
    关闭当前项并销毁TRegistry对象，一般直接调用对象的Free。
  }

  OpenKey方法

  function OpenKey(const Key: String; CanCreate: Boolean):Boolean;
  {
  功能：
    打开注册表项
    
  参数：
    Key		指定要打开的注册表的项
    CanCreate	指明当要打开的项不存在时是否创建，默认值为False
      
  返回值：
    如果打开成功返回True，否则返回False。
  }

  OpenKeyReadOnly方法

  function OpenKeyReadOnly(const Key: String): Boolean;
  {
  功能：
    以只读方式打开注册表项
    
  参数：
    Key		指定要打开的注册表的项
      
  返回值：
    如果打开成功返回True，否则返回False。
  }

  CloseKey方法

  procedure CloseKey;
  {
  功能：
    将当前项写入注册表并关闭该项
  }

  DeleteKey方法

  function DeleteKey(const Key: string): Boolean;
  {
  功能：
    删除注册表项
    
  参数：
    Key		指定要删除的注册表的项
      
  返回值：
    删除成功返回True。出现错误时，返回False。
  
  注：删除一个项及相关联的数据，在win95中子项也将被删除，NT中子项必须一个个删除。
  }

  DeleteValue方法

  function DeleteValue(const Name: string): Boolean;
  {
  功能:
    删除注册表数据值
    
  参数：
    Name	指定要删除的数据值
      
  返回值：
    删除成功返回True；删除失败返回False
  }

  GetDataSize方法

  function GetDataSize(const ValueName: string): Integer;
  {
  功能：
    返回与当前项关联的指定数据值的大小（字节）
    
  参数：
    ValueName	指定要查询的数据值
      
  返回值：
    成功返回数据值的大小；失败返回-1。
  
  注意：如果数据值是字符串，GetDataSize将返回数据值的大小，并为终止的空字符返回一个额外字节。
  }

  GetDataType方法

  function GetDataType(const ValueName: string): TRegDataType;
  {
  功能：
    返回当前项中一个指定数值ValueName数据的类型
    
  参数：
    ValueName	指定要查询的数据值
      
  返回值：
    ValueName数据的类型
  }

  GetKeyInfo方法

  function GetKeyInfo(var Value: TRegKeyInfo): Boolean;
  {
  功能：
    返回当前项的信息，信息是一个TRegKeyInfo结构，具体如下：
    TRegKeyInfo = record
      NumSubKeys: Integer; // 子项数量
      MaxSubKeyLen: Integer; // 子项名的最长值（字节）
      NumValues: Integer;  // 数据值的数量
      MaxValueLen: Integer; // 最长的项值名的长度
      MaxDataLen: Integer;  // 数据值的最大长度
      FileTime: TFileTime; // 最后一次更改的时间
    end;
    
  参数：
    Value	TRegKeyInfo结构对象
      
  返回值：
    成功回True；失败返回False，值记录设置为零。
  }

  GetKeyNames方法

  procedure GetKeyNames(Strings: TStrings);
  {
  功能：
    返回包含属于当前项的所有子项的名称的字符串列表
    
  参数：
    Strings	字符串列表
      
  返回值：
    Strings是TStrings类型的变量，用于返回子项名称列表。
  }

  GetValueNames方法

  procedure GetValueNames(Strings: TStrings);
  {
  功能：
    返回包含与当前项关联的所有数据值的名称的字符串列表
    
  参数：
    Strings	字符串列表
      
  返回值：
    Strings是TStrings类型的变量，用于返回数据值名称列表。
  }

  HasSubKeys方法

  function HasSubKeys: Boolean;
  {
  功能：
    确定当前项是否有子项
      
  返回值：
    如果当前项至少有一个子项，则返回True。否则返回False
  }

  KeyExists方法

  function KeyExists(const Key: string): Boolean;
  {
  功能：
    确定指定名称的项是否存在。
    
  参数：
    Key		要搜索的项的名称
      
  返回值：
    存在返回True。否则返回False
  }

  ValueExists方法

  function ValueExists(const Name: string): Boolean;
  {
  功能：
    确定当前项是否存在指定的数据值。
    
  参数：
    Name 	要检查的数据值的名称
      
  返回值：
    存在返回True。否则返回False
  }

  LoadKey方法

  // 需要设置程序权限为'SeRestorePrivilege'权限。 具体使用参考LoadKey()方法的示例代码。
  function LoadKey(const Key, FileName: string): Boolean;
  {
  功能：
    在根项下创建子项，并将注册表信息从文件加载到新创建的子项中。
    
  参数：
　  Key		要创建子项的名称
　  FileName	文件的位置，所指定的文件必须为以前用SaveKey函数或RegSaveKey API函数所建立的，文件名不能包括扩展名。
      
  返回值：
    创建成功返回True。否则返回False
  }

  UnLoadKey方法

  function UnLoadKey(const Key: string): Boolean;
  {
  功能：
    移除使用LoadKey方法在根项下创建子项。
    
  参数：
　  Key		要移除子项的名称
      
  返回值：
    创建成功返回True。否则返回False
  }

  SaveKey方法

  // 需要设置程序权限为'SeBackupPrivilege'权限。 具体使用参考LoadKey()方法的示例代码。
  function SaveKey(const Key, FileName: string): Boolean;
  {
  功能：
    将一个打开的项(包括所有子项和内容)保存为注册表信息文件。(需要指定安全访问值为 KEY_ALL_ACCESS )
    
  参数：
　  Key		要保存的项
　  FileName	保存文件的位置
      
  返回值：
    创建成功返回True。否则返回False
  }

  MoveKey方法

  procedure MoveKey(const OldName, NewName: string; Delete: Boolean);
  {
  功能：
    将现有项及其子项和数据值移动到新位置。
    
  参数：
    OldName	要复制或移动的项
    NewName	新位置项的名称
    Delete	是否删除旧项
  }

  RegistryConnect方法

  function RegistryConnect(const UNCName: string): Boolean;
  {
  功能：
    建立与另一台计算机上注册表的连接。
    
  参数：
    UNCName	远程计算机的名称 (格式：\\计算机名)
    
  返回值：
    连接成功，将RootKey属性设置为远程计算机的根项并返回True。如果不成功返回False，RootKey保持不变。
    
  注意：在调用RegistryConnect之前，应用程序必须将其注册表对象的RootKey属性设置为HKEY_USERS或HKEY_LOCAL_MACHINE。
  }

 

  Read系列方法

    如果要读取默认的数据值，只需把Name设为''即可，使用方法参考后面示例。

function ReadCurrency(const Name: string): Currency; 
{
货币值

参数：
  Name 要读取的数据值的名称。

返回值：
  如果成功，将返回一个货币值。如果注册表项不包含货币值，则会引发异常。
}

function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer; 
{
二进制值

参数：
  Name 要读取的数据值的名称。
  Buffer 是用来存储读取到的数据的缓冲区。缓冲区必须足够大，以容纳返回的所有数据。
  BufSize 指定缓冲区的大小。

返回值：
  如果成功，ReadBinaryData将请求的数据写入缓冲区并返回写入的字节数。如果注册表项包含已知类型（例如字符串），ReadBinaryData将引发异常。
}

function ReadBool(const Name: string): Boolean;
{
布尔值

参数：
  Name 要读取的数据值的名称。

返回值：
  如果成功，ReadBool将返回请求的布尔值。如果注册表项不包含布尔值或整数值，则会引发异常。
}

function ReadDate(const Name: string): TDateTime;
{
日期值

参数：
  Name 要读取的数据值的名称。

返回值：
  如果成功，ReadDate返回一个TDateTime值。TDateTime值的组成部分是自1899年12月30日以来已过的天数。TDateTime值的小数部分是一天中的时间。如果注册表项不包含日期或时间值，则会引发异常。

注意：仅使用ReadDate读取以前与WriteDate过程一起存储的数据值。
}

function ReadDateTime(const Name: string): TDateTime;
{
日期时间值

参数：
  Name 要读取的数据值的名称。

返回值：
  如果成功，ReadDateTime将返回一个TDateTime值。TDateTime值的组成部分是自1899年12月30日以来已过的天数。TDateTime值的小数部分是一天中的时间。如果注册表项不包含日期或时间值，则会引发异常。
}

function ReadFloat(const Name: string): Double;
{
浮点值

参数：
  Name 要读取的数据值的名称。

返回值：
  如果成功，返回一个浮点值，如果注册表项不包含浮点值，则会引发异常。
}

function ReadInteger(const Name: string): Integer;
{
整数值

参数：
  Name 要读取的数据值的名称。

返回值：
  如果成功，返回一个整数值，如果注册表项不包含整数，则会引发异常。
}

function ReadString(const Name: string): string;
{
字符串值

参数：
  Name 要读取的数据值的名称。

返回值：
  如果没有具有指定名称的注册表项，ReadString将返回空字符串。如果注册表项包含字符串以外的内容，则会引发异常。

注意：ReadString检索由WriteString或WriteExpandString方法存储的数据。
}

function ReadTime(const Name: string): TDateTime;
{
时间值

参数：
  Name 要读取的数据值的名称。

返回值：
  如果成功，ReadTime返回一个TDateTime值。TDateTime值的组成部分是自1899年12月30日以来已过的天数。TDateTime值的小数部分是一天中的时间。如果指定的注册表项不包含日期或时间值，则会引发异常。

注意：仅使用ReadTime读取以前用WriteTime方法存储的数据值。
}

 

  Write系列方法

    如果要写入默认的数据值，只需把Name设为''即可，使用方法参考后面示例。

procedure WriteCurrency(const Name: string; Value: Currency);
{
货币值

参数：
  Name 要写入的数据值的名称
  Value 要写入的货币值

说明：
  如果名称已存在，则其当前值将被WriteCurrency覆盖。如果名称不存在，则创建该名称。
  如果WriteCurrency失败，则会引发异常，并且该值不会写入注册表。
}

procedure WriteBinaryData(const Name: string; const Buffer; BufSize: Integer);
{
二进制值

参数：
  Name 要写入的数据值的名称
  Buffer 数据缓冲区
  BufSize 指定缓冲区的大小
  
说明：
  如果名称已存在，则其当前值将被WriteBinary覆盖。如果名称不存在，则创建该名称。
  如果WriteBinaryData失败，则会引发异常，并且该值不会写入注册表。
  
注意：数据值长度受可用内存的限制。长值（超过2048字节）应作为单独的文件存储，这些文件名应存储在注册表中。应用程序元素（如图标、位图和可执行文件）应存储为单独的文件，而不是作为注册表中的值。
}

procedure WriteBool(const Name: string; Value: Boolean);
{
布尔值

参数：
  Name 要写入的数据值的名称
  Value 要写入的布尔值
  
说明：
  如果名称已存在，则其当前值将被WriteBool覆盖。如果名称不存在，则创建该名称。
  如果WriteBool失败，则会引发异常，并且该值不会写入注册表。
}

procedure WriteDate(const Name: string; Value: TDateTime);
{
日期值

参数：
  Name 要写入的数据值的名称
  Value 要写入的日期值
  
说明：
  如果名称已存在，则其当前值将被WriteDate覆盖。如果名称不存在，则创建该名称。
  如果WriteDate失败，则会引发异常，并且该值不会写入注册表。
  如果成功，WriteDate将存储TDateTime值。TDateTime值的组成部分是自1899年12月30日以来已过的天数。TDateTime值的小数部分是一天中的时间。
}

procedure WriteDateTime(const Name: string; Value: TDateTime);
{
日期时间值

参数：
  Name 要写入的数据值的名称
  Value 要写入的日期时间值
  
说明：
  如果名称已存在，则其当前值将被WriteDateTime覆盖。如果名称不存在，则创建该名称。
  如果WriteDateTime失败，则会引发异常，并且该值不会写入注册表。
  如果成功，WriteDateTime将存储TDateTime值。TDateTime值的组成部分是自1899年12月30日以来已过的天数。TDateTime值的小数部分是一天中的时间。
}

procedure WriteFloat(const Name: string; Value: Double);
{
浮点值

参数：
  Name 要写入的数据值的名称
  Value 要写入的浮点值
  
说明：
  如果名称已存在，则其当前值将被WriteFloat覆盖。如果名称不存在，则创建该名称。
  如果WriteFloat失败，则会引发异常，并且该值不会写入注册表。
}

procedure WriteInteger(const Name: string; Value: Integer);
{
整数值

参数：
  Name 要写入的数据值的名称
  Value 要写入的整数值
  
说明：
  如果名称已存在，则其当前值将被WriteInteger覆盖。如果名称不存在，则创建该名称。
  如果WriteInteger失败，则会引发异常，并且该值不会写入注册表。
}

procedure WriteString(const Name, Value: string);
{
字符串值

参数：
  Name 要写入的数据值的名称
  Value 要写入的字符串值
  
说明：
  如果名称已存在，则其当前值将被WriteString覆盖。如果名称不存在，则创建该名称。
  如果WriteString失败，将引发异常，并且该值不会写入注册表。
}

procedure WriteExpandString(const Name, Value: string);
{
扩展字符串值 
  该字符串包含对环境变量（如"%PATH%"）的未展开引用

参数：
  Name 要写入的数据值的名称
  Value 要写入的扩展字符串值
  
说明：
  如果名称已存在，则其当前值将被WriteExpandString覆盖。如果名称不存在，则创建该名称。
  如果WriteExpandString失败，则会引发异常。

注意：若要写入不包含未展开的环境变量的字符串，请改用WriteString
}

procedure WriteTime(const Name: string; Value: TDateTime);
{
时间值

参数：
  Name 要写入的数据值的名称
  Value 要写入的时间值
  
说明：
  如果名称已存在，则其当前值将被WriteTime覆盖。如果名称不存在，则创建该名称。
  如果WriteTime失败，则会引发异常，并且该值不会写入注册表。
  如果成功，WriteTime将存储一个TDateTime值。TDateTime值的组成部分是自1899年12月30日以来已过的天数。TDateTime值的小数部分是一天中的时间。
}

 

使用示例：

 

更多示例：

  取消注册表重定向功能操作64位注册表项

  32位程序在64位系统下读写注册表时操作HKEY_LOCAL_MACHINE主项下的部份项时，会重定向至32位的注册表项SOFTWARE\Wow6432Node。

  注：网上有说使用Wow64DisableWow64FsRedirection关闭文件重定向功能实现，经测试无效。

{
  如果你的程序是32位的，你会发现代码运行完后，在HKEY_LOCAL_MACHINE\SOFTWARE下没有建立test项。
  实行上它将test写入了32位的注册表项中 HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node
}
procedure TForm1.btn1Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('SOFTWARE\test', True) then // True 表示test项不存在则创建
    begin
      reg.WriteString('test', 'test123');

      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

{
  解决办法一( >=Delphi2010 )：
  构造时加 KEY_WOW64_64KEY

}
procedure TForm1.btn2Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);
  // 加 KEY_WOW64_64KEY
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('SOFTWARE\test', True) then // True 表示test项不存在则创建
    begin
      reg.WriteString('test', 'test123');

      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

{
  解决办法二：
  在老版本的delphi中并没有 KEY_WOW64_64KEY ,需自定义 KEY_WOW64_64KEY = $0100;
}
procedure TForm1.btn3Click(Sender: TObject);
const
  KEY_WOW64_64KEY = $0100;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('SOFTWARE\test', True) then // True 表示test项不存在则创建
    begin
      reg.WriteString('test', 'test123');

      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

 

  同时操作多个项

procedure TForm1.btn1Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    if reg.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName') then
    begin
      ShowMessage(reg.ReadString('ComputerName'));

      reg.CloseKey;
    end;

    reg.RootKey := HKEY_CURRENT_USER; // 如果是同一个 根项 则不用重复指定
    if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Run') then
    begin
      ShowMessage(reg.ReadString('ctfmon'));

      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

 

  读写注册表项的默认值

procedure TForm1.btn1Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('SOFTWARE\test', True) then // True 表示test项不存在则创建
    begin
      reg.WriteString('', '默认值测试'); // 把名称留空
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

 

  读写REG_DWORD数据

    REG_DWORD可以直接使用ReadInteger()方法读取和WriteInteger()写入。

procedure TForm1.btn1Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('SOFTWARE\test', True) then // True 表示test项不存在则创建
    begin
      reg.WriteInteger('dword', 16); // 十进制 16 十六进制 $10
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

 

  读写二进制数据

// 引入 StrUtils

// 写入
procedure TForm1.btn1Click(Sender: TObject);
var
  mStr: string; // 二进制数据字符串
  mBuf: array of byte; // 二进制字节流
  mCount, i: integer;
  reg: TRegistry;
begin
  // 通过二进制字符串构造出二进制字节流 (如果有现在的二进制字节流则可以直接使用)
  mStr := 'bf,31,36,30,98,14,02,92,61,41,ae,ac,c3,a9,b2,9a,19,96,a8,1c,e3';
  mStr := mStr + ','; // 最后必须以 , 结束

  mCount := (Length(mStr) div 3);
  SetLength(mBuf, mCount);
  for i := 0 to mCount - 1 do
  begin
    mBuf[i] := StrToInt('$' + LeftBStr(mStr, 2));
    Delete(mStr, 1, 3);
  end;

  reg := TRegistry.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);  // 取消重定向
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('SOFTWARE\test', True) then  // True 表示test项不存在则创建
    begin
      reg.WriteBinaryData('key', mBuf[0], mCount);

      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

// 读取
procedure TForm1.btn2Click(Sender: TObject);
var
  mBuf: array of byte; // 二进制字节流
  mCount: integer;
  reg: TRegistry;
begin
  reg := TRegistry.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);  // 取消重定向
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('SOFTWARE\test', True) then  // True 表示test项不存在则创建
    begin
      mCount := reg.GetDataSize('key'); // 通过GetDataSize函数获取数据值的大小(字节)
      if mCount <> -1 then
      begin
        SetLength(mBuf, mCount);
        reg.ReadBinaryData('key', mBuf[0], mCount);
      end;
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

 

 读写REG_QWORD、REG_MULTI_SZ数据

  由于TRegistry类没有带操作REG_QWORD和REG_MULTI_SZ类型的方法，所以只能继承TRegistry类来扩展实现。

  1，在项目中添加 uRegistryEx.pas 代码如下：

  

unit uRegistryEx;

interface

uses
  System.Classes, System.Win.Registry, Winapi.Windows, System.Math, System.RTLConsts;

type
  // 重新构造 TRegDataType
  TRegDataType = (rdUnknown, rdString, rdExpandString, rdInteger, rdBinary, rdUint64);

  TRegistryEx = class(TRegistry)
  protected
    procedure ReadError(const Name: string);
    function RegDataToDataType(Value: TRegDataType): Integer; // 覆盖
    function DataTypeToRegData(Value: Integer): TRegDataType; // 覆盖
    procedure PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType);
    function GetData(const Name: string; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataType): Integer;
  public
    function ReadUInt64(const Name: string): UInt64;
    procedure WriteUInt64(const Name: string; Value: UInt64);
    function ReadMultiSz(const name: string; var Strings: TStrings): boolean;
    function WriteMultiSz(const name: string; const value: TStrings): boolean;
  end;

implementation


procedure TRegistryEx.ReadError(const Name: string);
begin
  raise ERegistryException.CreateResFmt(@SInvalidRegType, [Name]);
end;

function TRegistryEx.RegDataToDataType(Value: TRegDataType): Integer;
begin
  case Value of
    rdString: Result := REG_SZ;
    rdExpandString: Result := REG_EXPAND_SZ;
    rdInteger: Result := REG_DWORD;
    rdBinary: Result := REG_BINARY;
    rdUint64: Result := REG_QWORD;
  else
    Result := REG_NONE;
  end;
end;

function TRegistryEx.DataTypeToRegData(Value: Integer): TRegDataType;
begin
  if Value = REG_SZ then Result := rdString
  else if Value = REG_EXPAND_SZ then Result := rdExpandString
  else if Value = REG_DWORD then Result := rdInteger
  else if Value = REG_BINARY then Result := rdBinary
  else if Value = REG_QWORD then Result := rdUint64
  else Result := rdUnknown;
end;

procedure TRegistryEx.PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType);
var
  DataType: Integer;
begin
  DataType := RegDataToDataType(RegData);
  if not CheckResult(RegSetValueEx(CurrentKey, PChar(Name), 0, DataType, Buffer,
    BufSize)) then
    raise ERegistryException.CreateResFmt(@SRegSetDataFailed, [Name]);
end;

function TRegistryEx.GetData(const Name: string; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataType): Integer;
var
  DataType: Integer;
begin
  DataType := REG_NONE;
  if not CheckResult(RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer),
    @BufSize)) then
    raise ERegistryException.CreateResFmt(@SRegGetDataFailed, [Name]);
  Result := BufSize;
  RegData := DataTypeToRegData(DataType);
end;

function TRegistryEx.ReadUInt64(const Name: string): UInt64;
var
  RegData: TRegDataType;
begin
  GetData(Name, @Result, SizeOf(UInt64), RegData);
  if RegData <> rdUint64 then ReadError(Name);
end;

procedure TRegistryEx.WriteUInt64(const Name: string; Value: UInt64);
begin
  PutData(Name, @Value, SizeOf(UInt64), rdUint64);
end;

function TRegistryEx.ReadMultiSz(const name: string; var Strings: TStrings): boolean;
var
  iSizeInByte: integer;
  Buffer: array of WChar;
  iWCharsInBuffer: integer;
  z: integer;
  sString: string;
begin
  iSizeInByte := GetDataSize(name);
  if iSizeInByte > 0 then begin
    SetLength(Buffer, Floor(iSizeInByte / sizeof(WChar)));
    iWCharsInBuffer := Floor(ReadBinaryData(name, Buffer[0], iSizeInByte) / sizeof(WChar));
    sString := '';
    for z := 0 to iWCharsInBuffer do begin
      if Buffer[z] <> #0 then begin
        sString := sString + Buffer[z];
      end else begin
        if sString <> '' then begin
          Strings.Append(sString);
          sString := '';
        end;
      end;
    end;
    result := true;
  end else begin
    result := false;
  end;
end;

function TRegistryEx.WriteMultiSz(const name: string; const value: TStrings): boolean;
var
  sContent: string;
  x: integer;
begin
  sContent := '';
  for x := 0 to pred(value.Count) do begin
    sContent := sContent + value.Strings[x] + #0;
  end;
  sContent := sContent + #0;
  result := RegSetValueEx(CurrentKey, pchar(name), 0, REG_MULTI_SZ,
    pointer(sContent), Length(sContent)*sizeof(Char)) = 0;
end;
end.

 

  2，调用：  

procedure TForm1.btn1Click(Sender: TObject);
var
  reg: TRegistryEx;
begin
  reg := TRegistryEx.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('SOFTWARE\test', True) then // True 表示test项不存在则创建
    begin
      reg.WriteUInt64('qword', 18446744073709551615); // 十进制 18446744073709551615 十六进制 $ffffffffffffffff
      lbl1.Caption := (reg.ReadUInt64('qword').ToString);
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

procedure TForm1.btn2Click(Sender: TObject);
var
  reg: TRegistryEx;
  myList: TStrings;
begin
  myList := TStringList.Create();
  reg := TRegistryEx.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('SOFTWARE\test', True) then
    begin
      myList.Add('test1');
      myList.Add('test2');
      myList.Add('test3');
      reg.WriteMultiSz('TestMultiSz', myList);
      mmo1.Lines := myList; // TMemo 显示读取的数据

      myList.Clear;
      reg.ReadMultiSz('TestMultiSz', myList);
      mmo2.Lines := myList; // TMemo 显示读取的数据
    end;
  finally
    myList.Free;
    reg.Free;
  end;
end;

 

  3，效果：

  

 

  获取根项下所有子项的名称的字符串列表

  目的：

  1，了解如何打开根项进行操作

  2，怎么使用GetKeyNames返回包含属于当前项的所有子项的名称的字符串列表

procedure TForm1.btn1Click(Sender: TObject);
var
  reg: TRegistry;
  strList: TStringList;
begin
  strList := TStringList.Create; // 初始化strList;

  reg := TRegistry.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);  // 取消重定向
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKeyReadOnly('\') then  // 打开根项可用 '\' 或 ''
    begin
      reg.GetKeyNames(strList); // 获取当前项下所有子项的名称的字符串列表存入strList中
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

 

 从文件中获取注册表信息，以便进行相应的增、删、改、查。

{
  设置进程权限
  PrivilegeName： 权限的名称
  Enable： 打开或关闭权限
}
function SetPrivilege(const PrivilegeName: String; Enable: Boolean): Boolean;
var
  hToken:           THandle;
  tokenPrivileges:  TTokenPrivileges;
  returnLength:     DWORD;
begin
  Result := False;
  If OpenProcessToken(GetCurrentProcess, TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES, hToken) then
  try
    If LookupPrivilegeValue(nil, PChar(PrivilegeName), tokenPrivileges.Privileges[0].Luid) then
      begin
        tokenPrivileges.PrivilegeCount := 1;
        tokenPrivileges.Privileges[0].Attributes := Ord(Enable) * SE_PRIVILEGE_ENABLED;
        If AdjustTokenPrivileges(hToken, False, tokenPrivileges, 0, nil, returnLength) then
          Result := GetLastError = ERROR_SUCCESS;
      end;
  finally
    CloseHandle(hToken);
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  reg: TRegistry;
  fileName, key: string;
begin
  // LoadKey 需要 'SeRestorePrivilege' 权限
  if not SetPrivilege('SeRestorePrivilege', True) then Exit;

  fileName := 'D:\Windows\System32\config\SOFTWARE';
  key := 'TEST';

  reg := TRegistry.Create(KEY_ALL_ACCESS or KEY_WOW64_64KEY);
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if not reg.LoadKey(key, fileName) then Exit;
    try
      // 具体操作
      ShowMessage('ok');
    finally
      reg.UnLoadKey(key);
    end;

  finally
    reg.Free;
  end;
end;