* Apply patch from mgr.inz.Player for bug ID 36842

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@47411 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 59 insertions, 19 deletions

diff --git a/packages/fcl-registry/src/xregreg.inc b/packages/fcl-registry/src/xregreg.inc
index e9a1989216..aad9c635b2 100644
--- a/packages/fcl-registry/src/xregreg.inc
+++ b/packages/fcl-registry/src/xregreg.inc
@@ -39,6 +39,22 @@ begin
   end;
 end;
 
+Function RootKeyToRootKeyStr(Value: HKEY): UnicodeString;
+
+begin
+  Case Value of
+    HKEY_CLASSES_ROOT     : Result := 'HKEY_CLASSES_ROOT';
+    HKEY_CURRENT_USER     : Result := 'HKEY_CURRENT_USER';
+    HKEY_LOCAL_MACHINE    : Result := 'HKEY_LOCAL_MACHINE';
+    HKEY_USERS            : Result := 'HKEY_USERS';
+    HKEY_PERFORMANCE_DATA : Result := 'HKEY_PERFORMANCE_DATA';
+    HKEY_CURRENT_CONFIG   : Result := 'HKEY_CURRENT_CONFIG';
+    HKEY_DYN_DATA         : Result := 'HKEY_DYN_DATA';
+  else
+    Result:=Format('Key%d',[Value]);
+  end;
+end;
+
 type
 
   { TXMLRegistryInstance }
@@ -115,6 +131,26 @@ begin
   Dec(FRefCount);
 end;
 
+procedure useKeyFromTRegistryInstance(reg: TRegistry);
+var XmlRegistry: TXMLRegistry;
+    RootKeyStr: UnicodeString;
+begin
+  XmlRegistry:=TXMLRegistry(reg.FSysData);
+  RootKeyStr:=RootKeyToRootKeyStr(reg.RootKey);
+
+  // '/' at the end when comparing
+  if (reg.CurrentKey=0) and (UnicodeCompareText(XmlRegistry.RootKey, RootKeyStr + '/')<>0) then
+    XmlRegistry.SetRootKey(RootKeyStr)
+  else
+    begin
+    if UnicodeCompareText(XmlRegistry.CurrentKey, RootKeyStr+'/'+reg.CurrentPath + '/')<>0 then
+      begin
+      XmlRegistry.SetRootKey(RootKeyStr);
+      XmlRegistry.SetKey(reg.CurrentPath, false);
+      end;
+    end;
+end;
+
 procedure TRegistry.SysRegCreate;
 var s : string;
 begin
@@ -139,17 +175,20 @@ end;
 function TRegistry.SysCreateKey(Key: UnicodeString): Boolean;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).CreateKey(Key);
 end;
 
 function TRegistry.DeleteKey(const Key: UnicodeString): Boolean;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXMLRegistry(FSysData).DeleteKey(Key);
 end;
 
 function TRegistry.DeleteValue(const Name: UnicodeString): Boolean;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).DeleteValue(Name);
 end;
 
@@ -159,6 +198,7 @@ function TRegistry.SysGetData(const Name: UnicodeString; Buffer: Pointer;
 Var
   DataType : TDataType;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=BufSize;
   If TXmlregistry(FSysData).GetValueDataUnicode(Name,DataType,Buffer^,Result) then
     RegData:=DataTypeToRegDataType(DataType)
@@ -172,6 +212,7 @@ Var
   Info : TDataInfo;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info,True);
   If Not Result then
     With Value do
@@ -198,6 +239,7 @@ Var
   Info : TKeyInfo;
 
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).GetKeyInfo(info);
   If Result then
     With Value,Info do
@@ -213,6 +255,7 @@ end;
 
 function TRegistry.KeyExists(const Key: UnicodeString): Boolean;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).KeyExists(Key);
 end;
 
@@ -227,9 +270,10 @@ var
   S: UnicodeString;
   P: SizeInt;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
-  FCurrentKey:=1;
   If Result then begin
+    fCurrentKey:=1;
     S:=TXmlRegistry(FSysData).CurrentKey;
     if (S>'') then begin
       //S starts with RootKey+'/'
@@ -237,14 +281,14 @@ begin
       if (P>0) then
         System.Delete(S,1,P);
     end;
-    ChangeKey(FCurrentKey, S);
+    ChangeKey(fCurrentKey, S);
   end;
 end;
 
 function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean;
 
 begin
-  Result:=TXmlRegistry(FSysData).SetKey(Key,False);
+  Result:=OpenKey(Key,False);
 end;
 
 function TRegistry.RegistryConnect(const UNCName: UnicodeString): Boolean;
@@ -274,6 +318,7 @@ end;
 
 function TRegistry.ValueExists(const Name: UnicodeString): Boolean;
 begin
+  useKeyFromTRegistryInstance(self);
   Result := TXmlRegistry(FSysData).ValueExists(Name);
 end;
 
@@ -284,11 +329,13 @@ end;
 
 function TRegistry.GetKeyNames: TUnicodeStringArray;
 begin
+  useKeyFromTRegistryInstance(self);
   Result:=TXmlRegistry(FSysData).EnumSubKeys;
 end;
 
 function TRegistry.GetValueNames: TUnicodeStringArray;
 begin
+  useKeyFromTRegistryInstance(self);
   Result := TXmlRegistry(FSysData).EnumValues;
 end;
 
@@ -300,6 +347,7 @@ Var
   DataType : TDataType;
 
 begin
+  useKeyFromTRegistryInstance(self);
   //writeln('TRegistry.SysPutData: Name=',Name,', RegData=',RegData,', BufSize=',BufSize);
   DataType:=RegDataTypeToXmlDataType(RegData);
 
@@ -308,6 +356,7 @@ end;
 
 procedure TRegistry.RenameValue(const OldName, NewName: UnicodeString);
 begin
+  useKeyFromTRegistryInstance(self);
   TXMLRegistry(FSysData).RenameValue(OldName,NewName);
 end;
 
@@ -323,24 +372,11 @@ Var
   S: UnicodeString;
 
 begin
-  If (Value=HKEY_CLASSES_ROOT) then
-    S:='HKEY_CLASSES_ROOT'
-  else if (Value=HKEY_CURRENT_USER) then
-    S:='HKEY_CURRENT_USER'
-  else if (Value=HKEY_LOCAL_MACHINE) then
-    S:='HKEY_LOCAL_MACHINE'
-  else if (Value=HKEY_USERS) then
-    S:='HKEY_USERS'
-  else if Value=HKEY_PERFORMANCE_DATA then
-    S:='HKEY_PERFORMANCE_DATA'
-  else if (Value=HKEY_CURRENT_CONFIG) then
-    S:='HKEY_CURRENT_CONFIG'
-  else if (Value=HKEY_DYN_DATA) then
-    S:='HKEY_DYN_DATA'
-  else
-    S:=Format('Key%d',[Value]);
+  S:=RootKeyToRootKeyStr(Value);
   TXmlRegistry(FSysData).SetRootKey(S);
   fRootKey := Value;
+  fCurrentKey:=0;
+  FCurrentPath:='';
 end;
 
 function TRegistry.GetLastErrorMsg: string;
@@ -357,6 +393,8 @@ begin
   begin
     TXMLRegistry(FSysData).Flush;
     TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+    fCurrentKey:=0;
+    FCurrentPath:='';
   end;
 end;
 
@@ -367,6 +405,8 @@ begin
   begin
     TXMLRegistry(FSysData).Flush;
     TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
+    fCurrentKey:=0;
+    FCurrentPath:='';
   end;
 end;