Delphi XE2 / Indy TIdTCPServer /“连接由对等方重置”

2024-02-20

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

举个例子: 我有 2 台设备,我将与设备 1 进行通信。 当我向设备 1 发送消息时,消息发送正常。 但在不关闭程序的情况下,当我向设备 2 发送消息时,Delphi 返回“连接由对等方重置”。

下面是我的代码:

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 时,应用程序崩溃。 谢谢!


Your Clients列表不受多线程访问保护。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;

Update:话虽这么说,我建议推导TSimpleClient from TIdServerContext并将其分配给服务器的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;
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

Delphi XE2 / Indy TIdTCPServer /“连接由对等方重置” 的相关文章

  • 如何在以管理员身份运行模式下部署应用程序?

    如何部署应用程序 使其需要管理员权限 而无需最终用户手动执行此操作 我使用 Delphi 2009 来构建该应用程序 您可以使用以下命令通知 Windows 您的应用程序需要以管理员身份运行requestedExecutionLevel应用
  • 使用 gmail 和 Indy 发送电子邮件

    我正在尝试使用 gmail 从 Delphi 发送电子邮件 我有 Indy 10 5 9 0 和 Delphi XE3 我从以下位置获得了示例代码 http www andrecelestino com delphi xe envio de
  • 如何安装DBMonitor

    这可能是一个非常简单的问题 但就是这样 我刚刚更新了 Firebird 的 DevArt DBExpress 驱动程序的许可证 帮助文件说我可以使用他们的免费软件 DBMonitor 应用程序 但由于我使用的是 D2006 所以我必须使用以
  • 如果鼠标不在 VirtualTreeView (TVirtualStringTree) 上,如何禁用 MouseWheel

    如果 TVirtualStringTree 获得焦点 则默认情况下它会在鼠标滚轮上滚动 即使鼠标未超出控制范围 除非它位于另一个 TVirtualStringTree 上方 有没有一种快速而优雅的方法来禁用这种行为 我已经这样做了OnMou
  • XE2 中的 COM 是否损坏?我该如何解决它?

    Update XE2 Update 2 修复了下述错误 下面的程序是从实际程序中截取的 在 XE2 中失败并出现异常 这是 2010 年的回归 我没有 XE 来测试 但我希望该程序在 XE 上运行良好 感谢 Primo 确认代码在 XE 上
  • 在 Delphi 中强制非阻塞临时提示窗口

    我一直在寻找 但找不到解决方案 所以我想也许我应该简单地发布它 这是我想要在 Delphi 2009 中做的事情 在我的应用程序中的某个时刻 我想向用户显示一条消息 这应该是正常的提示窗口 在正常应用程序定义的提示暂停后自动消失 并带有自定
  • Delphi - 通过 ADO 查询获取 Excel 行

    我有以下 Excel 文件 我将 AdoConnection ConnectionString 设置为 AdoConnection ConnectionString Provider Microsoft Jet OLEDB 4 0 Data
  • Delphi错误数据集未处于插入或编辑模式

    客观的 单击 TRxDBCombo 上的按钮调用搜索框 从搜索框中选择记录时 结果将设置为 TComboEditBox 的字段值 并发布在 TRxMemoryData 数据集中 错误 第二次调用此函数时出现数据集未处于插入或编辑模式 TDB
  • 使用 NestJS 的 TCP 服务器

    是否可以使用 NestJS 创建 TCP 服务器 我有一个仅通过 TCP 进行通信的 GPS 跟踪器 由于 NestJS 可以通过 TCP 在微服务之间进行通信 我认为也许 NestJS 可以用作低级网络应用程序 例如 java netty
  • 如何从具有管理员权限的应用程序接收键盘输入到非管理员应用程序?

    我编写了一个应用程序 该应用程序具有覆盖类型的窗口 可以通过热键显示和隐藏该窗口 而另一个应用程序具有焦点 所述另一个应用程序是一个以管理员权限运行的 DirectX 游戏 我已经尝试了 3 种可能的解决方案 以便在其他应用程序中按下我的热
  • 我可以在“Delphi 2007 for Win32”中使用.NET DLL吗?

    是否可以在 Delphi 2007 for Win32 中使用 NET DLL 我尝试以与 ActiveX 组件相同的方式导入 DLL 但它似乎不起作用 组件菜单 gt 导入组件 gt 导入 NET 程序集 是否可能 如果可以 步骤是什么
  • Delphi线程死锁

    我有时会在销毁某些线程时遇到死锁问题 我尝试过调试该问题 但在 IDE 中调试时似乎从未存在死锁 可能是因为 IDE 中的事件速度较低 问题 当应用程序启动时 主线程会创建多个线程 线程始终处于活动状态并与主线程同步 完全没有问题 当应用程
  • 如何在 Delphi REST 中发布内容类型为“multipart/form-data”的数据?

    我正在尝试使用 REST API 发送请求multipart form data作为内容类型 我总是收到 HTTP 1 1 500 Internal Error 作为响应 我尝试向需要的方法发送请求application x www for
  • 当显示对话框时淡出应用程序的所有其他窗口?

    如何在 Delphi 2009 中调暗 淡出应用程序的所有其他窗口 Form 有一个 AlphaBlend 属性 但它仅控制透明度级别 但如果我们能有这样的东西那就太好了 集中窗口 http www anappaday com downlo
  • Async InputQuery 不处理“取消”按钮

    我正在使用一个简单的调用TDialogServiceAsync InputQuery 使用单个输入 它只是忽略了Cancel按钮和窗口的X关闭按钮 But the Ok按钮工作正常 这是我的代码 uses FMX DialogService
  • 使用 OLE 和 Delphi 提高 Word 文档中搜索替换的性能

    经过一些实验 我最终得到了以下代码来在 MSWord 中执行搜索和替换 此代码在页眉和页脚中也能完美运行 包括首页或奇数 偶数页的页眉和 或页脚不同的情况 问题是我需要打电话MSWordSearchAndReplaceInAllDocume
  • 以编程方式重新启动 Delphi 应用程序

    应该不可能运行我的应用程序的多个实例 因此项目源码包含 CreateMutex nil False PChar ID if GetLastError ERROR ALREADY EXISTS then Halt 现在我想以编程方式重新启动我
  • 具有 csOwnerDrawFixed 样式的组合框如何表现得像 csDropDown 样式?

    我正在使用一个组合框 http docwiki embarcadero com Libraries en Vcl StdCtrls TComboBoxstyle 属性设置为的组件csOwnerDrawFixed 我实现了绘图项一切工作正常
  • 当responseText包含有效的Xml时,IXMLHttpRequest.responseXml为空,没有解析错误

    我正在从中获取一些 XML政府网站 http www bankofcanada ca stats assets rates rss noon en all xml http www bankofcanada ca stats assets
  • Delphi 2009 IDE结构视图折叠功能

    现在有谁知道折叠 Delphi 2009 IDE 结构视图中的所有项目吗 我不知道折叠所有项目 这使我很难从视图中找到我的课程 Thanks 选择根节点 类 并按数字键盘上的 除号 那会让一切崩溃 然后按数字键盘上的 加号 键 第一级将展开

随机推荐