Vahid
Vahid

Reputation: 584

TCPServer and Error1400

I made a program in Delphi to create a server and listen for clients response. Clients connect to the server, send some data, and disconnect immediately. The problem is that sometimes when data received my program stops responding. And most of the times when I close the program I see EOSError 1400 [Invalid window handle.] (I know that this error is because of socks thread). I am setting Active property of TCPServer to false before closeing the window. I tested both of TTCPServer and TIdTCPServer, but the problem does not solved.

This is my code for 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;

And this is my code for 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;

Upvotes: 1

Views: 308

Answers (1)

Remy Lebeau
Remy Lebeau

Reputation: 595235

The problem with both code examples is that they are manipulating UI controls from outside the context of the main UI thread. Both codes are running their client I/O in a worker thread, so they must synchronize with the main UI thread. One way to do that is with the TThread.Synchronize() method, eg:

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;

However, with that said, be careful NOT to deactivate either server from the main UI thread while synchronizing with the main UI thread. That is a guaranteed deadlock. You will have to either:

  1. make sure no sync request is in progress before deactivating the server.

  2. use an asynchronous UI update instead of a synchronous update. You can use TThread.Queue(), TIdNotify, etc. Or store your data in thread-safe variables and then use a UI timer to update the UI periodically. This way, the I/O threads are not blocked while the main UI thread is deactivating the server.

  3. use another thread to deactivate the server so the main UI thread can continue processing sync requests while deactivating is busy.

Upvotes: 2

Related Questions