Delphi 读取注册表REG_MULTI_SZ类型，注意事项

其他 2021-01-28 10:49:45 阅读次数: 0

注意Delphi版本，网络上的代码大多是Delphi7基于Ansi编码格式读取，默认的PChar是AnsiChar，不是WideChar，这样的代码是不能用在Delphi XE或以后的Delphi 版本;

//通用兼容Delphi7，推荐
function ReadMultiSZ(const ValueName: string; TS: TStrings): Boolean;
function WriteMultiSZ(const ValueName: string; TS: TStrings): Boolean;

原文地址：http://www.ceiwei.com/blog/index.php/2019/05/15/delphi-reg_multi_sz/

下载完整代码 Delphi7 , DelphiXE7

//------------------------------------------------------------------------------------

unit uRegMutilSZ;

interface

uses
Windows, SysUtils, Classes, Registry;

type
{$IF CompilerVersion >= 22} //Delphi XE或以上
TChars = System.TArray<Char>;
{$ELSE}
TChars = array of Char;
TBytes = array of Byte;
{$ENDIF}

TRegistryMultiSZ = class(TRegistry)
private
function QueryMultiSZValue(ValueName: AnsiString; var aBytes: TBytes): DWORD; overload;
function QueryMultiSZValue(ValueName: WideString; var aBytes: TBytes): DWORD; overload;
function QueryMultiSZ(ValueName: string; var aBuffer: TChars): DWORD;
public
procedure ReadStrings(const ValueName: AnsiString; TS: TStrings); overload;
procedure ReadStrings(const ValueName: WideString; TS: TStrings); overload;
procedure WriteStrings(const ValueName: AnsiString; TS: TStrings); overload;
procedure WriteStrings(const ValueName: WideString; TS: TStrings); overload;
//通用兼容Delphi7
function ReadMultiSZ(const ValueName: string; TS: TStrings): Boolean;
function WriteMultiSZ(const ValueName: string; TS: TStrings): Boolean;
end;

implementation

{ TRegistryMultiSZ }

function TRegistryMultiSZ.QueryMultiSZValue(ValueName: AnsiString; var aBytes: TBytes): DWORD;
var
Error: Integer;
valueType: DWORD;
begin
Error := RegQueryValueExA (CurrentKey, PAnsiChar (valueName), nil, @valueType, nil, @Result);
if Error = ERROR_SUCCESS then
begin
if valueType = REG_MULTI_SZ then
begin
SetLength(aBytes, Result);
Error := RegQueryValueExA (CurrentKey, PAnsiChar(valueName), nil, nil, PBYTE(aBytes), @Result);
if Error <> ERROR_SUCCESS then
Windows.OutputDebugStringA(PAnsiChar(Format('QueryMultiSZValueA.error=%d, %s', [Error, SysUtils.SysErrorMessage(Error)])));
end;
end
else
Windows.OutputDebugStringA(PAnsiChar(Format('QueryMultiSZValueA.error=%d, %s', [Error, SysUtils.SysErrorMessage(Error)])));
end;

function TRegistryMultiSZ.QueryMultiSZ(ValueName: string; var aBuffer: TChars): DWORD;
var
Error: Integer;
valueType: DWORD;
begin
Error := RegQueryValueEx(CurrentKey, PChar(ValueName), nil, @valueType, nil, @Result);
if Error = ERROR_SUCCESS then
begin
if valueType = REG_MULTI_SZ then
begin
SetLength(aBuffer, Result div SizeOf(Char));
Error := RegQueryValueEx(CurrentKey, PChar(ValueName), nil, nil, PBYTE(@aBuffer[0]), @Result);
if Error <> ERROR_SUCCESS then
Windows.OutputDebugString(PChar(Format('QueryMultiSZ.error=%d, %s', [Error, SysUtils.SysErrorMessage(Error)])));
end;
end
else
Windows.OutputDebugString(PChar(Format('QueryMultiSZ.error=%d, %s', [Error, SysUtils.SysErrorMessage(Error)])));
end;

