* Patch from Bart Broersma to fix writing unicode strings in the Windows

registry + test (modified, bug #35060)

git-svn-id: trunk@41415 -

.gitattributes

@@ -12728,6 +12728,7 @@ 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-registry/tw35060c.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/registry.pp

@@ -504,7 +504,7 @@ var
   u: UnicodeString;
 
 begin
-  u:=UTF8Decode(Value);
+  u:=Value;
   PutData(Name, PWideChar(u), ByteLength(u), rdExpandString);
 end;
 
@@ -538,7 +538,7 @@ var
   u: UnicodeString;
 
 begin
-  u:=UTF8Decode(Value);
+  u:=Value;
   PutData(Name, PWideChar(u), ByteLength(u), rdString);
 end;
 

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

@@ -48,15 +48,6 @@ begin
   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;
@@ -66,7 +57,7 @@ Var
   FLastError: LongInt;
 begin
   SecurityAttributes := Nil;
-  u:=PrepKeyW(Key);
+  u:=Key;
   Handle := 0;
   FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
                               PWideChar(u),
@@ -103,12 +94,12 @@ var
   Key: UnicodeString;
   FLastError: LongInt;
 begin
-  Key:=PRepKeyW(TestKeyFull);
+  Key:=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);
+  Key:=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))]));

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

@@ -49,14 +49,6 @@ begin
 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;
@@ -66,7 +58,7 @@ Var
   FLastError: LongInt;
 begin
   SecurityAttributes := Nil;
-  u:=PrepKeyW(Key);
+  u:=Key;
   Handle := 0;
   FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
                               PWideChar(u),
@@ -103,12 +95,12 @@ var
   Key: UnicodeString;
   FLastError: LongInt;
 begin
-  Key:=PRepKeyW(TestKeyFull);
+  Key:=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);
+  Key:=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))]));

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

@@ -0,0 +1,148 @@
+{ %TARGET=win32,win64,wince }
+
+program tw35060c;
+
+{$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;
+
+procedure CreateKeyInHKCU(const Key: UnicodeString);
+Var
+  u: UnicodeString;
+//  name,value: UnicodeString;
+  Disposition: Dword;
+  Handle: HKEY;
+  SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
+  FLastError: LongInt;
+begin
+  SecurityAttributes := Nil;
+  u:=Key;
+  Handle := 0;
+  FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
+                              PWideChar(u),
+                              0,
+                              '',
+                              REG_OPTION_NON_VOLATILE,
+                              KEY_ALL_ACCESS,
+                              SecurityAttributes,
+                              Handle,
+                              @Disposition);
+  Assert(FLastError=ERROR_SUCCESS,format('Creating key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+
+  //name := UnicodeString('äëï');
+  //value := UnicodeString('äëï');
+  //FLastError:=RegSetValueExW(Handle,PWideChar(name),0,REG_SZ,PWideChar(Value),ByteLength(Value));
+  //writeln('FLastError=',flasterror);
+  //RegCloseKey(Handle);
+end;
+
+
+procedure CreateTestKey;
+const
+  TestKey: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
+var
+  Len: Integer;
+begin
+  Len := Length(TestKey);
+  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: LONG;
+begin
+  Key:=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:=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))]));
+  writeln('Test keys successfully removed.');
+end;
+
+var
+  R: TRegistry;
+  Name, Value, S, Key: String;
+  U: UnicodeString;
+  B: Boolean;
+  Err: Integer;
+
+begin
+  CreateTestKey;
+  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;
+    B := R.OpenKey(Key,False);
+    Err := GetLastOSError;
+    writeln('B=',B);
+    Assert(B,format('OpenKey(''%s'') failed: "%s" [%d]',[Key,Trim(SysErrorMessage(Err)),Err]));
+    R.WriteString(Name,Name);
+    Value := R.ReadString(Name);
+    SetCodePage(RawByteString(Value), 1252, True);
+    S := AnsiToHex(Value);
+    Assert(S=ExpectedAnsiHex ,format('Found Value="%s" Bytes: %s, expected bytes: %s',[Value,S,ExpectedAnsiHex]));
+    writeln('ReadString value equals WriteString value.');
+  finally
+    R.Free;
+    RemoveTestKey;
+  end;
+end.