TCPServer 和 Error1400

Question

我在 Delphi 中编写了一个程序来创建服务器并监听客户端响应。客户端连接到服务器，发送一些数据，然后立即断开连接。问题是有时当收到数据时我的程序停止响应。大多数情况下，当我关闭程序时，我会看到 EOSError 1400 [Invalid window handle.]（我知道这个错误是由于 socks 线程造成的）。在关闭窗口之前，我将 TCPServer 的 Active 属性设置为 false。我测试了 TTCPServer 和 TIdTCPServer，但问题没有解决。

这是我的 TTCPServer 代码：

procedure TMonitorFrm.TcpSerAccept(Sender: TObject;
  ClientSocket: TCustomIpClient);
var
  b: array [0..300] of Byte;
  z, k: Byte;
  s: String;
begin
repeat
  z := ClientSocket.ReceiveBuf(b, SizeOf(b), 0);
  s := '';
  if (z > 6) then
    begin
    for k := 0 to z - 1 do
      begin
      s := s + IntToHex(b[k], 2);
      if (k in [2, 5, 6]) then s := s + ' ';
      end;
    FullLst.Items.Add(s);
    FullMessageEdt.Text := s;
    if (Length(s) > 17) then Delete(s, 1, 17) else s := '';
    k := MessagesGrd.RowCount;
    MessagesGrd.RowCount := k + 1;
    MessagesGrd.Cells[0, k] := Format('%d.%d.%d', [b[3], b[4], b[5]]);
    MessagesGrd.Cells[1, k] := Format('%d.%d.%d:%d', [b[0], b[1], b[2], b[6]]);
    MessagesGrd.Cells[2, k] := s;
    MessagesGrd.Cells[3, k] := TimeToStr(Now);
    MessagesGrd.Row := k;
    end;
until (z = 0);
Application.ProcessMessages;
end;

这是我的 TIdTCPServer 代码：

procedure TMonitorFrm.IdTCPSerExecute(AContext: TIdContext);
var
  r: TIdBytes;
  k: Byte;
  s: String;
begin
AContext.Connection.IOHandler.ReadTimeout := TCPTimeOut;
AContext.Connection.IOHandler.ReadBytes(r, -1, False);
if (Length(r) > 6) then
  begin
  for k := 0 to High(r) do
    begin
    s := s + IntToHex(r[k], 2);
    if (k in [2, 5, 6]) then s := s + ' ';
    end;
  FullLst.Items.Add(s);
  FullMessageEdt.Text := s;
  if (Length(s) > 17) then Delete(s, 1, 17) else s := '';
  k := MessagesGrd.RowCount;
  MessagesGrd.RowCount := k + 1;
  MessagesGrd.Cells[0, k] := Format('%d.%d.%d', [b[3], b[4], b[5]]);
  MessagesGrd.Cells[1, k] := Format('%d.%d.%d:%d', [b[0], b[1], b[2], b[6]]);
  MessagesGrd.Cells[2, k] := s;
  MessagesGrd.Cells[3, k] := TimeToStr(Now);
  MessagesGrd.Row := k;
  end;
Finalize(r);
Application.ProcessMessages;
end;

Answer 1

这两个代码示例的问题在于它们在主 UI 线程的上下文之外操作 UI 控件。两个代码都在工作线程中运行它们的客户端 I/O，因此它们必须与主 UI 线程同步。一种方法是使用TThread.Synchronize() 方法，例如：

procedure TMonitorFrm.TcpSerAccept(Sender: TObject;
  ClientSocket: TCustomIpClient);
var
  b: array [0..300] of Byte;
  z, k: Byte;
  s: String;
begin
  repeat
    z := ClientSocket.ReceiveBuf(b, SizeOf(b), 0);
    s := '';
    if (z > 6) then
    begin
      for k := 0 to z - 1 do
      begin
        s := s + IntToHex(b[k], 2);
        if (k in [2, 5, 6]) then s := s + ' ';
      end;
      TThread.Synchronize(nil,
        procedure
        begin
          FullLst.Items.Add(s);
          FullMessageEdt.Text := s;
          k := MessagesGrd.RowCount;
          MessagesGrd.RowCount := k + 1;
          MessagesGrd.Cells[0, k] := Format('%d.%d.%d', [b[3], b[4], b[5]]);
          MessagesGrd.Cells[1, k] := Format('%d.%d.%d:%d', [b[0], b[1], b[2], b[6]]);
          MessagesGrd.Cells[2, k] := Copy(s, 18, MaxInt);
          MessagesGrd.Cells[3, k] := TimeToStr(Now);
          MessagesGrd.Row := k;
        end
      );
    end;
  until (z = 0);
end;

procedure TMonitorFrm.IdTCPSerConnect(AContext: TIdContext);
begin
  AContext.Connection.IOHandler.ReadTimeout := TCPTimeOut;
end;

procedure TMonitorFrm.IdTCPSerExecute(AContext: TIdContext);
var
  r: TIdBytes;
  k: Byte;
  s: String;
begin
  AContext.Connection.IOHandler.ReadBytes(r, -1, False);
  if (Length(r) > 6) then
  begin
    for k := 0 to High(r) do
    begin
      s := s + IntToHex(r[k], 2);
      if (k in [2, 5, 6]) then s := s + ' ';
    end;
    TThread.Synchronize(nil,
      procedure
      begin
        FullLst.Items.Add(s);
        FullMessageEdt.Text := s;
        k := MessagesGrd.RowCount;
        MessagesGrd.RowCount := k + 1;
        MessagesGrd.Cells[0, k] := Format('%d.%d.%d', [b[3], b[4], b[5]]);
        MessagesGrd.Cells[1, k] := Format('%d.%d.%d:%d', [b[0], b[1], b[2], b[6]]);
        MessagesGrd.Cells[2, k] := Copy(s, 18, MaxInt);
        MessagesGrd.Cells[3, k] := TimeToStr(Now);
        MessagesGrd.Row := k;
      end
    );
  end;
end;

不过，话虽如此，请注意不要在与主 UI 线程同步时从主 UI 线程停用任一服务器。这是一个有保证的死锁。您必须：

1. 确保在停用服务器之前没有正在进行的同步请求。

2. 使用异步 UI 更新而不是同步更新。您可以使用TThread.Queue()、TIdNotify 等。或者将数据存储在线程安全变量中，然后使用 UI 计时器定期更新 UI。这样，当主 UI 线程停用服务器时，I/O 线程不会被阻塞。

3. 使用另一个线程停用服务器，以便主 UI 线程可以在停用繁忙时继续处理同步请求。