View Issue Details

IDProjectCategoryView StatusLast Update
0035060FPCFCLpublic2019-02-23 15:23
ReporterBart BroersmaAssigned ToJoost van der Sluis 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformi386OSWindowsOS Version10
Product Version3.3.1Product Buildr41290 
Target Version3.2.0Fixed in Version3.3.1 
Summary0035060: TRegistry: regression when reading a key that has unicode charcters in it's name
DescriptionIf you try to read a key, that has unicode characters in it's name the result will be an empty string.
Steps To ReproduceOpen regedit.
In HKCU\Software create the key 'XXXXXXXXXX' (10 X's)
In HKCU\Sotware\XXXXXXXXXX create the string with name 'äëï' and set content to anything other than an empty string.

Build and runn attached program.
Note: the sourcode is encoded in cp1252.

Output with fpc 3.0.4 and Delphi 7:
Value="a-umlaut,e-umlaut,i-umlaut"

Output with fpctrunk:
Value=""
Additional InformationIn current registry implementation, before querying the API the AnsiString parameters are converted to UnicodeString using Utf8Decode().
In the attached example project Utf8Decode(Name) will give you (represented as word values): 003F 003F 003F, while the proper representation of Name as UnicodeString is 00E4 00EB 00EF.
TagsNo tags attached.
Fixed in Revisionr41325, r41415
FPCOldBugId
FPCTarget
Attached Files
  • notascii.lpr (2,114 bytes)
  • registry.stringtounicode.diff (2,550 bytes)
    Index: packages/fcl-registry/src/winreg.inc
    ===================================================================
    --- packages/fcl-registry/src/winreg.inc	(revision 41290)
    +++ packages/fcl-registry/src/winreg.inc	(working copy)
    @@ -52,7 +52,7 @@
     
     begin
       SecurityAttributes := Nil;
    -  u:=UTF8Decode(PrepKey(Key));
    +  u:=UnicodeString(PrepKey(Key));
       FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
                                   PWideChar(u),
                                   0,
    @@ -71,7 +71,7 @@
     Var
       u: UnicodeString;
     begin
    -  u:=UTF8Decode(PRepKey(Key));
    +  u:=UnicodeString(PRepKey(Key));
       FLastError:=RegDeleteKeyW(GetBaseKey(RelativeKey(Key)),PWideChar(u));
       Result:=FLastError=ERROR_SUCCESS;
     end;
    @@ -78,7 +78,7 @@
     
     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 +89,7 @@
       RD : DWord;
     
     begin
    -  u := UTF8Decode(Name);
    +  u := UnicodeString(Name);
       FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,
                           @RD,Buffer,lpdword(@BufSize));
       if (FLastError<>ERROR_SUCCESS) Then
    @@ -110,7 +110,7 @@
       RD : DWord;
     
     begin
    -  u:=UTF8Decode(ValueName);
    +  u:=UnicodeString(ValueName);
       With Value do
         begin
         FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
    @@ -147,7 +147,7 @@
     {$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 +212,7 @@
       S: string;
     begin
       SecurityAttributes := Nil;
    -  u:=UTF8Decode(PrepKey(Key));
    +  u:=UnicodeString(PrepKey(Key));
       If CanCreate then
         begin
         Handle:=0;
    @@ -260,7 +260,7 @@
     {$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 +422,7 @@
     
     begin
       RegDataType:=RegDataWords[RegData];
    -  u:=UTF8Decode(Name);
    +  u:=UnicodeString(Name);
       FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
       Result:=FLastError=ERROR_SUCCESS;
     end;
    
  • tw35060.pp (4,248 bytes)
    { %TARGET=win32,win64,wince }
    
    program tw35060;
    
    {$apptype console}
    {$assertions on}
    {$ifdef fpc}
    {$codepage cp1252}
    {$mode objfpc}
    {$h+}
    {$endif fpc}
    
    {$WARN 5057 off : Local variable "$1" does not seem to be initialized}
    //Suppress Handle is not initialized in CreateKeyInHKCU
    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 = 'Bug0035060';
    
    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);
      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=23) 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;
    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;
          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.
    
    
    tw35060.pp (4,248 bytes)
  • registrytests.diff (868 bytes)
    Index: tests/test/packages/fcl-registry/tw35060a.pp
    ===================================================================
    --- tests/test/packages/fcl-registry/tw35060a.pp	(revision 41332)
    +++ tests/test/packages/fcl-registry/tw35060a.pp	(working copy)
    @@ -38,7 +38,7 @@
       Result := Trim(Result);
     end;
     
    -function AnsiToHex(const S: String): String;
    +function AnsiToHex(const S: RawByteString): String;
     var
       i: Integer;
     begin
    Index: tests/test/packages/fcl-registry/tw35060b.pp
    ===================================================================
    --- tests/test/packages/fcl-registry/tw35060b.pp	(revision 41332)
    +++ tests/test/packages/fcl-registry/tw35060b.pp	(working copy)
    @@ -38,7 +38,7 @@
       Result := Trim(Result);
     end;
     
    -function Utf8ToHex(const S: String): String;
    +function Utf8ToHex(const S: RawByteString): String;
     var
       i: Integer;
     begin
    
    registrytests.diff (868 bytes)
  • registry.stringtounicode.2.diff (547 bytes)
    Index: packages/fcl-registry/src/registry.pp
    ===================================================================
    --- packages/fcl-registry/src/registry.pp	(revision 41343)
    +++ packages/fcl-registry/src/registry.pp	(working copy)
    @@ -504,7 +504,7 @@
       u: UnicodeString;
     
     begin
    -  u:=UTF8Decode(Value);
    +  u:=Value;
       PutData(Name, PWideChar(u), ByteLength(u), rdExpandString);
     end;
     
    @@ -538,7 +538,7 @@
       u: UnicodeString;
     
     begin
    -  u:=UTF8Decode(Value);
    +  u:=Value;
       PutData(Name, PWideChar(u), ByteLength(u), rdString);
     end;
     
    
  • tw35060c.pp (4,507 bytes)
    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 = 'Bug0035060';
    
    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: RawByteString): 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;
    
    
    Function PrepKeyW(Const S : UnicodeString) : UnicodeString;
    begin
      Result:=S;
      If (Result<>'') and (Result[1]='\') then
        System.Delete(Result,1,1);
    end;
    
    procedure CreateKeyInHKCU(const Key: UnicodeString);
    Var
      u,name,value: UnicodeString;
      Disposition: Dword;
      Handle: HKEY;
      SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
      FLastError: LongInt;
    
    begin
      SecurityAttributes := Nil;
      u:=PrepKeyW(Key);
      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(u),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=23) 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:=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))]));
      writeln('Test keys successfully removed.');
    end;
    
    var
      R: TRegistry;
      Name, Value, S, Key: String;
      U: UnicodeString;
      B: Boolean;
      Err: Integer;
    
    {$R *.res}
    
    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.
    
    tw35060c.pp (4,507 bytes)

