JS 

unit ComPort;


interface

uses
  SysUtils, Windows, Variants, Classes;

type
  EComPortError = class(Exception);

  TBaudRate = (br110 = CBR_110,
               br300 = CBR_300,
               br600 = CBR_600,
               br1200 = CBR_1200,
               br2400 = CBR_2400,
               br4800 = CBR_4800,
               br9600 = CBR_9600,
               br14400 = CBR_14400,
               br19200 = CBR_19200,
               br38400 = CBR_38400,
               br56000 = CBR_56000,
               br57600 = CBR_57600,
               br115200 = CBR_115200,
               br128000 = CBR_128000,
               br256000 = CBR_256000);

  TComPort = class;

  {Reading thread}
  TReadThread = class(TThread)
  private
    FBuf: array[ 0 ..$FF] of Byte;
    FComPort: TComPort;
    FOverRead: TOverlapped;
    FRead: DWORD;
    procedure DoRead;
  protected
    procedure Execute; override;
  public
    constructor Create(ComPort: TComPort);
    destructor Destroy; override;
  end;

  {Reading event}
  TReadEvent = procedure(Sender: TObject; ReadBytes: array of Byte) of object;

  {Com port class}
  TComPort = class
  private
    FOverWrite: TOverlapped;
    FPort: THandle;
    FPortName: String;
    FReadEvent: TReadEvent;
    FReadThread: TReadThread;
  public
    constructor Create(PortNumber: Cardinal; BaudRate: TBaudRate);
    destructor Destroy; override;
    procedure Write(WriteBytes: array of Byte);
  published
    property OnRead: TReadEvent read FReadEvent write FReadEvent;
    property PortName: String read FPortName;
  end;

implementation

constructor TReadThread.Create(ComPort: TComPort);
begin
  FComPort := ComPort;
  ZeroMemory(@FOverRead, SizeOf(FOverRead));

  {Event}
  FOverRead.hEvent := CreateEvent(nil, True, False, nil);

  if FOverRead.hEvent = Null then
    raise EComPortError.Create('Error creating read event');

  inherited Create(False);
end;

destructor TReadThread.Destroy;
begin
  CloseHandle(FOverRead.hEvent);

  inherited Destroy;
end;

procedure TReadThread.Execute;
var
  ComStat: TComStat;
  dwMask, dwError: DWORD;
begin
  FreeOnTerminate := True;

  while not Terminated do
  begin
    if not WaitCommEvent(FComPort.FPort, dwMask, @FOverRead) then
    begin
      if GetLastError = ERROR_IO_PENDING then
        WaitForSingleObject(FOverRead.hEvent, INFINITE)
      else
        raise EComPortError.Create('Error waiting port ' + FComPort.PortName
          + ' event');
    end;

    if not ClearCommError(FComPort.FPort, dwError, @ComStat) then
      raise EComPortError.Create('Error clearing port ' + FComPort.PortName);

    FRead := ComStat.cbInQue;

    if FRead >  0  then
    begin
      if not ReadFile(FComPort.FPort, FBuf, FRead, FRead, @FOverRead) then
        raise EComPortError.Create('Error reading port ' + FComPort.PortName);

      Synchronize(DoRead);
    end;
  end; {while}
end;

procedure TReadThread.DoRead;
var
  arrBytes: array of Byte;
  i: Integer;
begin
  if Assigned(FComPort.FReadEvent) then
  begin
    SetLength(arrBytes, FRead);
    for i := Low(FBuf) to FRead -  1  do
      arrBytes[i] := FBuf[i];

    FComPort.FReadEvent(Self, arrBytes);

    arrBytes := nil;
  end;  
end;

constructor TComPort.Create(PortNumber: Cardinal; BaudRate: TBaudRate);
var
  Dcb: TDcb;
begin
  inherited Create;

  ZeroMemory(@FOverWrite, SizeOf(FOverWrite));
  FPortName := 'COM' + IntToStr(PortNumber);

  {Open port}
  FPort := CreateFile(PChar(PortName),
    GENERIC_READ or GENERIC_WRITE,  0 , nil,
    OPEN_EXISTING, FILE_FLAG_OVERLAPPED,  0 );

  if FPort = INVALID_HANDLE_VALUE then
    raise EComPortError.Create('Error opening port ' + PortName);


  try
    {Set port state}
    if not GetCommState(FPort, Dcb) then
      raise EComPortError.Create('Error setting port ' + PortName + ' state');

    Dcb.BaudRate := DWORD(BaudRate);
    Dcb.Parity := NOPARITY;
    Dcb.ByteSize :=  8 ;
    Dcb.StopBits := ONESTOPBIT;

    if not SetCommState(FPort, Dcb) then
      raise EComPortError.Create('Error setting port ' + PortName + ' state');

    {Purge port}
    if not PurgeComm(FPort, PURGE_TXCLEAR or PURGE_RXCLEAR) then
      raise EComPortError.Create('Error purging port ' + PortName);

    {Set mask}
    if not SetCommMask(FPort, EV_RXCHAR) then
      raise EComPortError.Create('Error setting port ' + PortName + ' mask');

    FOverWrite.hEvent := CreateEvent(nil, True, False, nil);

    if FOverWrite.hEvent = Null then
      raise EComPortError.Create('Error creating write event');

    {Reading thread}
    FReadThread := TReadThread.Create(Self);
  except
    CloseHandle(FOverWrite.hEvent);
    CloseHandle(FPort);
    raise;
  end;
end;

destructor TComPort.Destroy;
begin
  if Assigned(FReadThread) then
    FReadThread.Terminate;
    
  CloseHandle(FOverWrite.hEvent);
  CloseHandle(FPort);

  inherited Destroy;
end;

procedure TComPort.Write(WriteBytes: array of Byte);
var
  dwWrite: DWORD;
begin
  if  (not WriteFile(FPort, WriteBytes, SizeOf(WriteBytes), dwWrite, @FOverWrite))
  and (GetLastError <> ERROR_IO_PENDING) then
    raise EComPortError.Create('Error writing port ' + PortName);
end;

end.

TReadEvent = procedure(Sender: TObject; ReadBytes: array of Byte) of object;

TReadEvent = procedure(Sender: TObject; ReadBytes: array of Byte) of object;

typedef void __fastcall (__closure * TReadEvent)(TObject * Sender , char * ReadBytes);