Browse Source

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

git-svn-id: trunk@36765 -
michael 8 years ago
parent
commit
3b5d532ab5

+ 1 - 0
.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 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

+ 257 - 0
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.
+

+ 28 - 21
packages/fcl-registry/src/registry.pp

@@ -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
-       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;
 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);

+ 109 - 75
packages/fcl-registry/src/winreg.inc

@@ -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);
-  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;
   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);
-  FLastError:=RegDeleteKeyA(GetBaseKey(RelativeKey(Key)),P);
+  u:=UTF8Decode(PRepKey(Key));
+  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);
-  FLastError:=RegQueryValueExA(fCurrentKey,P,Nil,
+  u := UTF8Decode(Name);
+  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)),
-                         P,0,fAccess,Handle);
+    FLastError:=RegOpenKeyExW(GetBaseKey(RelativeKey(Key)),
+                              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
-  L : Cardinal;
-  I: Integer;
-  Info: TRegKeyInfo;
-  P : PChar;
+var
+  Info:    TRegKeyInfo;
+  dwLen:   DWORD;
+  lpName:  LPWSTR;
+  dwIndex: DWORD;
+  lResult: LONGINT;
+  s:       string;
 
 
 begin
 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;
 end;
 
 
 procedure TRegistry.GetValueNames(Strings: TStrings);
 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
 begin
    Strings.Clear;
    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;
 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);
-  FLastError:=RegSetValueExA(fCurrentKey,P,0,RegDataType,Buffer,BufSize);
+  u:=UTF8Decode(Name);
+  FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
   Result:=FLastError=ERROR_SUCCESS;
   Result:=FLastError=ERROR_SUCCESS;
 end;
 end;
 
 

+ 65 - 15
packages/fcl-registry/src/xmlreg.pp

@@ -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
-                     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;
                      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
-      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;
       L:=0;
     With Info do
     With Info do
       begin
       begin

+ 3 - 3
packages/fcl-registry/src/xregreg.inc

@@ -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);