delphiserial-portdelphi-xe2tcomport

TComPort data loss when trying to read ASTM 1391 data using TComDataPacket


I'm using TComPort and TComDataPacket to communicate with various medical instruments in one of my applications. I have a few lines of code in TComDataPacket.OnCustomStart and TComDataPacket.OnCustomEnd to mark start and end of the data packet depending on the instrument type. For simple packets which have a fixed start and end character pair (e.g. STX/ETX), everything works fine.

I tried to add support for the ASTM 1391 protocol using the same method. ASTM 1391 packets consist of an ENQ, one or more packets beginning with STX and ending with CR LF, and one EOT to mark the end of data transmission. And in response to the ENQ and CR LF, and ACK should be sent back. A very simple schematic of the dialog between and instrument and a computer would look like this:

Here's the code in my OnCustomStart, OnCustomEnd, and OnPacket events:

procedure TdmInstrument.cdpPacketCustomStart(Sender: TObject; const Str: string;
  var Pos: Integer);
begin
  if not FInitInfo.IsASTM then // simple packet structure
    Pos := System.Pos(FInitInfo.StartChar, Str)
  else
  begin
    Sleep(500); // no idea why this is required
    Application.ProcessMessages;
    Pos := System.Pos(cENQ, Str);
    if Pos = 0 then
    begin
      Pos := System.Pos(cSTX, Str);
      if Pos = 0 then
        Pos := System.Pos(cEOT, Str);
    end
    else
      ASTMStr := '';
  end;
end;

procedure TdmInstrument.cdpPacketCustomStop(Sender: TObject; const Str: string;
  var Pos: Integer);
begin
  if not FInitInfo.IsASTM then
    Pos := System.Pos(FInitInfo.EndChar, Str)
  else
  begin
    Pos := System.Pos(cENQ, Str);
    if Pos = 0 then
    begin
      Pos := System.Pos(cCR + cLF, Str) + 1;
      if Pos = 0 then
        Pos := System.Pos(cEOT, Str);
    end;
  end;
end;

procedure TdmInstrument.cdpPacketPacket(Sender: TObject; const Str: string);
var
  i: Integer;
begin
  if not FInitInfo.IsASTM then
  begin
    RawRecord := '';
    for i := 1 to Length(Str) do
      if Str[i] <> #0 then
        RawRecord := RawRecord + Str[i]
      else
        RawRecord := RawRecord + ' ';
  end else begin
    ASTMStr := ASTMStr + Str;
    if Str <> cEOT then
      cpCom.WriteStr(cACK);
    if Pos(cENQ, ASTMStr) * Pos(cEOT, ASTMStr) = 0 then // ASTM packet is not yet complete - exit
      Exit;
    RawRecord := ASTMStr;
  end;

  // we have a packet, so parse it
  ParsePacket;
end;

My issue is, if I do not call Sleep() with a value larger than 500 in OnCustomStart, in the OnPacket, Str is set to STX only. Since I have had this issue on more than a handful of different computers and different instruments, and even on my test machine with a loop-back virtual serial port, my guess is this has something to do with the internal structure of TComPort or TComDataPacket. Can anyone point me into the right direction?


Solution

  • You have a Typo in your Code.

    procedure TdmInstrument.cdpPacketCustomStop ...
    
    begin
      ....
    
          Pos := System.Pos(cCR + cLF, Str) + 1;
          if Pos = 0 then
            Pos := System.Pos(cEOT, Str);
      ....
    end;
    

    if Pos = 0 then . Pos never can be 0

    You should not use Pos as your variable. And using it to competition to System.Pos.

    Some code optimization

    procedure TdmInstrument.cdpPacketPacket(Sender: TObject; const Str: string);
    
    begin
      if not FInitInfo.IsASTM then
      begin
        RawRecord := '';
        if Pos(#0, Str) > 0 then Str:=Stringreplace(Str,#0,' ',[]);
        RawRecord := RawRecord + Str;
      end else begin
        ASTMStr := ASTMStr + Str;
        if (Pos(cENQ, ASTMStr) + Pos(cEOT, ASTMStr) + Pos(cCR + cLF,Str) = 0)  then 
          Exit; // ASTM packet is not yet complete - exit
                // Do Not exit if there is a `cCR + cLF`
        if Pos(cEOT, Str) = 0 then cpCom.WriteStr(cACK);
                // write only when one of  `cENQ , cCR + cLF` is present
        RawRecord := ASTMStr;
      end;
    
     // we have a packet, so parse it
      ParsePacket;
      end;