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

发布于 2024-10-28 22:12:30 字数 175 浏览 4 评论 0原文

我想知道当前客户端连接到 Indy 9 TIdTCPServer(在 Delphi 2007 上)的数量,

我似乎找不到提供此信息的属性。

我尝试在服务器 OnConnect/OnDisconnect 事件上增加/减少计数器,但当客户端断开连接时,该数字似乎永远不会减少。

有什么建议吗?

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?

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(4

新雨望断虹 2024-11-04 22:12:30

当前活动的客户端存储在服务器的 Threads 属性中,该属性是一个 TThreadList。只需锁定列表,读取其 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 中,Threads 属性已替换为 Contexts 属性:

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;

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;
枕头说它不想醒 2024-11-04 22:12:30

不确定为什么使用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;

在我们的tidcustomtcpserver descondant的doconnect覆盖中对于一个独特的价值:

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;

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;
人间不值得 2024-11-04 22:12:30

如何从 OnExecute (或 DoExecute 如果您覆盖它)增加/减少计数器?那不会出错的!

如果您使用InterlockedincrementInterlockedDecrement您甚至不需要关键部分来保护计数器。

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.

戴着白色围巾的女孩 2024-11-04 22:12:30

这应该适用于 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;

然后,使用 telnet 打开几个客户端:

3 连接的客户端

然后,关闭一个客户端

2 个已连接的客户端

就是这样。

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

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:

3 connected clients

then, closing one client

2 connected clients

That's it.

INDY 10 is available for Delphi 2007, my main advise is to upgrade anyway.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文