function TRegistryMultiSZ.QueryMultiSZValue(ValueName: WideString;
var aBytes: TBytes): DWORD;
var
Error: Integer;
valueType: DWORD;
begin
Error := RegQueryValueExW (CurrentKey, PWideChar(ValueName), nil, @valueType, nil, @Result);
if Error = ERROR_SUCCESS then
begin
if valueType = REG_MULTI_SZ then
begin
SetLength(aBytes, Result);
Error := RegQueryValueExW (CurrentKey, PWideChar(ValueName), nil, nil, PBYTE(aBytes), @Result);
if Error <> ERROR_SUCCESS then
Windows.OutputDebugString(PChar(Format('QueryMultiSZValueW.error=%d, %s', [Error, SysUtils.SysErrorMessage(Error)])));
end;
end
else
Windows.OutputDebugString(PChar(Format('QueryMultiSZValueW.error=%d, %s', [Error, SysUtils.SysErrorMessage(Error)])));
end;

procedure TRegistryMultiSZ.ReadStrings(const ValueName: WideString;
TS: TStrings);
var
I: Integer;
valueLen : DWORD;
S, aLine: WideString;
aTemp, aBytes: TBytes;
begin
TS.Clear;
valueLen := QueryMultiSZValue(ValueName, aBytes);
aLine := '';
if valueLen > 0 then
begin
SetLength(S, valueLen div SizeOf(Char));
System.Move(aBytes[0], S[1], valueLen);
end;
for I := 1 to (valueLen div SizeOf(Char)) do
begin
if S[I] = #0 then //以0结束的字符串数组,最后，还要一个0结束数组, 双字节的话是0000
begin
if aLine <> '' then TS.Add(aLine);
aLine := '';
end
else
aLine := aLine+WideChar(S[I]);
end;
end;

procedure TRegistryMultiSZ.ReadStrings(const ValueName: AnsiString; TS: TStrings);
var
I: Integer;
valueLen : DWORD;
aLine: AnsiString;
aBytes: TBytes;
begin
TS.Clear;
valueLen := QueryMultiSZValue(ValueName, aBytes);
aLine := '';
if valueLen > 0 then
for I := Low(aBytes) to valueLen-1 do
begin
if aBytes[I] = 0 then //以0结束的字符串数组,最后，还要一个0结束数组, 双字节的话是0000
begin
if aLine <> '' then TS.Add(aLine);
aLine := '';
end
else
aLine := aLine+AnsiChar(aBytes[I]);
end;
end;

procedure TRegistryMultiSZ.WriteStrings(const ValueName: AnsiString; TS: TStrings);
var
I, Error: Integer;
aLineCount, aTotalCount: Integer;
aBytes, aTemp: TBytes;
aLine: string;
begin
//如果是XE或以上版本 TS是Unicode 需转换成Ansi 字符串

aTotalCount := 0;
for I := 0 to TS.Count - 1 do
begin
aLine := TS[I];
if aLine = '' then System.Continue; //REG_MULTI_SZ 类型的数据不能包含空字符串。注册表编辑器将删除找到得空字符串。

{$IF CompilerVersion >= 22}
aTemp := TEncoding.ANSI.GetBytes(aLine); //XE 以上
{$ELSE}
SetLength(aTemp, Length(aLine)); //兼容Delphi7
System.Move(aLine[1], aTemp[0], Length(aLine));
{$ENDIF}

aLineCount := Length(aTemp)+1;

Inc(aTotalCount, aLineCount);
SetLength(aBytes, aTotalCount);
System.Move(aTemp[0], aBytes[aTotalCount-aLineCount], aLineCount-1);
aBytes[aTotalCount-1] := 0; //０结束
end;

Inc(aTotalCount);
SetLength(aBytes, aTotalCount);
aBytes[aTotalCount-1] := 0; //最后一个数组０结束

Error := RegSetValueExA (CurrentKey, PAnsiChar(valueName), 0, REG_MULTI_SZ, @aBytes[0], aTotalCount);
if Error <> ERROR_SUCCESS then
Windows.OutputDebugString(PChar(Format('WriteStringsA.error=%d, %s', [Error, SysUtils.SysErrorMessage(Error)])));
end;

