一个应用程序中的TiptcpServer和客户端

我看到这个代码有很多问题。

• 如何 addToLog() 和 addToConsole() 实施?它们是安全的吗?记住 TIdTCPServer 是一个多线程组件,它的事件是在工作线程的上下文中触发的,而不是主UI线程,因此必须同步对UI、共享变量等的任何访问。

• 是什么 clients ?它是一个UI控件吗?您需要同步对它的访问,这样当多个线程试图同时访问它时,您就不会损坏它的内容。

• 你的使用 TIdTCPServer.Contexts 属性未得到充分保护,无法免受例外情况的影响。你需要一个 try..finally 阻止以便您可以呼叫 Contexts.UnlockList() 安全地。

• 更重要的是,你打电话来 Contexts.LockList() 太多次 在你 serverConnect() 循环(这是问题的根本原因)。 LockList() 返回A TIdContextList 对象。在循环中,您应该访问该列表的 Items[] 属性而不是调用 锁列表() 再一次。因为你没有匹配的 UnlockList() 对于每一个 锁列表() ,一旦客户机连接到服务器, Contexts 列表已死锁,无法再访问一次 Server连接() 退出,包括客户端连接/断开连接以及 TIDTCP服务器 关闭(例如在您的情况下)。

• serverDisconnect() 没有从中删除任何项目 客户 . Server连接() 不应重置 客户 完全。它应该只添加调用 TIdContext 到 客户 然后 服务器断开连接() 应该去掉那个 Twitter上下文 从 客户 后来。

有了这句话,试着做些类似的事情:

procedure TfrmMain.addToConsole(const AMsg: string);
begin
  TThread.Queue(nil,
    procedure
    begin
      // add AMsg to console ...
    end
  );
end;

procedure TfrmMain.addToLog(const AMsg: string);
begin
  TThread.Queue(nil,
    procedure
    begin
      // add AMsg to log ...
    end
  );
end;

procedure TfrmMain.startClick(Sender: TObject);
begin
  if server.Active then
    stopServer()
  else
    startServer();
end;

procedure TfrmMain.startServer();
var
  binding: TIdSocketHandle;
begin
  server.Bindings.Clear();

  try
    server.DefaultPort := StrToInt(port.Text);
    binding := server.Bindings.Add();
    binding.IP := ip;
    binding.Port := StrToInt(port.Text);

    server.Active := True;

    addToLog('Server started');
    start.Caption := 'Stop';
  except
    on e: Exception do
      addToLog('Error: ' + e.message + '.');
  end;
end;

procedure TfrmMain.stopServer();
begin
  try
    server.Active := False;
    server.Bindings.Clear();

    addToLog('Server stopped');
    start.Caption := 'Start';
  except
    on e: Exception do
      addToLog('Server shutdown error.');
  end;
end;

procedure TfrmMain.serverConnect(AContext: TIdContext);
var
  PeerIP: string;
begin
  PeerIP := AContext.Binding.PeerIP;
  addToLog('New client: ' + PeerIP + '.');

  TThread.Queue(nil,
    procedure
    {
    var
      i: integer;
      list: TIdContextList;
    }
    begin
      {
      clients.clear();
      list := server.Contexts.LockList;
      try
        for i := 0 to list.count - 1 do begin
          clients.Items.Add(TIdContext(list[i]).Binding.PeerIP);
        end;
      finally
        list.UnlockList();
      end;
      }

      // I'm assuming clients is a UI control whose Items property
      // is a TStrings object.  If not, adjust this code as needed...
      clients.Items.AddObject(PeerIP, AContext);
    end;
  );
end;

procedure TfrmMain.serverDisconnect(AContext: TIdContext);
begin
  addToLog('Client ' + AContext.Binding.PeerIP + ' disconnected from the server.');

  TThread.Queue(nil,
    procedure
    var
      i: Integer;
    begin
      // I'm assuming clients is a UI control whose Items property
      // is a TStrings object.  If not, adjust this code as needed...
      i := clients.Items.IndexOfObject(AContext);
      if i <> -1 then
        clients.Items.Delete(i);
    end
  );
end;

procedure TfrmMain.clientConnected(Sender: TObject);
begin
  addToConsole('You connected to server successfully.');
end;

procedure TfrmMain.clientDisconnected(Sender: TObject);
begin
  addToConsole('The connection to the server was interrupted.');
end;