Activities

Bart Broersma

2019-02-10 23:14

reporter  

notascii.lpr (2,114 bytes)

Bart Broersma

2019-02-11 10:49

reporter   ~0114026

Fixes 3.2 has the same issue and since this is a regression it would be nice if it were to be fixed (and merged) before final 3.2.0 is out.

Bart Broersma

2019-02-11 11:50

reporter  

registry.stringtounicode.diff (2,550 bytes)
Index: packages/fcl-registry/src/winreg.inc
===================================================================
--- packages/fcl-registry/src/winreg.inc	(revision 41290)
+++ packages/fcl-registry/src/winreg.inc	(working copy)
@@ -52,7 +52,7 @@
 
 begin
   SecurityAttributes := Nil;
-  u:=UTF8Decode(PrepKey(Key));
+  u:=UnicodeString(PrepKey(Key));
   FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
                               PWideChar(u),
                               0,
@@ -71,7 +71,7 @@
 Var
   u: UnicodeString;
 begin
-  u:=UTF8Decode(PRepKey(Key));
+  u:=UnicodeString(PRepKey(Key));
   FLastError:=RegDeleteKeyW(GetBaseKey(RelativeKey(Key)),PWideChar(u));
   Result:=FLastError=ERROR_SUCCESS;
 end;
@@ -78,7 +78,7 @@
 
 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 +89,7 @@
   RD : DWord;
 
 begin
