如何在每次收到消息时让 TIdTCPServer 回复?
How to have TIdTCPServer reply every time it receives a message?
我正在学习如何使用 HL7 以及 IdTCPClient 和 IdTCPServer。收到 HL7 消息,我仅从服务器收到第一条消息的确认回复。但在那之后,收到消息但没有发送确认回复。它挂在 AContext.Connection.IOHandler.WriteLn。如何让 IdTCPServer 为收到的每条消息发送确认回复?非常感谢您的意见。这是服务器端代码 onExcute:
procedure THL7DM.IdTCPServer1Execute(AContext: TIdContext);
Function AcknowledgementMessage(HL7_msg: string): string;
var
s: TStrings;
MSA: TMSASegment;
MSH: TMSHSegment;
begin
result := '';
MSH := TMSHSegment.Create(HL7_msg); {HL7 MSH Segment}
MSA := TMSASegment.Create(''); {HL7 MSA Segment}
s := TStringList.Create;
try
MSH.Accept_Acknowledgment_Type_15 := 'AA';
MSA.Acknowledgment_Code_18 := 'AA';
MSH.Sending_Facility_4 := 'AEdge Lab';
MSH.Message_Type_9 := 'ACK';
MSA.Message_Waiting_Number_1827 := DateTimeToStr(now);
s.Text := MSH.ToString + #13 + #10 + 'MSA' + '|' + MSA.ToString;
s.Text := #11 + s.Text + #28 + #13;
result := s.Text;
finally
MSA.Free;
MSH.Free;
s.Free;
end;
end;
var
MsgStrings: TStrings;
s: string;
msg: string;
begin
MsgStrings := TStringList.Create;
s := AContext.Connection.IOHandler.ReadLn(IndyTextEncoding_OSDefault());
try
MsgStrings.Text := StrEscapedToString(s);
Form2.Memo3.Text := TRegEx.Replace(MsgStrings.Text, #11 + '|' + #28, '');
msg := AcknowledgementMessage(Form2.Memo3.Text);
if TRegEx.IsMatch(msg, #28#13) = True then
==> AContext.Connection.IOHandler.WriteLn(StrStringToEscaped(msg),
IndyTextEncoding_OSDefault());
if TRegEx.IsMatch(MsgStrings.Text, #11) = True then
SaveMessageToDatabase(MsgStrings);
finally
MsgStrings.Free;
end;
end;
客户端发送消息如下:
procedure TForm2.BitBtn1Click(Sender: TObject);
var
LLine: String;
I: Integer;
s: string;
begin
// wrapping for HL7
LLine := #11 + Memo1.Text + #28 + #13;
if Receiving_System_Accepts_Escaped_Strings then
HL7DM.IdTCPClient1.IOHandler.WriteLn(StrStringToEscaped(LLine),
IndyTextEncoding_OSDefault())
else
HL7DM.IdTCPClient1.IOHandler.WriteLn(LLine, IndyTextEncoding_OSDefault());
if Assigned(ACKReplyHandler) = False then
begin
ACKReplyHandler := TACK_MsgHandlingThread.Create;
//This will handle incoming HL7 ACK replies
end;
end;
TACK_MsgHandlingThread 看起来像这样:
procedure TACK_MsgHandlingThread.Execute;
begin
HandleACK_Replies;
end;
procedure TACK_MsgHandlingThread.HandleACK_Replies;
var
s: string;
begin
s := (HL7DM.IdTCPClient1.IOHandler.ReadLn(IndyTextEncoding_UTF8));
// ShowMessage(s);
s := StrEscapedToString(s);
s := TRegEx.Replace(s, #11, '');
s := TRegEx.Replace(s, #28#13#10, '');
Form2.Memo4.Clear;
Form2.Memo4.Text := (s);
end;
唯一可以阻止的方法是 TIdIOHandler.WriteLn()
如果接收方未读取已发送的数据,导致其入站缓冲区填满并阻止发送方发送更多数据。这是因为您的 TACK_MsgHandlingThread.Execute()
方法仅读取 1 个传入回复,然后在 Execute()
退出时终止线程,因此它停止读取后续回复。您需要 运行 在线程的生命周期循环中 HandleACK_Replies()
的逻辑,为发送的每个回复调用 TIdIOHandler.ReadLn()
直到套接字关闭 and/or 线程已终止。
此外,IndyTextEncoding_OSDefault
不可跨机器边界移植。但更重要的是,您在客户端使用的是 IndyTextEncoding_UTF8
。您需要在两侧使用相同的编码,否则会有数据丢失的风险。
此外,您的服务器正在访问 Memo3
,而您的客户端正在访问 Memo4
,根本没有与它们各自的 UI 线程同步。那是非常危险的。 VCL 和 FMX 框架不是线程安全的(大多数 UI 框架不是),因此从 UI 线程外部访问 UI 控件时必须同步。
我正在学习如何使用 HL7 以及 IdTCPClient 和 IdTCPServer。收到 HL7 消息,我仅从服务器收到第一条消息的确认回复。但在那之后,收到消息但没有发送确认回复。它挂在 AContext.Connection.IOHandler.WriteLn。如何让 IdTCPServer 为收到的每条消息发送确认回复?非常感谢您的意见。这是服务器端代码 onExcute:
procedure THL7DM.IdTCPServer1Execute(AContext: TIdContext);
Function AcknowledgementMessage(HL7_msg: string): string;
var
s: TStrings;
MSA: TMSASegment;
MSH: TMSHSegment;
begin
result := '';
MSH := TMSHSegment.Create(HL7_msg); {HL7 MSH Segment}
MSA := TMSASegment.Create(''); {HL7 MSA Segment}
s := TStringList.Create;
try
MSH.Accept_Acknowledgment_Type_15 := 'AA';
MSA.Acknowledgment_Code_18 := 'AA';
MSH.Sending_Facility_4 := 'AEdge Lab';
MSH.Message_Type_9 := 'ACK';
MSA.Message_Waiting_Number_1827 := DateTimeToStr(now);
s.Text := MSH.ToString + #13 + #10 + 'MSA' + '|' + MSA.ToString;
s.Text := #11 + s.Text + #28 + #13;
result := s.Text;
finally
MSA.Free;
MSH.Free;
s.Free;
end;
end;
var
MsgStrings: TStrings;
s: string;
msg: string;
begin
MsgStrings := TStringList.Create;
s := AContext.Connection.IOHandler.ReadLn(IndyTextEncoding_OSDefault());
try
MsgStrings.Text := StrEscapedToString(s);
Form2.Memo3.Text := TRegEx.Replace(MsgStrings.Text, #11 + '|' + #28, '');
msg := AcknowledgementMessage(Form2.Memo3.Text);
if TRegEx.IsMatch(msg, #28#13) = True then
==> AContext.Connection.IOHandler.WriteLn(StrStringToEscaped(msg),
IndyTextEncoding_OSDefault());
if TRegEx.IsMatch(MsgStrings.Text, #11) = True then
SaveMessageToDatabase(MsgStrings);
finally
MsgStrings.Free;
end;
end;
客户端发送消息如下:
procedure TForm2.BitBtn1Click(Sender: TObject);
var
LLine: String;
I: Integer;
s: string;
begin
// wrapping for HL7
LLine := #11 + Memo1.Text + #28 + #13;
if Receiving_System_Accepts_Escaped_Strings then
HL7DM.IdTCPClient1.IOHandler.WriteLn(StrStringToEscaped(LLine),
IndyTextEncoding_OSDefault())
else
HL7DM.IdTCPClient1.IOHandler.WriteLn(LLine, IndyTextEncoding_OSDefault());
if Assigned(ACKReplyHandler) = False then
begin
ACKReplyHandler := TACK_MsgHandlingThread.Create;
//This will handle incoming HL7 ACK replies
end;
end;
TACK_MsgHandlingThread 看起来像这样:
procedure TACK_MsgHandlingThread.Execute;
begin
HandleACK_Replies;
end;
procedure TACK_MsgHandlingThread.HandleACK_Replies;
var
s: string;
begin
s := (HL7DM.IdTCPClient1.IOHandler.ReadLn(IndyTextEncoding_UTF8));
// ShowMessage(s);
s := StrEscapedToString(s);
s := TRegEx.Replace(s, #11, '');
s := TRegEx.Replace(s, #28#13#10, '');
Form2.Memo4.Clear;
Form2.Memo4.Text := (s);
end;
唯一可以阻止的方法是 TIdIOHandler.WriteLn()
如果接收方未读取已发送的数据,导致其入站缓冲区填满并阻止发送方发送更多数据。这是因为您的 TACK_MsgHandlingThread.Execute()
方法仅读取 1 个传入回复,然后在 Execute()
退出时终止线程,因此它停止读取后续回复。您需要 运行 在线程的生命周期循环中 HandleACK_Replies()
的逻辑,为发送的每个回复调用 TIdIOHandler.ReadLn()
直到套接字关闭 and/or 线程已终止。
此外,IndyTextEncoding_OSDefault
不可跨机器边界移植。但更重要的是,您在客户端使用的是 IndyTextEncoding_UTF8
。您需要在两侧使用相同的编码,否则会有数据丢失的风险。
此外,您的服务器正在访问 Memo3
,而您的客户端正在访问 Memo4
,根本没有与它们各自的 UI 线程同步。那是非常危险的。 VCL 和 FMX 框架不是线程安全的(大多数 UI 框架不是),因此从 UI 线程外部访问 UI 控件时必须同步。