View Issue Details

IDProjectCategoryView StatusLast Update
0035022FPCFCLpublic2019-07-12 11:36
ReporterBart BroersmaAssigned ToJoost van der Sluis 
PrioritynormalSeverityminorReproducibilityalways
Status assignedResolutionopen 
Platformi386OSWindowsOS Version10
Product Version3.3.1Product Buildr40745 
Target VersionFixed in Version 
Summary0035022: TRegIni.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 Revision
FPCOldBugId
FPCTarget
Attached Files
  • 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);
    
  • tw0035022.pp (4,957 bytes)
    { %TARGET=win32,win64,wince }
    
    program tw0035022;
    
    {$apptype console}
    {$mode objfpc}{$h+}
    {$ASSERTIONS ON}
    
    uses
        registry, sysutils, classes;
    
    const
      ROOT = 'Software';
      subFPCREGINITEST = 'FreePascalRegIniTest';
      subRegIni = 'RegIni';
      subStrings = 'FPCTESTString';
      fqFREEPASCALREGINITEST = Root + '\'+ subFPCREGINITEST;
      fqFPCTESTRegIni = fqFREEPASCALREGINITEST + '\' + subRegIni;
      fqFPCTESTStrings = fqFPCTESTRegIni+'\' + subStrings;
      fqWrongFPCTESTStrings = Root + '\' + subStrings;
      idString1 = 'String1';
      valValue1 = 'Value1';
    
    procedure CheckCreate;
    var
      Reg: TRegistry;
      S, SKey: String;
      B: Boolean;
    begin
      write('CheckCreate: ');
      Reg := TRegistry.Create(KEY_READ);
      try
        Reg.RootKey := HKEY_CURRENT_USER;
        SKey := fqFPCTESTRegIni;
        B := Reg.OpenKeyReadOnly(SKey);
        Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[SKey]));
    
        SKey := subStrings;
        B := Reg.OpenKeyReadOnly(Skey);
        Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[fqFPCTESTStrings]));
    
        S := Reg.ReadString(idString1);
        Assert(S=valValue1,format('ReadString(''%s''): expected '+'%s, but found: ''%s''',[idString1,valValue1,S]));
    
        Reg.CloseKey;
    
        writeln('OK');
      finally
        Reg.Free;
      end;
    
    end;
    
    procedure FindErroneousEntries;
    var
      Reg: TRegistry;
      B: Boolean;
    begin
      write('FindErroneousEntries: ');
      Reg := TRegistry.Create(KEY_READ);
      try
        B := Reg.OpenKeyReadOnly(fqWrongFPCTESTStrings);
        Reg.CloseKey;
        Assert(not B, format('RegOpenKeyReadOnly found %s, which at this point is unexpected.',[fqWrongFPCTESTStrings]));
        writeln(' no erroneous entries found (OK).');
      finally
        Reg.Free;
      end;
    end;
    
    procedure CreateTestEntries;
    var
      RegIni: TRegIniFile;
      B: Boolean;
      function TryOpenKey(Key: String; CanCreate: Boolean): Boolean;
      begin
        Result := RegIni.OpenKey(Key, CanCreate);
      end;
    
      function TryWriteString(Section, Ident, Value: String): Boolean;
      begin
        Result := False;
        try
          RegIni.WriteString(Section, Ident, Value);
          Result := True;
        except
          on E: Exception do
        end;
      end;
    
    begin
      write('CreateTestEntries: ');
      RegIni := TRegIniFile.Create(Root);
      try
        Assert(RegIni.CurrentPath=Root,'Expected: CurrenPath='+Root);
        B := RegIni.CreateKey(subFPCREGINITEST);
        Assert(B,format('Error: CreateKey(''%s'') failed.',[fqFREEPASCALREGINITEST]));
    
        B := TryOpenKey(subFPCREGINITEST,False);
        Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFREEPASCALREGINITEST]));
    
        Assert(RegIni.CurrentPath=fqFREEPASCALREGINITEST,'Expected: CurrenPath='+fqFREEPASCALREGINITEST);
    
        B := TryOpenKey(subRegIni,True);
        Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFPCTESTRegIni]));
        Assert(RegIni.CurrentPath=fqFPCTESTRegIni,'Expected: CurrenPath='+fqFPCTESTRegIni);
    
        B := TryWriteString(subStrings,idString1,valValue1);
        Assert(B,format('Error: WriteString(''%s'',''%s'',''%s'') failed.',[fqFPCTESTStrings,idString1,valValue1]));
    
        writeln('OK');
      finally
        RegIni.Free;
      end;
    
    end;
    
    procedure DeleteFPCTESTEntries;
      procedure DeleteStrings;
      var
        Reg: TRegistry;
        B: Boolean;
      begin
        Reg := TRegistry.Create(KEY_ALL_ACCESS);
        try
          Reg.RootKey := HKEY_CURRENT_USER;
          if Reg.KeyExists(fqFPCTESTStrings) then
          begin
            B := Reg.OpenKey(fqFPCTESTStrings, False);
            //writeln('OpenKey: ',B);
            if B then
            begin
              B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1);
              Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqFPCTESTStrings]));
            end;
            Reg.CloseKey;
          end;
    
          if Reg.KeyExists(fqWrongFPCTESTStrings) then
          begin
            B := Reg.OpenKey(fqWrongFPCTESTStrings, False);
            //writeln('OpenKey: ',B);
            if B then
            begin
              B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1);
              Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqWrongFPCTESTStrings]));
            end;
            Reg.CloseKey;
          end;
        finally
          Reg.Free;
        end;
      end;
    
      procedure DeleteEmptyKey(Key: String);
      var
        Reg: TRegistry;
        B: Boolean;
      begin
        Reg := TRegistry.Create(KEY_ALL_ACCESS);
        try
          Reg.RootKey := HKEY_CURRENT_USER;
          if Reg.KeyExists(Key) then
          begin
            B := Reg.DeleteKey(Key);
            Assert(B, format('Error DeleteKey(''%s'')',[Key]));
          end;
        finally
          Reg.Free;
        end;
      end;
    
    begin
      DeleteStrings;
      DeleteEmptyKey(fqFPCTESTStrings);
      DeleteEmptyKey(fqWrongFPCTESTStrings);
      DeleteEmptyKey(fqFPCTESTRegIni);
      DeleteEmptyKey(fqFREEPASCALREGINITEST);
    end;
    
    begin
      DeleteFPCTESTEntries;
      CreateTestEntries;
      CheckCreate;
      FindErroneousEntries;
      DeleteFPCTESTEntries;
    end.
    
    tw0035022.pp (4,957 bytes)
  • 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);
    
  • 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);
    
  • 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);
    
  • 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;
    
  • 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;
    
  • 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;
     
    

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)
{ %TARGET=win32,win64,wince }

