* Corrected patch from Rolf Wetjen to use unicode API on windows (bug ID 32185)

git-svn-id: trunk@36765 -
This commit is contained in:
michael 2017-07-22 17:09:45 +00:00
parent 3b48c6e316
commit 3b5d532ab5
6 changed files with 462 additions and 113 deletions

1
.gitattributes vendored
View File

@ -2701,6 +2701,7 @@ packages/fcl-registry/Makefile svneol=native#text/plain
packages/fcl-registry/Makefile.fpc svneol=native#text/plain packages/fcl-registry/Makefile.fpc svneol=native#text/plain
packages/fcl-registry/Makefile.fpc.fpcmake svneol=native#text/plain packages/fcl-registry/Makefile.fpc.fpcmake svneol=native#text/plain
packages/fcl-registry/examples/remotereg.pp svneol=native#text/pascal packages/fcl-registry/examples/remotereg.pp svneol=native#text/pascal
packages/fcl-registry/examples/testunicode.pp svneol=native#text/plain
packages/fcl-registry/fpmake.pp svneol=native#text/plain packages/fcl-registry/fpmake.pp svneol=native#text/plain
packages/fcl-registry/src/regdef.inc svneol=native#text/plain packages/fcl-registry/src/regdef.inc svneol=native#text/plain
packages/fcl-registry/src/regini.inc svneol=native#text/plain packages/fcl-registry/src/regini.inc svneol=native#text/plain

View File

