•  

ГлавнаяIndyЧастые вопросы по Indy → При подключении TIdTCPClient к TIdTCPServer, серверная начинает занимать большую часть процессорного времени

Создано: 17.05.2014 3:33:49 · Исправлено: 17.05.2014 3:33:49 · Прочтений: 2865

Есть проблема с Indy версии 10.1.5 (последняя версия с сайта на текущий момент).
Пишу приложение с использованием TIdTCPServer,TIdTCPClient компонентами под Turbo Delphi Explorer.
При подключении клиентской части к серверной, серверная начинает занимать большую часть процессорного времени (почти 100%, для одноядерного процессора :-), пока подключен клиент (а хочется, чтобы клиент был все время подключен, потому как их будет не один). При этом VCL окно, продолжает функционировать, сообщения windows выполняются, и вообще сама программа работает. VCL элементы сервера работают только через TIdSync.
Путем поиска в исходниках, где зависает программ, нашел что в модуле IdThread в методе
procedure TIdThread.Execute;
в месте:


try
          try
            BeforeRun;
            try
              if Loop then begin
                while not Stopped do begin
                  try
                  {ЗДЕСЬ}
                  {TUT}
                  sleep(1); //я добавил
                  {TUT}
                  {ЗДЕСЬ}
                    Run;
                  except
                    on E: Exception do begin
                      if not HandleRunException(E) then begin
                        Terminate;
                        raise;
                      end;
                    end;
                  end;
                end;


программа зацикливается (более детально не углублялся), достаточно хотя бы поставить один sleep, как нагрузка на процессор падает до нуля, при этом программа продолжает нормально работать.
В чем может быть проблема такого поведения? Это так и должно быть или я что-то не учитываю (особенно, учитывая то условие, что создаю компоненты в run-time (бесплатная лицензия не позволяет работать indy в designe-time) и не вижу каких-нибудь свойств TIdTCPServer, которые обычно меняют на другое, не default, значение :-)?

Приведу пример, который быстренько состряпал, в нем наблюдается такой же эффект. В примере создается сервер и клиент, имеется две кнопки, два edit, одна из кнопкок посылает текст одного из edit от сервера к клиенту, а другая наоборот. Даже не посылая сообщения программа загружает процессор по максимуму, пока подключен клиент:

unit ExampleUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,IdTCPServer, StdCtrls,IdContext, IdSync,IdTCPClient, ExtCtrls;

type
  TMainForm = class(TForm)
    SendServerToClient: TButton;
    SendClientToServer: TButton;
    EditServerText: TEdit;
    EditClientText: TEdit;
    MemoLog: TMemo;
    TimerReadClient: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerReadClientTimer(Sender: TObject);
    procedure SendServerToClientClick(Sender: TObject);
    procedure SendClientToServerClick(Sender: TObject);
  private
    { Private declarations }
  public
  IdTCPSrv: TIdTCPServer;
  IdTCPClient:TIdTCPClient;
  procedure IdTCPServerExecute(AContext: TIdContext);
  procedure IdTCPServerConnect(AContext: TIdContext);
  procedure IdTCPServerDisconnect(AContext: TIdContext);
    { Public declarations }
  end;

TClientsListSync = class(TIdSync)
  protected
    FContext:TIdContext;
    procedure DoSynchronize; override;
  public
    constructor Create(const AContext: TIdContext); reintroduce;
    class procedure Add(const AContext: TIdContext);
end;

TClientsListDisconnectSync = class(TIdSync)
  protected
    FContext:TIdContext;
    procedure DoSynchronize; override;
  public
    constructor Create(const AContext: TIdContext); reintroduce;
    class procedure Add(const AContext: TIdContext);
end;

var
  MainForm: TMainForm;


implementation

uses IdIOHandler;

{$R *.dfm}

//для лога
constructor TClientsListSync.Create(const AContext: TIdContext);
begin
inherited Create;
FContext := AContext;
end;

procedure TClientsListSync.DoSynchronize;
begin
Mainform.MemoLog.lines.Add(Подключился... +FContext.Connection.Socket.Binding.PeerIP);
end;

class procedure TClientsListSync.Add(const AContext: TIdContext);
begin
with Create(AContext) do try
  Synchronize;
finally
  Free;
end;
end;

constructor TClientsListDisconnectSync.Create(const AContext: TIdContext);
begin
inherited Create;
FContext := AContext;
end;

procedure TClientsListDisconnectSync.DoSynchronize;
begin
Mainform.MemoLog.lines.Add(Отключился... +FContext.Connection.Socket.Binding.PeerIP);
end;

class procedure TClientsListDisconnectSync.Add(const AContext: TIdContext);
begin
with Create(AContext) do try
Synchronize;
finally
Free;
end;
end;

