德尔福 XE2/Indy TIdTCPServer/"Connection reset by peer"

标签 delphi delphi-xe2 indy tcpserver

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

例如: 我有 2 台设备，我将与设备 1 进行通信。 当我向设备 1 发送消息时，消息发送正常。 但是在不关闭程序的情况下，当我向设备2发送消息时，Delphi返回“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 时，应用程序崩溃。 谢谢!

最佳答案

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

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

试试这个:

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 事件在安全时发送数据，例如:

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;

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

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;

关于德尔福 XE2/Indy TIdTCPServer/"Connection reset by peer"，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/23070968/

上一篇：asp.net - 多行文本框中的自动高度

下一篇：django - Django 项目目录结构是否可以更简单，带或不带 South ？

相关文章：

delphi - 如何隐藏我的数据不被嗅探？

delphi - 如何从系统快捷方式获取快捷方式 shell 图标？

delphi - IdUDPClient ，如何向服务器发送数据包？

delphi - 启动程序并与现有程序对接 Delphi 2010

delphi - 通过IdHTTP读取并保存部分文件流

php - 我可以从 Delphi 的 Indy 客户端发送 TCP RST 吗？

delphi - 为什么通过 FTP 传输后，文件有时会出现大小不同或损坏的情况？

macos - 使用 beginActivityWithOptions 禁用 App Nap

delphi - 无法在 XE2 中编译包含 DSUtils 的包

delphi - 如何开发 DLL 和两个访问它的应用程序

©2024 IT工具网  联系我们