Search code examples
delphiconsole-applicationtcomport

Tcomport in console application with Delphi 10.3


I am using TComPort (4.11f) in a simple Delphi 10.3 console application, see below, but I do not get any data.

Using the same code in a VCL application works fine. Any thoughts?

My guess is that I am not connecting the ComDataPacket1 and ComPort1 objects correctly. However, I could not find another way to do it.

program commapp;

{$APPTYPE CONSOLE}

uses
  Vcl.Forms, CPort, CPortCtl, system.sysutils, classes, Windows;

{$R *.res}

var
  ComPort1: TComPort;
  ComDataPacket1: TComDataPacket;
  Sender: TObject;
  Str: string;

type
  TEventHandlers = class
    class procedure ComDataPacket1Packet(Sender: TObject; const Str: string);
  end;

class procedure TEventHandlers.ComDataPacket1Packet(Sender: TObject; const Str: string);
begin
  WriteLn('Inside the proc with ' + str);
end;

begin // Main program                 ///
  ComPort1 := TComPort.Create(nil);  // create the    comm
  ComDataPacket1 := TComDataPacket.Create(nil);
  ComPort1.BaudRate := br115200;                 // set parameters
  ComPort1.Port     := 'COM3';
  ComPort1.Parity.Bits := prNone;

  ComDataPacket1.Size := 33;
  ComDataPacket1.ComPort  := ComPort1;
  ComDataPacket1.OnPacket := TEventHandlers.ComDataPacket1Packet;
  ComDataPacket1.StartString := '';
  ComDataPacket1.StopString := '';

  if ParamCount = 0 then // no paramters passed enter menu
  begin
    ComPort1.ShowSetupDialog; // Open the port settings.
    ComPort1.Open;
    ComPort1.WriteStr('b') ;  // Send the command to start sending data
    WriteLn('After sending an b I get  :  ' + str); 
    ReadLn;
  end;

  // release the components
  ComDataPacket1.Free;
  ComPort1.Free;
end.

Solution

  • Try running a message loop while waiting for the OnPacket event to fire, eg:

    program commapp;
    
    {$APPTYPE CONSOLE}
    
    uses
      Vcl.Forms, CPort, CPortCtl, System.SysUtils,
      System.Classes, Winapi.Windows, System.SyncObjs;
    
    {$R *.res}
    
    var
      ComPort1: TComPort;
      ComDataPacket1: TComDataPacket;
      DataEvent: TEvent;
      hEvent: THandle;
      DataStr: string;
    
    type
      TEventHandlers = class
        class procedure ComDataPacket1Packet(Sender: TObject; const Str: string);
      end;
    
    class procedure TEventHandlers.ComDataPacket1Packet(Sender: TObject; const Str: string);
    begin
      WriteLn('Inside the proc with ' + Str);
      DataStr := Str;
      DataEvent.SetEvent;
    end;
    
    begin // Main program
      ComPort1 := TComPort.Create(nil); // create the comm
      ComDataPacket1 := TComDataPacket.Create(nil);
      DataEvent := TEvent.Create;
    
      ComPort1.BaudRate := br115200; // set parameters
      ComPort1.Port := 'COM3';
      ComPort1.Parity.Bits := prNone;
    
      ComDataPacket1.Size := 33;
      ComDataPacket1.ComPort := ComPort1;
      ComDataPacket1.OnPacket := TEventHandlers.ComDataPacket1Packet;
      ComDataPacket1.StartString := '';
      ComDataPacket1.StopString := '';
    
      if ParamCount = 0 then // no paramters passed enter menu
      begin
        ComPort1.ShowSetupDialog; // Open the port settings.
      end;
    
      ComPort1.Open;
      ComPort1.WriteStr('b') ; // Send the command to start sending data
    
      hEvent := DataEvent.Handle;
      repeat
        case MsgWaitForMultipleObjects(1, hEvent, False, INFINITE, QS_ALLINPUT) of
          WAIT_OBJECT_0: Break;
          WAIT_OBJECT_0 + 1: Application.HandleMessage; // or Application.ProcessMessages()
          WAIT_FAILED: RaiseLastOSError;
        end;
      until False;
    
      WriteLn('After sending an b I get : ' + DataStr);
      ReadLn;
    
      // release the components
      DataEvent.Free;
      ComDataPacket1.Free;
      ComPort1.Free;
    end.