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

Info about active connections

Browse Source
This commit is contained in:
Ondrej Pokorny 2021-08-14 06:18:09 +02:00 committed by Michaël Van Canneyt
parent 52c00037d3
commit 7ccdcd3d14
1 changed files with 4 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
packages/fcl-web/examples/httpserver/threadedhttpserver.pas
View File

@ -13,6 +13,8 @@ Type
THTTPServer = class(TTestHTTPServer) THTTPServer = class(TTestHTTPServer)
protected protected
function CreateConnection(Data: TSocketStream): TFPHTTPConnection; override; function CreateConnection(Data: TSocketStream): TFPHTTPConnection; override;
public
Property ConnectionCount;
end; end;
TServerThread = class(TThread) TServerThread = class(TThread)
@ -53,7 +55,7 @@ begin
FServ.Threaded:=True; FServ.Threaded:=True;
FServ.Port:=8080; FServ.Port:=8080;
FServ.WriteInfo := @WriteInfo; FServ.WriteInfo := @WriteInfo;
FServ.AcceptIdleTimeout := 500; FServ.AcceptIdleTimeout := 1000;
FServ.OnAcceptIdle := @ServOnIdle; FServ.OnAcceptIdle := @ServOnIdle;
end; end;
@ -71,6 +73,7 @@ end;
procedure TServerThread.ServOnIdle(Sender: TObject); procedure TServerThread.ServOnIdle(Sender: TObject);
begin begin
WriteInfo('Active connections: '+IntToStr(FServ.ConnectionCount));
if Terminated then if Terminated then
FServ.Active := False; FServ.Active := False;
end; end;