--- Merging r22653 into '.':

U    packages/fcl-registry/tests/testbasics.pp
U    packages/fcl-registry/tests/tregistry2.pp
U    packages/fcl-registry/src/winreg.inc
--- Merging r22654 into '.':
G    packages/fcl-registry/tests/tregistry2.pp
G    packages/fcl-registry/src/winreg.inc
U    packages/fcl-registry/src/regini.inc
U    packages/fcl-registry/src/registry.pp
--- Merging r23233 into '.':
U    rtl/os2/system.pas
U    rtl/os2/systhrd.inc
--- Merging r23237 into '.':
U    packages/fcl-net/src/ssockets.pp
--- Merging r23247 into '.':
U    packages/fcl-base/examples/testtimer.pp
U    packages/fcl-base/src/fptimer.pp
--- Merging r23252 into '.':
U    packages/fcl-base/src/contnrs.pp

# revisions: 22653,22654,23233,23237,23247,23252,
r22653 | yury | 2012-10-15 13:27:59 +0200 (Mon, 15 Oct 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-registry/src/winreg.inc
   M /trunk/packages/fcl-registry/tests/testbasics.pp
   M /trunk/packages/fcl-registry/tests/tregistry2.pp

* Clear CurrentPath when closing registry.
* Delete test registry keys.
r22654 | yury | 2012-10-15 14:43:14 +0200 (Mon, 15 Oct 2012) | 3 lines
Changed paths:
   M /trunk/packages/fcl-registry/src/regini.inc
   M /trunk/packages/fcl-registry/src/registry.pp
   M /trunk/packages/fcl-registry/src/winreg.inc
   M /trunk/packages/fcl-registry/tests/tregistry2.pp

* Make TRegIniFile Delphi compatible.
* Fix completely broken TRegistryIniFile.
+ Tests.
r23233 | hajny | 2012-12-27 23:23:03 +0100 (Thu, 27 Dec 2012) | 1 line
Changed paths:
   M /trunk/rtl/os2/system.pas
   M /trunk/rtl/os2/systhrd.inc

  * GetCPUCount implementation for OS/2 added
r23237 | michael | 2012-12-28 12:28:08 +0100 (Fri, 28 Dec 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-net/src/ssockets.pp

* Implemented some server socket options
r23247 | michael | 2012-12-29 10:58:12 +0100 (Sat, 29 Dec 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/examples/testtimer.pp
   M /trunk/packages/fcl-base/src/fptimer.pp

* Fixed bug ID #23444, improved example to show elapsed time
r23252 | michael | 2012-12-29 16:35:02 +0100 (Sat, 29 Dec 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/contnrs.pp

* TFPHashlist.Pack now also reclaims unused string memory

git-svn-id: branches/fixes_2_6@23653 -

packages/fcl-base/examples/testtimer.pp

@@ -14,6 +14,7 @@ Type
     FTimer : TFPTimer;
     FCount : Integer;
     FTick : Integer;
+    N : TDateTime;
   Public  
     Procedure DoRun; override;
     Procedure DoTick(Sender : TObject);
@@ -29,11 +30,12 @@ begin
   Try
     FTick:=0;
     FCount:=0;
+    N:=Now;
     While (FCount<10) do
       begin
       Inc(FTick);
-      CheckSynchronize; // Needed, because we are not running in a GUI loop.
       Sleep(1);
+      CheckSynchronize; // Needed, because we are not running in a GUI loop.
       end;
   Finally
     FTimer.Enabled:=False;
@@ -44,10 +46,15 @@ end;
 
 Procedure TTestTimerApp.DoTick(Sender : TObject);
 
+Var
+  D : TDateTime;
+
 begin
   Inc(FCount);
-  Writeln('Received timer event ',FCount,' after ',FTick,' ticks.');
+  D:=Now-N;
+  Writeln('Received timer event ',FCount,' after ',FTick,' ticks. (Elapsed time: ',FormatDateTime('ss.zzz',D),')');
   FTick:=0;
+  N:=Now;
 end;
         
 

packages/fcl-base/src/contnrs.pp

@@ -1559,20 +1559,31 @@ var
   i : integer;
   pdest,
   psrc : PHashItem;
+  FOldStr : Pchar;
+
 begin
   NewCount:=0;
   psrc:=@FHashList^[0];
-  pdest:=psrc;
-  For I:=0 To FCount-1 Do
-    begin
-      if assigned(psrc^.Data) then
-        begin
-          pdest^:=psrc^;
-          inc(pdest);
-          inc(NewCount);
-        end;
-      inc(psrc);
-    end;
+  FOldStr:=FStrs;
+  try
+    FStrs:=Nil;
+    FStrCount:=0;
+    FStrCapacity:=0;
+    pdest:=psrc;
+    For I:=0 To FCount-1 Do
+      begin
+        if assigned(psrc^.Data) then
+          begin
+            pdest^:=psrc^;
+            Pdest^.strindex:=AddStr(PShortString(@FOldStr[PDest^.StrIndex])^);
+            inc(pdest);
+            inc(NewCount);
+          end;
+        inc(psrc);
+      end;
+  finally
+    FreeMem(FoldStr);
+  end;
   FCount:=NewCount;
   { We need to ReHash to update the IndexNext }
   ReHash;

packages/fcl-base/src/fptimer.pp

@@ -216,7 +216,7 @@ end;
 procedure TFPTimerThread.Execute;
 var
   SleepTime: Integer;
-  Last: Cardinal;
+  S,Last: Cardinal;
   T : TFPCustomTimer;
   
 begin
@@ -229,9 +229,15 @@ begin
       SleepTime := T.FInterval - (_GetTickCount - Last);
       if SleepTime < 10 then
         SleepTime := 10;
-      Sleep(SleepTime);
+      Repeat  
+        S:=5;
+        If S>SleepTime then
+          S:=SleepTime;
+        Sleep(S);
+        Dec(Sleeptime,S);
+      until (SleepTime<=0) or Terminated;
       T:=Timer;
-      If Assigned(T) then
+      If Assigned(T) and not terminated then
         Synchronize(@T.Timer);
       end
     else

packages/fcl-net/src/ssockets.pp

@@ -18,7 +18,7 @@ unit ssockets;
 interface
 
 uses
- SysUtils, Classes, sockets;
+ SysUtils, Classes, ctypes, sockets;
 
 type
 
@@ -40,11 +40,15 @@ type
     constructor Create(ACode: TSocketErrorType; const MsgArgs: array of const);
   end;
 
+  { TSocketStream }
+
   TSocketStream = class(THandleStream)
   Private
+    FReadFlags: Integer;
     FSocketInitialized : Boolean;
     FSocketOptions : TSocketOptions;
     FLastError : integer;
+    FWriteFlags: Integer;
     Procedure GetSockOptions;
     Procedure SetSocketOptions(Value : TSocketOptions);
     function GetLocalAddress: TSockAddr;
@@ -60,6 +64,8 @@ type
     property LocalAddress: TSockAddr read GetLocalAddress;
     property RemoteAddress: TSockAddr read GetRemoteAddress;
     Property LastError : Integer Read FLastError;
+    Property ReadFlags : Integer Read FReadFlags Write FReadFlags;
+    Property WriteFlags : Integer Read FWriteFlags Write FWriteFlags;
   end;
 
   TConnectEvent = Procedure (Sender : TObject; Data : TSocketStream) Of Object;
@@ -79,6 +85,12 @@ type
     FOnConnect : TConnectEvent;
     FOnConnectQuery : TConnectQuery;
     Procedure DoOnIdle;
+    Function GetReuseAddress: Boolean;
+    Function GetKeepAlive : Boolean;
+    Function GetLinger : Integer;
+    Procedure SetReuseAddress (AValue : Boolean);
+    Procedure SetKeepAlive (AValue : Boolean);
+    Procedure SetLinger(ALinger : Integer);
   Protected
     FSockType : Longint;
     FBound : Boolean;
@@ -93,6 +105,8 @@ type
     Constructor Create(ASocket : Longint);
     Destructor Destroy; Override;
     Procedure Listen;
+    function  GetSockopt(ALevel,AOptName : cint; var optval; Var optlen : tsocklen): Boolean;
+    function  SetSockopt(ALevel,AOptName : cint; var optval; optlen : tsocklen): Boolean;
     Procedure StartAccepting;
     Procedure StopAccepting;
     Procedure SetNonBlocking;
@@ -105,6 +119,10 @@ type
     Property NonBlocking : Boolean Read FNonBlocking;
     Property Socket : Longint Read FSocket;
     Property SockType : Longint Read FSockType;
+    Property KeepAlive : Boolean Read GetKeepAlive Write SetKeepAlive;
+    Property ReuseAddress : Boolean Read GetReuseAddress Write SetReuseAddress;
+    // -1 means no linger. Any value >=0 sets linger on.
+    Property Linger: Integer Read GetLinger Write Setlinger;
   end;
 
   { TInetServer }
@@ -258,7 +276,7 @@ Var
   Flags : longint;
 
 begin
-  Flags:=0;
+  Flags:=FReadFlags;
   Result:=fprecv(handle,@Buffer,count,flags);
   If Result<0 then
     FLastError:=SocketError
@@ -272,7 +290,7 @@ Var
   Flags : longint;
 
 begin
-  Flags:=0;
+  Flags:=FWriteFlags;
   Result:=fpsend(handle,@Buffer,count,flags);
   If Result<0 then
     FLastError:=SocketError
@@ -339,6 +357,18 @@ begin
     Raise ESocketError.Create(seListenFailed,[FSocket,SocketError]);
 end;
 
+function TSocketServer.GetSockopt(ALevel, AOptName: cint; Var optval;
+  var optlen: tsocklen): Boolean;
+begin
+  Result:=fpGetSockOpt(FSocket,ALevel,AOptName,@optval,@optlen)<>-1;
+end;
+
+function TSocketServer.SetSockopt(ALevel, AOptName: cint; var optval;
+  optlen: tsocklen): Boolean;
+begin
+  Result:=fpSetSockOpt(FSocket,ALevel,AOptName,@optval,optlen)<>-1;
+end;
+
 Function TSocketServer.GetConnection : TSocketStream;
 
 var
@@ -401,6 +431,55 @@ begin
     FOnIdle(Self);
 end;
 
+function TSocketServer.GetReuseAddress: Boolean;
+Var
+  L : cint;
+  ls : Tsocklen;
+begin
+  L:=0;
+  ls:=0;
+{$IFDEF UNIX}
+  if not GetSockOpt(SOL_SOCKET, SO_REUSEADDR, L, LS) then
+    Raise ESocketError.CreateFmt('Failed to get SO_REUSEADDR to %d: %d',[l,socketerror]);
+  Result:=(L<>0);
+{$ELSE}
+  Result:=True;
+{$ENDIF}
+
+end;
+
+function TSocketServer.GetKeepAlive: Boolean;
+Var
+  L : cint;
+  ls : Tsocklen;
+begin
+  L:=0;
+  ls:=0;
+{$IFDEF UNIX}
+  if Not GetSockOpt(SOL_SOCKET, SO_KEEPALIVE, L, LS) then
+    Raise ESocketError.CreateFmt('Failed to get SO_KEEPALIVE: %d',[socketerror]);
+  Result:=(L<>0);
+{$ELSE}
+  Result:=True;
+{$ENDIF}
+end;
+
+function TSocketServer.GetLinger: Integer;
+Var
+  L : linger;
+  ls : tsocklen;
+
+begin
+  L.l_onoff:=0;
+  l.l_linger:=0;
+  if Not GetSockOpt(SOL_SOCKET, SO_LINGER, l, ls) then
+    Raise ESocketError.CreateFmt('Failed to set linger: %d',[socketerror]);
+  if l.l_onoff=0 then
+    Result:=-1
+  else
+    Result:=l.l_linger;
+end;
+
 Procedure TSocketServer.DoConnect(ASocket : TSocketStream);
 
 begin
@@ -425,6 +504,41 @@ begin
   FNonBlocking:=True;
 end;
 
+procedure TSocketServer.SetLinger(ALinger: Integer);
+Var
+  L : linger;
+begin
+  L.l_onoff:=Ord(ALinger>0);
+  if ALinger<0 then
+    l.l_linger:=ALinger
+  else
+    l.l_linger:=0;
+  if Not SetSockOpt(SOL_SOCKET, SO_LINGER, l, SizeOf(L)) then
+    Raise ESocketError.CreateFmt('Failed to set linger: %d',[socketerror]);
+end;
+
+procedure TSocketServer.SetReuseAddress(AValue: Boolean);
+Var
+  L : cint;
+begin
+  L:=Ord(AValue);
+{$IFDEF UNIX}
+  if not SetSockOpt(SOL_SOCKET, SO_REUSEADDR , L, SizeOf(L)) then
+    Raise ESocketError.CreateFmt('Failed to set SO_REUSEADDR to %d: %d',[l,socketerror]);
+{$ENDIF}
+end;
+
+procedure TSocketServer.SetKeepAlive(AValue: Boolean);
+Var
+  L : cint;
+begin
+  L:=Ord(AValue);
+{$IFDEF UNIX}
+  if Not SetSockOpt(SOL_SOCKET, SO_KEEPALIVE, L, SizeOf(L)) then
+    Raise ESocketError.CreateFmt('Failed to set SO_REUSEADDR to %d: %d',[l,socketerror]);
+{$ENDIF}
+end;
+
 { ---------------------------------------------------------------------
     TInetServer
   ---------------------------------------------------------------------}

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

@@ -134,6 +134,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;
@@ -187,6 +191,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;
 
@@ -489,122 +494,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;
@@ -622,60 +558,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;
@@ -691,146 +589,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

@@ -260,12 +260,13 @@ begin
     else
       RegFlushKey(CurrentKey);
     fCurrentKey:=0;
-    end
+    end;
+  fCurrentPath:='';
 end;
 
 procedure TRegistry.CloseKey(key:HKEY);
 begin
-  RegCloseKey(CurrentKey)
+  RegCloseKey(key);
 end;
 
 procedure TRegistry.ChangeKey(Value: HKey; const Path: String);

packages/fcl-registry/tests/testbasics.pp

@@ -42,7 +42,14 @@ var
   fn: string;
 {$endif}
 begin
-{$ifndef windows}
+{$ifdef windows}
+  with TRegistry.Create do
+    try
+      DeleteKey('FirstNode');
+    finally
+      Free;
+    end;
+{$else}
   FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml';
   if FileExists(FN) then
     AssertTrue(DeleteFile(FN));
@@ -70,7 +77,7 @@ begin
   DeleteUserXmlFile;
   with TRegistry.Create do
     try
-      OpenKey('test', true);
+      OpenKey('FirstNode', true);
       WriteString('LAYOUT', '');
       CloseKey;
     finally
@@ -78,7 +85,7 @@ begin
     end;
   with TRegistry.Create do
     try
-      OpenKey('test', true);
+      OpenKey('FirstNode', true);
       WriteString('LAYOUT', '');
       CloseKey;
     finally
@@ -155,3 +162,4 @@ end;
 initialization
   RegisterTest(TTestBasics);
 end.
+

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,26 +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);
+
+    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
+        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
+        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;
 

rtl/os2/system.pas

@@ -28,6 +28,7 @@ interface
 
 {$DEFINE OS2EXCEPTIONS}
 {$define DISABLE_NO_THREAD_MANAGER}
+{$DEFINE HAS_GETCPUCOUNT}
 
 {$I systemh.inc}
 

rtl/os2/systhrd.inc

@@ -170,6 +170,10 @@ function DosQuerySysState (EntityList, EntityLevel, PID, TID: cardinal;
                                 var Buffer; BufLen: cardinal): cardinal; cdecl;
                                                  external 'DOSCALLS' index 368;
 
+function DosQuerySysInfo (First, Last: cardinal; var Buf; BufSize: cardinal):
+                                                               cardinal; cdecl;
+                                                 external 'DOSCALLS' index 348;
+
 
 
 {*****************************************************************************
@@ -707,6 +711,19 @@ begin
 end;
 
 
+{$DEFINE HAS_GETCPUCOUNT}
+function GetCPUCount: LongWord;
+const
+  svNumProcessors = 26;
+var
+  ProcNum: cardinal;
+begin
+  GetCPUCount := 1;
+  if DosQuerySysInfo (svNumProcessors, svNumProcessors, ProcNum,
+                                                     SizeOf (ProcNum)) = 0 then
+   GetCPUCount := ProcNum;
+end;
+
 
 var
   OS2ThreadManager: TThreadManager;