Virtual Serial Port on USB, not working.

[Marus 0]

Hi !

I want to send data from a Raspberry Pi Pico to my laptop, on USB. The Pico is seen in Windows as a virtual serial port (COM3). I tested the Pico with Putty and indeed it sends data and Putty receive it and display it. So, the Pico side is working. Now, to read the data from COM port in my app, I use the Windows dedicated APIs. I open the port withe CreateFile and read with ReadFile. See the code below. The problem is that I don't receive anything and the code is stuck at WaitForMultipleObjects call. What could be wrong ?

 

Problem code:

procedure TCommThread.Execute;
var WaitHands: array[0..1] of THandle;
    EvOvLap: TOverLapped64;
    HasEvents: THandle;
    Dummy: DWORD;
begin
  EndReq:= CreateEvent(nil, True, False, nil);
  HasEvents:= CreateEvent(nil, True, False, nil);

  try
   FillChar(EvOvLap, SizeOf(EvOvLap), 0);
   EvOvLap.hEvent:= HasEvents;
   WaitHands[0]:= EndReq;
   WaitHands[1]:= HasEvents;

   repeat
    if WaitCommEvent(hCom, EventsMask, @EvOvLap) then HandleEvents
     else begin
       if GetLastError <> ERROR_IO_PENDING then Exit;
       if WaitForMultipleObjects(2, @WaitHands, False, INFINITE) = WAIT_OBJECT_0 + 1 then begin
         if not GetOverlappedResult(hCom, EvOvLap, Dummy, True) then Exit;
         HandleEvents;
       end;
     end;
   until Terminated;

  finally
   CloseHandle(EvOvLap.hEvent);
   CloseHandle(EndReq);
  end;
end;

 

All COM port component code:

  TCommThread = class(TThread)
  private type
    TDefaultSet = record
      BaudRate: DWORD;
      ByteSize: Byte;
      Parity: TParity;
      StopBits: TStopBit;
    end;
  private
    DCB: TDCB;
    EndReq: THandle;
    RXOvLap, TXOvLap: TOverLapped64;
    EventsMask: DWORD;
    Default: TDefaultSet;
    RX_BuffSize: Cardinal;
    procedure LoadSettings;
  protected
    hCom: THandle;
    FLineEvent: TLineEventNotify;
    ErrorMask: DWORD;
    procedure Execute; override;
    procedure HandleEvents;
    procedure DoReceive;
  public
    FOnReceive: TReceiveNotify;
    constructor Create;
    destructor  Destroy; override;
    function  OpenPort(APort: String): Boolean;
    function  ClosePort: Boolean;
    procedure SetCommParams(ABaudRate: DWORD; AByteSize: Byte = 0;
     NStopBits: TStopBit = sbDefault; AParity: TParity = ptDefault);
    function  HandleValid: Boolean;
    function  WriteComm(var Buff; ByteCount: Integer): DWORD;
    procedure SignalTerminate;
    procedure ClearComm;
  end;

constructor TCommThread.Create;
begin
  inherited Create(True);  // create suspended
  Priority:= tpHigher;
  FreeOnTerminate:= False;
  hCom:= INVALID_HANDLE_VALUE;
  FillChar(RXOvLap, SizeOf(RXOvLap), 0);
  RXOvLap.hEvent:= CreateEvent(nil, True, False, nil);
  SetCommParams(9600, 8, sbOne, ptNone);
end;

destructor TCommThread.Destroy;
begin
  ClosePort;
  CloseHandle(RXOvLap.hEvent);
end;

procedure TCommThread.SetCommParams(ABaudRate: DWORD; AByteSize: Byte = 0;
  NStopBits: TStopBit = sbDefault; AParity: TParity = ptDefault);
begin
  with Default do begin
   BaudRate:= ABaudRate;
   if AByteSize <> 0 then ByteSize:= AByteSize;
   if NStopBits <> sbDefault then StopBits:= NStopBits;
   if AParity <> ptDefault then Parity:= AParity;
  end;
  LoadSettings;
end;

procedure TCommThread.LoadSettings;
begin
  if not HandleValid then Exit;
  GetCommState(hCom, DCB);
  with DCB do begin
    BaudRate:= Default.BaudRate;
    ByteSize:= Default.ByteSize;
    Parity  := DWORD(Default.Parity);
    StopBits:= DWORD(Default.StopBits);
    Flags:= 1;
  end;
  SetCommState(hCom, DCB);