-  u := UTF8Decode(Name);
+  u := UnicodeString(Name);
   FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,
                       @RD,Buffer,lpdword(@BufSize));
   if (FLastError<>ERROR_SUCCESS) Then
@@ -110,7 +110,7 @@
   RD : DWord;
 
 begin
-  u:=UTF8Decode(ValueName);
+  u:=UnicodeString(ValueName);
   With Value do
     begin
     FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
@@ -147,7 +147,7 @@
 {$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 +212,7 @@
   S: string;
 begin
   SecurityAttributes := Nil;
-  u:=UTF8Decode(PrepKey(Key));
+  u:=UnicodeString(PrepKey(Key));
   If CanCreate then
     begin
     Handle:=0;
@@ -260,7 +260,7 @@
 {$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 +422,7 @@
 
 begin
   RegDataType:=RegDataWords[RegData];
-  u:=UTF8Decode(Name);
+  u:=UnicodeString(Name);
   FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
   Result:=FLastError=ERROR_SUCCESS;
 end;

Bart Broersma

2019-02-11 11:53

reporter   ~0114027

Possible patch attached in file registry.stringtounicode.diff.

(I left the instances of Utf8Encode for return values intact, since this will set the codepage of the string to CP_UTF8 and conversion to current system codepage will be triggerd later if necessary.)

Bart Broersma

2019-02-12 13:09

reporter  

tw35060.pp (4,248 bytes)
{ %TARGET=win32,win64,wince }

program tw35060;

{$apptype console}
{$assertions on}
{$ifdef fpc}
{$codepage cp1252}
{$mode objfpc}
{$h+}
{$endif fpc}

{$WARN 5057 off : Local variable "$1" does not seem to be initialized}
//Suppress Handle is not initialized in CreateKeyInHKCU
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 = 'Bug0035060';

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);
  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=23) 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;
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;
      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.

tw35060.pp (4,248 bytes)

Bart Broersma

2019-02-12 13:19

reporter   ~0114051

Last edited: 2019-02-12 13:20

View 2 revisions

Please find attached a test program tw35060.pp.
It is supposed to go in /tests/test/packages/fcl-registry

The program uses plain Windows API call to create the Key:
HKCU\Software\Bug0035060\äëï.
The program will fail if OpenKeyReadOnly fails on that key.
The program will (try to) remove the test key afterwards (again using plain API calls).

Currently fpc trunk fails with:
EAssertionFailed: OpenKey('Software\Bug0035060\äëï') failed: "De bewerking is voltooid." [0] (tw35060.pp, line 142)
  $0040F866
(The strange part of this is that GetLastOSError returns 0 in this case.)

The test program can be compiled with Delphi 7 and runs fine.
For testing with newer Delphis (if that is a requirement) all occurrences of "String" must be replaced wint "AnsiString".
If needed I will adjust tw35060.pp

Thaddy de Koning

2019-02-12 14:00

reporter   ~0114052

Last edited: 2019-02-12 14:02

View 3 revisions

Bart, the only way to do this properly is to make the code Ansi and UTF16 agnostic. There should not be any explicit UTF8 in the Freepascal rtl and packages. Making it utf16 agnostic will mean it is also assignment compatible to UTF8 on the Lazarus side. In that case string can stay string.
IOW AnsiString and UnicodeString would suffice.

Bart Broersma

2019-02-12 15:29

reporter   ~0114053

IMO returned stringvalues (not stringlists) that are UTF8 encoded (and which have there StringCodePage properly set to CP_UTF8) should cause no problems on the caller side.
Canging all Utf8Encode(AUnicodeStringVar) into String(AUnicodeStringVar) is not necessary to resolve this issue, hence I did not do that.

Joost van der Sluis

2019-02-15 22:31

manager   ~0114163

Thanks for the bug report. The proposed patch was not right, though. But the provided test was very useful (tests always are).
I duplicated your test and adapted it to see if the 'old' behavior with UTF8-encoded strings did still work. This was not the case.
At first I thought I made a mistake in the test, but in the end I discovered that the strings were converted into pchar's by the fcl-registry code. And thus lost all their codepage-information. Well, it's seems to be fixed now. Can you confirm this?

I did not touch the utf8encode functions for now, but I agree that they should be removed. (But not without a proper test)

Bart Broersma

2019-02-16 10:24

reporter   ~0114172