procedure TRegistryMultiSZ.WriteStrings(const ValueName: WideString;
TS: TStrings);
var
I, Error: Integer;
aLineCount, aTotalCount: Integer;
aBytes, aTemp: TBytes;
aLine: WideString;
begin
//如果是XE或以上版本 TS是Unicode 需转换成Ansi 字符串

aTotalCount := 0;
for I := 0 to TS.Count - 1 do
begin
aLine := TS[I];
if aLine = '' then System.Continue; //REG_MULTI_SZ 类型的数据不能包含空字符串。注册表编辑器将删除找到得空字符串。

{$IF CompilerVersion >= 22}
aTemp := TEncoding.Unicode.GetBytes(aLine); //XE 以上
{$ELSE}
SetLength(aTemp, Length(aLine) * SizeOf(WideChar)); //兼容Delphi7
System.Move(aLine[1], aTemp[0], Length(aLine)* SizeOf(WideChar));
{$ENDIF}

aLineCount := Length(aTemp)+2;

Inc(aTotalCount, aLineCount);
SetLength(aBytes, aTotalCount);
System.Move(aTemp[0], aBytes[aTotalCount-aLineCount], aLineCount-2);
aBytes[aTotalCount-2] := 0; //０结束
aBytes[aTotalCount-1] := 0;
end;

Inc(aTotalCount, 2);
SetLength(aBytes, aTotalCount);
aBytes[aTotalCount-2] := 0;
aBytes[aTotalCount-1] := 0; //最后一个数组０结束

Error := RegSetValueExW(CurrentKey, PWideChar(valueName), 0, REG_MULTI_SZ, @aBytes[0], aTotalCount);
if Error <> ERROR_SUCCESS then
Windows.OutputDebugString(PChar(Format('WriteStringsW.error=%d, %s', [Error, SysUtils.SysErrorMessage(Error)])));
end;

function TRegistryMultiSZ.ReadMultiSZ(const ValueName: string;
TS: TStrings): Boolean;
var
cbBufferSize, I: integer;
aBuffer: TChars;
aLine: string;
begin
//通用兼容Delphi7
TS.Clear;
cbBufferSize := QueryMultiSZ(ValueName, aBuffer);
if cbBufferSize > 0 then
for I := 0 to (cbBufferSize div SizeOf(Char))-1 do
begin
if aBuffer[I] = #0 then //以0结束的字符串数组,最后，还要一个0结束数组, 双字节的话是0000
begin
if aLine <> '' then TS.Add(aLine);
aLine := '';
end
else
aLine := aLine+aBuffer[I];
end;

Result := TS.Count > 0;
end;

function TRegistryMultiSZ.WriteMultiSZ(const ValueName: string; TS: TStrings): Boolean;
var
I, Error: Integer;
aLineCount, aTotalCount: Integer;
aLine: string;
begin
//通用兼容Delphi7
aLine := '';
for I := 0 to TS.Count - 1 do
begin
aLine := aLine+TS[I] + #0;
end;
aLine := aLine + #0;

Error := RegSetValueEx(CurrentKey, PChar(ValueName), 0, REG_MULTI_SZ,
PChar(aLine), Length(aLine)*Sizeof(Char));

Result := Error = ERROR_SUCCESS;
if not Result then
Windows.OutputDebugString(PChar(Format('WriteMultiSZ.error=%d, %s', [Error, SysUtils.SysErrorMessage(Error)])));
end;

end.

//------------------------------------------------------------------

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
TForm1 = class(TForm)
btn1: TButton;
btn2: TButton;
mmo1: TMemo;
btn3: TButton;
btn4: TButton;
btn5: TButton;
btn6: TButton;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure btn4Click(Sender: TObject);
procedure btn6Click(Sender: TObject);
procedure btn5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses
uRegMutilSZ;

{$R *.dfm}

