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 Windows 7 应用程序的规则 [关闭]

    Closed 这个问题不符合堆栈溢出指南 help closed questions 目前不接受答案 在哪里可以找到开发适用于 Windows 7 的 Delphi 应用程序时应遵循的最佳规则集 Marco 最近发表了 2 篇关于此主题的帖
  • 对 smtp.live.com 和 TIdSmtp(Indy、Delphi)的 SSL 支持

    我正在尝试连接到 smtp live com 发送电子邮件 live com 自 2009 年以来显然支持免费的 pop3 smtp 但这对我来说完全是新闻 当我尝试连接到 smtp live com 端口 587 时 会发生以下情况 Me
  • 以与文件大小相同的格式获取类或对象的大小?

    如何从内存中最好地确定类的大小 这是一个可以使用的基本示例类 请注意 这些变量除了用于示例之外没有其他用途 type TMyClass class public fString1 string fString2 string fIntege
  • Firemonkey - 更新视觉组件

    我们从版本 1 开始就使用 Firemonkey 但仍然发现更新当前在屏幕上可见的组件很困难 在 Firemonkey 中请求重画的 方式 有很多 也许太多了 应用样式 ApplyStyle 事件 主要是当它在屏幕上可见时 请求 repai
  • 启动时系统托盘图标不出现

    我在 FormCreate 事件处理程序中使用以下代码来创建系统托盘图标 当我运行程序时 系统托盘图标显示正常 我将应用程序设置为在 Windows 启动时自动启动 当我重新启动计算机时 我的应用程序进程已启动 但系统托盘图标从未出现 我认
  • TRESTRequest:是否可以在 POST 请求中使用自定义媒体类型?

    例如 我们有一个 API 需要我们自己的供应商特定内容类型application vnd xxxx custom custom data json但查看 REST Client 的源代码 它似乎总是默认为 REST Types 中的 Con
  • Delphi 2010:如何将 UTF8 编码的 PAnsiChar 转换为 UnicodeString?

    情况 我有一个外部 DLL 它使用 UTF 8 作为其内部字符串格式 接口函数都使用 PAnsiChar 来传递字符串 我的应用程序的其余部分使用 Delphi 的本机string类型 由于我正在使用 Delphi 2010 这将映射到Un
  • 如何修复 Delphi Prism ASP.NET 错误:“解析器错误消息:‘Oxygene’不是受支持的语言”

    我在 Delphi Prism 中编写了一个 ASP NET Web 应用程序 不是网站 在我的开发机器上一切正常 但是当我将其安装在测试服务器上时 出现以下错误 Server Error in MyApp Application Pars
  • FreeMM 与 ShareMem

    我们有很多用 delphi 和 c builder 编写的 dll 库 并使用 sharemem 和 borlndmm dll 3d party 库中的对齐问题迫使我们转向 delphi 2007 中的新内存管理器 有人可以帮我解释一下 共
  • Winform 没有.NET 框架?

    我必须创建一些表单并将其作为直接 EXE 提供 而不是安装程序 它安装 NET 框架 最终用户对此不满意 他们想要可以直接打开和工作的东西 我知道它可以作为网络完成 但我正在寻找 winforms 吗 请建议哪种工具 技术可以处理这个问题
  • 将记录转换为序列化表单数据以通过 HTTP 发送

    有没有办法转换此记录 TError record code Word message String end TState record caption String address Cardinal counters TArray
  • Delphi如何使用其他窗体中的类型?

    抱歉 这是一个非常新手的问题 我正在对这个庞大的应用程序进行维护 它有5种不同的形式 我们将全局变量放在一个单元 uGlobal 中 但我似乎无法从数据单元 uData 访问它 我有这个 Unit uGlobal type TmyType
  • Delphi XE2 Firemonkey 示例应用程序未在 MAC 上运行

    我正在尝试在 Mac 上运行示例 Firemonkey 应用程序 但我在 Mac 中收到以下消息 dyld Library not loaded rpath libcgunwind 1 0 dylib Referenced from Use
  • Delphi DataSnap REST 服务器从 TStream 返回 JSON 数组,而不是二进制

    我有一个与 Android 客户端通信的 REST 服务器 我将它从 XE3 ish 升级到 Berlin 其中一个服务器方法返回一个包含 jpeg 的 TStream 并且工作得很好 很高兴将图像作为二进制图像返回 升级到 Berlin
  • 如何追踪手柄泄漏?

    在我的一个应用程序中 我观察到句柄数量不断增加 在不使用应用程序的情况下 该数字大约每秒增加一次 因此后台处理代码的某些部分一定存在句柄泄漏 我如何追踪此类泄漏 有什么工具可以帮助解决这个问题吗 跟踪句柄泄漏时要寻找哪些模式 导致手柄泄漏的
  • Delphi XE5 REST/Android 客户端“会话已过期”

    我有一个REST Server与Android Client 都在Deplhi Xe5 Android客户端成功连接Rest服务器 在我的服务器中我有一个TDSHttpWebDispatcher with SessionTimeout 12
  • 以 png 格式剪辑幻灯片 (Delphi 2010)

    I have a filmstrip of images in png format like this 我想知道如何剪辑每个图像并将这些图像放入 TImageList 控件中 并始终保留透明度 EDIT 是的 在设计时 RRUZ 提到的技
  • 在TImageViewer中,如何获取用户点击图片的位置?

    在TImageViewer控件中 用户可以缩放或平移图片 我的问题是 当用户点击图片时 如何获取用户在图片上的点击位置 尤其是用户可以对图片进行放大 缩小或平移之后 如何获取对应的图片点击位置呢 As shown below How to
  • Delphi 5 的哈希表实现 [关闭]

    Closed 这个问题正在寻求书籍 工具 软件库等的推荐 不满足堆栈溢出指南 help closed questions 目前不接受答案 您知道 Delphi 5 的良好且免费的哈希表实现吗 我需要在哈希表中组织大量数据 并且我有点担心在网
  • 查找Delphi项目中的所有编译错误

    我正在对我的 Delphi 项目进行一些重构 我希望能够做出改变 然后看看all项目中因该更改而中断的地方 类似于 Eclipse 列出项目的所有编译错误 在 Java 中 在 Delphi 中 我可以进行更改 然后重新编译我的项目 但编译

随机推荐