Как отследить количество клиентов с Indy TIdTCPServer - PullRequest
4 голосов
/ 01 апреля 2011

Я хочу узнать количество текущих клиентских подключений к Indy 9 TIdTCPServer (в Delphi 2007)

Я не могу найти свойство, которое дает это.

Я пытался увеличить / уменьшить счетчик на событиях OnConnect / OnDisconnect на сервере, но, кажется, число никогда не уменьшается при отключении клиента.

Есть предложения?

Ответы [ 4 ]

9 голосов
/ 02 апреля 2011

Активные в данный момент клиенты хранятся в свойстве 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;
4 голосов
/ 01 апреля 2011

Не уверен, почему использование 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;
3 голосов
/ 01 апреля 2011

Как насчет увеличения / уменьшения счетчика от OnExecute (или DoExecute, если вы переопределите это)? Это не может пойти не так!

Если вы используете InterlockedIncrement и InterlockedDecrement, вам даже не нужен критический участок для защиты счетчика.

2 голосов
/ 01 апреля 2011

Это должно работать на 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 connected clients

затем закрытие одного клиента

2 connected clients

Вот и все.

INDY 10 доступна для Delphi 2007, мой главный совет - все равно обновить.

...