TCP-сервер без события OnExecute - PullRequest
4 голосов
/ 17 февраля 2012

Я хочу создать TCP-сервер и отправлять / получать сообщения клиентам при необходимости , а не событие OnExecute TCPserver.

Отправить / получить сообщение не проблема;Мне это нравится:

procedure TFormMain.SendMessage(IP, Msg: string);
var
  I: Integer;
begin
  with TCPServer.Contexts.LockList do
  try
    for I := 0 to Count-1 do
      if TIdContext(Items[I]).Connection.Socket.Binding.PeerIP = IP then
      begin
        TIdContext(Items[I]).Connection.IOHandler.WriteBuffer(Msg[1], Length(Msg));
        //  and/or Read 
        Break;
      end;
  finally
    TCPServer.Contexts.UnlockList;
  end;
end;

Примечание 1: Если я не использую OnExecute, программа вызывает исключение при подключении клиента.
Примечание 2: Если я использую OnExecute без каких-либо действий,Загрузка ЦП достигает% 100
Примечание 3: У меня нет возможности сменить клиентов TCP.

Так что мне делать?

Ответы [ 5 ]

7 голосов
/ 18 февраля 2012

TIdTCPServer требуется обработчик событий OnExecute, назначенный по умолчанию. Чтобы обойти это, вам нужно извлечь новый класс из TIdTCPServer и переопределить его виртуальный метод CheckOkToBeActive(), а также переопределить виртуальный DoExecute() для вызова Sleep(). В противном случае просто назначьте обработчик события и вызовите его Sleep().

Однако это неэффективное использование TIdTCPServer. Лучшее решение - не записывать исходящие данные клиентам изнутри вашего метода SendMessage() напрямую. Он не только подвержен ошибкам (вы не перехватываете исключения из WriteBuffer()) и блокирует SendMessage() во время записи, но также сериализует ваши сообщения (клиент 2 не может получать данные, пока клиент 1 не сделает первый). Гораздо более эффективный способ - предоставить каждому клиенту свою собственную потокобезопасную исходящую очередь, а затем SendMessage() поместить данные в очередь каждого клиента по мере необходимости. Затем вы можете использовать событие OnExecute, чтобы проверить очередь каждого клиента и выполнить фактическую запись. Таким образом, SendMessage() больше не блокируется, менее подвержен ошибкам, и клиенты могут записываться параллельно (как и должно быть).

Попробуйте что-то вроде этого:

uses
  ..., IdThreadSafe;

type
  TMyContext = class(TIdServerContext)
  private
    FQueue: TIdThreadSafeStringList;
    FEvent: TEvent;
  public
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
    destructor Destroy; override;
    procedure AddMsgToQueue(const Msg: String);
    function GetQueuedMsgs: TStrings;
  end;

constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited;
  FQueue := TIdThreadSafeStringList.Create;
  FEvent := TEvent.Create(nil, True, False, '');
end;

destructor TMyContext.Destroy;
begin
  FQueue.Free;
  FEvent.Free;
  inherited;
end;

procedure TMyContext.AddMsgToQueue(const Msg: String);
begin
  with FQueue.Lock do
  try
    Add(Msg);
    FEvent.SetEvent;
  finally
    FQueue.Unlock;
  end;
end;

function TMyContext.GetQueuedMsgs: TStrings;
var
  List: TStringList;
begin
  Result := nil;
  if FEvent.WaitFor(1000) <> wrSignaled then Exit;
  List := FQueue.Lock;
  try
    if List.Count > 0 then
    begin
      Result := TStringList.Create;
      try
        Result.Assign(List);
        List.Clear;
      except
        Result.Free;
        raise;
      end;
    end;
    FEvent.ResetEvent;
  finally
    FQueue.Unlock;
  end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  TCPServer.ContextClass := TMyContext;
end; 

procedure TFormMain.TCPServerExecute(AContext: TIdContext);
var
  List: TStrings;
  I: Integer;
begin
  List := TMyContext(AContext).GetQueuedMsgs;
  if List = nil then Exit;
  try
    for I := 0 to List.Count-1 do
      AContext.Connection.IOHandler.Write(List[I]);
  finally
    List.Free;
  end;
end;

procedure TFormMain.SendMessage(const IP, Msg: string); 
var 
  I: Integer; 
begin 
  with TCPServer.Contexts.LockList do 
  try 
    for I := 0 to Count-1 do 
    begin
      with TMyContext(Items[I]) do
      begin
        if Binding.PeerIP = IP then 
        begin 
          AddMsgToQueue(Msg); 
          Break; 
        end;
      end; 
    end;
  finally 
    TCPServer.Contexts.UnlockList; 
  end; 
end; 
4 голосов
/ 17 февраля 2012

Используйте OnExecute и, если вам нечего делать, Sleep () на некоторое время, скажем, 10 миллисекунд. Каждое соединение имеет свой собственный обработчик OnExecute, так что это повлияет только на каждое отдельное соединение.

1 голос
/ 28 мая 2012

У меня была похожая ситуация с загрузкой 100% процессора, и она была решена добавлением IdThreadComponent и:

void __fastcall TForm3::IdThreadComponent1Run(TIdThreadComponent *Sender)
{
    Sleep(10);
}

Это правильно? Я не уверен.

1 голос
/ 17 февраля 2012

В обработчике OnExecute вы можете использовать методы связи потоков, такие как TEvent и TMonitor, для ожидания получения данных для клиента.

TMonitor доступен с Delphi 2009 и предоставляет методы (Wait, Pulse и PulseAll) для отправки / получения уведомлений с минимальным использованием ЦП.

1 голос
/ 17 февраля 2012

Компонент Indy предназначен для эмуляции блокирования операции с сетевым подключением. Вы должны инкапсулировать весь свой код в обработчик событий OnExecute. Предполагается, что это будет проще , потому что большинство протоколов блокируются любым способом (команда отправки, ожидание ответа и т. Д.).

Вам, видимо, не нравится его режим работы, вам нужно что-то, что работает без блокировки. Вам следует подумать об использовании набора компонентов, который разработан так, как вы намереваетесь его использовать: попробуйте пакет ICS ! ICS не использует потоки, вся работа выполняется в обработчиках событий.

...