Delphi 如何使用Indy TIdTCPServer跟踪客户端数量

我想知道Indy 9 TIdTCPServer的当前客户端连接数（在Delphi 2007上）

我似乎找不到一个能提供这个的属性

我尝试过在服务器上递增/递减connect/OnDisconnect事件的计数器，但当客户端断开连接时，计数器的数目似乎从未递减

---

有什么建议吗？

如何从

OnExecute

递增/递减计数器（或

DoExecute

，如果您覆盖它）？那不会错的

---

如果您使用

InterlockedIncrement

和

InterlockedIncrement

您甚至不需要一个关键部分来保护计数器。

不确定为什么使用OnConnect和OnDisconnect对您不起作用，但我们所做的是创建TIdCustomTCPServer的后代；重写其DoConnect和DoDisconnect方法，并创建和使用我们自己的TIdServerContext子体（一个将“服务”连接的线程子体）

您可以通过以下方式使TIdCustomTCPServer了解您自己的TIdServerContext类：

（编辑添加了条件定义，以显示如何使其适用于Indy9）

在TIdCustomTCPServer子代的DoConnect覆盖中，我们将上下文类的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;

---

这应该适用于Indy 9，但它现在已经过时了，也许你的版本有问题，请尝试更新到最新的Indy 9

我使用Indy 10做了一个简单的测试，它与OnConnect/OnDisconnect事件处理程序中的简单互锁递增/递减非常配合。这是我的代码：

//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;

//关闭并打开服务器，该服务器在端口1025侦听所有属性的默认值
程序TForm2.按钮1单击（发件人：ToObject）；
开始
IdTCPServer1.Active:=非IdTCPServer1.Active；
更新；
结束；
过程TForm2.FormCreate（发送方：TObject）；
开始
更新；
结束；
//只需增加计数并更新UI即可
过程TForm2.IdTCPServer1Connect（AContext:TIdContext）；
开始
联锁增量（FClientCount）；
同步（nil，UpdateUI）；
结束；
//只需减少计数并更新UI
过程TForm2.IdTCPServer1Disconnect（AContext:TIdContext）；
开始
联锁折旧（FClientCount）；
同步（nil，UpdateUI）；
结束；
//简单的“X”回复任何字符，A是退出的“命令”
过程TForm2.IdTCPServer1Execute（AContext:TIdContext）；
开始
AContext.Connection.IOHandler.Writeln（'Write anything，but A to exit'）；
而AContext.Connection.IOHandler.ReadByte 65执行
AContext.Connection.IOHandler.Write（'X'）；
AContext.Connection.IOHandler.Writeln（“”）；
AContext.Connection.IOHandler.Writeln（'再见'）；
AContext.Connection.Disconnect；
结束；
//带有服务器状态和已连接客户端计数的标签更新
程序TForm2.UpdateUI；
开始
标签1.标题：=格式（'服务器为%s，%d个已连接的客户端'[
IfThen（IdTCPServer1.Active，'Open'，'Closed'），FClientCount]）；
结束；

然后，使用telnet打开几个客户端：

然后，关闭一个客户端

就这样

---

INDY 10适用于Delphi 2007，我的主要建议是无论如何都要升级。

当前活动的客户端存储在服务器的

线程

属性中，该属性是

线程列表

。只需锁定列表，读取其

Count

属性，然后解锁列表：

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;

在Indy 10中，

线程

属性被

上下文

属性替换：

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;

---

设置Indy使用线程池时会发生什么？根据我所能确定的，TCP服务器实例化线程池中的线程数（Indy10中的上下文）。计算这些不会给你一个活跃用户的计数，而是一个实例化线程/上下文的计数…？谢谢Remy，这就是我想要的。我以前不知道如何从TThreadList获取TList。@Marjan:

线程

/

上下文

列表只包含当前活动（即连接到客户端）的线程/上下文。池完全在TIdTCPServer之外管理（它由

TIdThreadMgrPool

/

TIdSchedulerOfThreadPool

的实现来处理），因此池中的空闲线程/上下文不会对

计数产生影响。结果表明，我的onconnect/disconnect方法工作正常，但由于服务器中存在错误，他们没有正确退出。Doh。
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;