* Make TRegIniFile Delphi compatible.

* Fix completely broken TRegistryIniFile.
+ Tests.

git-svn-id: trunk@22654 -

packages/fcl-registry/src/regini.inc

@@ -5,57 +5,50 @@
 
 constructor TRegIniFile.Create(const FN: String);
 begin
-  inherited Create;
-  fFileName := FN;
-  if fFileName<>'' then
-   fPath := fFileName + '\'
-  else
-   fPath := '';
+  Create(FN, KEY_ALL_ACCESS);
 end;
 
 constructor TRegIniFile.Create(const FN: String;aaccess:longword);
 begin
   inherited Create(aaccess);
   fFileName := FN;
-  if fFileName<>'' then
-   fPath := fFileName + '\'
+  if fFileName<>'' then begin
+    fPath := fFileName + '\';
+    OpenKey(fFileName, aaccess <> KEY_READ);
+  end
   else
-   fPath := '';
+    fPath := '';
+  fPreferStringValues:=True; // Delphi compatibility
 end;
 
 procedure TRegIniFile.DeleteKey(const Section, Ident: String);
 begin
-	if not OpenKey(fPath+Section,true) then Exit;
-	try
-	 DeleteValue(Ident);
-	finally
-	 CloseKey;
-	end;
+  if OpenSection(Section) then
+  try
+    DeleteValue(Ident);
+  finally
+    CloseSection;
+  end;
 end;
 
 procedure TRegIniFile.EraseSection(const Section: string);
 begin
- inherited DeleteKey(fPath+Section);
+  inherited DeleteKey(Section);
 end;
 
 procedure TRegIniFile.ReadSection(const Section: string; Strings: TStrings);
 begin
-	if not OpenKey(fPath+Section,false) then Exit;
-	try
-	 GetValueNames(Strings);
-	finally
-	 CloseKey;
-	end;
+  if OpenSection(Section) then
+  try
+    GetValueNames(Strings);
+  finally
+    CloseSection;
+  end;
 end;
 
 procedure TRegIniFile.ReadSections(Strings: TStrings);
 begin
-	if not OpenKey(fFileName,false) then Exit;
-	try
-	 GetKeyNames(Strings);
-	finally
-	 CloseKey;
-	end;
+  GetKeyNames(Strings);
 end;
 
 procedure TRegIniFile.ReadSectionValues(const Section: string; Strings: TStrings);
@@ -64,24 +57,27 @@ var
  V : String;
  i : Integer;
 begin
-	if not OpenKey(fPath+Section,false) then Exit;
-	ValList := TStringList.Create;
-	try
-	 GetValueNames(ValList);
-	 for i:=0 to ValList.Count-1 do
-	 begin
-	   V := inherited ReadString(ValList.Strings[i]);
-	   Strings.Add(ValList.Strings[i] + '=' + V);
-	 end;
-	finally
-	 ValList.Free;
-	 CloseKey;
-	end;
+  if OpenSection(Section) then
+  try
+ 	  ValList := TStringList.Create;
+ 	  try
+      GetValueNames(ValList);
+      for i:=0 to ValList.Count-1 do
+      begin
+        V := inherited ReadString(ValList.Strings[i]);
+        Strings.Add(ValList.Strings[i] + '=' + V);
+      end;
+ 	  finally
+      ValList.Free;
+ 	  end;
+  finally
+    CloseSection;
+  end;
 end;
 
 procedure TRegIniFile.WriteBool(const Section, Ident: string; Value: Boolean);
 begin
-	if not OpenKey(fPath+Section,true) then Exit;
+  if OpenSection(Section) then
 	try
     if not fPreferStringValues then
   	  inherited WriteBool(Ident,Value)
@@ -92,13 +88,13 @@ begin
         inherited WriteString(Ident,BoolToStr(Value));
     end;
   finally
-	  CloseKey;
+    CloseSection;
 	end;
 end;
 
 procedure TRegIniFile.WriteInteger(const Section, Ident: string; Value: LongInt);
 begin
-  if not OpenKey(fPath+Section,true) then Exit;
+  if OpenSection(Section) then
   try
     if not fPreferStringValues then
       inherited WriteInteger(Ident,Value)
@@ -109,24 +105,24 @@ begin
         inherited WriteString(Ident,IntToStr(Value));
     end;
   finally
-    CloseKey;
+    CloseSection;
   end;
 end;
 
 procedure TRegIniFile.WriteString(const Section, Ident, Value: String);
 begin