@ -0,0 +1,257 @@
program testunicode;
{$mode objfpc}{$H+}
{$codepage utf8}
{$IFNDEF UNIX}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils, classes, registry;
Var
EditKey : UTF8String = 'ASCII;这是一个测试';
labeledEditName : UTF8String = 'ASCII;പേര് ഇതാണ്ASCII;这是一个测试';
labeledEditValue : UTF8String = 'これは値です;ASCII';
labelkeycaption : string = 'HKCU\Software\zzz_test\';
reg: TRegistry;
Results : TStrings;
function TestKey (const AKey: utf8string): boolean;
begin
Result:=false;
try
reg.CloseKey;
if reg.KeyExists(AKey) then
reg.DeleteKey(AKey);
if reg.KeyExists(AKey) then
begin
Results.Add('TestKey-01 failed: DeleteKey(%s);',[AKey]);
exit;
end;
if not reg.OpenKey(AKey,true) then
begin
Results.Add('TestKey-02 failed: OpenKey(%s,true)',[AKey]);
exit;
end;
reg.CloseKey;
if not reg.KeyExists(AKey) then
begin
Results.Add('TestKey-03 failed: OpenKey(%s,true)',[AKey]);
exit;
end;
reg.DeleteKey(AKey);
if not reg.CreateKey(AKey) then
begin
Results.Add('TestKey-04 failed: CreateKey(%s)',[AKey]);
exit;
end;
if not reg.KeyExists(AKey) then
begin
Results.Add('TestKey-05 failed: CreateKey(%s,true)',[AKey]);
exit;
end;
if not reg.OpenKeyReadOnly(AKey) then
begin
Results.Add('TestKey-06 failed: OpenKeyReadOnly(%s)',[AKey]);
exit;
end;
reg.CloseKey;
if not reg.OpenKey(AKey,false) then
begin
Results.Add('TestKey-07 failed: OpenKey(%s,false)',[AKey]);
exit;
end;
Results.Add('TestKey passed: %s',[AKey]);
except
on e:Exception do
Results.Add('TestKey-08 failed: %s; %s;',[AKey,e.Message]);
end;
Result:=true;
end;
procedure TestValue (const AName, AValue: utf8string);
var
wrong,s: string;
begin
try
wrong:=AName+'_wrong';
if reg.ValueExists(wrong) then
reg.DeleteValue(wrong);
if reg.ValueExists(wrong) then
begin
Results.Add('TestValue-01 failed: DeleteValue(%s)',[wrong]);
exit;
end;
reg.WriteString(wrong,AValue);
s:=reg.ReadString(wrong);
if s<>AValue then
begin
Results.Add('TestValue-02 failed: WriteString(%s,%s)',[wrong,AValue]);
exit;
end;
if reg.ValueExists(AName) then
reg.DeleteValue(AName);
if reg.ValueExists(AName) then
begin
Results.Add('TestValue-03 failed: DeleteValue(%s)',[AName]);
exit;
end;
reg.RenameValue(wrong,AName);
s:=reg.ReadString(AName);
if s<>AValue then
begin
Results.Add('TestValue-04 failed: RenameValue(%s,%s)',[wrong,AName]);
exit;
end;
Results.Add('TestValue passed: %s; %s;',[AName,AValue]);
except
on e:Exception do
Results.Add('TestValue-08 failed: %s; %s; %s;',[AName,AValue,e.Message]);
end;
end;
procedure TestGetKeyNames (const AKey, AExpected: utf8string);
var
sl: TStringList;
begin
sl:=TStringList.Create;
sl.Delimiter:=';';
reg.CloseKey;
try
if not reg.OpenKeyReadOnly(AKey) then
begin
Results.Add('TestGetKeyNames-01 failed: Key "%s";',[AKey]);
exit;
end;
reg.GetKeyNames(sl);
if sl.DelimitedText=AExpected then
Results.Add('TestGetKeyNames passed: Key: "%s"; Expected: "%s";',[AKey,AExpected])
else
Results.Add('TestGetKeyNames-02 failed: Key: "%s"; got: "%s"; expected: "%s";',
[AKey,sl.DelimitedText,AExpected]);
except
on e:Exception do
Results.Add('TestGetKeyNames-03 failed exception: Key: "%s"; Got: "%s"; Expected: "%s"; Exception: "%s";',
[AKey,sl.DelimitedText,AExpected,e.Message]);
end;
sl.Free;
end;
procedure TestGetValueNames (const AKey, AExpected: UTF8string);
var
sl: TStringList;
begin
sl:=TStringList.Create;
sl.Delimiter:=';';
try
reg.GetValueNames(sl);
if sl.DelimitedText=AExpected then
Results.Add('TestGetValueNames passed: Key: "%s"; Expected "%s";',[AKey,AExpected])
else
Results.Add('TestGetValueNames-01 failed: Key "%s"; Got: "%s"; Expected: "%s";',
[AKey,sl.DelimitedText,AExpected]);
except
on e:Exception do
Results.Add('TestGetValueNames-02 failed exception: Key: "%s"; Got: "%s"; expected: "%s"; exception: "%s";',
[AKey,sl.DelimitedText,AExpected,e.Message]);
end;
sl.Free;
end;
procedure Test;
var
sKey: string;
slKeys,
slNames,
slValues: TStringList;
sValueNames,
s: string;
k,n,v: integer;
l: longint;
begin
sKey:=LabelKeyCaption;
l:=pos('\',LabelKeyCaption);
if l>0 then
delete(sKey,1,l);
if sKey[Length(sKey)]='\' then
SetLength(sKey,Length(sKey)-1);
slKeys:=TStringList.Create;
slKeys.Delimiter:=';';
slKeys.DelimitedText:=EditKey;
slNames:=TStringList.Create;
slNames.Delimiter:=';';
slNames.DelimitedText:=LabeledEditName;
slValues:=TStringList.Create;
slValues.Delimiter:=';';
slValues.DelimitedText:=LabeledEditValue;
for k:=0 to slKeys.Count-1 do
if TestKey(sKey+'\'+slKeys[k]) then
begin
sValueNames:='';
for n:=0 to slNames.Count-1 do
for v:=0 to slValues.Count-1 do
begin
s:=Format('%d%d%d_%s',[k,n,v,slNames[n]]);
if sValueNames='' then
sValueNames:=s
else
sValueNames:=sValueNames+slNames.Delimiter+s;
TestValue(s,slValues[v]);
end;
TestGetValueNames(reg.CurrentPath,sValueNames);
end;
TestGetKeyNames(sKey,slKeys.DelimitedText);
reg.CloseKey;
slKeys.Free;
slNames.Free;
slValues.Free;
end;
Procedure WN;
Var
F : Text;
begin
Assign(F,'names.txt');
Rewrite(F);
Writeln(F,EditKey);
Writeln(F,labeledEditName);
Writeln(F,LabeledEditValue);
Writeln(F,LabelKeyCaption);
Close(F);
end;
begin
defaultsystemcodepage:=CP_UTF8;
if (ParamStr(1)='-s') then
WN;
reg:=TRegistry.Create;
reg.lazywrite:=false;
Results:=TStringList.Create;
Test;
Reg.Free;
if (ParamStr(1)='-s') then
Results.SaveToFile('result.txt');
Writeln(Results.Text);
Results.Free;
{$IFDEF WINDOWS}Readln;{$ENDIF}
end.

View File

@ -383,30 +383,31 @@ function TRegistry.ReadString(const Name: string): string;
Var Var
Info : TRegDataInfo; Info : TRegDataInfo;
ReadDataSize: Integer; ReadDataSize: Integer;
u: UnicodeString;
begin begin
Result:='';
GetDataInfo(Name,Info); GetDataInfo(Name,Info);
if info.datasize>0 then if info.datasize>0 then
begin
if Not (Info.RegData in [rdString,rdExpandString]) then
Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
if Odd(Info.DataSize) then
SetLength(u,round((Info.DataSize+1)/SizeOf(UnicodeChar)))
else
SetLength(u,round(Info.DataSize/SizeOf(UnicodeChar)));
ReadDataSize := GetData(Name,@u[1],Info.DataSize,Info.RegData);
if ReadDataSize > 0 then
begin begin
If Not (Info.RegData in [rdString,rdExpandString]) then // If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type,
Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]); // the size includes any terminating null character or characters
SetLength(Result,Info.DataSize); // unless the data was stored without them! (RegQueryValueEx @ MSDN)
ReadDataSize := GetData(Name,PChar(Result),Info.DataSize,Info.RegData); if StringSizeIncludesNull and
if ReadDataSize > 0 then (u[Length(u)] = WideChar(0)) then
begin SetLength(u,Length(u)-1);
// If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type, Result:=UTF8Encode(u);
// the size includes any terminating null character or characters end;
// unless the data was stored without them! (RegQueryValueEx @ MSDN) end;
if StringSizeIncludesNull then
if Result[ReadDataSize] = #0 then
Dec(ReadDataSize);
SetLength(Result, ReadDataSize);
end
else
Result := '';
end
else
result:='';
end; end;
function TRegistry.ReadTime(const Name: string): TDateTime; function TRegistry.ReadTime(const Name: string): TDateTime;
@ -449,9 +450,12 @@ begin
end; end;
procedure TRegistry.WriteExpandString(const Name, Value: string); procedure TRegistry.WriteExpandString(const Name, Value: string);
var
u: UnicodeString;
begin begin
PutData(Name, PChar(Value), Length(Value),rdExpandString); u:=UTF8Decode(Value);
PutData(Name, PWideChar(u), ByteLength(u), rdExpandString);
end; end;
procedure TRegistry.WriteFloat(const Name: string; Value: Double); procedure TRegistry.WriteFloat(const Name: string; Value: Double);
@ -465,9 +469,12 @@ begin
end; end;
procedure TRegistry.WriteString(const Name, Value: string); procedure TRegistry.WriteString(const Name, Value: string);
var
u: UnicodeString;
begin begin
PutData(Name, PChar(Value), Length(Value), rdString); u:=UTF8Decode(Value);
PutData(Name, PWideChar(u), ByteLength(u), rdString);
end; end;
procedure TRegistry.MoveKey(const OldName, NewName: string; Delete: Boolean); procedure TRegistry.MoveKey(const OldName, NewName: string; Delete: Boolean);

