Как заставить TIdTCPServer отвечать каждый раз, когда получает сообщение? - PullRequest
Новая
       9

Как заставить TIdTCPServer отвечать каждый раз, когда получает сообщение?

0 голосов
/ 29 октября 2018

Я учусь работать с 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;

1 Ответ

0 голосов
/ 29 октября 2018

Единственный способ, которым TIdIOHandler.WriteLn() может заблокировать, - это если получатель не читает данные, которые были отправлены, что приводит к заполнению входящего буфера и не позволяет отправителю отправлять больше данных.Это связано с тем, что ваш метод TACK_MsgHandlingThread.Execute() читает только 1 входящий ответ, а затем завершает поток при выходе из Execute(), поэтому он прекращает чтение последующих ответов.Вам нужно запустить логику HandleACK_Replies() в цикле на весь срок жизни потока, вызывая TIdIOHandler.ReadLn() для каждого ответа, который отправляется до тех пор, пока сокет не будет закрыт и / или поток не завершится.

ТакжеIndyTextEncoding_OSDefault не переносится через границы машин.Но что более важно, вы используете IndyTextEncoding_UTF8 на стороне клиента.Вам необходимо использовать одну и ту же кодировку с обеих сторон, иначе вы рискуете потерять данные.

Кроме того, ваш сервер обращается к Memo3, а ваш клиент обращается к Memo4 без синхронизации с соответствующими потоками пользовательского интерфейса ввсе.Это очень опасно.Фреймворки VCL и FMX не являются поточно-ориентированными (большинство фреймворков пользовательского интерфейса - нет), поэтому вы ДОЛЖНЫ синхронизироваться при доступе к элементам управления пользовательского интерфейса извне потока пользовательского интерфейса.

...