View Issue Details

IDProjectCategoryView StatusLast Update
0035022FPCFCLpublic2020-04-01 12:48
ReporterBart Broersma Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformi386OSWindows 
Product Version3.3.1 
Target Version3.2.0Fixed in Version3.3.1 
Summary0035022: TRegIniFile.WriteString writes to wrong Key
DescriptionWhilst trying to see if I could fix 0033980 I stumbled uopn this bug.

Consider this piece of code that simply tries to create some registry entries:

function CreateTestEntry: Boolean;
const
  BoolStr: array[Boolean] of String = ('False','True');
  OKStr: array[Boolean] of String = ('FAIL','OK');
var
  RegIni: TRegIniFile;
  B: Boolean;
  function TryOpenKey(Key: String; CanCreate: Boolean): Boolean;
  begin
    Result := RegIni.OpenKey(Key, CanCreate);
    writeln(format('OpenKey(''%s'',%s): %s',[Key,BoolStr[CanCreate],OkStr[Result]]));
  end;
  function TryWriteString(Section, Ident, Value: String): Boolean;
  begin
    Result := False;
    try
      RegIni.WriteString(Section, Ident, Value);
      Result := True;
      writeln(format('WriteString(''%s'',''%s'',''%s''): %s',[Section,Ident,Value,OkStr[Result]]));
    except
      on E: Exception do
        writeln(format('WriteString(''%s'',''%s'',''%s''): %s',[Section,Ident,Value,E.Message]));
    end;

  end;

begin
  Result := False;
  RegIni := TRegIniFile.Create('\Software');
  try
    writeln('CurrentPath=',RegIni.CurrentPath);
    B := RegIni.CreateKey('FPCTEST');
    writeln('CreateKey=',B);
    if not B then Exit;

    if not TryOpenKey('FPCTEST',False) then Exit;
    writeln('CurrentPath=',RegIni.CurrentPath);

    if not TryOpenKey('RegIni',True) then Exit;
    writeln('CurrentPath=',RegIni.CurrentPath);

    // should create \Software\FPCTEST\RegIni\Strings\String1 with value Value1
    // FPC creates \Software\Strings\String1 with Value1
    if not TryWriteString('Strings','String1','Value1') then Exit;
    // should create \Software\FPCTEST\RegIni\Strings\String2 with value Value2
    // FPC creates \Software\Strings\String1 with Value1
    if not TryWriteString('Strings','String2','Value2') then Exit;

    // should create \Software\FPCTEST\RegIni\String1 with value Value1
    // gives Exception in FPC: ERegistryException: Failed to set data for value "String1"
    if not TryWriteString('','String1','Value1') then Exit;
    if not TryWriteString('','String2','Value2') then Exit;


    Result := True;
  finally
    RegIni.Free;
  end;

end;

var
  B: Boolean;
begin
  B := CreateTestEntry;
  writeln('CreateTestEntry=',B);
end.
Steps To ReproduceBuild and run attached program on Windows.
Then open the registry editor.
Notice that the WriteString('Strings','String1','Value1') creates the Ident/Value pair in \Software\Strings, while it should create them in \Software\FPCTEST\RegIni
(Delphi 7 puts them in the expected place)

Notice also that the program fails to do a WriteString() with '' as Section parameter.

Further notice that the value for CurrentPath is broken (it missed the separating backslashes).

See output with Delphi7 versus Fpc trunk:

C:\Users\Bart\LazarusProjecten\bugs\Console\regini>dcc32 rtest.lpr
Borland Delphi Version 15.0
...
154 lines, 0.03 seconds, 76944 bytes code, 4153 bytes data.

C:\Users\Bart\LazarusProjecten\bugs\Console\regini>rtest
CurrentPath=Software
CreateKey=TRUE
OpenKey('FPCTEST',False): OK
CurrentPath=Software\FPCTEST
OpenKey('RegIni',True): OK
CurrentPath=Software\FPCTEST\RegIni
WriteString('Strings','String1','Value1'): OK
WriteString('Strings','String2','Value2'): OK
WriteString('','String1','Value1'): OK
WriteString('','String2','Value2'): OK
CreateTestEntry=TRUE


C:\Users\Bart\LazarusProjecten\bugs\Console\regini>fpc rtest.lpr
Free Pascal Compiler version 3.3.1 [2019/01/02] for i386
...
152 lines compiled, 0.2 sec, 158992 bytes code, 6692 bytes data

C:\Users\Bart\LazarusProjecten\bugs\Console\regini>rtest
CurrentPath=Software
CreateKey=TRUE
OpenKey('FPCTEST',False): OK
CurrentPath=SoftwareFPCTEST
OpenKey('RegIni',True): OK
CurrentPath=SoftwareFPCTESTRegIni
WriteString('Strings','String1','Value1'): OK
WriteString('Strings','String2','Value2'): OK
WriteString('','String1','Value1'): Failed to set data for value "String1"
CreateTestEntry=FALSE
TagsNo tags attached.
Fixed in Revision44478
FPCOldBugId
FPCTarget-
Attached Files

Relationships

related to 0033980 closedMichael Van Canneyt TRegIniFile: failure on consecutive reads when Section parameter is empty 
related to 0035023 closedMichael Van Canneyt TRegIniFile.OpenKey does not update FCurrenPath correctly 

Activities

Bart Broersma

2019-02-06 12:58

reporter   ~0113898

An observation (not sure if it is relevant, it may simply be an implementation detail).

After OpenKey('RegIni') in Delphi the value of CurrentKey will remain the same.

In fpc when calling the first WriteString() CurrentKey has the value it had after OpenKey('RegIni'), but after the first WriteString() it hase the same value as after OpenKey('FPCTEST') and after the second WriteString() it has the same value as right after the call to TRegIniFile.Create('\Software').

Benito van der Zander

2019-02-06 13:05

reporter   ~0113900

>0035022: TRegIni.WriteString writes to wong Key

So FPC is some kind of cheap chinese knockoff software

Chinese software only writes to Wong key.

Russian software would only write to Ivanov key

Bart Broersma

2019-02-06 13:13

reporter   ~0113901

Can some devel please change summary from
 TRegIni.WriteString writes to wong Key
into
 TRegIniFile.WriteString writes to wrong Key

Bart Broersma

2019-02-06 18:37

reporter   ~0113904

function TRegIniFile.OpenSection(const Section: string; CreateSection : Boolean = false): boolean;
var
  k: HKEY;
  S : String;

