* Fixed bug #35060, proper unicode-handling of registry-keynames. With test

   (modified) from Bart Broersma

git-svn-id: trunk@41325 -

.gitattributes

@@ -12722,6 +12722,8 @@ tests/test/packages/fcl-db/tdb5.pp svneol=native#text/plain
 tests/test/packages/fcl-db/tdb6.pp svneol=native#text/plain
 tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tw35060a.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tw35060b.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/tw22495.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/uw22495.pp svneol=native#text/plain

packages/fcl-registry/src/winreg.inc

@@ -28,12 +28,13 @@ begin
   Dispose(PWinRegData(FSysData));
 end;
 
-Function PrepKey(Const S : String) : pChar;
+Function PrepKey(Const S : String) : String;
 
 begin
-  Result:=PChar(S);
-  If Result^='\' then
-    Inc(Result);
+  If Copy(S, 1, 1)='\' then
+    Result := Copy(Result, 2)
+  else
+    Result := S;
 end;
 
 Function RelativeKey(Const S : String) : Boolean;
@@ -52,7 +53,7 @@ Var
 
 begin
   SecurityAttributes := Nil;
-  u:=UTF8Decode(PrepKey(Key));
+  u:=PrepKey(Key);
   FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
                               PWideChar(u),
                               0,
@@ -71,14 +72,14 @@ function TRegistry.DeleteKey(const Key: String): Boolean;
 Var
   u: UnicodeString;
 begin
-  u:=UTF8Decode(PRepKey(Key));
+  u:=PRepKey(Key);
   FLastError:=RegDeleteKeyW(GetBaseKey(RelativeKey(Key)),PWideChar(u));
   Result:=FLastError=ERROR_SUCCESS;
 end;
 
 function TRegistry.DeleteValue(const Name: String): Boolean;
 begin
-  FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UTF8Decode(Name)));
+  FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UnicodeString(Name)));
   Result:=FLastError=ERROR_SUCCESS;
 end;
 
@@ -89,7 +90,7 @@ Var
   RD : DWord;
 
 begin
-  u := UTF8Decode(Name);
+  u := Name;
   FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,
                       @RD,Buffer,lpdword(@BufSize));
   if (FLastError<>ERROR_SUCCESS) Then
@@ -110,7 +111,7 @@ Var
   RD : DWord;
 
 begin
-  u:=UTF8Decode(ValueName);
+  u:=ValueName;
   With Value do
     begin
     FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
@@ -147,7 +148,7 @@ begin
 {$ifdef WinCE}
   FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
 {$else WinCE}
-  u:=UTF8Decode(S);
+  u:=UnicodeString(S);
   FLastError:=RegOpenKeyExW(GetBaseKey(Rel),PWideChar(u),0,FAccess,Result);
 {$endif WinCE}
 end;
@@ -212,7 +213,7 @@ Var
   S: string;
 begin
   SecurityAttributes := Nil;
-  u:=UTF8Decode(PrepKey(Key));
+  u:=PrepKey(Key);
   If CanCreate then
     begin
     Handle:=0;
@@ -260,7 +261,7 @@ begin
 {$ifdef WinCE}
   Result:=False;
 {$else}
-  FLastError:=RegConnectRegistryW(PWideChar(UTF8Decode(UNCName)),RootKey,newroot);
+  FLastError:=RegConnectRegistryW(PWideChar(UnicodeString(UNCName)),RootKey,newroot);
   Result:=FLastError=ERROR_SUCCESS;
   if Result then begin
     RootKey:=newroot;
@@ -422,7 +423,7 @@ Var
 
 begin
   RegDataType:=RegDataWords[RegData];
-  u:=UTF8Decode(Name);
+  u:=UnicodeString(Name);
   FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
   Result:=FLastError=ERROR_SUCCESS;
 end;

tests/test/packages/fcl-registry/tw35060a.pp

