[英]Delphi XE2 / Indy TIdTCPServer / “Connection reset by peer”
I'm with one problem using Indy in Delphi XE2 to send TCP Messages using TIdTCPServer. 我在Delphi XE2中使用Indy来使用TIdTCPServer发送TCP消息时遇到一个问题。
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. 例如:我有2台设备,我将与设备1进行通信。当我向设备1发送消息时,消息发送正常。 But without close the program, when i send messages to device 2, Delphi returns "Connection reset by peer".
但没有关闭程序,当我向设备2发送消息时,Delphi返回“对等连接重置”。
Below is my code: 下面是我的代码:
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;
To send the messages to devices: 要将消息发送到设备:
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;
And i have another problem. 我还有另一个问题。
When i set active := False on tidtcpserver Component, the application crashes. 当我在tidtcpserver组件上设置active:= False时,应用程序崩溃。 Thanks!
谢谢!
Your Clients
list is not protected from multithreaded access. 您的“
Clients
列表没有受到多线程访问的保护。 TIdTCPServer
is a multi-threaded component, each client runs in its own worker thread. TIdTCPServer
是一个多线程组件,每个客户端都在其自己的工作线程中运行。 You need to take that into account. 您需要考虑到这一点。 I suggest you get rid of your
Clients
list altogether and use the TIdTCPServer.Contexts
property instead. 我建议您完全摆脱“
Clients
列表,而改用TIdTCPServer.Contexts
属性。 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). 否则,您需要保护您的“
Clients
列表,例如将其更改为TThreadList
,或者至少用TCriticalSection
包装(这是TThreadList
在内部执行的操作)。
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. 我看到的另一个问题是您将
Client.DNS
字段设置为错误的值,这可能会影响您的通信,具体取决于您使用Client.DNS
的确切方式。
Try this instead: 尝试以下方法:
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;
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. 话虽如此,如果您的服务器从
OnExecute
事件或CommandsHandlers
集合内部发送任何数据,则这种从其线程外部向客户端发送消息的方法并不安全,因为您可能会重叠数据,从而破坏与该客户端的通信。 。 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: 一种比较安全的方法是将传出的数据排队,并在
OnExecute
下让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: 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: 更新:话虽如此,我建议从
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;
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.