-  if not OpenKey(fPath+Section,true) then Exit;
+  if OpenSection(Section) then
   try
-   inherited WriteString(Ident,Value);
+    inherited WriteString(Ident,Value);
   finally
-   CloseKey;
+    CloseSection;
   end;
 end;
 
 function TRegIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
 begin
 	Result := Default;
-	if not OpenKey(fPath+Section,false) then Exit;
+  if OpenSection(Section) then
 	try
     if ValueExists(Ident) then
       if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then
@@ -134,14 +130,14 @@ begin
       else
         Result := StrToBool(inherited ReadString(Ident));
 	finally
-	  CloseKey;
+    CloseSection;
 	end;
 end;
 
 function TRegIniFile.ReadInteger(const Section, Ident: string; Default: LongInt): LongInt;
 begin
   Result := Default;
-  if not OpenKey(fPath+Section,false) then Exit;
+  if OpenSection(Section) then
   try
     if ValueExists(Ident) then
       if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then
@@ -149,18 +145,45 @@ begin
       else
         Result := StrToInt(inherited ReadString(Ident));
   finally
-    CloseKey;
+    CloseSection;
   end;
 end;
 
 function TRegIniFile.ReadString(const Section, Ident, Default: String): String;
 begin
   Result := Default;
-  if not OpenKey(fPath+Section,false) then Exit;
+  if OpenSection(Section) then
   try
     if ValueExists(Ident) then
       Result := inherited ReadString(Ident);
   finally
-    CloseKey;
+    CloseSection;
   end;
 end;
+
+function TRegIniFile.OpenSection(const Section: string): boolean;
+var
+  k: HKEY;
+begin
+  ASSERT(fOldCurKey = 0);
+  if Section <> '' then begin
+    k:=GetKey(Section);
+    if k = 0 then begin
+      Result:=False;
+      exit;
+    end;
+    fOldCurKey:=CurrentKey;
+    SetCurrentKey(k);
+  end;
+  Result:=True;
+end;
+
+procedure TRegIniFile.CloseSection;
+begin
+  if fOldCurKey <> 0 then begin
+    CloseKey(CurrentKey);
+    SetCurrentKey(fOldCurKey);
+    fOldCurKey:=0;
+  end;
+end;
+

packages/fcl-registry/src/registry.pp

@@ -135,6 +135,10 @@ type
     fFileName          : String;
     fPath              : String;
     fPreferStringValues: Boolean;
+    fOldCurKey         : HKEY;
+
+    function OpenSection(const Section: string): boolean;
+    procedure CloseSection;
   public
     constructor Create(const FN: string); overload;
     constructor Create(const FN: string;aaccess:longword); overload;
@@ -188,6 +192,7 @@ type
     procedure EraseSection(const Section: string); override;
     procedure DeleteKey(const Section, Name: String); override;
     procedure UpdateFile; override;
+    function ValueExists(const Section, Ident: string): Boolean; override;
     property RegIniFile: TRegIniFile read FRegIniFile;
   end;
 
@@ -490,122 +495,53 @@ end;
 
 function TRegistryIniFile.ReadDate(const Section, Name: string;
   Default: TDateTime): TDateTime;
-var sectkey,curkey : HKey;
-begin 
+begin
+  Result:=Default;
   with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              if ValueExists(Name) THen 
-                result:=FRegIniFile.ReadDate(Name)
-              else
-                result:=default;
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-       else
-         result:=default; 
-    end;          
+    if OpenSection(Section) then
+      try
+        if ValueExists(Name) then
+          Result:=FRegInifile.ReadDate(Name);
+      finally
+        CloseSection;
+      end;
 end;
 
 function TRegistryIniFile.ReadDateTime(const Section, Name: string;
   Default: TDateTime): TDateTime;
-var sectkey,curkey : HKey;  
 begin
+  Result:=Default;
   with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              if ValueExists(Name) THen 
-                result:=FRegIniFile.ReadDateTime(Name)
-              else
-                result:=default;
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-       else
-         result:=default; 
-    end;          
+    if OpenSection(Section) then
+      try
+        if ValueExists(Name) then
+          Result:=FRegInifile.ReadDateTime(Name);
+      finally
+        CloseSection;
+      end;
 end;
 
 function TRegistryIniFile.ReadFloat(const Section, Name: string;
   Default: Double): Double;
-var sectkey,curkey : HKey;  
 begin