The tests run fine now, but I think the tests for the correct encoding of Name should use RawByteString as parameter, to prevent unwanted codepage conversion inside the test.
Patch attached.

Bart Broersma

2019-02-16 10:25

reporter  

registrytests.diff (868 bytes)
Index: tests/test/packages/fcl-registry/tw35060a.pp
===================================================================
--- tests/test/packages/fcl-registry/tw35060a.pp	(revision 41332)
+++ tests/test/packages/fcl-registry/tw35060a.pp	(working copy)
@@ -38,7 +38,7 @@
   Result := Trim(Result);
 end;
 
-function AnsiToHex(const S: String): String;
+function AnsiToHex(const S: RawByteString): String;
 var
   i: Integer;
 begin
Index: tests/test/packages/fcl-registry/tw35060b.pp
===================================================================
--- tests/test/packages/fcl-registry/tw35060b.pp	(revision 41332)
+++ tests/test/packages/fcl-registry/tw35060b.pp	(working copy)
@@ -38,7 +38,7 @@
   Result := Trim(Result);
 end;
 
-function Utf8ToHex(const S: String): String;
+function Utf8ToHex(const S: RawByteString): String;
 var
   i: Integer;
 begin
registrytests.diff (868 bytes)

Bart Broersma

2019-02-17 12:33

reporter   ~0114214

I noticed that there are still 2 occurrences of Utf8Decode in registry.pp.
Attached patch: registry.stringtounicode.2.diff

Bart Broersma

2019-02-17 12:34

reporter  

registry.stringtounicode.2.diff (547 bytes)
Index: packages/fcl-registry/src/registry.pp
===================================================================
--- packages/fcl-registry/src/registry.pp	(revision 41343)
+++ packages/fcl-registry/src/registry.pp	(working copy)
@@ -504,7 +504,7 @@
   u: UnicodeString;
 
 begin
-  u:=UTF8Decode(Value);
+  u:=Value;
   PutData(Name, PWideChar(u), ByteLength(u), rdExpandString);
 end;
 
@@ -538,7 +538,7 @@
   u: UnicodeString;
 
 begin
-  u:=UTF8Decode(Value);
+  u:=Value;
   PutData(Name, PWideChar(u), ByteLength(u), rdString);
 end;
 

Thaddy de Koning

2019-02-17 13:52

reporter   ~0114216

These were left in intentional, but nice work Bart: the patch works.

Joost van der Sluis

2019-02-17 21:45

manager   ~0114226

Bart, I don't think that the parameters should be of type rawbytestring. I checked that by querying System.StringCodePage() on a few locations, and there are no changes in the dynamic codepage?

Joost van der Sluis

2019-02-17 21:46

manager   ~0114227

Thaddy, what do you mean that they were left in intentional? At first sight I think that Bart is right, and they should be removed?
Bart could you create a test for this?

Bart Broersma

2019-02-17 22:02

reporter   ~0114229

@Joost.
1. I'll try to make some test. May take some time.
2. I think from a theoretical standpoint RawByteString is correct? Nevertheless it seems to work OK, but I was afraid that was just "implementation detail".
I'll leave that up to your discretion.

@Thaddy: I overlooked them in my initial patch, because I only searched for Utf8Decode in the winreg.inc file, not in registry.pp itself.

Bart Broersma

2019-02-17 23:00

reporter  

tw35060c.pp (4,507 bytes)
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 = 'Bug0035060';

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: RawByteString): 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;


Function PrepKeyW(Const S : UnicodeString) : UnicodeString;
begin
  Result:=S;
  If (Result<>'') and (Result[1]='\') then
    System.Delete(Result,1,1);
end;

procedure CreateKeyInHKCU(const Key: UnicodeString);
Var
  u,name,value: UnicodeString;
  Disposition: Dword;
  Handle: HKEY;
  SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
  FLastError: LongInt;

begin
  SecurityAttributes := Nil;
  u:=PrepKeyW(Key);
  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(u),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=23) 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:=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))]));
  writeln('Test keys successfully removed.');
end;

var
  R: TRegistry;
  Name, Value, S, Key: String;
  U: UnicodeString;
  B: Boolean;
  Err: Integer;

{$R *.res}

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.
tw35060c.pp (4,507 bytes)

Bart Broersma

