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

注意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;

 

//————————————————————————————

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; //0结束
end;

 

Inc(aTotalCount);
SetLength(aBytes, aTotalCount);
aBytes[aTotalCount-1] := 0; //最后一个数组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; //0结束
aBytes[aTotalCount-1] := 0;
end;

 

Inc(aTotalCount, 2);
SetLength(aBytes, aTotalCount);
aBytes[aTotalCount-2] := 0;
aBytes[aTotalCount-1] := 0; //最后一个数组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.