Delphi XE2 / Indy TIdTCPServer /“由对等方重置连接” [英] Delphi XE2 / Indy TIdTCPServer / "Connection reset by peer"

问题描述

我在Delphi XE2中使用Indy来通过TIdTCPServer发送TCP消息时遇到一个问题。

I'm with one problem using Indy in Delphi XE2 to send TCP Messages using TIdTCPServer.

例如：
我有2个设备，我我将与设备1进行通信。
当我向设备1发送消息时，消息发送正常。
但是没有关闭程序，当我向设备2发送消息时，Delphi返回对等连接重置。

For exemple: I have 2 devices and i'll go communicate with device 1. When i send messages to device 1, the messages were send fine. But without close the program, when i send messages to device 2, Delphi returns "Connection reset by peer".

下面是我的代码：

procedure TMainHost.idTCPServerNewConnect(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Sleep(1000);
  Client := TSimpleClient.Create();

  Client.DNS := AContext.Connection.Socket.Host;
  Client.Conectado := True;
  Client.Port := idTCPServerNew.DefaultPort;
  Client.Name := 'Central';
  Client.ListLink := Clients.Count;
  Client.Thread := AContext;
  Client.IP := AContext.Connection.Socket.Binding.PeerIP;

  AContext.Data := Client;

  Clients.Add(Client);
  Sleep(500);

  if (MainEstrutura.current_central.IP = Client.IP) then
  begin
    MainEstrutura.current_central.Conectado := true;
    MainEstrutura.envia_configuracao;
  end;

end;

procedure TMainHost.idTCPServerNewDisconnect(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  { Retrieve Client Record from Data pointer }
  Client := Pointer(AContext.Data);
  { Remove Client from the Clients TList }
  Clients.Remove(Client);
  { Free the Client object }
  FreeAndNil(Client);
  AContext.Data := nil;

end;

要将消息发送到设备：

procedure TMainHost.DirectTCPMessage(IP: String; TheMessage: String);
var
  Client: TSimpleClient;
  i: Integer;
  List: TList;
  Msg: String;
begin

  Msg := Trim(TheMessage);

  for i := 0 to Clients.Count - 1 do
  begin

    Client := TSimpleClient(Clients.Items[i]);

    if TIdContext(Client.Thread).Connection.Socket.Binding.PeerIP = IP then
    begin

      TIdContext(Client.Thread).Connection.Socket.WriteLn(Msg);

    end;

  end;
end;

我还有另一个问题。

当我在tidtcpserver组件上设置active：= False时，应用程序崩溃。
谢谢！

When i set active := False on tidtcpserver Component, the application crashes. Thanks!

推荐答案

您的客户列表不受保护从多线程访问。 TIdTCPServer 是一个多线程组件，每个客户端都在其自己的工作线程中运行。您需要考虑到这一点。我建议您完全摆脱 Clients 列表，而使用 TIdTCPServer.Contexts 属性。否则，您需要保护您的 Clients 列表，例如将其更改为 TThreadList ，或至少将其包装起来带有 TCriticalSection （这是 TThreadList 在内部执行的操作）。

Your Clients list is not protected from multithreaded access. TIdTCPServer is a multi-threaded component, each client runs in its own worker thread. You need to take that into account. I suggest you get rid of your Clients list altogether and use the TIdTCPServer.Contexts property instead. Otherwise, you need to protect your Clients list, such as by changing it to a TThreadList, or at least wrapping it with a TCriticalSection (which is what TThreadList does internally).

我看到的另一个问题是您将 Client.DNS 字段设置为错误的值，这可能会影响您的通信，具体取决于使用的是 Client.DNS 。

Another problem I see is that you are setting your Client.DNS field to the wrong value, which may affect your communications depending on what you are using Client.DNS for exactly.

尝试以下操作：

procedure TMainHost.idTCPServerNewConnect(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient.Create();

  Client.IP := AContext.Binding.PeerIP;
  Client.DNS := GStack.HostByAddress(Client.IP, AContext.Binding.IPVersion);
  Client.Conectado := True;
  Client.Port := AContext.Binding.Port;
  Client.Name := 'Central';
  Client.Thread := AContext;

  AContext.Data := Client;

  // this may or may not need to be Synchronized, depending on what it actually does...
  if (MainEstrutura.current_central.IP = Client.IP) then
  begin
    MainEstrutura.current_central.Conectado := true;
    MainEstrutura.envia_configuracao;
  end;
end;

procedure TMainHost.idTCPServerNewDisconnect(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  { Retrieve Client Record from Data pointer }
  Client := TSimpleClient(AContext.Data);
  { Free the Client object }
  FreeAndNil(Client);
  AContext.Data := nil;    
end;

procedure TMainHost.DirectTCPMessage(IP: String; TheMessage: String);
var
  List: TIdContextList; // or TList in an earlier version that did not have TIdContextList yet
  Context: TIdContext;
  i: Integer;
  Msg: String;
begin
  Msg := Trim(TheMessage);

  List := idTCPServerNew.Contexts.LockList;
  try
    for i := 0 to List.Count - 1 do
    begin
      Context := Context(List[i]);
      if TSimpleClient(Context.Data).IP = IP then
      begin
        try
          Context.Connection.IOHandler.WriteLn(Msg);
        except
        end;
        Break;
      end;
    end;
  finally
    idTCPServerNew.Contexts.UnlockList;
  end;
end;

这样说，如果您的服务器从 OnExecute内部发送任何数据事件或 CommandsHandlers 集合，则这种从其线程外部向客户端发送消息的方法并不安全，因为您可能会重叠损坏的数据与该客户的沟通。一种比较安全的方法是将传出的数据排队，并在安全的情况下让 OnExecute 事件发送数据，例如：

With that said, if your server sends any data from inside of the OnExecute event or CommandsHandlers collection then this approach of sending a message to a client from outside of its thread is not safe, as you risk overlapping data that corrupts the communication with that client. A safer approach is to queue the outgoing data and have the OnExecute event send the data when it is safe to do so, eg:

procedure TMainHost.idTCPServerNewConnect(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient.Create();
  ...
  Client.Queue := TIdThreadSafeStringList.Create; // <-- add this
  ...
end;

procedure TMainHost.idTCPServerNewExecute(AContext: TIdContext);
var
  List: TStringList;
  I: Integer;
begin
  Client := TSimpleClient(AContext.Data);
  ...
  List := Client.Queue.Lock;
  try
    while List.Count > 0 do
    begin
      AContext.Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
  finally
    Client.Queue.Unlock;
  end;
  ...
end;

procedure TMainHost.DirectTCPMessage(IP: String; TheMessage: String);
var
  List: TIdContextList; // or TList in an earlier version that did not have TIdContextList yet
  Context: TIdContext;
  i: Integer;
  Msg: String;
begin
  Msg := Trim(TheMessage);

  List := idTCPServerNew.Contexts.LockList;
  try
    for i := 0 to List.Count - 1 do
    begin
      Context := Context(List[i]);
      if TSimpleClient(Context.Data).IP = IP then
      begin
        TSimpleClient(Context.Data).Queue.Add(Msg);
        Break;
      end;
    end;
  finally
    idTCPServerNew.Contexts.UnlockList;
  end;
end;

更新：话虽如此，我建议推导 TSimpleClient 从 TIdServerContext 并将其分配给服务器的 ContextsClass 属性，那么您就不必不再需要使用 TIdContext.Data 属性：

Update: that being said, I would suggest deriving TSimpleClient from TIdServerContext and assign that to the server's ContextsClass property, then you don't need to use the TIdContext.Data property anymore:

type
  TSimpleClient = class(TIdServerContext)
  public
    Queue: TIdThreadSafeStringList;
    ...
    // or TThreadList in an earlier version that did not have TIdContextThreadList yet
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
  end;

constructor TSimpleClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited;
  Queue := TIdThreadSafeStringList.Create;
  ...
end;

destructor TSimpleClient.Destroy;
begin
  ...
  Queue.Free;
  inherited;
end;

procedure TMainHost.FormCreate(Sener: TObject);
begin
  // this must be assigned before the server is activated
  idTCPServerNew.ContextClass := TSimpleClient;
end;

procedure TMainHost.idTCPServerNewConnect(AContext: TIdContext);
var
  Client: TSimpleClient;
  ...
 begin
  Client := AContext as TSimpleClient;
  // use Client as needed...
end;

procedure TMainHost.idTCPServerNewExecute(AContext: TIdContext);
var
  Client: TSimpleClient;
  ...
begin
  Client := AContext as TSimpleClient;
  // use Client as needed...
end;

procedure TMainHost.DirectTCPMessage(IP: String; TheMessage: String);
var
  List: TIdContextList; // or TList in an earlier version that did not have TIdContextList yet
  Client: TSimpleClient;
  i: Integer;
  Msg: String;
begin
  Msg := Trim(TheMessage);

  List := idTCPServerNew.Contexts.LockList;
  try
    for i := 0 to List.Count - 1 do
    begin
      Client := TIdContext(Context(List[i])) as TSimpleClient;
      if Client.IP = IP then
      begin
        Client.Queue.Add(Msg);
        Break;
      end;
    end;
  finally
    idTCPServerNew.Contexts.UnlockList;
  end;
end;

这篇关于Delphi XE2 / Indy TIdTCPServer /“由对等方重置连接”的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！