* Patch from Bart Broersma to fix bug ID #35022

git-svn-id: trunk@44477 -

packages/fcl-registry/src/regini.inc

@@ -300,18 +300,18 @@ begin
   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;
 

packages/fcl-registry/src/registry.pp

@@ -57,6 +57,7 @@ type
     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 @@ begin
   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;

packages/fcl-registry/src/winreg.inc

@@ -227,8 +227,12 @@ begin
     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 @@ procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
   CloseKey;
   FCurrentKey:=Value;
-  FCurrentPath:=Path;
+  FCurrentPath:=FixPath(Path);
 end;
 
 

packages/fcl-registry/src/xmlreg.pp

@@ -81,6 +81,7 @@ Type
     // 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;

packages/fcl-registry/src/xregreg.inc

@@ -223,9 +223,22 @@ end;
 
 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 @@ end;
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString);
 begin
-
+  FCurrentPath:=FixPath(Path);
 end;
 
 function TRegistry.GetKeyNames: TUnicodeStringArray;