2019-02-17 23:02

reporter   ~0114232

Last edited: 2019-02-17 23:03

View 2 revisions

Test tw35060c.pp shows that WriteString currently translates unicode characters to '?'.
I did not bother testing WriteExpandString, since it uses the same mechanism.

The posted patch fixes it.

Let me know if you need a codepage UTF8 version of the test.

Bart Broersma

2019-02-18 11:37

reporter   ~0114237

tw35060c.pp misses the first line direcctive for test suite:
{ %TARGET=win32,win64,wince }

Can you add it yourself?

Joost van der Sluis

2019-02-22 23:29

manager   ~0114355

Thanks, applied.

And no, from a theoretical standpoint rawbytestring is not correct. Simply use string. Always use string, unless it is really necessary to use rawbytestring. (It's like casting a class-instance to a pointer. You override the checks the compiler made for you)

Bart Broersma

2019-02-23 15:23

reporter   ~0114364

Thanks.

> And no, from a theoretical standpoint rawbytestring is not correct.
Thanks for pointing that out.

Issue History

Date Modified Username Field Change
2019-02-10 23:14 Bart Broersma New Issue
2019-02-10 23:14 Bart Broersma File Added: notascii.lpr
2019-02-11 10:49 Bart Broersma Note Added: 0114026
2019-02-11 11:50 Bart Broersma File Added: registry.stringtounicode.diff
2019-02-11 11:53 Bart Broersma Note Added: 0114027
2019-02-12 13:09 Bart Broersma File Added: tw35060.pp
2019-02-12 13:19 Bart Broersma Note Added: 0114051
2019-02-12 13:20 Bart Broersma Note Edited: 0114051 View Revisions
2019-02-12 14:00 Thaddy de Koning Note Added: 0114052
2019-02-12 14:00 Thaddy de Koning Note Edited: 0114052 View Revisions
2019-02-12 14:02 Thaddy de Koning Note Edited: 0114052 View Revisions
2019-02-12 15:29 Bart Broersma Note Added: 0114053
2019-02-12 15:41 Joost van der Sluis Assigned To => Joost van der Sluis
2019-02-12 15:41 Joost van der Sluis Status new => assigned
2019-02-15 22:31 Joost van der Sluis Fixed in Revision => r41325
2019-02-15 22:31 Joost van der Sluis Note Added: 0114163
2019-02-15 22:31 Joost van der Sluis Status assigned => resolved
2019-02-15 22:31 Joost van der Sluis Fixed in Version => 3.3.1
2019-02-15 22:31 Joost van der Sluis Resolution open => fixed
2019-02-15 22:31 Joost van der Sluis Target Version => 3.2.0
2019-02-16 10:24 Bart Broersma Note Added: 0114172
2019-02-16 10:24 Bart Broersma Status resolved => feedback
2019-02-16 10:24 Bart Broersma Resolution fixed => reopened
2019-02-16 10:25 Bart Broersma File Added: registrytests.diff
2019-02-17 12:33 Bart Broersma Note Added: 0114214
2019-02-17 12:33 Bart Broersma Status feedback => assigned
2019-02-17 12:34 Bart Broersma File Added: registry.stringtounicode.2.diff
2019-02-17 13:52 Thaddy de Koning Note Added: 0114216
2019-02-17 21:45 Joost van der Sluis Note Added: 0114226
2019-02-17 21:46 Joost van der Sluis Note Added: 0114227
2019-02-17 22:02 Bart Broersma Note Added: 0114229
2019-02-17 23:00 Bart Broersma File Added: tw35060c.pp
2019-02-17 23:02 Bart Broersma Note Added: 0114232
2019-02-17 23:03 Bart Broersma Note Edited: 0114232 View Revisions
2019-02-18 11:37 Bart Broersma Note Added: 0114237
2019-02-22 23:29 Joost van der Sluis Fixed in Revision r41325 => r41325, r41415
2019-02-22 23:29 Joost van der Sluis Note Added: 0114355
2019-02-22 23:29 Joost van der Sluis Status assigned => resolved
2019-02-22 23:29 Joost van der Sluis Resolution reopened => fixed
2019-02-23 15:23 Bart Broersma Note Added: 0114364
2019-02-23 15:23 Bart Broersma Status resolved => closed