+  Result:=Default;
   with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              if ValueExists(Name) THen 
-                result:=FRegIniFile.ReadFloat(Name)
-              else
-                result:=default;
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-       else
-         result:=default; 
-    end;          
+    if OpenSection(Section) then
+      try
+        if ValueExists(Name) then
+          Result:=FRegInifile.ReadFloat(Name);
+      finally
+        CloseSection;
+      end;
 end;
 
 function TRegistryIniFile.ReadInteger(const Section, Name: string;
   Default: Integer): Longint;
-var sectkey,curkey : HKey;  
 begin
-  with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              if ValueExists(Name) THen 
-                result:=FRegIniFile.ReadInteger(section,Name,default)
-              else
-                result:=default;
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-       else
-         result:=default; 
-    end;          
-end;
-
-procedure TRegistryIniFile.ReadSection(const Section: string;
-  Strings: TStrings);
+  Result:=FRegInifile.ReadInteger(Section, Name, Default);
+end;
+
+procedure TRegistryIniFile.ReadSection(const Section: string; Strings: TStrings);
 begin
   FRegIniFile.ReadSection(Section,strings);
 end;
@@ -623,60 +559,22 @@ end;
 
 function TRegistryIniFile.ReadString(const Section, Name,
   Default: string): string;
-var sectkey,curkey : HKey;  
 begin
-  with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              if ValueExists(Name) THen 
-                result:=FRegIniFile.ReadString(section,Name,default)
-              else
-                result:=default;
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-       else
-         result:=default; 
-    end;          
+  Result:=FRegInifile.ReadString(Section, Name, Default);
 end;
 
 function TRegistryIniFile.ReadTime(const Section, Name: string;
   Default: TDateTime): TDateTime;
-var sectkey,curkey : HKey;  
 begin
+  Result:=Default;
   with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              if ValueExists(Name) THen 
-                result:=FRegIniFile.ReadTime(Name)
-              else
-                result:=default;
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-       else
-         result:=default; 
-    end;          
+    if OpenSection(Section) then
+      try
+        if ValueExists(Name) then
+          Result:=FRegInifile.ReadTime(Name);
+      finally
+        CloseSection;
+      end;
 end;
 
 procedure TRegistryIniFile.UpdateFile;
@@ -692,146 +590,72 @@ end;
 
 procedure TRegistryIniFile.WriteDate(const Section, Name: string;
   Value: TDateTime);
-var sectkey,curkey : HKey;  
 begin
   with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              FRegIniFile.WriteDate(name,value)
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-    end;          
+    if OpenSection(Section) then
+      try
+        FRegInifile.WriteDate(Name, Value);
+      finally
+        CloseSection;
+      end;
 end;
 
 procedure TRegistryIniFile.WriteDateTime(const Section, Name: string;
   Value: TDateTime);
-var sectkey,curkey : HKey;  
 begin
   with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              FRegIniFile.WriteDateTime(Name,value)
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-    end;
+    if OpenSection(Section) then
+      try
+        FRegInifile.WriteDateTime(Name, Value);
+      finally
+        CloseSection;
+      end;
 end;
 
 procedure TRegistryIniFile.WriteFloat(const Section, Name: string;
   Value: Double);
-var sectkey,curkey : HKey;  
 begin
   with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              FRegIniFile.WriteFloat(Name,value)
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-    end;          
+    if OpenSection(Section) then
+      try
+        FRegInifile.WriteFloat(Name, Value);
+      finally
+        CloseSection;
+      end;
 end;
 
 procedure TRegistryIniFile.WriteInteger(const Section, Name: string;
   Value: Integer);
-var sectkey,curkey : HKey;  
 begin
-  with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              FRegIniFile.WriteInteger(section,Name,value)
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-    end;          
-
+  FRegInifile.WriteInteger(Section, Name, Value);
 end;
 
 procedure TRegistryIniFile.WriteString(const Section, Name, Value: String);
-var sectkey,curkey : HKey;  
 begin
-  with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin           
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;               
-            SetCurrentKey(sectKey);
-            try             // save current key
-              FRegIniFile.WriteString(section,Name,value)
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-    end;
+  FRegInifile.WriteString(Section, Name, Value);
 end;
 
 procedure TRegistryIniFile.WriteTime(const Section, Name: string;
   Value: TDateTime);
-var sectkey,curkey : HKey;
 begin
   with FRegInifile do
