I am learning how to work with HL7 and IdTCPClient and IdTCPServer. The HL7 message is received and I get an acknowledgement reply from the server only for the first message. But after that, messages are received but no acknowledgement reply is sent. It hangs at AContext.Connection.IOHandler.WriteLn. How can you make the IdTCPServer send acknowledgement replies for every message it receives? Your input is highly appreciated. Here is the server side code 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;
Here is the Client side sending the message:
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;
The TACK_MsgHandlingThread looks like this:
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;
The only way TIdIOHandler.WriteLn() can block is if the receiver is not reading data that has been sent, causing its inbound buffer to fill up and stop the sender from sending more data. This is because your TACK_MsgHandlingThread.Execute() method is reading only 1 incoming reply and then terminating the thread when Execute() exits, so it stops reading subsequent replies. You need to run the logic of HandleACK_Replies() in a loop for the lifetime of the thread, calling TIdIOHandler.ReadLn() for each reply that is sent until the socket is closed and/or the thread is terminated.
Also, IndyTextEncoding_OSDefault is not portable across machine boundaries. But more importantly, you are using IndyTextEncoding_UTF8 on the client side instead. You need to use the same encoding on both sides or else you risk data loss.
Also, your server is accessing Memo3, and your client is accessing Memo4, without syncing with their respective UI threads at all. That is very dangerous. The VCL and FMX frameworks are not thread-safe (most UI frameworks are not), so you MUST synchronize when accessing UI controls from outside of the UI thread.
Related
I started implementing a system using a client server connection with a TIdCmdTcpServer and a TIdTcpClient.
The connection is established fine and communication seems to work in general, too. But LastCmdResults contains always the response of the command issued before the last command. It starts with an empty response for the TcpClient.Connect and then continues with a "welcome" as a response to the first TcpClient.SendCmd ('LIST'). When I issue the LIST command again I get the desired result but for the one before (tested with a counter variable).
Relevant Code Snippets:
Initialising Command Handler
CmdHandler := TCPCmdServer.CommandHandlers.Add;
CmdHandler.Name := 'cmhList';
CmdHandler.Command := 'LIST';
CmdHandler.OnCommand := Cmd_ListDevices;
CmdHandler.ExceptionReply.NumericCode := 550;
CmdHandler.Disconnect := FALSE;
TCPCmdServer.Active := TRUE;
Command handler event Cmd_ListDevices
procedure TSPM_Server.Cmd_ListDevices (aSender : TIdCommand);
begin
aSender.Reply.SetReply (200, 'List');
aSender.Reply.Text.Add ('Device 1');
aSender.Reply.Text.Add ('Device 2');
aSender.Reply.Text.Add ('Device 3');
aSender.SendReply;
end;
Client Side
function TSPM_TCPClient.Connect (var aResponseText : string) : boolean;
begin
TcpClient.Connect;
aResponseText := TcpClient.LastCmdResult.Text.Text;
result := TcpClient.Connected;
end;
function TSPM_TCPClient.RequestList (var aList : string) : integer;
begin
aList := '';
result := TcpClient.SendCmd ('LIST');
if result = 200 then
begin
aList := 'CMD: ' + TcpClient.LastCmdResult.DisplayName + sLineBreak
+ TcpClient.LastCmdResult.Text.Text;
end;
end;
Anything obviously wrong here?
LastCmdResults contains always the response of the command issued before the last command
That happens when you have the server setup to send a greeting when a new client connects (see the TIdCmdTCPServer.Greeting property), but your client code is not reading that greeting. The greeting remains in the client's receive buffer until it is read. So, the 1st SendCmd() will read the greeting, then the 2nd SendCmd() will read the response of the 1st SendCmd(), and so on.
After TIdTCPClient.Connect() is successful, call TIdTCPClient.GetResponse() immediately to read the greeting, TIdTCPClient.Connect() will not read it for you, eg:
function TSPM_TCPClient.Connect (var aResponseText : string) : boolean;
begin
TcpClient.Connect;
try
TcpClient.GetResponse(200); // <-- add this!
aResponseText := TcpClient.LastCmdResult.Text.Text;
Result := True;
except
TcpClient.Disconnect;
Result := False;
end;
end;
Then you can call TIdTCPClient.SendCmd() afterwards as needed.
With the TIdTCPServer component of Indy, a package is received in two fractions but the client sent one with 64 KB.
How do I receive the complete package in the Server OnExecute event?
Now I put a prototype (Server and Client) code to recreate the situation.
Server Code
procedure TFrmServer.IdTCPServer1Execute(AContext: TIdContext);
Var
ReceivedBytesTCP : Integer;
IBuf : TIdBytes;
begin
if Not AContext.Connection.IOHandler.InputBufferIsEmpty then Begin
Try
ReceivedBytesTCP := AContext.Connection.IOHandler.InputBuffer.Size;
SetLength(IBuf,ReceivedBytesTCP);
AContext.Connection.IOHandler.ReadBytes(IBuf,ReceivedBytesTCP,False);
AContext.Connection.IOHandler.Write(IBuf,Length(IBuf),0);
Except
On E : Exception Do Begin
Memo1.Lines.Add('Except Server TCP: ' + E.Message);
End;
End;
End Else Begin
Sleep(1);
End;
end;
Client Code
procedure TFrm_TCP_Client.BtnSendClick(Sender: TObject);
Var
IBuf,RBuf : TIdBytes;
I : Integer;
LenPacket : Integer;
begin
LenPacket := StrToInt(EdtLength.Text);
if IdTCPClient1.Connected then Begin
SetLength(IBuf,LenPacket);
for I := 1 to LenPacket do
IBuf[I] := 1;
IdTCPClient1.IOHandler.Write(IBuf,Length(IBuf),0);
I := 0;
Repeat
IdTCPClient1.IOHandler.CheckForDataOnSource(50);
Inc(I);
Until Not IdTCPClient1.IOHandler.InputBufferIsEmpty or (I >= 10);
If Not IdTCPClient1.IOHandler.InputBufferIsEmpty Then Begin
SetLength(RBuf,IdTCPClient1.IOHandler.InputBuffer.Size);
IdTCPClient1.IOHandler.ReadBytes(RBuf,IdTCPClient1.IOHandler.InputBuffer.Size,False);
if Length(RBuf) = Length(IBuf) then
Memo1.Lines.Add('Response Received OK: '+IntToStr(Length(RBuf)))
Else
Memo1.Lines.Add('Response Received With Different Length: '+IntToStr(Length(RBuf)));
if Not IdTCPClient1.IOHandler.InputBufferIsEmpty then
Memo1.Lines.Add('Llego otro Mensaje');
End Else Begin
Memo1.Lines.Add('NO Response Received');
End;
End;
end;
How to know that a message is the first or the second fragment?
How to force the receive of second fragment?
There is no 1-to-1 relationship between sends and reads in TCP. It is free to fragment data however it wants to optimize network transmissions. TCP guarantees only that data is delivered, and in the same order it was sent, but nothing about HOW data is fragmented during transmission. TCP will reconstruct the fragments on the receiving end. This is simply how TCP works, it is not unique to Indy. Every TCP app has to deal with this issue regardless of which TCP framework is used.
If you are expecting 64KB of data, then simply read 64KB of data, and let the OS and Indy handle the fragments internally for you. This fragmentation of TCP is exactly why Indy's IOHandler uses an InputBuffer to collect the fragments when piecing data back together.
Update: stop focusing on fragments. That is an implementation detail at the TCP layer, which you are not operating at. You don't need to deal with fragments in your code. Let Indy handle it for you. Just focus on your application level protocol instead.
And FYI, you have essentially implemented an ECHO client/server solution. Indy has actual ECHO client/server components, TIdECHO and TIdECHOServer, you should have a look at them.
In any case, your server-side exception handling is very problematic. It is not syncing with the main UI thread (OnExecute is called in a worker thread). But, more importantly, it as preventing TIdTCPServer from processing any notifications issued by Indy itself when the client connection is lost/disconnected, so the client thread will keep running and not stop until you deactivate the server. DO NOT swallow Indy's own exceptions (which are derived from EIdException). If you need to catch them in your code, you should re-raise them when done, let TIdTCPServer process them. But, in your example, it would be easier to remove the try..except altogether and use the server's OnException event instead.
Also, your client-side reading loop is wrong for what you are attempting to do with it. You are not initializing IBuf correctly. But, more importantly, you are using a very short timeout (TCP connections may have latency), and you are breaking your reading loop as soon as any data arrives or 500ms max have elapsed, even if there is more data still coming. You should be reading until there is nothing left to read.
Try something more like this instead:
Server:
procedure TFrmServer.IdTCPServer1Execute(AContext: TIdContext);
var
IBuf : TIdBytes;
begin
AContext.Connection.IOHandler.ReadBytes(IBuf, -1);
AContext.Connection.IOHandler.Write(IBuf);
end;
procedure TFrmServer.IdTCPServer1Exception(AContext: TIdContext, AException: Exception);
var
Msg: string;
begin
if AException <> nil then
Msg := AException.Message
else
Msg := 'Unknown';
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add('Except Server TCP: ' + Msg);
end
);
end;
Client:
procedure TFrm_TCP_Client.BtnSendClick(Sender: TObject);
Var
IBuf,RBuf : TIdBytes;
LenPacket : Integer;
begin
if not IdTCPClient1.Connected then Exit;
LenPacket := StrToInt(EdtLength.Text);
if LenPacket < 1 then Exit;
SetLength(IBuf, LenPacket);
FillBytes(IBuf, LenPacket, $1);
try
IdTCPClient1.IOHandler.InputBuffer.Clear;
IdTCPClient1.IOHandler.Write(IBuf);
except
Memo1.Lines.Add('Request Send Error');
Exit;
end;
try
while IdTCPClient1.IOHandler.CheckForDataOnSource(500) do;
if not IdTCPClient1.IOHandler.InputBufferIsEmpty then
begin
IdTCPClient1.IOHandler.ReadBytes(RBuf, IdTCPClient1.IOHandler.InputBuffer.Size, True);
if Length(RBuf) = Length(IBuf) then
Memo1.Lines.Add('Response Received OK: ' + IntToStr(Length(RBuf)))
else
Memo1.Lines.Add('Response Received With Different Length. Expected: ' + IntToStr(Length(IBuf)) + ', Got: ' + IntToStr(Length(RBuf)));
end
else
Memo1.Lines.Add('NO Response Received');
except
Memo1.Lines.Add('Response Receive Error');
end;
end;
A better solution would be to not rely on such logic at all, be more explicit about the structure of your data protocol, for instance <length><data>, eg:
Server:
procedure TFrmServer.IdTCPServer1Execute(AContext: TIdContext);
var
IBuf : TIdBytes;
LenPacket : Int32;
begin
LenPacket := AContext.Connection.IOHandler.ReadInt32;
AContext.Connection.IOHandler.ReadBytes(IBuf, LenPacket, True);
AContext.Connection.IOHandler.Write(LenPacket);
AContext.Connection.IOHandler.Write(IBuf);
end;
procedure TFrmServer.IdTCPServer1Exception(AContext: TIdContext, AException: Exception);
var
Msg: string;
begin
if AException <> nil then
Msg := AException.Message
else
Msg := 'Unknown';
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add('Except Server TCP: ' + Msg);
end
);
end;
Client:
procedure TFrm_TCP_Client.BtnSendClick(Sender: TObject);
Var
IBuf,RBuf : TIdBytes;
LenPacket : Int32;
begin
if not IdTCPClient1.Connected then Exit;
LenPacket := StrToInt(EdtLength.Text);
if LenPacket < 1 then Exit;
SetLength(IBuf, LenPacket);
FillBytes(IBuf, LenPacket, $1);
try
IdTCPClient1.IOHandler.InputBuffer.Clear;
IdTCPClient1.IOHandler.Write(LenPacket);
IdTCPClient1.IOHandler.Write(IBuf);
except
Memo1.Lines.Add('Request Send Error');
Exit;
end;
try
IdTCPClient1.IOHandler.ReadTimeout := 5000;
LenPacket := IdTCPClient1.IOHandler.ReadInt32;
IdTCPClient1.IOHandler.ReadBytes(RBuf, LenPacket, True);
except
Memo1.Lines.Add('Response Receive Error');
Exit;
end;
Memo1.Lines.Add('Response Received OK');
end;
I have 2 applications- Manager with this code:
procedure TForm1.CopyData(var Msg: TWMCopyData);
var sMsg: String;
begin
if IsIconic(Application.Handle) then Application.Restore;
sMsg := PWideChar(Msg.CopyDataStruct.lpData);
Caption := Caption+'#'+sMsg;
Msg.Result := 123;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
WM_MY_MESSAGE = WM_USER + 1;
var
h: HWND;
begin
Caption := 'X';
h := FindWindow('TForm1', 'Client');
if not IsWindow(h) then Exit;
Caption := Caption+'#';
SendMessage(h, WM_MY_MESSAGE, 123, 321);
end;
And Client with:
procedure TForm1.WndProc(var Message: TMessage);
const
WM_MY_MESSAGE = WM_USER + 1;
var DataStruct: CopyDataStruct;
S: String;
h: HWND;
begin
inherited;
if Message.Msg <> WM_MY_MESSAGE then Exit;
h := FindWindow('TForm1', 'Manager');
if not IsWindow(h) then Exit;
Message.Result := 123;
S := Edit2.Text + '#' + Edit1.Text;
DataStruct.dwData := 0;
DataStruct.cbData := 2*Length(S)+1;
DataStruct.lpData := PWideChar(S);
Caption := Caption + '#';
PostMessage(h, WM_CopyData, Form1.handle, integer(#DataStruct));
end;
The code works- but only once.
Manager sends 2 integers: 123 and 321 as a "wake up" message to the Client.
Client responds by sending contents of Edit1 + Edit2.
Then Manager gets this data and shows on its caption.
Why does it work only once? After I click Button1 again it does nothing.
As noted in comments, you must use SendMessage with WM_COPYDATA. The primary reason for this is that the message sender is responsible for cleaning up the resources used for the transfer. As noted in the documentation :
The receiving application should consider the data read-only. The lParam parameter is valid only during the processing of the message. The receiving application should not free the memory referenced by lParam. If the receiving application must access the data after SendMessage returns, it must copy the data into a local buffer.
The only way this can work is if the message sender waits for the receiver to process the message and return a result. Otherwise the sender cannot know when it is safe to release those resources.
PostMessage is asynchronous and returns immediately so this is simply not viable. SendMessage will block until the receiver processes the message and assigns a return value.
Here you are passing a pointer to a stack allocated (local variable) record #DataStruct. Further, you are also passing a pointer to a string which is a local variable. If you use PostMessage, this method will return immediately - the stack locations (for value types like the record) will become invalid and susceptible to being overwritten. The string lives on the heap but is reference counted and, in this case, will be freed when the method returns.
The solution is to always be sure to use SendMessage with WM_COPYDATA.
I want to read a string from my Arduino via Usb(Serial).
I made this script but it has a problem:
procedure TForm1.ApdComPort1TriggerAvail(CP: TObject; Count: Word);
var
msg:string;
I:word;
C:ansichar;
begin
msg := '';
for I := 1 to count do
begin
C := apdComPort1.GetChar;
if C = #7 = false then
begin
if C in [#32..#126] then
begin
msg := msg + C;
end;
end;
end;
listbox1.Items.Add(msg);
msg := '';
end;
The problem is that the "count" isn't right.
For example, when i send "Backspace" this is the output:
Bac
kspace
But on the arduino serial monitor it works fine.
Does anyone know why the the "count" isn't right and how to fix it?
You are assuming a 1-to-1 relationship between the complete data and the event. There is no such guarantee. It may take multiple events to receive the complete data. The event is simply reporting that there is some data available at that moment. In your example, you likely received an event for 3 characters, and then received a second event for the remaining 6 characters. You called Add() twice, once for each portion of data, rather than once for the complete data.
As such, you have to analyze the data you are receiving, caching it as needed between events, and then call Add() only when you have complete data to display. For example:
var
msg: string;
procedure TForm1.ApdComPort1TriggerAvail(CP: TObject; Count: Word);
var
I: Word;
C: AnsiChar;
begin
for I := 1 to Count do
begin
C := apdComPort1.GetChar;
if C <> #7 then
begin
if C in [#32..#126] then
begin
msg := msg + C;
end;
end else
begin
ListBox1.Items.Add(msg);
msg := '';
end;
end;
end;
As Remy said, when receiving data in serial communication you may have many events triggerin for the same string. In fact each byte is an event, but drivers usually buffer the data.
To know the end of your message you should add some char sequence at the end of this message. If you send the string from Arduino using Serial.println() instead of Serial.print(), then it will add a new line mark after the text. This way you just need to add the characters to the ListBox1.Items.Text property instead of using Add function. You need to allow the chars #10 and #13 to make this work.
procedure TForm1.ApdComPort1TriggerAvail(CP: TObject; Count: Word);
var
C: AnsiChar;
begin
while Count > 0 do
begin
Dec(Count);
C := apdComPort1.GetChar;
if C in [#32..#126, #10, #13] then
begin
ListBox1.Items.Text := ListBox1.Items.Text + C;
end;
end;
end;
Also, if you do it this way, you don't need to send the bell character (#7).
So I'm having this code that processes what the client sends on a pattern. If he sends 'getBENUds', the server sends the DataSet for this table back using the SaveToString method.
Then, this is sent to the client. (I'm using Synapse).
procedure TTCPSocketThrd.Execute;
var s: String;
strm: TMemoryStream;
ADO_CON: TADOConnection;
ADO_QUERY: TADOQuery;
DS_PROV: TDataSetProvider;
DS_CLIENT: TClientDataSet;
begin
CoInitialize(nil);
Sock := TTCPBlockSocket.Create;
try
Sock.Socket := CSock;
Sock.GetSins;
with Sock do
begin
repeat
if terminated then break;
s := RecvTerminated(60000,'|');
if s = 'getBENUds' then
begin
//ini ADO_CON
ADO_CON := TADOConnection.Create(Form1);
ADO_CON.ConnectionString := 'not for public';
ADO_CON.LoginPrompt := false;
ADO_CON.Provider := 'SQLOLEDB.1';
ADO_CON.Open;
//ini ADO_QUERY
ADO_QUERY := TADOQuery.Create(ADO_CON);
ADO_QUERY.Connection := ADO_CON;
//ini DS_PROV
DS_PROV := TDataSetProvider.Create(ADO_CON);
DS_PROV.DataSet := ADO_QUERY;
//ini DS_CLIENT
DS_CLIENT := TClientDataSet.Create(ADO_CON);
DS_CLIENT.ProviderName := 'DS_PROV';
//SQLQUERY Abfrage
ADO_QUERY.SQL.Clear;
ADO_QUERY.SQL.Add('SELECT * FROM BENU');
ADO_QUERY.Open;
//DSCLIENTDATASET bauen
strm := TMemoryStream.Create;
DS_CLIENT.Open;
DS_CLIENT.SaveToStream(strm);
end
else if s = 'getBESTEds' then
...
The line it says: DS_CLIENT.Open an exception is thrown:
An exception has been thrown: class EDatabaseError. Text: 'missing data-provider or data package'.
The data-provider has been set as can be seen above to 'DS_PROV', so it has to be the missing data package.
But shouldn't the ClientDataSet get its data from the DataSetProvider which in turn gets it from the ADOQuery that gets the data from the database?
This is as far as I get with my level of knowledge. I hope its not too difficult, because in my eyes, everything I did was correct.
Use
DS_CLIENT.SetProvider(DS_PROV);
or after DS_PROV creation: (at this time your component has really no name)
DS_PROV.name := 'DS_PROV';