program tw0035022;

{$apptype console}
{$mode objfpc}{$h+}
{$ASSERTIONS ON}

uses
    registry, sysutils, classes;

const
  ROOT = 'Software';
  subFPCREGINITEST = 'FreePascalRegIniTest';
  subRegIni = 'RegIni';
  subStrings = 'FPCTESTString';
  fqFREEPASCALREGINITEST = Root + '\'+ subFPCREGINITEST;
  fqFPCTESTRegIni = fqFREEPASCALREGINITEST + '\' + subRegIni;
  fqFPCTESTStrings = fqFPCTESTRegIni+'\' + subStrings;
  fqWrongFPCTESTStrings = Root + '\' + subStrings;
  idString1 = 'String1';
  valValue1 = 'Value1';

procedure CheckCreate;
var
  Reg: TRegistry;
  S, SKey: String;
  B: Boolean;
begin
  write('CheckCreate: ');
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    SKey := fqFPCTESTRegIni;
    B := Reg.OpenKeyReadOnly(SKey);
    Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[SKey]));

    SKey := subStrings;
    B := Reg.OpenKeyReadOnly(Skey);
    Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[fqFPCTESTStrings]));

    S := Reg.ReadString(idString1);
    Assert(S=valValue1,format('ReadString(''%s''): expected '+'%s, but found: ''%s''',[idString1,valValue1,S]));

    Reg.CloseKey;

    writeln('OK');
  finally
    Reg.Free;
  end;

