I want to know the number of current client connections to an Indy 9 TIdTCPServer (on Delphi 2007)
I can't seem to find a property that gives this.
I've tried incrementing/decrementing a counter on the server OnConnect/OnDisconnect events, but the number never seems to decrement when a client disconnects.
Any suggestions?
The currently active clients are stored in the server's Threads
property, which is a TThreadList
. Simply lock the list, read its Count
property, and then unlock the list:
procedure TForm1.Button1Click(Sender: TObject);
var
NumClients: Integer;
begin
with IdTCPServer1.Threads.LockList do try
NumClients := Count;
finally
IdTCPServer1.Threads.UnlockList;
end;
ShowMessage('There are currently ' + IntToStr(NumClients) + ' client(s) connected');
end;
In Indy 10, the Threads
property was replaced with the Contexts
property:
procedure TForm1.Button1Click(Sender: TObject);
var
NumClients: Integer;
begin
with IdTCPServer1.Contexts.LockList do try
NumClients := Count;
finally
IdTCPServer1.Contexts.UnlockList;
end;
ShowMessage('There are currently ' + IntToStr(NumClients) + ' client(s) connected');
end;
Not sure why using OnConnect and OnDisconnect wouldn't work for you, but what we have done is to create a descendant of TIdCustomTCPServer; to override its DoConnect and DoDisconnect methods and create and use our own descendant of TIdServerContext (a thread descendant that will "serve" a connection).
You make the TIdCustomTCPServer aware of your own TIdServerContext class by:
(Edit Added conditional defines to show how to make it work for Indy9)
type
// Conditional defines so that we can use the same ancestors as in Indy10 and we
// can use the same method signatures for DoConnect and DoDisconnect regardless
// of the Indy version. Add other conditional defines as needed.
// Note: for INDY9 to be defined, you need to include the appropriate includes
// from Indy, or define it in your own include file.
{$IFDEF INDY9}
TIdContext = TIdPeerThread;
TIdServerContext = TIdContext;
TIdCustomTCPServer = TIdTCPServer;
{$ENDIF}
TOurContext = class(TIdServerContext)
private
FConnectionId: cardinal;
public
property ConnectionId: cardinal ...;
end;
...
constructor TOurServer.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
...
{$IFDEF INDY10_UP}
ContextClass := TOurContext;
{$ELSE}
ThreadClass := TOurContext;
{$ENDIF}
...
end;
In the DoConnect override of our TIdCustomTCPServer descendant we set the ConnectionID of our context class to a unique value:
procedure TOurServer.DoConnect(AContext: TIdContext);
var
OurContext: TOurContextabsolute AContext;
begin
Assert(AContext is TOurContext);
HandleGetNewConnectionID(OurContext, OurContext.FConnectionID);
inherited DoConnect(AContext);
...
end;
Our DoDisconnect override clears the ConnectionID:
procedure TOurServer.DoDisconnect(AContext: TIdContext);
var
OurContext: TOurContextabsolute AContext;
begin
Assert(AContext is TOurContext);
OurContext.FConnectionID := 0;
...
inherited DoDisconnect(AContext);
end;
Now it is possible to get a count of the current connections at any time:
function TOurServer.GetConnectionCount: Integer;
var
i: Integer;
CurrentContext: TOurContext;
ContextsList: TList;
begin
MyLock.BeginRead;
try
Result := 0;
if not Assigned(Contexts) then
Exit;
ContextsList := Contexts.LockList;
try
for i := 0 to ContextsList.Count - 1 do
begin
CurrentContext := ContextsList[i] as TOurContext;
if CurrentContext.ConnectionID > 0 then
Inc(Result);
end;
finally
Contexts.UnLockList;
end;
finally
MyLock.EndRead;
end;
end;
How about incrementing / decrementing a counter from OnExecute
(or DoExecute
if you override that)? That can't go wrong!
If you use InterlockedIncrement
and InterlockedDecrement
you don't even need a critical section to protect the counter.
This should work on Indy 9, but it is pretty outdated nowadays, and maybe something is broken in your version, try to update to the latest Indy 9 available.
I made a simple test using Indy 10, which works very well with a simple interlocked Increment/Decrement in the OnConnect/OnDisconnect event handlers. This is my code:
//closes and opens the server, which listens at port 1025, default values for all properties
procedure TForm2.Button1Click(Sender: TObject);
begin
IdTCPServer1.Active := not IdTCPServer1.Active;
UpdateUI;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
UpdateUI;
end;
//Just increment the count and update the UI
procedure TForm2.IdTCPServer1Connect(AContext: TIdContext);
begin
InterlockedIncrement(FClientCount);
TThread.Synchronize(nil, UpdateUI);
end;
//Just decrement the count and update the UI
procedure TForm2.IdTCPServer1Disconnect(AContext: TIdContext);
begin
InterlockedDecrement(FClientCount);
TThread.Synchronize(nil, UpdateUI);
end;
//Simple 'X' reply to any character, A is the "command" to exit
procedure TForm2.IdTCPServer1Execute(AContext: TIdContext);
begin
AContext.Connection.IOHandler.Writeln('Write anything, but A to exit');
while AContext.Connection.IOHandler.ReadByte <> 65 do
AContext.Connection.IOHandler.Write('X');
AContext.Connection.IOHandler.Writeln('');
AContext.Connection.IOHandler.Writeln('Good Bye');
AContext.Connection.Disconnect;
end;
//Label update with server status and count of connected clients
procedure TForm2.UpdateUI;
begin
Label1.Caption := Format('Server is %s, %d clients connected', [
IfThen(IdTCPServer1.Active, 'Open', 'Closed'), FClientCount]);
end;
then, opening a couple of clients with telnet:
then, closing one client
That's it.
INDY 10 is available for Delphi 2007, my main advise is to upgrade anyway.
来源:https://stackoverflow.com/questions/5513637/how-to-track-number-of-clients-with-indy-tidtcpserver