networking - 当 OnConnect 事件与 Lazarus 中另一个表单的 TTabControls 选项卡交互时，在 Indy10 上运行的服务器进程部分停止响应

Question

试图在标题中描述我的大部分问题，我基本上做到了。

基本上，我在 Lazarus 中使用 Indy 10 制作了自己的小型 TCP 服务器。它所做的只是接受字节形式的数据包，这些数据包包含代表英文字母的某个 char 。我正在使用 Context 的 IOHandler 读取这些字节，如下所示:

procedure TServerSideForm.OnExecuteServer(Context: TIdContext);
var
  IO: TIdIOHandler;
  keyPressed: char;
begin
  //
  IO := Context.Connection.IOHandler;

  if not(IO.InputBufferIsEmpty) then
  begin
    LogForm.LogToForm('Recieving a packet from ' + Context.Binding.IP + '(' + Context.Binding.PeerIP + ')');

    keyPressed := IO.ReadChar;
    AddKeyToAppropriateClient(keyPressed, Context.Binding.IP);
  end;

  IndySleep(10);
  //
end; 

这很完美。

但是，我有另一种形式，其中有一个 TTabControl，它为连接到我的服务器的每个用户都有一个选项卡，还有一个 TMemo每个选项卡。选项卡和备忘录是在运行时创建的，执行此操作的函数不会抛出任何异常。

这是我的其他表单中的 AddTab() 函数的样子(用于创建上述选项卡和备忘录):

procedure TConnectionsForm.AddTab(IP: string);
var
  newMemo: TMemo;
begin
  ConnectionTabs.Tabs.Add(IP);
  currTabIndx := ConnectionTabs.TabIndex;

  newMemo := TMemo.Create(ConnectionsForm);

  newMemo.AnchorSide[akTop].Side:=asrTop;
  newMemo.AnchorSide[akTop].Control:=ConnectionTabs;
  newMemo.BorderSpacing.Top:=2;

  newMemo.AnchorSide[akBottom].Side:=asrBottom;
  newMemo.AnchorSide[akBottom].Control:=ConnectionTabs;
  newMemo.BorderSpacing.Bottom:=2;

  newMemo.AnchorSide[akLeft].Side:=asrLeft;
  newMemo.AnchorSide[akLeft].Control:=ConnectionTabs;
  newMemo.BorderSpacing.Left:=2;

  newMemo.AnchorSide[akRight].Side:=asrRight;
  newMemo.AnchorSide[akRight].Control:=ConnectionTabs;
  newMemo.BorderSpacing.Right:=2;

  newMemo.Anchors := [akTop, akBottom, akLeft, akRight];

  newMemo.Parent := ConnectionTabs;
  newMemo.Visible:=true;

  newMemo.Lines.Add(IP);

  SetLength(connectionMessagesArr, Length(connectionMessagesArr)+1);
  connectionMessagesArr[Length(connectionMessagesArr)-1] := newMemo;

  ShowOnly(currTabIndx);
end; 

它似乎工作正常，我自己测试了很多次。

但是，当我从我的 TIdTCPServer 的 OnConnect 函数运行该函数时，服务器进程似乎会卡住，直到发生其他事件，例如 OnExecute ，例如，发生。当 OnExecute 执行时，进程已接受的消息也将执行。例如，如果我的程序卡住，并且在卡住期间，我将尝试最小化我的一个表单并将其他表单移动到屏幕上的其他位置，他们将在程序解冻后执行此操作。

这是我自己的 OnConnect 函数:

procedure TServerSideForm.OnConnectServer(Context: TIdContext);
begin
  LogForm.LogToForm(Context.Binding.IP + ' has connected to the server (' + Context.Binding.PeerIP + ')');

  //ConnectionsForm.AddTab(Context.Binding.PeerIP); // Boom
  //ConnectionsForm.ConnectionTabs.Tabs.Add('!!'); // Boom
end;  

正如我在标题中所述，与 TTabControl 选项卡的任何类型的交互都会使程序卡住。 ConnectionsForm.ConnectionTabs.Tabs.Add('!!'); 也使程序卡住(这里，ConnectionsTabs 是我的 TTabControl 变量名为 ConnectionsForm 的表单。

我真的不知道这里发生了什么，所以非常感谢您的帮助。

Answer 1

嗯，是的，我的程序确实是线程不安全的。

通过添加我的小同步类解决了这个问题:

type
  TMySync = class(TIdSync)
  protected
    procedure DoSynchronize; override;
  public
    context: TIdContext;
  end;

并在其 DoSyncronize 重写函数中执行我所有的 TTabControl 恶作剧。

procedure TMySync.DoSynchronize;
begin
  LogForm.LogToForm(Context.Binding.IP + ' has connected to the server (' + Context.Binding.PeerIP + ')');

  ConnectionsForm.AddTab(Context.Binding.PeerIP);
end; 

并且 OnConnect 已更改为:

procedure TServerSideForm.OnConnectServer(Context: TIdContext);
var
  sync: TMySync;
begin
//
  sync := TMySync.Create;
  try
    sync.context := Context;
    sync.Synchronize;
  finally
    Sync.Free;
  end;
end;     

附言对我的 OnDisconnect 函数做了类似的操作。

目前看来一切正常。