View File

@ -40,23 +40,23 @@ end;
function TRegistry.sysCreateKey(const Key: String): Boolean; function TRegistry.sysCreateKey(const Key: String): Boolean;
Var Var
P: PChar; u: UnicodeString;
Disposition: Dword; Disposition: Dword;
Handle: HKEY; Handle: HKEY;
SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES; SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
begin begin
SecurityAttributes := Nil; SecurityAttributes := Nil;
P:=PrepKey(Key); u:=UTF8Decode(PrepKey(Key));
FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)), FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
P, PWideChar(u),
0, 0,
'', '',
REG_OPTION_NON_VOLATILE, REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS, KEY_ALL_ACCESS,
SecurityAttributes, SecurityAttributes,
Handle, Handle,
@Disposition); @Disposition);
Result:=FLastError=ERROR_SUCCESS; Result:=FLastError=ERROR_SUCCESS;
RegCloseKey(Handle); RegCloseKey(Handle);
end; end;
@ -64,28 +64,28 @@ end;
function TRegistry.DeleteKey(const Key: String): Boolean; function TRegistry.DeleteKey(const Key: String): Boolean;
Var Var
P: PChar; u: UnicodeString;
begin begin
P:=PRepKey(Key); u:=UTF8Decode(PRepKey(Key));
FLastError:=RegDeleteKeyA(GetBaseKey(RelativeKey(Key)),P); FLastError:=RegDeleteKeyW(GetBaseKey(RelativeKey(Key)),PWideChar(u));
Result:=FLastError=ERROR_SUCCESS; Result:=FLastError=ERROR_SUCCESS;
end; end;
function TRegistry.DeleteValue(const Name: String): Boolean; function TRegistry.DeleteValue(const Name: String): Boolean;
begin begin
FLastError:= RegDeleteValueA(fCurrentKey, @Name[1]); FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UTF8Decode(Name)));
Result:=FLastError=ERROR_SUCCESS; Result:=FLastError=ERROR_SUCCESS;
end; end;
function TRegistry.SysGetData(const Name: String; Buffer: Pointer; function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
BufSize: Integer; Out RegData: TRegDataType): Integer; BufSize: Integer; Out RegData: TRegDataType): Integer;
Var Var
P: PChar; u: UnicodeString;
RD : DWord; RD : DWord;
begin begin
P := PChar(Name); u := UTF8Decode(Name);
FLastError:=RegQueryValueExA(fCurrentKey,P,Nil, FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,
@RD,Buffer,lpdword(@BufSize)); @RD,Buffer,lpdword(@BufSize));
if (FLastError<>ERROR_SUCCESS) Then if (FLastError<>ERROR_SUCCESS) Then
Result:=-1 Result:=-1
@ -108,13 +108,13 @@ end;
function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo): Boolean; function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo): Boolean;
Var Var
P: PChar; u: UnicodeString;
begin begin
P:=PChar(ValueName); u:=UTF8Decode(ValueName);
With Value do With Value do
begin begin
FLastError:=RegQueryValueExA(fCurrentKey,P,Nil,lpdword(@RegData),Nil,lpdword(@DataSize)); FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
Result:=FLastError=ERROR_SUCCESS; Result:=FLastError=ERROR_SUCCESS;
end; end;
If Not Result Then If Not Result Then
@ -128,6 +128,9 @@ end;
function TRegistry.GetKey(const Key: String): HKEY; function TRegistry.GetKey(const Key: String): HKEY;
var var
S : string; S : string;
{$ifndef WinCE}
u : UnicodeString;
{$endif}
Rel : Boolean; Rel : Boolean;
begin begin
Result:=0; Result:=0;
@ -138,7 +141,8 @@ begin
{$ifdef WinCE} {$ifdef WinCE}
FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result); FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
{$else WinCE} {$else WinCE}
FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PChar(S),0,FAccess,Result); u:=UTF8Decode(S);
FLastError:=RegOpenKeyExW(GetBaseKey(Rel),PWideChar(u),0,FAccess,Result);
{$endif WinCE} {$endif WinCE}
end; end;
@ -195,19 +199,18 @@ end;
function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean; function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
Var Var
P: PChar; u: UnicodeString;
Handle: HKEY; Handle: HKEY;
Disposition: Integer; Disposition: Integer;
SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES; SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
S: string; S: string;
begin begin
SecurityAttributes := Nil; SecurityAttributes := Nil;
P:=PrepKey(Key); u:=UTF8Decode(PrepKey(Key));
If CanCreate then If CanCreate then
begin begin
Handle:=0; Handle:=0;
FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),P,0,'', FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),PWideChar(u),0,'',
REG_OPTION_NON_VOLATILE, REG_OPTION_NON_VOLATILE,
fAccess,SecurityAttributes,Handle, fAccess,SecurityAttributes,Handle,
pdword(@Disposition)); pdword(@Disposition));
@ -215,15 +218,15 @@ begin
end end
else else
begin begin
FLastError:=RegOpenKeyExA(GetBaseKey(RelativeKey(Key)), FLastError:=RegOpenKeyExW(GetBaseKey(RelativeKey(Key)),
P,0,fAccess,Handle); PWideChar(u),0,fAccess,Handle);
Result:=FLastError=ERROR_SUCCESS; Result:=FLastError=ERROR_SUCCESS;
end; end;
If Result then begin If Result then begin
if RelativeKey(Key) then if RelativeKey(Key) then
S:=CurrentPath + Key S:=CurrentPath + Key
else else
S:=P; S:=UTF8Encode(u);
ChangeKey(Handle, S); ChangeKey(Handle, S);
end; end;
end; end;
@ -251,7 +254,7 @@ begin
{$ifdef WinCE} {$ifdef WinCE}
Result:=False; Result:=False;
{$else} {$else}
FLastError:=RegConnectRegistryA(PChar(UNCName),RootKey,newroot); FLastError:=RegConnectRegistryW(PWideChar(UTF8Decode(UNCName)),RootKey,newroot);
Result:=FLastError=ERROR_SUCCESS; Result:=FLastError=ERROR_SUCCESS;
if Result then begin if Result then begin
RootKey:=newroot; RootKey:=newroot;
@ -316,64 +319,95 @@ end;
procedure TRegistry.GetKeyNames(Strings: TStrings); procedure TRegistry.GetKeyNames(Strings: TStrings);
Var var
L : Cardinal; Info: TRegKeyInfo;
I: Integer; dwLen: DWORD;
Info: TRegKeyInfo; lpName: LPWSTR;
P : PChar; dwIndex: DWORD;
lResult: LONGINT;
s: string;
begin begin
Strings.Clear; Strings.Clear;
if GetKeyInfo(Info) then if GetKeyInfo(Info) then
begin begin
L:=Info.MaxSubKeyLen+1; dwLen:=Info.MaxSubKeyLen+1;
GetMem(P,L); GetMem(lpName,dwLen*SizeOf(WideChar));
Try try
for I:=0 to Info.NumSubKeys-1 do for dwIndex:=0 to Info.NumSubKeys-1 do
begin begin
L:=Info.MaxSubKeyLen+1; dwLen:=Info.MaxSubKeyLen+1;
RegEnumKeyExA(CurrentKey,I,P,L,Nil,Nil,Nil,Nil); lResult:=RegEnumKeyExW(CurrentKey,dwIndex,lpName,dwLen,Nil,Nil,Nil,Nil);
Strings.Add(StrPas(P)); if lResult<>ERROR_SUCCESS then
end; raise ERegistryException.Create(SysErrorMessage(lResult));
Finally if dwLen=0 then
FreeMem(P); s:=''
end; else
end; begin // dwLen>0
SetLength(s,dwLen*3);
dwLen:=UnicodeToUTF8(PChar(s),Length(s)+1,lpName,dwLen);
if dwLen<=1 then
s:=''
else // dwLen>1
SetLength(s,dwLen-1);
end; // if dwLen=0
Strings.Add(s);
end; // for dwIndex:=0 ...
finally
FreeMem(lpName);
end;
end;
end; end;
procedure TRegistry.GetValueNames(Strings: TStrings); procedure TRegistry.GetValueNames(Strings: TStrings);
Var var
L : Cardinal; Info: TRegKeyInfo;
I: Integer; dwLen: DWORD;
Info: TRegKeyInfo; lpName: LPWSTR;
P : PChar; dwIndex: DWORD;
lResult: LONGINT;
s: string;
begin begin
Strings.Clear; Strings.Clear;
if GetKeyInfo(Info) then if GetKeyInfo(Info) then
begin begin
L:=Info.MaxValueLen+1; dwLen:=Info.MaxValueLen+1;
GetMem(P,L); GetMem(lpName,dwLen*SizeOf(WideChar));
Try try
for I:=0 to Info.NumValues-1 do for dwIndex:=0 to Info.NumValues-1 do
begin begin
L:=Info.MaxValueLen+1; dwLen:=Info.MaxValueLen+1;
RegEnumValueA(CurrentKey,I,P,L,Nil,Nil,Nil,Nil); lResult:=RegEnumValueW(CurrentKey,dwIndex,lpName,dwLen,Nil,Nil,Nil,Nil);
Strings.Add(StrPas(P)); if lResult<>ERROR_SUCCESS then
end; raise ERegistryException.Create(SysErrorMessage(lResult));
Finally if dwLen=0 then
FreeMem(P); s:=''
end; else
end; begin // dwLen>0
SetLength(s,dwLen*3);
dwLen:=UnicodeToUTF8(PChar(s),Length(s)+1,lpName,dwLen);
if dwLen<=1 then
s:=''
else // dwLen>1
SetLength(s,dwLen-1);
end; // if dwLen=0
Strings.Add(s);
end; // for dwIndex:=0 ...
finally
FreeMem(lpName);
end;
end;
end; end;
Function TRegistry.SysPutData(const Name: string; Buffer: Pointer; Function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
BufSize: Integer; RegData: TRegDataType) : Boolean; BufSize: Integer; RegData: TRegDataType) : Boolean;
Var Var
P: PChar; u: UnicodeString;
RegDataType: DWORD; RegDataType: DWORD;
begin begin
@ -384,8 +418,8 @@ begin
rdInteger : RegDataType:=REG_DWORD; rdInteger : RegDataType:=REG_DWORD;
rdBinary : RegDataType:=REG_BINARY; rdBinary : RegDataType:=REG_BINARY;
end; end;
P:=PChar(Name); u:=UTF8Decode(Name);
FLastError:=RegSetValueExA(fCurrentKey,P,0,RegDataType,Buffer,BufSize); FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
Result:=FLastError=ERROR_SUCCESS; Result:=FLastError=ERROR_SUCCESS;
end; end;

