まずクラスヘルパの宣言です。
uses
Windows, Classes, Registry;
type
TRegistryHelper = class helper for TRegistry
function ReadInt64(const Name: string): Int64;
procedure WriteInt64(const Name: string; Value: Int64);
procedure ReadStrings(const Name: String; Value: TStrings); overload;
function ReadStrings(const Name: String): String; overload;
procedure WriteStrings(const Name: String; Value: TStrings); overload;
procedure WriteStrings(const Name: String; Value: String); overload;
class function StringsToDoubleNulTerminated(Strings: TStrings): String; static;
class procedure DoubleNulTerminatedToStrings(const Str: String; Strings: TStrings); static;
end;
またWindowsユニットにREG_QWORDの定義が不足していますのでこれも定義しておきます。const
REG_QWORD = 11;
{$EXTERNALSYM REG_QWORD}
最初にInt64の読み書きです。TRegistryの実装を見てみると、Delphi 2009まではRegQueryValueEx (ja)およびRegSetValueEx (ja)の戻値を直接確認していましたが、Delphi 2010以降ではLastErrorプロパティを追加した関係からCheckResultを使用するように変更されているので、ここではこれに従います。またエラー時に生成する例外のメッセージのためにRTLConstsユニットをusesに追加する必要があります。uses
RTLConsts;
function TRegistryHelper.ReadInt64(const Name: string): Int64;
var
BufSize: Integer;
DataType: Integer;
begin
DataType := REG_NONE;
BufSize := SizeOf(Int64);
{$IF RTLVersion >= 21.0}
if CheckResult(RegQueryValueEx(CurrentKey,PChar(Name),nil,@DataType,PByte(@Result),@BufSize)) = False then
{$ELSE}
if RegQueryValueEx(CurrentKey,PChar(Name),nil,@DataType,PByte(@Result),@BufSize) <> ERROR_SUCCESS then
{$IFEND}
begin
raise ERegistryException.CreateResFmt(@SRegGetDataFailed, [Name]);
end;
if DataType <> REG_QWORD then
begin
raise ERegistryException.CreateResFmt(@SInvalidRegType,[Name]);
end;
end;
procedure TRegistryHelper.WriteInt64(const Name: string; Value: Int64);
var
DataType: Integer;
begin
DataType := REG_QWORD;
{$IF RTLVersion >= 21.0}
if CheckResult(RegSetValueEx(CurrentKey,PChar(Name),0,DataType,@Value,SizeOf(Int64))) = False then
{$ELSE}
if RegSetValueEx(CurrentKey,PChar(Name),0,DataType,@Value,SizeOf(Int64)) <> ERROR_SUCCESS then
{$IFEND}
begin
raise ERegistryException.CreateResFmt(@SRegSetDataFailed, [Name]);
end;
end;
次に複数行文字列です。RegQueryValueExとRegSetValueExでREG_MULTI_SZの値を読み書きする場合は、各行がNUL文字で終端されていて、最後に空行(NUL文字だけ)が付加される"double null terminated string"が使われるため、まずTStringsとの間の変換を行う処理を用意します。class function TRegistryHelper.StringsToDoubleNulTerminated(Strings: TStrings): String;
var
Index: Integer;
begin
if Strings.Count > 0 then
begin
Result := '';
for Index := 0 to Strings.Count - 1 do
begin
Result := Result + Strings.Strings[Index] + #0;
end;
Result := Result + #0;
end
else
begin
Result := #0 + #0;
end;
end;
class procedure TRegistryHelper.DoubleNulTerminatedToStrings(const Str: String; Strings: TStrings);
var
P: PChar;
Start: PChar;
S: String;
begin
Strings.BeginUpdate;
try
Strings.Clear;
P := PChar(Str);
while P^ <> #0 do
begin
Start := P;
while (P^ <> #0) do
begin
Inc(P);
end;
SetString(S,Start,P - Start);
Strings.Add(S);
Inc(P);
end;
finally
Strings.EndUpdate;
end;
end;
これらのメソッドを利用してTStringsを読み書きします。procedure TRegistryHelper.ReadStrings(const Name: String; Value: TStrings);
var
Len: Integer;
Data: String;
DataType: Integer;
begin
Len := GetDataSize(Name);
if Len > 0 then
begin
SetString(Data,nil,Len div SizeOf(Char));
DataType := REG_NONE;
{$IF RTLVersion >= 21.0}
if CheckResult(RegQueryValueEx(CurrentKey,PChar(Name),nil,@DataType,PByte(Data),@Len)) = False then
{$ELSE}
if RegQueryValueEx(CurrentKey,PChar(Name),nil,@DataType,PByte(Data),@Len) <> ERROR_SUCCESS then
{$IFEND}
begin
raise ERegistryException.CreateResFmt(@SRegGetDataFailed,[Name]);
end;
if DataType <> REG_MULTI_SZ then
begin
raise ERegistryException.CreateResFmt(@SInvalidRegType,[Name]);
end;
SetLength(Data,Len div SizeOf(Char));
DoubleNulTerminatedToStrings(Data,Value);
end;
end;
procedure TRegistryHelper.WriteStrings(const Name: String; Value: TStrings);
var
Data: String;
begin
Data := StringsToDoubleNulTerminated(Value);
{$IF RTLVersion >= 21.0}
if CheckResult(RegSetValueEx(CurrentKey,PChar(Name),0,REG_MULTI_SZ,
PChar(Data),Length(Data) * SizeOf(Char))) = False then
{$ELSE}
if RegSetValueEx(CurrentKey,PChar(Name),0,REG_MULTI_SZ,
PChar(Data),Length(Data) * SizeOf(Char)) <> ERROR_SUCCESS then
{$IFEND}
begin
raise ERegistryException.CreateResFmt(@SRegSetDataFailed,[Name]);
end;
end;
またTStringsではなく改行文字(#13#10)を含む通常のStringで読み書きするoverloadも用意してみました。function TRegistryHelper.ReadStrings(const Name: String): String;
var
SL: TStringList;
begin
SL := TStringList.Create;
try
ReadStrings(Name,SL);
Result := SL.Text;
finally
SL.Free;
end;
end;
procedure TRegistryHelper.WriteStrings(const Name: String; Value: String);
var
SL: TStringList;
begin
SL := TStringList.Create;
try
SL.Text := Value;
WriteStrings(Name,SL);
finally
SL.Free;
end;
end;
0 件のコメント:
コメントを投稿