TCPServer and Error1400

Question

Я сделал программу в Delphi для создания сервера и прослушивания ответа клиентов. Клиенты подключаются к серверу, отправляют некоторые данные и немедленно отключаются. Проблема в том, что иногда при получении данных моя программа перестает отвечать. И большую часть времени, когда я закрываю программу, я вижу EOSError 1400 [Invalid window handle.] (Я знаю, что эта ошибка связана с потоком носков). Я устанавливаю Active свойство TCPServer на 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

Проблема с обоими примерами кода является то, что они манипулируют управления пользовательского интерфейса из вне контекста основного потока пользовательского интерфейса. Оба кода запускают свой клиентский ввод-вывод в рабочем потоке, поэтому они должны синхронизировать с основным потоком пользовательского интерфейса. Один из способов сделать это с 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; 

Однако, с тем, что, будьте осторожны и не деактивировать либо сервер от основного потока пользовательского интерфейса во время синхронизации с основным Пользовательский интерфейс. Это гарантированный тупик. Вы должны будете либо:

1. убедитесь, что запрос на синхронизацию не выполняется перед деактивацией сервера.

2. использовать асинхронное обновление пользовательского интерфейса вместо синхронного обновления. Вы можете использовать TThread.Queue(), TIdNotify и т. Д. Или сохраните данные в поточно-безопасных переменных, а затем используйте таймер пользовательского интерфейса для периодического обновления пользовательского интерфейса. Таким образом, потоки ввода-вывода не блокируются, а основной поток пользовательского интерфейса отключает сервер.

3. использовать другой поток для деактивации сервера, чтобы основной поток пользовательского интерфейса мог продолжить обработку запросов синхронизации, в то время как деактивация занята.