// Ansi的部份
procedure TForm1.Btn1Click(Sender: TObject);
var
reg: TRegistryMultiSZ;
begin
reg := TRegistryMultiSZ.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKey('SOFTWARE\Microsoft\Active Setup\InstallInfo', False) then
reg.ReadStrings(AnsiString('UpperFilters'), mmo1.Lines);
finally
reg.Free;
end;
end;

// Ansi的部份
procedure TForm1.Btn2Click(Sender: TObject);
var
reg: TRegistryMultiSZ;
begin
reg := TRegistryMultiSZ.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKey('SOFTWARE\Microsoft\Active Setup\InstallInfo', False) then
reg.WriteStrings(AnsiString('UpperFilters'), mmo1.Lines);
finally
reg.Free;
end;
end;

// WideString的部份
procedure TForm1.Btn3Click(Sender: TObject);
var
reg: TRegistryMultiSZ;
begin
reg := TRegistryMultiSZ.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKey('SOFTWARE\Microsoft\Active Setup\InstallInfo', False) then
reg.ReadStrings( WideString('UpperFilters'), mmo1.Lines);
finally
reg.Free;
end;
end;

// WideString的部份
procedure TForm1.Btn4Click(Sender: TObject);
var
reg: TRegistryMultiSZ;
begin
reg := TRegistryMultiSZ.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKey('SOFTWARE\Microsoft\Active Setup\InstallInfo', False) then
reg.WriteStrings( WideString('UpperFilters'), mmo1.Lines);
finally
reg.Free;
end;
end;

// general的部份
procedure TForm1.Btn5Click(Sender: TObject);
var
reg: TRegistryMultiSZ;
begin
reg := TRegistryMultiSZ.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKey('SOFTWARE\Microsoft\Active Setup\InstallInfo', False) then
reg.ReadMultiSZ('UpperFilters', mmo1.Lines);
finally
reg.Free;
end;
end;

// general的部份
procedure TForm1.Btn6Click(Sender: TObject);
var
reg: TRegistryMultiSZ;
begin
reg := TRegistryMultiSZ.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKey('SOFTWARE\Microsoft\Active Setup\InstallInfo', False) then
reg.WriteMultiSZ( 'UpperFilters', mmo1.Lines);
finally
reg.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
self.mmo1.Clear;
end;

end.

原文地址：http://www.ceiwei.com/blog/index.php/2019/05/15/delphi-reg_multi_sz/

下载完整代码 Delphi7 , DelphiXE7

猜你喜欢

转载自blog.csdn.net/jfyes/article/details/90238437
今日推荐
美国拟限制 AI 大模型出口中国和俄罗斯
苹果将与 OpenAI 达成协议，将 ChatGPT 应用于 iPhone
openKylin 社区生态委员会第六次会议圆满召开
阿里云正式发布通义千问 2.5
Python 3.13 发布首个 Beta：实验性自由线程模式和 JIT、改进交互式解释器
Stack Overflow 拿我的代码去训练 AI 大模型，还封了我的账号
Pop!_OS 的 COSMIC 桌面完成 App Store 上架工作
报告：Django 仍然是 74% 开发者的首选
《2024 年一季度互联网投融资运行情况》研究报告
15 年前上了“FFmpeg 耻辱柱”，今天他还得谢谢咱——腾讯QQPlayer一雪前耻？
TIOBE 5 月榜单：Fortran “复活”进入 Top 10
GCC 14.1 发布
周排行
NEFU 117 素数个数的位数
Closest Common Ancestors (Lca,tarjan)
ELK部署
【转载】Hive笔记整理（三）
SQL语句（一）基本表的定义
关于Java web开发中的MySQL的事务语句
MFC创建自定义窗体
如何用一句话激怒程序员？
《逆袭大学》文摘——9.4 基础和应用的平衡中找到大学的节奏
【spring源码分析】@Value注解原理
每日归档
更多
2024-05-11(38)
2024-05-10(38)
2024-05-09(35)
2024-05-08(42)
2024-05-07(14)
2024-05-06(40)
2024-05-05(0)
2024-05-04(7)
2024-05-03(19)
2024-05-02(0)

代码天地 © 2018 codetd.com

境外服务器   最新电视剧2022