@@ -0,0 +1,154 @@
+{ %TARGET=win32,win64,wince }
+
+program tw35060a;
+
+{$apptype console}
+{$assertions on}
+{$ifdef fpc}
+{$codepage cp1252}
+{$mode objfpc}
+{$h+}
+{$endif fpc}
+
+uses
+  SysUtils, Classes, Windows, Registry;
+
+{$ifndef fpc}
+type
+  UnicodeString = WideString;
+
+function GetLastOSError: Integer;
+begin
+  Result := GetLastError;
+end;
+{$endif}
+
+const
+  ExpectedAnsiHex = 'E4 EB EF';
+  ExpectedUnicodeHex = '00E4 00EB 00EF';
+  BugID = 'FPCBug0035060';
+
+function UnicodeToHex(const S: UnicodeString): String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to length(S) do
+    Result := Result + IntToHex(Word(S[i]),4) + #32;
+  Result := Trim(Result);
+end;
+
+function AnsiToHex(const S: String): String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to length(S) do
+    Result := Result + IntToHex(Byte(S[i]),2) + #32;
+  Result := Trim(Result);
+end;
+
+
+//Creating and removing Keys using plain Windows W-API
+function PrepKeyW(Const S : UnicodeString) : pWideChar;
+begin
+  Result:=PWideChar(S);
+  If Result^='\' then
+    Inc(Result);
+end;
+
+procedure CreateKeyInHKCU(const Key: UnicodeString);
+Var
+  u: UnicodeString;
+  Disposition: Dword;
+  Handle: HKEY;
+  SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
+  FLastError: LongInt;
+begin
+  SecurityAttributes := Nil;
+  u:=PrepKeyW(Key);
+  Handle := 0;
+  FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
+                              PWideChar(u),
+                              0,
+                              '',
+                              REG_OPTION_NON_VOLATILE,
+                              KEY_ALL_ACCESS,
+                              SecurityAttributes,
+                              Handle,
+                              @Disposition);
+  RegCloseKey(Handle);
+  Assert(FLastError=ERROR_SUCCESS,format('Creating key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+end;
+
+
+procedure CreateTestKey;
+const
+  TestKey: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
+var
+  Len: Integer;
+begin
+  Len := Length(TestKey);
+  //Being a bit paranoid here?
+  Assert((Len=26) and (Word(TestKey[Len])=$EF) and (Word(TestKey[Len-1])=$EB) and (Word(TestKey[Len-2])=$E4),'Wrong encoding of TestKey');
+  CreateKeyInHKCU(TestKey);
+end;
+
+procedure RemoveTestKey;
+const
+  TestKeyFull: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
+  TestKeyBugID: UnicodeString = 'Software\'+ UniCodeString(BugID);
+var
+  Key: UnicodeString;
+  FLastError: LongInt;
+begin
+  Key:=PRepKeyW(TestKeyFull);
+  FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
+  Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+
+  Key:=PRepKeyW(TestKeyBugID);
+  FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
+  Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+end;
+
+//End Registry plain API functions
+
+var
+  R: TRegistry;
+  Name, S, Key: String;
+  U: UnicodeString;
+  B: Boolean;
+  Err: Integer;
+  CP: TSystemCodePage;
+begin
+  CreateTestKey;
+  try
+    Name := 'äëï';
+    U := UnicodeString(Name);
+    S := AnsiToHex(Name);
+    Assert(S=ExpectedAnsiHex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedAnsiHex,S]));
+    S := UnicodeToHex(U);
+    Assert(S=ExpectedUnicodeHex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedUnicodeHex,S]));
+
+    R := TRegistry.Create(KEY_ALL_ACCESS);
+    try
+      R.RootKey := HKEY_CURRENT_USER;
+      Key := '\Software\'+BugId+'\'+Name;
+      CP := System.StringCodePage(Key);
+      Assert(CP <> 65001,format('The string that contains the key does not have CP_ACP as dynamic code page, but has codepage %d',[CP]));
+      B := R.OpenKeyReadOnly(Key);
+      Err := GetLastOSError;
+      Assert(B,format('OpenKey(''%s'') failed: "%s" [%d]',[Key,Trim(SysErrorMessage(Err)),Err]));
+      writeln(format('OpenKeyReadOnly(''%s''): OK',[Key]));
+    finally
+      R.Free;
+    end;
+
+  finally
+    RemoveTestKey;
+  end;
+end.
+

tests/test/packages/fcl-registry/tw35060b.pp