begin
  S:=Section;
  If (S<>'') and (S[1] = '\') then
    Delete(S,1,1);
  if CreateSection then
    CreateKey('\'+FPath+S); <<==

FPath is only set in the constructor of TRegIniFile AFAICS.
(In the example above it is 'Software')

Bart Broersma

2019-02-06 19:33

reporter  

reginifile.opensection.currentpath.diff (1,480 bytes)   
Index: packages/fcl-registry/src/regini.inc
===================================================================
--- packages/fcl-registry/src/regini.inc	(revision 40745)
+++ packages/fcl-registry/src/regini.inc	(working copy)
@@ -300,18 +300,22 @@
   S:=Section;
   If (S<>'') and (S[1] = '\') then
     Delete(S,1,1);
-  if CreateSection then
-    CreateKey('\'+FPath+S);
+
+  if CreateSection and (Section<>'') then
+    CreateKey('\'+CurrentPath+'\'+S);
   if Section <> '' then
     begin
-    k:=GetKey('\'+FPath+S);
-    if k = 0 then
-      begin
-      Result:=False;
-      exit;
-      end;
-    SetCurrentKey(k);
-  end;
+    k:=GetKey('\'+CurrentPath+'\'+S);
+  end
+  else
+    k:=GetKey('\'+CurrentPath);
+  if k = 0 then
+    begin
+    Result:=False;
+    exit;
+    end;
+  SetCurrentKey(k);
+
   Result:=True;
 end;
 
Index: packages/fcl-registry/src/winreg.inc
===================================================================
--- packages/fcl-registry/src/winreg.inc	(revision 40745)
+++ packages/fcl-registry/src/winreg.inc	(working copy)
@@ -230,7 +230,12 @@
     end;                     
   If Result then begin
     if RelativeKey(Key) then
-      S:=CurrentPath + Key
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '\' + Key
+          else
+            S:=CurrentPath + Key;
+        end
     else
       S:=UTF8Encode(u);
     ChangeKey(Handle, S);

Bart Broersma

2019-02-06 19:39

reporter   ~0113906

Attached patch reginifile.opensection.currentpath.diff seems to resolve this issue.
It includes the fix for issue 0035023, because it depends on that fix.
It also seems to resolve 0033980.

Please review.

Bart Broersma

2019-02-10 18:34

reporter  

tw0035022.pp (4,957 bytes)

Bart Broersma

2019-02-10 18:42

reporter   ~0114017

Last edited: 2019-02-10 18:45

View 2 revisions

Attached tw0035022.pp, which is meant to go in tests/test/packages/fcl-registry.

The test will fail if:
- a key cannot be opened or created
- currentpath is wrong after openening a key
- readstring or writestring fails unexpectedly
- a wrong (or rather unexpected) value is read by readstring
- values are written to the wrong key
- cleanup fails

The test program will also try to remove values that may be written to the wrong key, like described in this bugreport.

The test program will try to create entries in:
HKEY_CURRENT_USER\Software\FreePascalRegIniTest
This should be safe.
The created entries will be removed at program end, so you won't be able to see them with regedit.

Currently the test program fails (as expected) with:

C:\Users\Bart\LazarusProjecten\bugs\Console\regini>tw0035022
CreateTestEntries: An unhandled exception occurred at $00402302:
EAssertionFailed: Expected: CurrenPath=Software\FreePascalRegIniTest (tw0035022.pp, line 102)
  $00402302 main, line 183 of tw0035022.pp

After applying reginifile.opensection.currentpath.diff it runs fine:

C:\Users\Bart\LazarusProjecten\bugs\Console\regini>tw0035022
CreateTestEntries: OK
CheckCreate: OK
FindErroneousEntries: no erroneous entries found (OK).

Bart Broersma

2019-02-20 13:32

reporter   ~0114294

Bump!
Without the attached patch it gets increasingly difficult to fix issues with TRegistry (the part that fixes CurrentPath affects TRegsitry itself, not just TRegIniFile).

Michael Van Canneyt

2019-03-10 12:54

administrator   ~0114768

I tested the patch on Linux. The problem exists there as well, and needs to be fixed there too, but the patch does not fix that.

You can test the behaviour on windows as well by defining XMLREG when you compile the registry unit. It will then use the XML version of the registry unit.

Bart Broersma

2019-03-10 14:38

reporter   ~0114770

Last edited: 2019-03-10 14:48

View 3 revisions

While I can fix the CurrentPath issue in the XML implementation, and this wil fix writing to the wrong key (first WriteString in the example), this will however not fix writing to an empty section.
Part of the proble here is that GetKey returns hardcoded 0, so OpenSection fails.
I was unable to figure out how to fix that, it's beyond my capabilities.

I will upload a new patch that fixes CurrentPath in XML implementation.
[ETA] Attached as reginifile.opensection.currentpath.2.diff

Bart Broersma

2019-03-10 14:47

reporter  

reginifile.opensection.currentpath.2.diff (2,531 bytes)   
Index: packages/fcl-registry/src/regini.inc
===================================================================
--- packages/fcl-registry/src/regini.inc	(revision 41667)
+++ packages/fcl-registry/src/regini.inc	(working copy)
@@ -300,18 +300,22 @@
   S:=Section;
   If (S<>'') and (S[1] = '\') then
     Delete(S,1,1);
-  if CreateSection then
-    CreateKey('\'+FPath+S);
+
+  if CreateSection and (Section<>'') then
+    CreateKey('\'+CurrentPath+'\'+S);
   if Section <> '' then
     begin
-    k:=GetKey('\'+FPath+S);
-    if k = 0 then
-      begin
-      Result:=False;
-      exit;
-      end;
-    SetCurrentKey(k);
-  end;
+    k:=GetKey('\'+CurrentPath+'\'+S);
+  end
+  else
+    k:=GetKey('\'+CurrentPath);
+  if k = 0 then
+    begin
+    Result:=False;
+    exit;
+    end;
+  SetCurrentKey(k);
+
   Result:=True;
 end;
 
Index: packages/fcl-registry/src/winreg.inc
===================================================================
--- packages/fcl-registry/src/winreg.inc	(revision 41667)
+++ packages/fcl-registry/src/winreg.inc	(working copy)
@@ -230,7 +230,12 @@
     end;                     
   If Result then begin
     if RelativeKey(Key) then
-      S:=CurrentPath + Key
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '\' + Key
+          else
+            S:=CurrentPath + Key;
+        end
     else
       S:=UTF8Encode(u);
     ChangeKey(Handle, S);
Index: packages/fcl-registry/src/xregreg.inc
===================================================================
--- packages/fcl-registry/src/xregreg.inc	(revision 41667)
+++ packages/fcl-registry/src/xregreg.inc	(working copy)
@@ -216,10 +216,23 @@
 end;
 
 function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
-
+var
+  S: String;
 begin
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
+  If Result then begin
+    if not ((Key='') or (Key[1]in['\','/'])) then
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '/' + Key
+          else
+            S:=CurrentPath + Key;
+        end
+    else
+      S:=Key;
+    end;
   FCurrentKey:=1;
+  ChangeKey(FCurrentKey, S);
 end;
 
 function TRegistry.OpenKeyReadOnly(const Key: string): Boolean;
@@ -260,7 +273,7 @@
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: string);
 begin
-
+  FCurrentPath:=Path;
 end;
 
 procedure TRegistry.GetKeyNames(Strings: TStrings);

Bart Broersma

2019-03-10 14:53

reporter   ~0114771

Last edited: 2019-03-10 15:00

View 2 revisions

With the new patch the folowing sequence:

RegIni := TRegIniFile.Create('\Software');
RegIni.OpenKey('FPCTEST',True);
RegIni.OpenKey('RegIni',True);
RegIni.WriteString('_Software_FPCTEST_RegIni_Strings','String1','Value1');

produces the follwing reg.xml:
<?xml version="1.0" encoding="utf-8"?>
<XMLReg>
  <Key Name="HKEY_CURRENT_USER">
    <Key Name="Software">
      <Key Name="FPCTEST">
        <Key Name="RegIni">
          <Key Name=""> //<<-- where does this come from?
            <Key Name="Software">
              <Key Name="FPCTEST">
                <Key Name="RegIni">
                  <Key Name="_Software_FPCTEST_RegIni_Strings"/>
                </Key>
              </Key>
            </Key>
          </Key>
        </Key>
      </Key>
    </Key>
  </Key>
</XMLReg>

WriteString does not seem to write any value into the key now, so that sucks.

Bart Broersma

2019-03-10 16:29

reporter   ~0114773

Last edited: 2019-03-10 16:47

View 2 revisions

Reading the code for TRegIniFile.OpenSection, I would think that this has never worked for the XML implementations at all, since GetKey() in that case will always return 0, so TRegIniFile.OpenSection returns False.

The original patch fixes the issue for Windows and at least does not make the situation worse for the XML implementation AFAICS.

I propose to apply the patch from reginifile.opensection.currentpath.3.diff as a first step and work from there.
(reginifile.opensection.currentpath.3.diff slightly improves the logic in OpenSection as compared to previous patch)


[ETA] This must have been broken (for XML implementation) from at least revision 22654 (Oct 15 12:43:14 2012 UTC (6 years, 4 months ago) by yury).
This revision introduces TRegIniFile.OpenSection, which even at that time always returns False in the XML implementation (TRegistry.GetKey retuns 0 from the first implementation I can find in svn).

Michael Van Canneyt

2019-03-10 16:57

administrator   ~0114774

Where is reginifile.opensection.currentpath.3.diff ?

Bart Broersma

2019-03-10 17:11

reporter  

reginifile.opensection.currentpath.3.diff (2,544 bytes)   
Index: packages/fcl-registry/src/regini.inc
===================================================================
--- packages/fcl-registry/src/regini.inc	(revision 41667)
+++ packages/fcl-registry/src/regini.inc	(working copy)
@@ -300,18 +300,22 @@
   S:=Section;
   If (S<>'') and (S[1] = '\') then
     Delete(S,1,1);
-  if CreateSection then
-    CreateKey('\'+FPath+S);
-  if Section <> '' then
+
+  if CreateSection and (S<>'') then
+    CreateKey('\'+CurrentPath+'\'+S);
+  if S <> '' then
     begin
-    k:=GetKey('\'+FPath+S);
-    if k = 0 then
-      begin
-      Result:=False;
-      exit;
-      end;
-    SetCurrentKey(k);
-  end;
+    k:=GetKey('\'+CurrentPath+'\'+S);
+  end
+  else
+    k:=GetKey('\'+CurrentPath);
+  if k = 0 then
+    begin
+    Result:=False;
+    exit;
+    end;
+  SetCurrentKey(k);
+
   Result:=True;
 end;
 
Index: packages/fcl-registry/src/winreg.inc
===================================================================
--- packages/fcl-registry/src/winreg.inc	(revision 41667)
+++ packages/fcl-registry/src/winreg.inc	(working copy)
@@ -230,7 +230,12 @@
     end;                     
   If Result then begin
     if RelativeKey(Key) then
-      S:=CurrentPath + Key
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '\' + Key
+          else
+            S:=CurrentPath + Key;
+        end
     else
       S:=UTF8Encode(u);
     ChangeKey(Handle, S);
Index: packages/fcl-registry/src/xregreg.inc
===================================================================
--- packages/fcl-registry/src/xregreg.inc	(revision 41667)
+++ packages/fcl-registry/src/xregreg.inc	(working copy)
@@ -216,10 +216,23 @@
 end;
 
 function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
-
+var
+  S: String;
 begin
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
+  If Result then begin
+    if not ((Key='') or (Key[1]in['\','/'])) then
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '/' + Key
+          else
+            S:=CurrentPath + Key;
+        end
+    else
+      S:=Key;
+    end;
   FCurrentKey:=1;
+  ChangeKey(FCurrentKey, S);
 end;
 
 function TRegistry.OpenKeyReadOnly(const Key: string): Boolean;
@@ -260,7 +273,7 @@
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: string);
 begin
-
+  FCurrentPath:=Path;
 end;
 
 procedure TRegistry.GetKeyNames(Strings: TStrings);

Bart Broersma

2019-03-10 17:12

reporter   ~0114775

It's there now.
(Multitasking is something I should leave to my computer, I suck at it)

Serge Anvarov

2019-03-10 19:06

reporter   ~0114778

Last edited: 2019-03-10 19:09

View 6 revisions

1. I didn't understand why had to enter the fPath field in TRegIniFile. Already has the fFileName field. So I removed fPath.
2. OpenSection change current key, but not restore it. Add field to restore.
3. Patch the OpenKey in winreg.inc a little different way.
The patch "reginifile.opensection.currentpath.4.diff" included.

Results:
The project in the description is executed correctly.
The included test is executed correctly.
reg.xml (when define XMLREG) is:
<?xml version="1.0" encoding="utf-8"?>
<XMLReg>
  <Key Name="HKEY_CURRENT_USER">
    <Key Name="Software">
      <Key Name="FPCTEST">
        <Key Name="RegIni">
          <Key Name="_Software_FPCTEST_RegIni_Strings"/>
        </Key>
      </Key>
    </Key>
  </Key>
</XMLReg>

Serge Anvarov

2019-03-10 19:07

reporter  

registry.stringlist.4.diff (3,821 bytes)   
Index: packages/fcl-registry/src/registry.pp
===================================================================
--- packages/fcl-registry/src/registry.pp	(revision 41425)
+++ packages/fcl-registry/src/registry.pp	(working copy)
@@ -427,37 +427,44 @@
 end;
 
 procedure TRegistry.ReadStringList(const Name: string; AList: TStrings);
-
-Var
-  Info : TRegDataInfo;
-  ReadDataSize: Integer;
-  Data: string;
-
+// 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)
+const
+  CSpaceFor2NullChars = 2 * SizeOf(WideChar);
+var
+  Info: TRegDataInfo;
+  DataSize: Integer;
+  PStart, PEnd, Buffer: PWideChar;
+  ReadLength: Integer;
+  U: UnicodeString;
 begin
+  if not Assigned(AList) then
+    Exit;
   AList.Clear;
-  GetDataInfo(Name,Info);
-  if info.datasize>0 then
+  if not GetDataInfo(Name, Info) or (Info.DataSize <= 0) then
+    Exit;
+  if Info.RegData <> rdMultiString then
+    raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
+  DataSize := Info.DataSize + CSpaceFor2NullChars;
+  GetMem(Buffer, DataSize);
+  try
+    ReadLength := (GetData(Name, Buffer, DataSize, Info.RegData) +
+      CSpaceFor2NullChars) div SizeOf(WideChar);
+    // Always add last 2 terminal #0, we allocate space for it
+    Buffer[ReadLength - 1] := #0;
+    Buffer[ReadLength - 2] := #0;
+    PStart := Buffer;
+    while PStart^ <> #0 do
     begin
-     If Not (Info.RegData in [rdMultiString]) then
-       Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
-     SetLength(Data,Info.DataSize);
-     ReadDataSize := GetData(Name,PChar(Data),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 begin
-         if Data[ReadDataSize] = #0 then
-           Dec(ReadDataSize);
-         if Data[ReadDataSize] = #0 then
-           Dec(ReadDataSize);
-       end;
-       SetLength(Data, ReadDataSize);
-       Data := StringReplace(Data, #0, LineEnding, [rfReplaceAll]);
-       AList.Text := Data;
-     end
-   end
+      PEnd := StrEnd(PStart);
+      SetString(U, PStart, PEnd - PStart);
+      AList.Append(UTF8Encode(U));
+      PStart := PEnd + 1;
+    end;
+  finally
+    FreeMem(Buffer);
+  end;
 end;
 
 function TRegistry.ReadTime(const Name: string): TDateTime;
@@ -509,13 +516,39 @@
 end;
 
 procedure TRegistry.WriteStringList(const Name: string; List: TStrings);
-
-Var
-  Data: string;
-
+var
+  Buffer: PWideChar;
+  U: UnicodeString;
+  i, BufSize, Len: Integer;
+  P: PWideChar;
 begin
-  Data := StringReplace(List.Text, LineEnding, #0, [rfReplaceAll]) + #0#0;
-  PutData(Name, PChar(Data), Length(Data),rdMultiString);
+  if not Assigned(List) or (List.Count = 0) then
+    Exit;
+  BufSize := 0;
+  for i := 0 to List.Count - 1 do
+  begin
+    U := UnicodeString(List[i]);
+    if U <> '' then // Ignore empty lines
+      Inc(BufSize, ByteLength(U) + SizeOf(WideChar)); // +1 = +#0
+  end;
+  Inc(BufSize, SizeOf(WideChar)); // Last #0
+  GetMem(Buffer, BufSize);
+  try
+    P := Buffer;
+    for i := 0 to List.Count - 1 do
+    begin
+      U := UnicodeString(List[i]);
+      if U = '' then
+        Continue;
+      Len := Length(U) + 1;  // +1 = +#0 and U have last #0
+      Move(PWideChar(U)^, P^, Len * SizeOf(WideChar));
+      Inc(P, Len);
+    end;
+    P^ := #0;
+    PutData(Name, Buffer, BufSize, rdMultiString);
+  finally
+    FreeMem(Buffer);
+  end;
 end;
 
 procedure TRegistry.WriteFloat(const Name: string; Value: Double);
registry.stringlist.4.diff (3,821 bytes)   

Serge Anvarov

2019-03-10 19:11

reporter  

reginifile.opensection.currentpath.4.diff (2,544 bytes)   
Index: packages/fcl-registry/src/regini.inc
===================================================================
--- packages/fcl-registry/src/regini.inc	(revision 41667)
+++ packages/fcl-registry/src/regini.inc	(working copy)
@@ -12,14 +12,7 @@
 begin
   inherited Create(aaccess);
   fFileName := FN;
-  if fFileName<>'' then begin
-    fPath := fFileName + '\';
-    if fPath[1]='\' then
-      System.Delete(fPath,1,1);
-    OpenKey(fFileName, aaccess <> KEY_READ);
-  end
-  else
-    fPath := '';
+  OpenKey(fFileName, aaccess <> KEY_READ);
   fPreferStringValues:=True; // Delphi compatibility
 end;
 
@@ -294,24 +287,14 @@
 function TRegIniFile.OpenSection(const Section: string; CreateSection : Boolean = false): boolean;
 var
   k: HKEY;
-  S : String;
-
 begin
-  S:=Section;
-  If (S<>'') and (S[1] = '\') then
-    Delete(S,1,1);
   if CreateSection then
-    CreateKey('\'+FPath+S);
-  if Section <> '' then
-    begin
-    k:=GetKey('\'+FPath+S);
-    if k = 0 then
-      begin
-      Result:=False;
-      exit;
-      end;
-    SetCurrentKey(k);
-  end;
+    CreateKey(Section);
+  k:=GetKey(Section);
+  if k = 0 then
+    Exit(False);
+  FKeyBeforeOpenSection := CurrentKey;
+  SetCurrentKey(k);
   Result:=True;
 end;
 
@@ -318,5 +301,6 @@
 procedure TRegIniFile.CloseSection;
 begin
   CloseKey(CurrentKey);
+  SetCurrentKey(FKeyBeforeOpenSection);
 end;
 
Index: packages/fcl-registry/src/registry.pp
===================================================================
--- packages/fcl-registry/src/registry.pp	(revision 41667)
+++ packages/fcl-registry/src/registry.pp	(working copy)
@@ -141,8 +141,8 @@
   TRegIniFile = class(TRegistry)
   private
     fFileName          : String;
-    fPath              : String;
     fPreferStringValues: Boolean;
+    FKeyBeforeOpenSection: HKEY;
     function OpenSection(const Section: string; CreateSection : Boolean = false): boolean;
     procedure CloseSection;
   public
Index: packages/fcl-registry/src/winreg.inc
===================================================================
--- packages/fcl-registry/src/winreg.inc	(revision 41667)
+++ packages/fcl-registry/src/winreg.inc	(working copy)
@@ -229,10 +230,9 @@
     Result:=FLastError=ERROR_SUCCESS;
     end;                     
   If Result then begin
-    if RelativeKey(Key) then
-      S:=CurrentPath + Key
-    else
-      S:=UTF8Encode(u);
+    S := UTF8Encode(u);
+    if RelativeKey(Key) and (CurrentKey <> 0) then
+      S := CurrentPath + '\' + S;
     ChangeKey(Handle, S);
   end;
 end;

Serge Anvarov

2019-03-10 19:13

reporter   ~0114779

registry.stringlist.4.diff was included by mistake

Bart Broersma

2019-03-24 12:06

reporter   ~0115016

Last edited: 2019-03-24 12:21

View 2 revisions

After the "unicode update" reginifile.opensection.currentpath.3.diff now has conflicts.
I'll create a new patch.

reginifile.opensection.currentpath.3.diff also touches the xmlreg implementation.
Not sure if this is really necessary.
Fixing TRegIniFile on non-windows platforms IMHO is not really something that should be accomplished in the context of this bug.
Moreover, it seems to be very unlikely that any fpc user on a non-windows platform uses TRegIniFile, otherwise numerous bugreports would have been filed in the last 6 years.

TRegIniFile was introduced in D2 as a means of easing the pain of porting code using IniFiles to now use the new Registry of Windows.
While Delphi still supports this on Windows (I doubt they support it on other platforms), IMHO we should abandon support for this component on non-windows platforms.

For Windows platforms we could adopt the policy that this component is not actively maintained anymore, but bugfixes are welcome as long as it is shown they don't break existing code.

To make a long story short: I plan to create a new patch that fixes this issue on Windows only, but only if that is OK with you.

Bart Broersma

2019-03-24 14:11

reporter  

registry.currentpath.diff (3,903 bytes)   
Index: packages/fcl-registry/src/registry.pp
===================================================================
--- packages/fcl-registry/src/registry.pp	(revision 41788)
+++ packages/fcl-registry/src/registry.pp	(working copy)
@@ -57,6 +57,7 @@
     fRootKey: HKEY;
     fLazyWrite: Boolean;
     fCurrentPath: UnicodeString;
+    function FixPath(APath: UnicodeString): UnicodeString;
     function GetLastErrorMsg: string;
     function RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
     function ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray;
@@ -631,6 +632,19 @@
   ReadStringList(UnicodeString(Name), AList);
 end;
 
+function TRegistry.FixPath(APath: UnicodeString): UnicodeString;
+const
+  Delim={$ifdef XMLREG}'/'{$else}'\'{$endif};
+begin
+  //At this point we know the path is valid, since this is only called after OpenKey succeeded
+  //Just sanitize it
+  while (Pos(Delim+Delim,APath) > 0) do
+    APath := UnicodeStringReplace(APath, Delim+Delim,Delim,[rfReplaceAll]);
+  if (Length(APath) > 1) and (APath[Length(APath)] = Delim) then
+    System.Delete(APath, Length(APath), 1);
+  Result := APath;
+end;
+
 function TRegistry.RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
 var
   Len, i, p: Integer;
Index: packages/fcl-registry/src/winreg.inc
===================================================================
--- packages/fcl-registry/src/winreg.inc	(revision 41788)
+++ packages/fcl-registry/src/winreg.inc	(working copy)
@@ -221,8 +221,12 @@
     end;                     
   If Result then begin
     if RelativeKey(Key) then
-      S:=CurrentPath + Key
-    else
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '\' + Key
+          else
+            S:=CurrentPath + Key;
+        end  else
       S:=u;
     ChangeKey(Handle, S);
   end;
@@ -319,7 +323,7 @@
 begin
   CloseKey;
   FCurrentKey:=Value;
-  FCurrentPath:=Path;
+  FCurrentPath:=FixPath(Path);
 end;
 
 
Index: packages/fcl-registry/src/xmlreg.pp
===================================================================
--- packages/fcl-registry/src/xmlreg.pp	(revision 41788)
+++ packages/fcl-registry/src/xmlreg.pp	(working copy)
@@ -81,6 +81,7 @@
     // These interpret the Data buffer as unicode data
     Function GetValueDataUnicode(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
     Function SetValueDataUnicode(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+    Property CurrentKey: UnicodeString read FCurrentKey; //used by TRegistry
     Property FileName : String Read FFileName Write SetFileName;
     Property RootKey : UnicodeString Read FRootKey Write SetRootkey;
     Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;
Index: packages/fcl-registry/src/xregreg.inc
===================================================================
--- packages/fcl-registry/src/xregreg.inc	(revision 41788)
+++ packages/fcl-registry/src/xregreg.inc	(working copy)
@@ -221,9 +221,22 @@
 
 function TRegistry.OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
 
+var
+  S: UnicodeString;
+  P: SizeInt;
 begin
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
   FCurrentKey:=1;
+  If Result then begin
+    S:=TXmlRegistry(FSysData).CurrentKey;
+    if (S>'') then begin
+      //S starts with RootKey+'/'
+      P:=Pos('/',S);
+      if (P>0) then
+        System.Delete(S,1,P);
+    end;
+    ChangeKey(FCurrentKey, S);
+  end;
 end;
 
 function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
@@ -264,7 +277,7 @@
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
-
+  FCurrentPath:=FixPath(Path);
 end;
 
 function TRegistry.GetKeyNames: TUnicodeStringArray;
registry.currentpath.diff (3,903 bytes)   

Bart Broersma

2019-03-24 14:14

reporter   ~0115018

Attached registry.currentpath.diff
This resolves the issue with TRegistry.CurrentPath not being updated.

If this can be applied, I will create a separate patch that resolves the actual TRegIniFile problem of this bugreport.

Bart Broersma

2019-03-24 14:29

reporter  

reginifile.opensection.diff (831 bytes)   
Index: packages/fcl-registry/src/regini.inc
===================================================================
--- packages/fcl-registry/src/regini.inc	(revision 41788)
+++ packages/fcl-registry/src/regini.inc	(working copy)
@@ -300,18 +300,18 @@
   S:=Section;
   If (S<>'') and (S[1] = '\') then
     Delete(S,1,1);
-  if CreateSection then
-    CreateKey('\'+FPath+S);
-  if Section <> '' then
+  if CreateSection and (S<>'') then
+    CreateKey('\'+CurrentPath+'\'+S);
+  if S <> '' then
+    k:=GetKey('\'+CurrentPath+'\'+S)
+  else
+    k:=GetKey('\'+CurrentPath);
+  if k = 0 then
     begin
-    k:=GetKey('\'+FPath+S);
-    if k = 0 then
-      begin
-      Result:=False;
-      exit;
-      end;
-    SetCurrentKey(k);
-  end;
+    Result:=False;
+    exit;
+    end;
+  SetCurrentKey(k);
   Result:=True;
 end;
 
reginifile.opensection.diff (831 bytes)   

Bart Broersma

2019-03-24 14:31

reporter   ~0115019

Attached reginifile.opensection.diff reslves the issue with TRegIniFile.OpenSection.

(It won't work without first applying registry.currentpath.diff though.
It also does not work on non-windows, as explained above.)

Bart Broersma

2019-07-12 11:36

reporter   ~0117212

Some feedback would be nice.

C Western

2019-09-16 23:02

reporter   ~0118092

Last edited: 2019-09-17 00:50

View 2 revisions

I have a simple use of TRegIni, which works fine on Delphi, but fails badly, even with the patches above. My usage is essentially:
with TRegistryIniFile.Create('SOFTWARE\Wibble') do begin
  ReadSectionValues('MRU Items', Files);
  Free; // fails as tries to close a closed key
end;

with TRegistryIniFile.Create('SOFTWARE\Wibble') do begin
  EraseSection('MRU Items');
  for i := 0 to Files.Count-1 do
      WriteString('MRU Items', 'F'+IntToStr(i), Files[i]); // Writes to wrong place
  Free;
end;

The attached patch (including the above patches) mmakes the two sequences above work for me; I think a key requirement is for OpenSection/CloseSection to leave the CurrentKey unchanged.

section.patch (5,238 bytes)   
Index: regini.inc
===================================================================
--- regini.inc	(revision 43022)
+++ regini.inc	(working copy)
@@ -297,14 +297,16 @@
   S : String;
 
 begin
+  fPreviousKey:=CurrentKey;
   S:=Section;
   If (S<>'') and (S[1] = '\') then
     Delete(S,1,1);
-  if CreateSection then
-    CreateKey('\'+FPath+S);
-  if Section <> '' then
-    begin
-    k:=GetKey('\'+FPath+S);
+  if CreateSection and (S<>'') then
+    CreateKey('\'+CurrentPath+'\'+S);
+  if S <> '' then
+    k:=GetKey('\'+CurrentPath+'\'+S)
+  else
+    k:=GetKey('\'+CurrentPath);
     if k = 0 then
       begin
       Result:=False;
@@ -311,7 +313,6 @@
       exit;
       end;
     SetCurrentKey(k);
-  end;
   Result:=True;
 end;
 
@@ -318,5 +319,6 @@
 procedure TRegIniFile.CloseSection;
 begin
   CloseKey(CurrentKey);
+  SetCurrentKey(fPreviousKey);
 end;
 
Index: registry.pp
===================================================================
--- registry.pp	(revision 43022)
+++ registry.pp	(working copy)
@@ -57,6 +57,7 @@
     fRootKey: HKEY;
     fLazyWrite: Boolean;
     fCurrentPath: UnicodeString;
+    function FixPath(APath: UnicodeString): UnicodeString;
     function GetLastErrorMsg: string;
     function RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
     function ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray;
@@ -201,6 +202,7 @@
     fFileName          : String;
     fPath              : String;
     fPreferStringValues: Boolean;
+    fPreviousKey       : HKEY;
     function OpenSection(const Section: string; CreateSection : Boolean = false): boolean;
     procedure CloseSection;
   public
@@ -632,6 +634,19 @@
   ReadStringList(UnicodeString(Name), AList);
 end;
 
+function TRegistry.FixPath(APath: UnicodeString): UnicodeString;
+const
+  Delim={$ifdef XMLREG}'/'{$else}'\'{$endif};
+begin
+  //At this point we know the path is valid, since this is only called after OpenKey succeeded
+  //Just sanitize it
+  while (Pos(Delim+Delim,APath) > 0) do
+    APath := UnicodeStringReplace(APath, Delim+Delim,Delim,[rfReplaceAll]);
+  if (Length(APath) > 1) and (APath[Length(APath)] = Delim) then
+    System.Delete(APath, Length(APath), 1);
+  Result := APath;
+end;
+
 function TRegistry.RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
 var
   Len, i, p: Integer;
Index: winreg.inc
===================================================================
--- winreg.inc	(revision 43022)
+++ winreg.inc	(working copy)
@@ -59,12 +59,12 @@
   Disposition: Dword;
   Handle: HKEY;
   SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
-
+  u: UnicodeString;
 begin
   SecurityAttributes := Nil;
-  Key:=PrepKey(Key);
+  u:=PrepKey(Key);
   FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
-                              PWideChar(Key),
+                              PWideChar(u),
                               0,
                               '',
                               REG_OPTION_NON_VOLATILE,
@@ -226,8 +226,12 @@
     end;                     
   If Result then begin
     if RelativeKey(Key) then
-      S:=CurrentPath + Key
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '\' + Key
     else
+            S:=CurrentPath + Key;
+        end  else
       S:=u;
     ChangeKey(Handle, S);
   end;
@@ -324,7 +328,7 @@
 begin
   CloseKey;
   FCurrentKey:=Value;
-  FCurrentPath:=Path;
+  FCurrentPath:=FixPath(Path);
 end;
 
 
Index: xmlreg.pp
===================================================================
--- xmlreg.pp	(revision 43022)
+++ xmlreg.pp	(working copy)
@@ -81,6 +81,7 @@
     // These interpret the Data buffer as unicode data
     Function GetValueDataUnicode(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
     Function SetValueDataUnicode(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+    Property CurrentKey: UnicodeString read FCurrentKey; //used by TRegistry
     Property FileName : String Read FFileName Write SetFileName;
     Property RootKey : UnicodeString Read FRootKey Write SetRootkey;
     Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;
Index: xregreg.inc
===================================================================
--- xregreg.inc	(revision 43022)
+++ xregreg.inc	(working copy)
@@ -223,9 +223,22 @@
 
 function TRegistry.OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
 
+var
+  S: UnicodeString;
+  P: SizeInt;
 begin
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
   FCurrentKey:=1;
+  If Result then begin
+    S:=TXmlRegistry(FSysData).CurrentKey;
+    if (S>'') then begin
+      //S starts with RootKey+'/'
+      P:=Pos('/',S);
+      if (P>0) then
+        System.Delete(S,1,P);
+    end;
+    ChangeKey(FCurrentKey, S);
+  end;
 end;
 
 function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
@@ -266,7 +279,7 @@
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
-
+  FCurrentPath:=FixPath(Path);
 end;
 
 function TRegistry.GetKeyNames: TUnicodeStringArray;
section.patch (5,238 bytes)   

C Western

2019-09-16 23:12

reporter   ~0118093

Minor update to the above, avoiding a range check error
section_update.patch (5,450 bytes)   
Index: regini.inc
===================================================================
--- regini.inc	(revision 43022)
+++ regini.inc	(working copy)
@@ -297,14 +297,16 @@
   S : String;
 
 begin
+  fPreviousKey:=CurrentKey;
   S:=Section;
   If (S<>'') and (S[1] = '\') then
     Delete(S,1,1);
-  if CreateSection then
-    CreateKey('\'+FPath+S);
-  if Section <> '' then
-    begin
-    k:=GetKey('\'+FPath+S);
+  if CreateSection and (S<>'') then
+    CreateKey('\'+CurrentPath+'\'+S);
+  if S <> '' then
+    k:=GetKey('\'+CurrentPath+'\'+S)
+  else
+    k:=GetKey('\'+CurrentPath);
     if k = 0 then
       begin
       Result:=False;
@@ -311,7 +313,6 @@
       exit;
       end;
     SetCurrentKey(k);
-  end;
   Result:=True;
 end;
 
@@ -318,5 +319,6 @@
 procedure TRegIniFile.CloseSection;
 begin
   CloseKey(CurrentKey);
+  SetCurrentKey(fPreviousKey);
 end;
 
Index: registry.pp
===================================================================
--- registry.pp	(revision 43022)
+++ registry.pp	(working copy)
@@ -57,6 +57,7 @@
     fRootKey: HKEY;
     fLazyWrite: Boolean;
     fCurrentPath: UnicodeString;
+    function FixPath(APath: UnicodeString): UnicodeString;
     function GetLastErrorMsg: string;
     function RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
     function ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray;
@@ -201,6 +202,7 @@
     fFileName          : String;
     fPath              : String;
     fPreferStringValues: Boolean;
+    fPreviousKey       : HKEY;
     function OpenSection(const Section: string; CreateSection : Boolean = false): boolean;
     procedure CloseSection;
   public
@@ -632,6 +634,19 @@
   ReadStringList(UnicodeString(Name), AList);
 end;
 
+function TRegistry.FixPath(APath: UnicodeString): UnicodeString;
+const
+  Delim={$ifdef XMLREG}'/'{$else}'\'{$endif};
+begin
+  //At this point we know the path is valid, since this is only called after OpenKey succeeded
+  //Just sanitize it
+  while (Pos(Delim+Delim,APath) > 0) do
+    APath := UnicodeStringReplace(APath, Delim+Delim,Delim,[rfReplaceAll]);
+  if (Length(APath) > 1) and (APath[Length(APath)] = Delim) then
+    System.Delete(APath, Length(APath), 1);
+  Result := APath;
+end;
+
 function TRegistry.RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
 var
   Len, i, p: Integer;
Index: winreg.inc
===================================================================
--- winreg.inc	(revision 43022)
+++ winreg.inc	(working copy)
@@ -59,12 +59,12 @@
   Disposition: Dword;
   Handle: HKEY;
   SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
-
+  u: UnicodeString;
 begin
   SecurityAttributes := Nil;
-  Key:=PrepKey(Key);
+  u:=PrepKey(Key);
   FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
-                              PWideChar(Key),
+                              PWideChar(u),
                               0,
                               '',
                               REG_OPTION_NON_VOLATILE,
@@ -226,8 +226,12 @@
     end;                     
   If Result then begin
     if RelativeKey(Key) then
-      S:=CurrentPath + Key
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '\' + Key
     else
+            S:=CurrentPath + Key;
+        end  else
       S:=u;
     ChangeKey(Handle, S);
   end;
@@ -324,7 +328,7 @@
 begin
   CloseKey;
   FCurrentKey:=Value;
-  FCurrentPath:=Path;
+  FCurrentPath:=FixPath(Path);
 end;
 
 
@@ -380,7 +384,7 @@
 
 begin
   Result:=nil;
-  if GetKeyInfo(Info) then
+  if GetKeyInfo(Info) and (Info.NumValues > 0) then
   begin
     dwLen:=Info.MaxValueLen+1;
     GetMem(lpName,dwLen*SizeOf(WideChar));
Index: xmlreg.pp
===================================================================
--- xmlreg.pp	(revision 43022)
+++ xmlreg.pp	(working copy)
@@ -81,6 +81,7 @@
     // These interpret the Data buffer as unicode data
     Function GetValueDataUnicode(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
     Function SetValueDataUnicode(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+    Property CurrentKey: UnicodeString read FCurrentKey; //used by TRegistry
     Property FileName : String Read FFileName Write SetFileName;
     Property RootKey : UnicodeString Read FRootKey Write SetRootkey;
     Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;
Index: xregreg.inc
===================================================================
--- xregreg.inc	(revision 43022)
+++ xregreg.inc	(working copy)
@@ -223,9 +223,22 @@
 
 function TRegistry.OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
 
+var
+  S: UnicodeString;
+  P: SizeInt;
 begin
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
   FCurrentKey:=1;
+  If Result then begin
+    S:=TXmlRegistry(FSysData).CurrentKey;
+    if (S>'') then begin
+      //S starts with RootKey+'/'
+      P:=Pos('/',S);
+      if (P>0) then
+        System.Delete(S,1,P);
+    end;
+    ChangeKey(FCurrentKey, S);
+  end;
 end;
 
 function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
@@ -266,7 +279,7 @@
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
-
+  FCurrentPath:=FixPath(Path);
 end;
 
 function TRegistry.GetKeyNames: TUnicodeStringArray;
section_update.patch (5,450 bytes)   

Bart Broersma

2020-03-15 15:43

reporter   ~0121617

Last edited: 2020-03-15 15:43

View 2 revisions

There are way to many patches attached to this report now, and I'm loosing track of what's going on with C Western's patch.

I propose to apply my two patches:

- registry.currentpath.diff (3,903 bytes)
- reginifile.opensection.diff (831 bytes) (requires the registry.currentpath.diff to be applied first.)
This will fix the original issue of this report.

The issue described by C Western can then be fixed in a separate patch.

It would be a shame not to fix this before the final 3.2 is released.

Marco van de Voort

2020-03-15 15:45

manager   ~0121618

Merging patches to 3.2 has been stalled anyway, these are still pending:

http://www.stack.nl/~marcov/mergelogs32/fcl-registry.html

Eric Heijnen

2020-03-29 11:27

reporter   ~0121747

One annoying usecase related to this that I can work around but would be nice to fix:
On non-windows systems, TRegistry is implemented using xmlregistry (i'm using tregistry as i'm porting a windows app to mac and don't want to rewrite all registry access)
The problem is that if you open two different registry keys at the same time, the last opened registry key is the one being used by both as OpenKey calls Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate); which affects every registry object in the current process
I can work around it by forcing the key before reading/writing but would be nice without

Bart Broersma

2020-03-29 12:20

reporter   ~0121748

@Eric: please don't hijack this issue.
This issue is about TRegIniFile.
Open a separate bugreport about the problem you described (and attach a sample program demonstrating the issue).

Bart Broersma

2020-03-31 22:32

reporter   ~0121808

New patch (registry.currentpath.opensection.diff) uploaded as requested by Michael, since the old patches could not be applied wihtou manual intervention due to code changes.
registry.currentpath.opensection.diff (4,734 bytes)   
Index: packages/fcl-registry/src/regini.inc
===================================================================
--- packages/fcl-registry/src/regini.inc	(revision 44469)
+++ packages/fcl-registry/src/regini.inc	(working copy)
@@ -300,18 +300,18 @@
   S:=Section;
   If (S<>'') and (S[1] = '\') then
     Delete(S,1,1);
-  if CreateSection then
-    CreateKey('\'+FPath+S);
-  if Section <> '' then
+  if CreateSection and (S<>'') then
+    CreateKey('\'+CurrentPath+'\'+S);
+  if S <> '' then
+    k:=GetKey('\'+CurrentPath+'\'+S)
+  else
+    k:=GetKey('\'+CurrentPath);
+  if k = 0 then
     begin
-    k:=GetKey('\'+FPath+S);
-    if k = 0 then
-      begin
-      Result:=False;
-      exit;
-      end;
-    SetCurrentKey(k);
-  end;
+    Result:=False;
+    exit;
+    end;
+  SetCurrentKey(k);
   Result:=True;
 end;
 
Index: packages/fcl-registry/src/registry.pp
===================================================================
--- packages/fcl-registry/src/registry.pp	(revision 44469)
+++ packages/fcl-registry/src/registry.pp	(working copy)
@@ -57,6 +57,7 @@
     fRootKey: HKEY;
     fLazyWrite: Boolean;
     fCurrentPath: UnicodeString;
+    function FixPath(APath: UnicodeString): UnicodeString;
     function GetLastErrorMsg: string;
     function RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
     function ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray;
@@ -632,6 +633,19 @@
   ReadStringList(UnicodeString(Name), AList);
 end;
 
+function TRegistry.FixPath(APath: UnicodeString): UnicodeString;
+const
+  Delim={$ifdef XMLREG}'/'{$else}'\'{$endif};
+begin
+  //At this point we know the path is valid, since this is only called after OpenKey succeeded
+  //Just sanitize it
+  while (Pos(Delim+Delim,APath) > 0) do
+    APath := UnicodeStringReplace(APath, Delim+Delim,Delim,[rfReplaceAll]);
+  if (Length(APath) > 1) and (APath[Length(APath)] = Delim) then
+    System.Delete(APath, Length(APath), 1);
+  Result := APath;
+end;
+
 function TRegistry.RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray;
 var
   Len, i, p: Integer;
Index: packages/fcl-registry/src/winreg.inc
===================================================================
--- packages/fcl-registry/src/winreg.inc	(revision 44469)
+++ packages/fcl-registry/src/winreg.inc	(working copy)
@@ -227,8 +227,12 @@
     end;                     
   If Result then begin
     if RelativeKey(Key) then
-      S:=CurrentPath + Key
-    else
+        begin
+          if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then
+            S:=CurrentPath + '\' + Key
+          else
+            S:=CurrentPath + Key;
+        end  else
       S:=u;
     ChangeKey(Handle, S);
   end;
@@ -325,7 +329,7 @@
 begin
   CloseKey;
   FCurrentKey:=Value;
-  FCurrentPath:=Path;
+  FCurrentPath:=FixPath(Path);
 end;
 
 
Index: packages/fcl-registry/src/xmlreg.pp
===================================================================
--- packages/fcl-registry/src/xmlreg.pp	(revision 44469)
+++ packages/fcl-registry/src/xmlreg.pp	(working copy)
@@ -81,6 +81,7 @@
     // These interpret the Data buffer as unicode data
     Function GetValueDataUnicode(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
     Function SetValueDataUnicode(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
+    Property CurrentKey: UnicodeString read FCurrentKey; //used by TRegistry
     Property FileName : String Read FFileName Write SetFileName;
     Property RootKey : UnicodeString Read FRootKey Write SetRootkey;
     Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;
Index: packages/fcl-registry/src/xregreg.inc
===================================================================
--- packages/fcl-registry/src/xregreg.inc	(revision 44469)
+++ packages/fcl-registry/src/xregreg.inc	(working copy)
@@ -223,9 +223,22 @@
 
 function TRegistry.OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean;
 
+var
+  S: UnicodeString;
+  P: SizeInt;
 begin
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
   FCurrentKey:=1;
+  If Result then begin
+    S:=TXmlRegistry(FSysData).CurrentKey;
+    if (S>'') then begin
+      //S starts with RootKey+'/'
+      P:=Pos('/',S);
+      if (P>0) then
+        System.Delete(S,1,P);
+    end;
+    ChangeKey(FCurrentKey, S);
+  end;
 end;
 
 function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
@@ -266,7 +279,7 @@
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
-
+  FCurrentPath:=FixPath(Path);
 end;
 
 function TRegistry.GetKeyNames: TUnicodeStringArray;

Michael Van Canneyt

2020-04-01 09:07

administrator   ~0121812

Checked & applied patch, added testprogram after verifying it runs OK.

Issue History

Date Modified Username Field Change
2019-02-06 11:58 Bart Broersma New Issue
2019-02-06 12:58 Bart Broersma Note Added: 0113898
2019-02-06 13:05 Benito van der Zander Note Added: 0113900
2019-02-06 13:13 Bart Broersma Note Added: 0113901
2019-02-06 18:37 Bart Broersma Note Added: 0113904
2019-02-06 19:33 Bart Broersma File Added: reginifile.opensection.currentpath.diff
2019-02-06 19:39 Bart Broersma Note Added: 0113906
2019-02-10 18:34 Bart Broersma File Added: tw0035022.pp
2019-02-10 18:42 Bart Broersma Note Added: 0114017
2019-02-10 18:45 Bart Broersma Note Edited: 0114017 View Revisions
2019-02-20 13:32 Bart Broersma Note Added: 0114294
2019-02-20 14:33 J. Gareth Moreton Summary TRegIni.WriteString writes to wong Key => TRegIni.WriteString writes to wrong Key
2019-03-10 12:45 Michael Van Canneyt Assigned To => Michael Van Canneyt
2019-03-10 12:45 Michael Van Canneyt Status new => assigned
2019-03-10 12:54 Michael Van Canneyt Note Added: 0114768
2019-03-10 12:54 Michael Van Canneyt Status assigned => feedback
2019-03-10 14:38 Bart Broersma Note Added: 0114770
2019-03-10 14:38 Bart Broersma Status feedback => assigned
2019-03-10 14:38 Bart Broersma Note Edited: 0114770 View Revisions
2019-03-10 14:47 Bart Broersma File Added: reginifile.opensection.currentpath.2.diff
2019-03-10 14:48 Bart Broersma Note Edited: 0114770 View Revisions
2019-03-10 14:53 Bart Broersma Note Added: 0114771
2019-03-10 15:00 Bart Broersma Note Edited: 0114771 View Revisions
2019-03-10 16:29 Bart Broersma Note Added: 0114773
2019-03-10 16:47 Bart Broersma Note Edited: 0114773 View Revisions
2019-03-10 16:57 Michael Van Canneyt Note Added: 0114774
2019-03-10 17:11 Bart Broersma File Added: reginifile.opensection.currentpath.3.diff
2019-03-10 17:12 Bart Broersma Note Added: 0114775
2019-03-10 17:50 Michael Van Canneyt Assigned To Michael Van Canneyt =>
2019-03-10 19:06 Serge Anvarov Note Added: 0114778
2019-03-10 19:07 Serge Anvarov File Added: registry.stringlist.4.diff
2019-03-10 19:07 Serge Anvarov Note Edited: 0114778 View Revisions
2019-03-10 19:07 Serge Anvarov Note Edited: 0114778 View Revisions
2019-03-10 19:08 Serge Anvarov Note Edited: 0114778 View Revisions
2019-03-10 19:08 Serge Anvarov Note Edited: 0114778 View Revisions
2019-03-10 19:09 Serge Anvarov Note Edited: 0114778 View Revisions
2019-03-10 19:11 Serge Anvarov File Added: reginifile.opensection.currentpath.4.diff
2019-03-10 19:13 Serge Anvarov Note Added: 0114779
2019-03-11 15:52 Michael Van Canneyt Status assigned => new
2019-03-23 09:51 Joost van der Sluis Assigned To => Joost van der Sluis
2019-03-23 09:51 Joost van der Sluis Status new => assigned
2019-03-24 12:06 Bart Broersma Note Added: 0115016
2019-03-24 12:21 Bart Broersma Note Edited: 0115016 View Revisions
2019-03-24 14:11 Bart Broersma File Added: registry.currentpath.diff
2019-03-24 14:14 Bart Broersma Note Added: 0115018
2019-03-24 14:29 Bart Broersma File Added: reginifile.opensection.diff
2019-03-24 14:31 Bart Broersma Note Added: 0115019
2019-07-12 11:36 Bart Broersma Note Added: 0117212
2019-09-07 21:55 Marco van de Voort Summary TRegIni.WriteString writes to wrong Key => TRegIniFile.WriteString writes to wrong Key
2019-09-07 21:55 Marco van de Voort FPCTarget => -
2019-09-16 23:02 C Western File Added: section.patch
2019-09-16 23:02 C Western Note Added: 0118092
2019-09-16 23:12 C Western File Added: section_update.patch
2019-09-16 23:12 C Western Note Added: 0118093
2019-09-17 00:50 C Western Note Edited: 0118092 View Revisions
2020-03-15 15:43 Bart Broersma Note Added: 0121617
2020-03-15 15:43 Bart Broersma Note Edited: 0121617 View Revisions
2020-03-15 15:45 Marco van de Voort Note Added: 0121618
2020-03-29 11:27 Eric Heijnen Note Added: 0121747
2020-03-29 12:20 Bart Broersma Note Added: 0121748
2020-03-31 22:32 Bart Broersma File Added: registry.currentpath.opensection.diff
2020-03-31 22:32 Bart Broersma Note Added: 0121808
2020-04-01 09:07 Michael Van Canneyt Assigned To Joost van der Sluis => Michael Van Canneyt
2020-04-01 09:07 Michael Van Canneyt Status assigned => resolved
2020-04-01 09:07 Michael Van Canneyt Resolution open => fixed
2020-04-01 09:07 Michael Van Canneyt Note Added: 0121812
2020-04-01 09:10 Michael Van Canneyt Relationship added related to 0033980
2020-04-01 09:12 Michael Van Canneyt Fixed in Version => 3.3.1
2020-04-01 09:12 Michael Van Canneyt Target Version => 3.2.0
2020-04-01 09:12 Michael Van Canneyt Fixed in Revision => 44478
2020-04-01 09:14 Michael Van Canneyt Relationship added related to 0035023
2020-04-01 12:48 Bart Broersma Status resolved => closed