end;

procedure FindErroneousEntries;
var
  Reg: TRegistry;
  B: Boolean;
begin
  write('FindErroneousEntries: ');
  Reg := TRegistry.Create(KEY_READ);
  try
    B := Reg.OpenKeyReadOnly(fqWrongFPCTESTStrings);
    Reg.CloseKey;
    Assert(not B, format('RegOpenKeyReadOnly found %s, which at this point is unexpected.',[fqWrongFPCTESTStrings]));
    writeln(' no erroneous entries found (OK).');
  finally
    Reg.Free;
  end;
end;

procedure CreateTestEntries;
var
  RegIni: TRegIniFile;
  B: Boolean;
  function TryOpenKey(Key: String; CanCreate: Boolean): Boolean;
  begin
    Result := RegIni.OpenKey(Key, CanCreate);
  end;

  function TryWriteString(Section, Ident, Value: String): Boolean;
  begin
    Result := False;
    try
      RegIni.WriteString(Section, Ident, Value);
      Result := True;
    except
      on E: Exception do
    end;
  end;

begin
  write('CreateTestEntries: ');
  RegIni := TRegIniFile.Create(Root);
  try
    Assert(RegIni.CurrentPath=Root,'Expected: CurrenPath='+Root);
    B := RegIni.CreateKey(subFPCREGINITEST);
    Assert(B,format('Error: CreateKey(''%s'') failed.',[fqFREEPASCALREGINITEST]));

    B := TryOpenKey(subFPCREGINITEST,False);
    Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFREEPASCALREGINITEST]));

    Assert(RegIni.CurrentPath=fqFREEPASCALREGINITEST,'Expected: CurrenPath='+fqFREEPASCALREGINITEST);

    B := TryOpenKey(subRegIni,True);
    Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFPCTESTRegIni]));
    Assert(RegIni.CurrentPath=fqFPCTESTRegIni,'Expected: CurrenPath='+fqFPCTESTRegIni);

    B := TryWriteString(subStrings,idString1,valValue1);
    Assert(B,format('Error: WriteString(''%s'',''%s'',''%s'') failed.',[fqFPCTESTStrings,idString1,valValue1]));

    writeln('OK');
  finally
    RegIni.Free;
  end;

end;

procedure DeleteFPCTESTEntries;
  procedure DeleteStrings;
  var
    Reg: TRegistry;
    B: Boolean;
  begin
    Reg := TRegistry.Create(KEY_ALL_ACCESS);
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.KeyExists(fqFPCTESTStrings) then
      begin
        B := Reg.OpenKey(fqFPCTESTStrings, False);
        //writeln('OpenKey: ',B);
        if B then
        begin
          B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1);
          Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqFPCTESTStrings]));
        end;
        Reg.CloseKey;
      end;

      if Reg.KeyExists(fqWrongFPCTESTStrings) then
      begin
        B := Reg.OpenKey(fqWrongFPCTESTStrings, False);
        //writeln('OpenKey: ',B);
        if B then
        begin
          B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1);
          Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqWrongFPCTESTStrings]));
        end;
        Reg.CloseKey;
      end;
    finally
      Reg.Free;
    end;
  end;

  procedure DeleteEmptyKey(Key: String);
  var
    Reg: TRegistry;
    B: Boolean;
  begin
    Reg := TRegistry.Create(KEY_ALL_ACCESS);
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.KeyExists(Key) then
      begin
        B := Reg.DeleteKey(Key);
        Assert(B, format('Error DeleteKey(''%s'')',[Key]));
      end;
    finally
      Reg.Free;
    end;
  end;

begin
  DeleteStrings;
  DeleteEmptyKey(fqFPCTESTStrings);
  DeleteEmptyKey(fqWrongFPCTESTStrings);
  DeleteEmptyKey(fqFPCTESTRegIni);
  DeleteEmptyKey(fqFREEPASCALREGINITEST);
end;

begin
  DeleteFPCTESTEntries;
  CreateTestEntries;
  CheckCreate;
  FindErroneousEntries;
  DeleteFPCTESTEntries;
end.
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);

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;

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;
 

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.

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