Не уверен, почему использование OnConnect и OnDisconnect не сработает для вас, но мы создали потомка TIdCustomTCPServer; переопределить его методы DoConnect и DoDisconnect и создать и использовать наш собственный потомок TIdServerContext (потомок потока, который будет «обслуживать» соединение).
Вы информируете TIdCustomTCPServer о своем собственном классе TIdServerContext следующим образом:
( Редактировать Добавлены условные определения, чтобы показать, как заставить его работать на 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;
В переопределении DoConnect нашего потомка TIdCustomTCPServer мы установили уникальному значению ConnectionID нашего контекстного класса:
procedure TOurServer.DoConnect(AContext: TIdContext);
var
OurContext: TOurContextabsolute AContext;
begin
Assert(AContext is TOurContext);
HandleGetNewConnectionID(OurContext, OurContext.FConnectionID);
inherited DoConnect(AContext);
...
end;
Наше переопределение DoDisconnect очищает ConnectionID:
procedure TOurServer.DoDisconnect(AContext: TIdContext);
var
OurContext: TOurContextabsolute AContext;
begin
Assert(AContext is TOurContext);
OurContext.FConnectionID := 0;
...
inherited DoDisconnect(AContext);
end;
Теперь можно получить количество текущих подключений в любое время:
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;