diff --git a/.gitattributes b/.gitattributes index 1abc516bc9..1fa4daa839 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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.fpcmake svneol=native#text/plain 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/src/regdef.inc svneol=native#text/plain packages/fcl-registry/src/regini.inc svneol=native#text/plain diff --git a/packages/fcl-registry/examples/testunicode.pp b/packages/fcl-registry/examples/testunicode.pp new file mode 100644 index 0000000000..55bdf18105 --- /dev/null +++ b/packages/fcl-registry/examples/testunicode.pp @@ -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. + diff --git a/packages/fcl-registry/src/registry.pp b/packages/fcl-registry/src/registry.pp index ef10ce8893..de2e425ffd 100644 --- a/packages/fcl-registry/src/registry.pp +++ b/packages/fcl-registry/src/registry.pp @@ -383,30 +383,31 @@ function TRegistry.ReadString(const Name: string): string; Var Info : TRegDataInfo; ReadDataSize: Integer; + u: UnicodeString; begin + Result:=''; GetDataInfo(Name,Info); 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 - If Not (Info.RegData in [rdString,rdExpandString]) then - Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]); - SetLength(Result,Info.DataSize); - ReadDataSize := GetData(Name,PChar(Result),Info.DataSize,Info.RegData); - if ReadDataSize > 0 then - begin - // If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type, - // the size includes any terminating null character or characters - // unless the data was stored without them! (RegQueryValueEx @ MSDN) - if StringSizeIncludesNull then - if Result[ReadDataSize] = #0 then - Dec(ReadDataSize); - SetLength(Result, ReadDataSize); - end - else - Result := ''; - end - else - result:=''; + // If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type, + // the size includes any terminating null character or characters + // unless the data was stored without them! (RegQueryValueEx @ MSDN) + if StringSizeIncludesNull and + (u[Length(u)] = WideChar(0)) then + SetLength(u,Length(u)-1); + Result:=UTF8Encode(u); + end; + end; end; function TRegistry.ReadTime(const Name: string): TDateTime; @@ -449,9 +450,12 @@ begin end; procedure TRegistry.WriteExpandString(const Name, Value: string); +var + u: UnicodeString; begin - PutData(Name, PChar(Value), Length(Value),rdExpandString); + u:=UTF8Decode(Value); + PutData(Name, PWideChar(u), ByteLength(u), rdExpandString); end; procedure TRegistry.WriteFloat(const Name: string; Value: Double); @@ -465,9 +469,12 @@ begin end; procedure TRegistry.WriteString(const Name, Value: string); +var + u: UnicodeString; begin - PutData(Name, PChar(Value), Length(Value), rdString); + u:=UTF8Decode(Value); + PutData(Name, PWideChar(u), ByteLength(u), rdString); end; procedure TRegistry.MoveKey(const OldName, NewName: string; Delete: Boolean); diff --git a/packages/fcl-registry/src/winreg.inc b/packages/fcl-registry/src/winreg.inc index fd400b9438..b0cf600f29 100644 --- a/packages/fcl-registry/src/winreg.inc +++ b/packages/fcl-registry/src/winreg.inc @@ -40,23 +40,23 @@ end; function TRegistry.sysCreateKey(const Key: String): Boolean; Var - P: PChar; + u: UnicodeString; Disposition: Dword; Handle: HKEY; SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES; begin SecurityAttributes := Nil; - P:=PrepKey(Key); - FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)), - P, - 0, - '', - REG_OPTION_NON_VOLATILE, - KEY_ALL_ACCESS, - SecurityAttributes, - Handle, - @Disposition); + u:=UTF8Decode(PrepKey(Key)); + FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)), + PWideChar(u), + 0, + '', + REG_OPTION_NON_VOLATILE, + KEY_ALL_ACCESS, + SecurityAttributes, + Handle, + @Disposition); Result:=FLastError=ERROR_SUCCESS; RegCloseKey(Handle); end; @@ -64,28 +64,28 @@ end; function TRegistry.DeleteKey(const Key: String): Boolean; Var - P: PChar; + u: UnicodeString; begin - P:=PRepKey(Key); - FLastError:=RegDeleteKeyA(GetBaseKey(RelativeKey(Key)),P); + u:=UTF8Decode(PRepKey(Key)); + FLastError:=RegDeleteKeyW(GetBaseKey(RelativeKey(Key)),PWideChar(u)); Result:=FLastError=ERROR_SUCCESS; end; function TRegistry.DeleteValue(const Name: String): Boolean; begin - FLastError:= RegDeleteValueA(fCurrentKey, @Name[1]); + FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UTF8Decode(Name))); Result:=FLastError=ERROR_SUCCESS; end; function TRegistry.SysGetData(const Name: String; Buffer: Pointer; BufSize: Integer; Out RegData: TRegDataType): Integer; Var - P: PChar; + u: UnicodeString; RD : DWord; begin - P := PChar(Name); - FLastError:=RegQueryValueExA(fCurrentKey,P,Nil, + u := UTF8Decode(Name); + FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil, @RD,Buffer,lpdword(@BufSize)); if (FLastError<>ERROR_SUCCESS) Then Result:=-1 @@ -108,13 +108,13 @@ end; function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo): Boolean; Var - P: PChar; + u: UnicodeString; begin - P:=PChar(ValueName); + u:=UTF8Decode(ValueName); With Value do 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; end; If Not Result Then @@ -128,6 +128,9 @@ end; function TRegistry.GetKey(const Key: String): HKEY; var S : string; +{$ifndef WinCE} + u : UnicodeString; +{$endif} Rel : Boolean; begin Result:=0; @@ -138,7 +141,8 @@ begin {$ifdef WinCE} FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result); {$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} end; @@ -195,19 +199,18 @@ end; function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean; Var - P: PChar; + u: UnicodeString; Handle: HKEY; Disposition: Integer; SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES; S: string; begin SecurityAttributes := Nil; - P:=PrepKey(Key); + u:=UTF8Decode(PrepKey(Key)); If CanCreate then begin Handle:=0; - FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),P,0,'', - + FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),PWideChar(u),0,'', REG_OPTION_NON_VOLATILE, fAccess,SecurityAttributes,Handle, pdword(@Disposition)); @@ -215,15 +218,15 @@ begin end else begin - FLastError:=RegOpenKeyExA(GetBaseKey(RelativeKey(Key)), - P,0,fAccess,Handle); + FLastError:=RegOpenKeyExW(GetBaseKey(RelativeKey(Key)), + PWideChar(u),0,fAccess,Handle); Result:=FLastError=ERROR_SUCCESS; end; If Result then begin if RelativeKey(Key) then S:=CurrentPath + Key else - S:=P; + S:=UTF8Encode(u); ChangeKey(Handle, S); end; end; @@ -251,7 +254,7 @@ begin {$ifdef WinCE} Result:=False; {$else} - FLastError:=RegConnectRegistryA(PChar(UNCName),RootKey,newroot); + FLastError:=RegConnectRegistryW(PWideChar(UTF8Decode(UNCName)),RootKey,newroot); Result:=FLastError=ERROR_SUCCESS; if Result then begin RootKey:=newroot; @@ -316,64 +319,95 @@ end; procedure TRegistry.GetKeyNames(Strings: TStrings); -Var - L : Cardinal; - I: Integer; - Info: TRegKeyInfo; - P : PChar; +var + Info: TRegKeyInfo; + dwLen: DWORD; + lpName: LPWSTR; + dwIndex: DWORD; + lResult: LONGINT; + s: string; begin - Strings.Clear; - if GetKeyInfo(Info) then - begin - L:=Info.MaxSubKeyLen+1; - GetMem(P,L); - Try - for I:=0 to Info.NumSubKeys-1 do - begin - L:=Info.MaxSubKeyLen+1; - RegEnumKeyExA(CurrentKey,I,P,L,Nil,Nil,Nil,Nil); - Strings.Add(StrPas(P)); - end; - Finally - FreeMem(P); - end; - end; + Strings.Clear; + if GetKeyInfo(Info) then + begin + dwLen:=Info.MaxSubKeyLen+1; + GetMem(lpName,dwLen*SizeOf(WideChar)); + try + for dwIndex:=0 to Info.NumSubKeys-1 do + begin + dwLen:=Info.MaxSubKeyLen+1; + lResult:=RegEnumKeyExW(CurrentKey,dwIndex,lpName,dwLen,Nil,Nil,Nil,Nil); + if lResult<>ERROR_SUCCESS then + raise ERegistryException.Create(SysErrorMessage(lResult)); + if dwLen=0 then + s:='' + else + 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; procedure TRegistry.GetValueNames(Strings: TStrings); -Var - L : Cardinal; - I: Integer; - Info: TRegKeyInfo; - P : PChar; +var + Info: TRegKeyInfo; + dwLen: DWORD; + lpName: LPWSTR; + dwIndex: DWORD; + lResult: LONGINT; + s: string; begin Strings.Clear; - if GetKeyInfo(Info) then - begin - L:=Info.MaxValueLen+1; - GetMem(P,L); - Try - for I:=0 to Info.NumValues-1 do - begin - L:=Info.MaxValueLen+1; - RegEnumValueA(CurrentKey,I,P,L,Nil,Nil,Nil,Nil); - Strings.Add(StrPas(P)); - end; - Finally - FreeMem(P); - end; - end; + if GetKeyInfo(Info) then + begin + dwLen:=Info.MaxValueLen+1; + GetMem(lpName,dwLen*SizeOf(WideChar)); + try + for dwIndex:=0 to Info.NumValues-1 do + begin + dwLen:=Info.MaxValueLen+1; + lResult:=RegEnumValueW(CurrentKey,dwIndex,lpName,dwLen,Nil,Nil,Nil,Nil); + if lResult<>ERROR_SUCCESS then + raise ERegistryException.Create(SysErrorMessage(lResult)); + if dwLen=0 then + s:='' + else + 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; Function TRegistry.SysPutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType) : Boolean; Var - P: PChar; + u: UnicodeString; RegDataType: DWORD; begin @@ -384,8 +418,8 @@ begin rdInteger : RegDataType:=REG_DWORD; rdBinary : RegDataType:=REG_BINARY; end; - P:=PChar(Name); - FLastError:=RegSetValueExA(fCurrentKey,P,0,RegDataType,Buffer,BufSize); + u:=UTF8Decode(Name); + FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize); Result:=FLastError=ERROR_SUCCESS; end; diff --git a/packages/fcl-registry/src/xmlreg.pp b/packages/fcl-registry/src/xmlreg.pp index 63793fc119..53c88928a0 100644 --- a/packages/fcl-registry/src/xmlreg.pp +++ b/packages/fcl-registry/src/xmlreg.pp @@ -39,6 +39,8 @@ Type FCurrentKey : String; Procedure SetFileName(Value : String); 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); Function NormalizeKey(KeyPath : String) : String; Procedure CreateEmptyDoc; @@ -61,7 +63,7 @@ Type Function CreateKey(KeyPath : String) : Boolean; Function GetValueSize(Name : String) : Integer; 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 EnumSubKeys(List : TStrings) : Integer; Function EnumValues(List : TStrings) : Integer; @@ -73,6 +75,9 @@ Type Procedure Load; Function GetValueData(Name : String; Out DataType : TDataType; Var Data; Var 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 RootKey : String Read FRootKey Write SetRootkey; Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush; @@ -285,7 +290,7 @@ begin MaybeFlush; 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 PCardinal = ^Cardinal; @@ -295,6 +300,7 @@ Var DataNode : TDomNode; BL,ND,NS : Integer; S : UTF8String; + U : UnicodeString; HasData: Boolean; D : DWord; @@ -321,11 +327,22 @@ begin dtString : // DataNode is optional if HasData then begin - S:=UTF8Encode(DataNode.NodeValue); // Convert to ansistring - NS:=Length(S); - Result:=(DataSize>=NS); - if Result then - Move(S[1],Data,NS); + if not IsUnicode then + begin + S:=UTF8Encode(DataNode.NodeValue); // Convert to ansistring + NS:=Length(S); + 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; dtBinary : // DataNode is optional @@ -345,7 +362,7 @@ begin 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 PCardinal = ^Cardinal; @@ -353,7 +370,8 @@ Type Var Node : TDomElement; DataNode : TDomNode; - SW : Widestring; + SW : UnicodeString; + begin Node:=FindValueKey(Name); If Node=Nil then @@ -367,7 +385,10 @@ begin Case DataType of dtDWORD : SW:=IntToStr(PCardinal(@Data)^); dtString : begin - SW:=WideString(PAnsiChar(@Data)); + if IsUnicode then + SW:=UnicodeString(PUnicodeChar(@Data)) + else + SW:=UnicodeString(PAnsiChar(@Data)); //S:=UTF8Encode(SW); end; dtBinary : SW:=BufToHex(Data,DataSize); @@ -393,6 +414,28 @@ begin 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; Var @@ -607,7 +650,7 @@ begin Result:=dtUnknown; end; -Function TXMLRegistry.GetValueInfo(Name : String; Out Info : TDataInfo) : Boolean; +function TXmlRegistry.GetValueInfo(Name: String; out Info: TDataInfo; AsUnicode: Boolean): Boolean; Var N : TDomElement; @@ -620,10 +663,17 @@ begin If Result then begin DN:=N.FirstChild; - if Assigned(DN) and (DN.NodeType=TEXT_NODE) then begin - S := UTF8Encode(DN.NodeValue); - L:=Length(S); - end else + if Assigned(DN) and (DN.NodeType=TEXT_NODE) then + begin + if AsUnicode then + L:=Length(DN.NodeValue)*SizeOf(UnicodeChar) + else + begin + S := UTF8Encode(DN.NodeValue); + L:=Length(S); + end + end + else L:=0; With Info do begin diff --git a/packages/fcl-registry/src/xregreg.inc b/packages/fcl-registry/src/xregreg.inc index ab155b7d45..67d2e11cf1 100644 --- a/packages/fcl-registry/src/xregreg.inc +++ b/packages/fcl-registry/src/xregreg.inc @@ -124,7 +124,7 @@ Var DataType : TDataType; begin Result:=BufSize; - If TXmlregistry(FSysData).GetValueData(Name,DataType,Buffer^,Result) then + If TXmlregistry(FSysData).GetValueDataUnicode(Name,DataType,Buffer^,Result) then begin Case DataType of dtUnknown : RegData:=rdUnknown; @@ -144,7 +144,7 @@ Var Info : TDataInfo; begin - Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info); + Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info,True); If Not Result then With Value do begin @@ -270,7 +270,7 @@ begin rdInteger : DataType := dtDword; rdBinary : DataType := dtBinary; end; - Result:=TXMLRegistry(FSysData).SetValueData(Name,DataType,Buffer^,BufSize); + Result:=TXMLRegistry(FSysData).SetValueDataUnicode(Name,DataType,Buffer^,BufSize); end; procedure TRegistry.RenameValue(const OldName, NewName: string);