@@ -0,0 +1,155 @@
+{ %TARGET=win32,win64,wince }
+
+program tw35060b;
+
+{$apptype console}
+{$assertions on}
+{$ifdef fpc}
+{$codepage utf8}
+{$mode objfpc}
+{$h+}
+{$endif fpc}
+
+uses
+  SysUtils, Classes, Windows, Registry;
+
+{$ifndef fpc}
+type
+  UnicodeString = WideString;
+
+function GetLastOSError: Integer;
+begin
+  Result := GetLastError;
+end;
+{$endif}
+
+const
+  ExpectedUtf8Hex = 'C3 A4 C3 AB C3 AF';
+  ExpectedUnicodeHex = '00E4 00EB 00EF';
+  BugID = 'FPCBug0035060';
+
+function UnicodeToHex(const S: UnicodeString): String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to length(S) do
+    Result := Result + IntToHex(Word(S[i]),4) + #32;
+  Result := Trim(Result);
+end;
+
+function Utf8ToHex(const S: String): String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to length(S) do
+    Result := Result + IntToHex(Byte(S[i]),2) + #32;
+  Result := Trim(Result);
+end;
+
+
+//Creating and removing Keys using plain Windows W-API
+function PrepKeyW(Const S : UnicodeString) : pWideChar;
+begin
+  Result:=PWideChar(S);
+  If Result^='\' then
+    Inc(Result);
+end;
+
+procedure CreateKeyInHKCU(const Key: UnicodeString);
+Var
+  u: UnicodeString;
+  Disposition: Dword;
+  Handle: HKEY;
+  SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
+  FLastError: LongInt;
+begin
+  SecurityAttributes := Nil;
+  u:=PrepKeyW(Key);
+  Handle := 0;
+  FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
+                              PWideChar(u),
+                              0,
+                              '',
+                              REG_OPTION_NON_VOLATILE,
+                              KEY_ALL_ACCESS,
+                              SecurityAttributes,
+                              Handle,
+                              @Disposition);
+  RegCloseKey(Handle);
+  Assert(FLastError=ERROR_SUCCESS,format('Creating key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+end;
+
+
+procedure CreateTestKey;
+const
+  TestKey: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
+var
+  Len: Integer;
+begin
+  Len := Length(TestKey);
+  //Being a bit paranoid here?
+  Assert((Len=26) and (Word(TestKey[Len])=$EF) and (Word(TestKey[Len-1])=$EB) and (Word(TestKey[Len-2])=$E4),'Wrong encoding of TestKey');
+  CreateKeyInHKCU(TestKey);
+end;
+
+procedure RemoveTestKey;
+const
+  TestKeyFull: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
+  TestKeyBugID: UnicodeString = 'Software\'+ UniCodeString(BugID);
+var
+  Key: UnicodeString;
+  FLastError: LongInt;
+begin
+  Key:=PRepKeyW(TestKeyFull);
+  FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
+  Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+
+  Key:=PRepKeyW(TestKeyBugID);
+  FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
+  Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+end;
+
+//End Registry plain API functions
+
+var
+  R: TRegistry;
+  Name, S: String;
+  Key: Utf8String;
+  U: UnicodeString;
+  B: Boolean;
+  Err: Integer;
+  CP: TSystemCodePage;
+begin
+  CreateTestKey;
+  try
+    Name := 'äëï';
+    U := UnicodeString(Name);
+    S := Utf8ToHex(Name);
+    Assert(S=ExpectedUtf8Hex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedUtf8Hex,S]));
+    S := UnicodeToHex(U);
+    Assert(S=ExpectedUnicodeHex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedUnicodeHex,S]));
+
+    R := TRegistry.Create(KEY_ALL_ACCESS);
+    try
+      R.RootKey := HKEY_CURRENT_USER;
+      Key := 'Software\'+BugId+'\'+Name;
+      CP := System.StringCodePage(Key);
+      Assert(CP = 65001,format('The string that contains the key does not have UTF-8 as dynamic code page, but has codepage %d',[CP]));
+      B := R.OpenKeyReadOnly(Key);
+      Err := GetLastOSError;
+      Assert(B,format('OpenKey(''%s'') failed: "%s" [%d]',[Key,Trim(SysErrorMessage(Err)),Err]));
+      writeln(format('OpenKeyReadOnly(''%s''): OK',[Key]));
+    finally
+      R.Free;
+    end;
+
+  finally
+    RemoveTestKey;
+  end;
+end.
+