paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 22:14:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

Use InterlockedExchangeAdd to get ConnectionCount

Browse Source
This commit is contained in:
Ondrej Pokorny 2021-08-14 07:39:34 +02:00 committed by Michaël Van Canneyt
parent 7ccdcd3d14
commit 964a9839d1
1 changed files with 7 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
packages/fcl-web/src/base/fphttpserver.pp
View File

@ -139,6 +139,7 @@ Type
FUseSSL: Boolean; FUseSSL: Boolean;
procedure DoCreateClientHandler(Sender: TObject; out AHandler: TSocketHandler); procedure DoCreateClientHandler(Sender: TObject; out AHandler: TSocketHandler);
function GetActive: Boolean; function GetActive: Boolean;
function GetConnectionCount: Integer;
function GetHostName: string; function GetHostName: string;
procedure SetAcceptIdleTimeout(AValue: Cardinal); procedure SetAcceptIdleTimeout(AValue: Cardinal);
procedure SetActive(const AValue: Boolean); procedure SetActive(const AValue: Boolean);
@ -188,7 +189,7 @@ Type
// Called when a connection encounters an unexpected error. Will call OnRequestError when set. // Called when a connection encounters an unexpected error. Will call OnRequestError when set.
procedure HandleRequestError(Sender: TObject; E: Exception); virtual; procedure HandleRequestError(Sender: TObject; E: Exception); virtual;
// Connection count // Connection count
Property ConnectionCount : Integer Read FConnectionCount; Property ConnectionCount : Integer Read GetConnectionCount;
public public
Constructor Create(AOwner : TComponent); override; Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override; Destructor Destroy; override;
@ -684,6 +685,11 @@ begin
Result:=Assigned(FServer); Result:=Assigned(FServer);
end; end;
function TFPCustomHttpServer.GetConnectionCount: Integer;
begin
Result := InterlockedExchangeAdd(FConnectionCount, 0);
end;
procedure TFPCustomHttpServer.DoCreateClientHandler(Sender: TObject; out AHandler: TSocketHandler); procedure TFPCustomHttpServer.DoCreateClientHandler(Sender: TObject; out AHandler: TSocketHandler);
begin begin
AHandler:=GetSocketHandler(UseSSL); AHandler:=GetSocketHandler(UseSSL);