View File

@ -39,6 +39,8 @@ Type
FCurrentKey : String; FCurrentKey : String;
Procedure SetFileName(Value : String); Procedure SetFileName(Value : String);
Protected Protected
function DoGetValueData(Name: String; out DataType: TDataType; Var Data; Var DataSize: Integer; IsUnicode: Boolean): Boolean; virtual;
function DoSetValueData(Name: String; DataType: TDataType; const Data; DataSize: Integer; IsUnicode: Boolean): Boolean; virtual;
Procedure LoadFromStream(S : TStream); Procedure LoadFromStream(S : TStream);
Function NormalizeKey(KeyPath : String) : String; Function NormalizeKey(KeyPath : String) : String;
Procedure CreateEmptyDoc; Procedure CreateEmptyDoc;
@ -61,7 +63,7 @@ Type
Function CreateKey(KeyPath : String) : Boolean; Function CreateKey(KeyPath : String) : Boolean;
Function GetValueSize(Name : String) : Integer; Function GetValueSize(Name : String) : Integer;
Function GetValueType(Name : String) : TDataType; Function GetValueType(Name : String) : TDataType;
Function GetValueInfo(Name : String; Out Info : TDataInfo) : Boolean; Function GetValueInfo(Name : String; Out Info : TDataInfo; AsUnicode : Boolean = False) : Boolean;
Function GetKeyInfo(Out Info : TKeyInfo) : Boolean; Function GetKeyInfo(Out Info : TKeyInfo) : Boolean;
Function EnumSubKeys(List : TStrings) : Integer; Function EnumSubKeys(List : TStrings) : Integer;
Function EnumValues(List : TStrings) : Integer; Function EnumValues(List : TStrings) : Integer;
@ -73,6 +75,9 @@ Type
Procedure Load; Procedure Load;
Function GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean; Function GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
Function SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean; Function SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
// These interpret the Data buffer as unicode data
Function GetValueDataUnicode(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
Function SetValueDataUnicode(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
Property FileName : String Read FFileName Write SetFileName; Property FileName : String Read FFileName Write SetFileName;
Property RootKey : String Read FRootKey Write SetRootkey; Property RootKey : String Read FRootKey Write SetRootkey;
Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush; Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;
@ -285,7 +290,7 @@ begin
MaybeFlush; MaybeFlush;
end; end;
Function TXmlRegistry.GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean; Function TXmlRegistry.DoGetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer; IsUnicode : Boolean) : Boolean;
Type Type
PCardinal = ^Cardinal; PCardinal = ^Cardinal;
@ -295,6 +300,7 @@ Var
DataNode : TDomNode; DataNode : TDomNode;
BL,ND,NS : Integer; BL,ND,NS : Integer;
S : UTF8String; S : UTF8String;
U : UnicodeString;
HasData: Boolean; HasData: Boolean;
D : DWord; D : DWord;
@ -321,11 +327,22 @@ begin
dtString : // DataNode is optional dtString : // DataNode is optional
if HasData then if HasData then
begin begin
S:=UTF8Encode(DataNode.NodeValue); // Convert to ansistring if not IsUnicode then
NS:=Length(S); begin
Result:=(DataSize>=NS); S:=UTF8Encode(DataNode.NodeValue); // Convert to ansistring
if Result then NS:=Length(S);
Move(S[1],Data,NS); Result:=(DataSize>=NS);
if Result then
Move(S[1],Data,NS);
end
else
begin
U:=DataNode.NodeValue;
NS:=Length(U)*SizeOf(UnicodeChar);
Result:=(DataSize>=NS);
if Result then
Move(U[1],Data,NS);
end
end; end;
dtBinary : // DataNode is optional dtBinary : // DataNode is optional
@ -345,7 +362,7 @@ begin
end; end;
end; end;
Function TXmlRegistry.SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean; Function TXmlRegistry.DoSetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer; IsUnicode : Boolean) : Boolean;
Type Type
PCardinal = ^Cardinal; PCardinal = ^Cardinal;
@ -353,7 +370,8 @@ Type
Var Var
Node : TDomElement; Node : TDomElement;
DataNode : TDomNode; DataNode : TDomNode;
SW : Widestring; SW : UnicodeString;
begin begin
Node:=FindValueKey(Name); Node:=FindValueKey(Name);
If Node=Nil then If Node=Nil then
@ -367,7 +385,10 @@ begin
Case DataType of Case DataType of
dtDWORD : SW:=IntToStr(PCardinal(@Data)^); dtDWORD : SW:=IntToStr(PCardinal(@Data)^);
dtString : begin dtString : begin
SW:=WideString(PAnsiChar(@Data)); if IsUnicode then
SW:=UnicodeString(PUnicodeChar(@Data))
else
SW:=UnicodeString(PAnsiChar(@Data));
//S:=UTF8Encode(SW); //S:=UTF8Encode(SW);
end; end;
dtBinary : SW:=BufToHex(Data,DataSize); dtBinary : SW:=BufToHex(Data,DataSize);
@ -393,6 +414,28 @@ begin
end; end;
end; end;
Function TXmlRegistry.SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
begin
Result:=DoSetValueData(Name,DataType,Data,DataSize,False);
end;
Function TXmlRegistry.GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
begin
Result:=DoGetValueData(Name,DataType,Data,DataSize,False);
end;
function TXmlRegistry.GetValueDataUnicode(Name: String; out DataType: TDataType; Var Data; Var DataSize: Integer): Boolean;
begin
Result:=DoGetValueData(Name,DataType,Data,DataSize,True);
end;
function TXmlRegistry.SetValueDataUnicode(Name: String; DataType: TDataType; const Data; DataSize: Integer): Boolean;
begin
Result:=DoSetValueData(Name,DataType,Data,DataSize,True)
end;
Function TXmlRegistry.FindSubKey (S : String; N : TDomElement) : TDomElement; Function TXmlRegistry.FindSubKey (S : String; N : TDomElement) : TDomElement;
Var Var
@ -607,7 +650,7 @@ begin
Result:=dtUnknown; Result:=dtUnknown;
end; end;
Function TXMLRegistry.GetValueInfo(Name : String; Out Info : TDataInfo) : Boolean; function TXmlRegistry.GetValueInfo(Name: String; out Info: TDataInfo; AsUnicode: Boolean): Boolean;
Var Var
N : TDomElement; N : TDomElement;
@ -620,10 +663,17 @@ begin
If Result then If Result then
begin begin
DN:=N.FirstChild; DN:=N.FirstChild;
if Assigned(DN) and (DN.NodeType=TEXT_NODE) then begin if Assigned(DN) and (DN.NodeType=TEXT_NODE) then
S := UTF8Encode(DN.NodeValue); begin
L:=Length(S); if AsUnicode then
end else L:=Length(DN.NodeValue)*SizeOf(UnicodeChar)
else
begin
S := UTF8Encode(DN.NodeValue);
L:=Length(S);
end
end
else
L:=0; L:=0;
With Info do With Info do
begin begin

