まずクラスヘルパの宣言です。
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 件のコメント:
コメントを投稿