-    begin
-      sectkey:=getkey(Section);
-      if sectkey<>0 then
-        begin
-          try // allocation ok
-            curkey:=FRegIniFile.CurrentKey;
-            SetCurrentKey(sectKey);
-            try             // save current key
-              FRegIniFile.WriteTime(Name,value)
-            finally
-              SetCurrentKey(CurKey);
-              end;
-          finally
-            closekey(sectkey);
-            end;
-        end
-    end;
+    if OpenSection(Section) then
+      try
+        FRegInifile.WriteTime(Name, Value);
+      finally
+        CloseSection;
+      end;
+end;
+
+function TRegistryIniFile.ValueExists(const Section, Ident: string): Boolean;
+begin
+  with FRegInifile do
+    if OpenSection(Section) then
+      try
+        Result:=FRegInifile.ValueExists(Ident);
+      finally
+        CloseSection;
+      end;
 end;
 
 end.

packages/fcl-registry/src/winreg.inc

@@ -266,7 +266,7 @@ end;
 
 procedure TRegistry.CloseKey(key:HKEY);
 begin
-  RegCloseKey(CurrentKey)
+  RegCloseKey(key);
 end;
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: String);

packages/fcl-registry/tests/tregistry2.pp

@@ -7,7 +7,7 @@ procedure DoRegTest2;
 
 implementation
 
-uses Windows, SysUtils, registry;
+uses Windows, SysUtils, Classes, registry;
 
 const
   STestRegPath = 'Software\FPC-RegTest';
@@ -17,36 +17,95 @@ begin
   raise Exception.Create('Test FAILED. Error code: ' + IntToStr(ErrCode));
 end;
 
+procedure ClearReg;
+begin
+  with TRegistry.Create do
+    try
+      DeleteKey(STestRegPath + '\1');
+      DeleteKey(STestRegPath);
+    finally
+      Free;
+    end;
+end;
+
 procedure DoRegTest2;
 var
   reg: TRegistry;
-  k: HKEY;
+  ri: TRegIniFile;
+  rini: TRegistryIniFile;
+  sl: TStringList;
 begin
+  ClearReg;
   reg:=TRegistry.Create;
   try
     if not reg.OpenKey(STestRegPath, True) then
       TestFailed(1);
     if reg.CurrentPath <> STestRegPath then
       TestFailed(2);
-    k:=reg.CurrentKey;
+    reg.WriteString('Item1', '1');
     if not reg.OpenKey('\' + STestRegPath + '\1', True) then
       TestFailed(3);
-    if RegCloseKey(k) = 0 then
-      TestFailed(4);
+    reg.WriteString('Item2', '2');
     if reg.CurrentPath <> STestRegPath + '\1' then
       TestFailed(5);
     reg.CloseKey;
     if reg.CurrentPath <> '' then
       TestFailed(6);
-  finally
-    reg.Free;
-    with TRegistry.Create do
+
+    ri:=TRegIniFile.Create(STestRegPath);
+    with ri do
+    try
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(10);
+      if ReadString('1', 'Item2', '') <> '2' then
+        TestFailed(11);
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(12);
+      if not ValueExists('Item1') then
+        TestFailed(13);
+
+      WriteInteger('1', 'Item3', 3);
+
+      sl:=TStringList.Create;
       try
-        DeleteKey(STestRegPath + '\1');
-        DeleteKey(STestRegPath);
+        ReadSectionValues('1', sl);
+        if sl.Count <> 2 then
+          TestFailed(14);
+        if sl.Values['Item2'] <> '2' then
+          TestFailed(15);
+        if sl.Values['Item3'] <> '3' then
+          TestFailed(16);
       finally
-        Free;
+        sl.Free;
       end;
+
+      WriteInteger('', 'Item4', 4);
+      if  GetDataType('Item4') <> rdString then
+        TestFailed(17);
+    finally
+      Free;
+    end;
+
+    rini:=TRegistryIniFile.Create(STestRegPath);
+    with rini do
+    try
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(20);
+      if ReadString('1', 'Item2', '') <> '2' then
+        TestFailed(21);
+      if ReadString('', 'Item1', '') <> '1' then
+        TestFailed(22);
+      if not ValueExists('', 'Item4') then
+        TestFailed(23);
+      if not ValueExists('1', 'Item2') then
+        TestFailed(24);
+    finally
+      Free;
+    end;
+
+  finally
+    reg.Free;
+    ClearReg;
   end;
 end;