//общая часть
procedure TMainForm.FormCreate(Sender: TObject);
begin
  //создание и запуск сервера
IdTCPSrv:=TIdTCPServer.Create;
  //событие подключения клиента
IdTCPSrv.OnConnect:=IdTCPServerConnect;
  //событие подлуения данных от клиента
IdTCPSrv.OnExecute:=IdTCPServerExecute;
  //событие отключения клиента
IdTCPSrv.OnDisconnect:=IdTCPServerDisconnect;
IdTCPSrv.DefaultPort:=7755;
IdTCPSrv.Active:=true;
  //создание и подключение клиента
IdTCPClient:=TIdTCPClient.Create;
IdTCPClient.Host:=localhost;
IdTCPClient.Port:=7755;
IdTCPClient.Connect;
  //таймер проверяет буфер клиента на наличие в нем данных
TimerReadClient.Enabled:=false;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
var
  List: TList;
  i: Integer;
begin
TimerReadClient.Enabled:=false;
if IdTCPClient.Connected then
  IdTCPClient.Disconnect;
IdTCPClient.Free;

try
  List := IdTCPSrv.Contexts.LockList;
  for i := 0 to List.Count - 1 do
  begin
    TIdContext(List.Items[i]).Connection.Socket.Close;
  end;
finally
IdTCPSrv.Contexts.UnlockList;
IdTCPSrv.Active := False;
IdTCPSrv.Bindings.Clear;
end;
IdTCPSrv.Free;
end;

  //серверная часть
procedure TMainForm.SendServerToClientClick(Sender: TObject);
var cList:TList;
    i:integer;
begin
  //отправить всем подключенным клиентам сообщение
cList:=IdTCPSrv.Contexts.LockList;
try
  for i := 0 to cList.Count -1 do
    begin
    TIdContext(cList[i]).Connection.IOHandler.Write(length(EditServerText.Text));
    TIdContext(cList[i]).Connection.IOHandler.Write(EditServerText.Text);
    end;
finally
  IdTCPSrv.Contexts.UnlockList;
end;
end;

procedure TMainForm.IdTCPServerConnect(AContext: TIdContext);
begin
  //при подключении
TClientsListSync.Add(AContext);
end;

procedure TMainForm.IdTCPServerDisconnect(AContext: TIdContext);
begin
  //при отключении
TClientsListDisconnectSync.Add(AContext);
end;

procedure TMainForm.IdTCPServerExecute(AContext: TIdContext);
var sz:integer;
    len:integer;
    s:string;
begin
  //событие при получении данных от клиента
AContext.Connection.IOHandler.CheckForDisconnect(True, True);
sz := AContext.Connection.IOHandler.InputBuffer.Size;
if sz>0 then
  begin
  len:=AContext.Connection.IOHandler.ReadInteger;
  s:=AContext.Connection.IOHandler.ReadString(len);
  EditServerText.Text:=s;
  end;
end;

{XXXXXXXXXXXXXXXXXXXXXXXXX}

  //клиентская часть
procedure TMainForm.SendClientToServerClick(Sender: TObject);
begin
  //послать сообщение серверу
if IdTCPClient.Connected then
  begin
  IdTCPClient.IOHandler.Write(integer(length(EditClientText.Text)));
  IdTCPClient.IOHandler.Write(EditClientText.Text);
  end;
end;

procedure TMainForm.TimerReadClientTimer(Sender: TObject);
var sz:integer;
    len:integer;
    s:string;
begin
  //с периодичностью 1000 мс проверяем, есть ли данные
if IdTCPClient.Connected then
  begin
  sz:=IdTCPClient.IOHandler.InputBuffer.Size;
  if sz>0 then
    begin
    len:=IdTCPClient.IOHandler.ReadInteger;
    s:=IdTCPClient.IOHandler.ReadString(len);
    EditClientText.Text:=s;
    end;
  end;
end;

end.



Исходный текст примера _ttp://ifolder.ru/7173563 (5кб)

В чем проблема такого поведения?

И еще при отключении сервера, необходимо отключить клиентов, если это не сделать сервер виснет (Ответ на вопрос »вопрос КС №46801«), но этот совет не всегда срабатывает. Почему?
Совет. Если у вас будет очень много подлючений висеть на сервере больше 500, то советую обратиться в сторону концепции работы MMORPG серверов.
Из любопытства посмотрю, хотя подключений планируется раза в четыре меньше.
Но вопрос даже не про множество подключений, а про поведение TIdTCPServer с хотя бы одним подключением.
По поводу Sleep в потоке - надавно в очередной раз обсуждалось
Это в принципе понятно.
Не понятно тогда вот что:
Т.е. у всех кто пользуется TIdTCPServer такое поведение и авторы Indy используя поток не особо задумывались, что у них имеется непрерывный цикл, который занимает весь процессор? :-)