end;

function TCommThread.HandleValid: Boolean;
begin
  Result:= hCom <> INVALID_HANDLE_VALUE;
end;

function TCommThread.OpenPort(APort: String): Boolean;
begin
  Result:= False;
  if HandleValid then Exit;
  hCom:= CreateFile(PChar('\\.\'+APort), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
  if not HandleValid then Exit;
  try
   SetUpComm(hCom, 4096, 4096);
   LoadSettings;
   SetCommMask(hCom, EV_RXCHAR or EV_ERR);
   ClearComm;
   Start;
   Result:= True;
  except
   CloseHandle(hCom);
   hCom:= INVALID_HANDLE_VALUE;
  end;
end;

function TCommThread.ClosePort: Boolean;
begin
  Result:= True;
  if not HandleValid then Exit;
  SignalTerminate;
  WaitFor;
  CloseHandle(hCom);
end;

procedure TCommTHread.ClearComm;
begin
  PurgeComm(hCom, PURGE_RXCLEAR or PURGE_TXCLEAR or PURGE_RXABORT or PURGE_TXABORT);
end;

procedure TCommThread.DoReceive; { synchronize }
begin
 if Assigned(FOnReceive) then FOnReceive(RX_BuffSize);
end;

procedure TCommThread.HandleEvents;
var ComStat: TComStat;
begin
  ClearCommError(hCom, ErrorMask, @ComStat);
  // do we have an error ?
  if ErrorMask > 0 then begin
    {handle error}
  end;
  // anything received ?
  if (EventsMask and EV_RXCHAR) > 0 then begin
    RX_BuffSize:= ComStat.cbInQue;
    Synchronize(DoReceive);
    //EventsMask:= EventsMask and not EV_RXCHAR;
  end;
end;

procedure TCommThread.SignalTerminate;
begin
  FOnReceive:= nil;       // kill callbacks...
  Terminate;              // signal thread to terminate
  SetEvent(EndReq);
end;

procedure TCommThread.Execute;
var WaitHands: array[0..1] of THandle;
    EvOvLap: TOverLapped64;
    HasEvents: THandle;
    Dummy: DWORD;
begin
  EndReq:= CreateEvent(nil, True, False, nil);
  HasEvents:= CreateEvent(nil, True, False, nil);

  try
   FillChar(EvOvLap, SizeOf(EvOvLap), 0);
   EvOvLap.hEvent:= HasEvents;
   WaitHands[0]:= EndReq;
   WaitHands[1]:= HasEvents;

   repeat
    if WaitCommEvent(hCom, EventsMask, @EvOvLap) then HandleEvents
     else begin
       if GetLastError <> ERROR_IO_PENDING then Exit;
       if WaitForMultipleObjects(2, @WaitHands, False, INFINITE) = WAIT_OBJECT_0 + 1 then begin
         if not GetOverlappedResult(hCom, EvOvLap, Dummy, True) then Exit;
         HandleEvents;
       end;
     end;
   until Terminated;

  finally
   CloseHandle(EvOvLap.hEvent);
   CloseHandle(EndReq);
  end;
end;

function TCommThread.ReadComm(var Buff; BytesToRead: DWORD): Boolean;
var bRead: DWORD;
begin
  Result:= True;
  if BytesToRead > 0 then begin
    ReadFile(hCom, Buff, BytesToRead, nil, @RXOvLap);
    if not GetOverlappedResult(hCom, RXOvLap, bRead, True)
     or (bRead <> BytesToRead) then Result:= False;
  end
end;

 

[Angus Robertson 526]

Why not just use one of several open source serial port components for your communication?  No-one will want to debug your code. 

 

I've been using Async Pro for 20 years, you can install it from GetIt.

 

Angus

 

[Marus 0]

Because I don't know any... I found just one but it's not working... 

Ok, I will give it a try to Async Pro. Thanks !

[aehimself 388]

I think we used this, before getting rid of COM altogether:

 

https://github.com/CWBudde/ComPort-Library

[Marus 0]

I failed to install AsyncPro...

But I managed to install @aehimself's ComPort component and it's working. It seems that I can read the output of the Raspberry Pico and send commands to it. Thanks a lot !