View File

@ -124,7 +124,7 @@ Var
DataType : TDataType; DataType : TDataType;
begin begin
Result:=BufSize; Result:=BufSize;
If TXmlregistry(FSysData).GetValueData(Name,DataType,Buffer^,Result) then If TXmlregistry(FSysData).GetValueDataUnicode(Name,DataType,Buffer^,Result) then
begin begin
Case DataType of Case DataType of
dtUnknown : RegData:=rdUnknown; dtUnknown : RegData:=rdUnknown;
@ -144,7 +144,7 @@ Var
Info : TDataInfo; Info : TDataInfo;
begin begin
Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info); Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info,True);
If Not Result then If Not Result then
With Value do With Value do
begin begin
@ -270,7 +270,7 @@ begin
rdInteger : DataType := dtDword; rdInteger : DataType := dtDword;
rdBinary : DataType := dtBinary; rdBinary : DataType := dtBinary;
end; end;
Result:=TXMLRegistry(FSysData).SetValueData(Name,DataType,Buffer^,BufSize); Result:=TXMLRegistry(FSysData).SetValueDataUnicode(Name,DataType,Buffer^,BufSize);
end; end;
procedure TRegistry.RenameValue(const OldName, NewName: string); procedure TRegistry.RenameValue(const OldName, NewName: string);