////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2023 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Communication ports.                                                       //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20011101 - Creation by A.K.                                                //
// 20011209 - First tested release                                            //
// 20020302 - bug fixed, I hope                                               //
// 20030330 - Struggle for safety (add some try/except checks)...             //
//            TUart.ReadConfig added.                                         //
// 20040709 - Uses \\.\COMn instead of COM. Problems with COMn, n>9 fixed.    //
// 20050221 - DcbFlags                                                        //
// 20061212 - EnumComPorts                                                    //
// 20210827 - MaxPortNum is now upto 255; Uart.Poll optimization.             //
// 20230801 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_uart; // Universal Asyncronouse Receiver / Transmitter

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
_crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
{$IFDEF UNIX} cthreads, dl, {$ENDIF}
{$IFDEF WINDOWS} windows, {$ENDIF}
sysutils, classes, math,
_crw_alloc, _crw_fifo, _crw_rtc, _crw_str, _crw_fio, _crw_polling, _crw_serio;

 {
 *******************************************************************************
 Назначение.
  Этот модуль предназначен для работы с последовательными портами (COM-портами)
  применительно к задачам измерений с внешними устройствами RS-232/422/485.
  Этот модуль НЕ содержит работы с сигналами RTS,CTS,DTR,RING & etc, так как
  в указанных задачах обычно используется 3-проводной RS-232 (Rx,Tx,Gnd) или
  RS-485 и эти сигналы просто не нужны. В то же время модуль ориентирован на
  интенсивную работу с многими портами в многопоточных измерительных задачах.
 *******************************************************************************
 Принцип работы.
     Прост до предела. Всеми операциями I/O занимается один высокоприоритетный
  поток, который общается с клиентскими потоками через FIFO. Поток периодически
  сканирует порты и инициирует необходимые операции чтения/записи, беря данные
  из FIFO передатчика и помещая в FIFO приемника, а также регистрируя ошибки.
     Этот метод не блещет изощренностью, но представляется наиболее устойчивым к
  возможным сбоям, а кроме того, он проще, чем работа по событиям или сообщениям,
  а потому кажется предпочтительнее. Тем более, что нагрузка CPU при работе
  оказалась близка к 0 (диспетчер задач Windows 2000 показывает 0).
     Из организации I/O в отдельным потоке вытекает наличие задержки в цикле
  запрос-ответ, связанного с переключением задач. Например, в Windows 2000 эта
  задержка составляет ровно 20 ms на сообщение (независимо от его длины), так
  что скорость опроса при этом не более 50 циклов опроса в секунду (50 Гц).
 *******************************************************************************
 Программирование.
  Вся работа с портами идет ТОЛЬКО через объект uart, который создается при
  запуске программы автоматически. Его нельзя удалять или создавать
  самостоятельно. Если надо приостановить обмен, надо использовать вызов
  uart.Polling.Enable(..).
     Для работы с портом номер n используется ссылка uart[n]. Сначала надо
  открыть порт вызовом uart[n].Open(...). При этом uart[n].Active становится true.
  Для ввода-вывода используются операторы uart[n].WriteStr(s), uart[n].ReadStr.
  Через вызовы RxCount,TxCount,RxSpace,TxSpace,RxTotal,TxTotal можно узнать
  число байт, накопленных в FIFO, свободное число байт в FIFO, а также полное
  число переданных или принятых байт соответственно. Процедуры RxClear,TxClear
  абортируют ввод-вывод и очищают все буферы.
     Для работы с устройствами в качестве Host - компьютера RS-485 предназначен
  набор функций типа запрос-ответ. RequestAvailable служит для проверки
  возможности инициировать запрос (когда запрос уже сделан, новый запрос
  невозможен до окончания первого). RaiseRequest возбуждает запрос, который
  посылается в порт, и запоминает состояние запроса. Потом надо периодически
  проверять состояние запроса при помощи AnswerRequest. Если Вызов AnswerRequest
  вернул rs_NoRequest - линия свободна, можно делать запрос, rs_Wait - идет
  ожидание ответа, rs_Answer - пришел ответ, rs_TimeOut - время ожидания истекло,
  rs_Error - при ошибке.
  Предполагается, что в промежутке между вызовами делается что-то полезное.
  ModalAnswerRequest напротив останавливает выполнение потока до получения
  ответа на запрос либо таймаута. Все аналогично CRW16.
     В конце работы с портом надо закрыть его вызовом uart[n].Close.
     Кажется, это все. Тайм-ауты организуются на верхнем уровне, uart только тупо
  передает и принимает все что может. Пакеты лучше анализировать по контрольным
  суммам, формату и так далее. Сделана максимальная защита от ошибок, которую
  только смог придумать. Вызов не проинициализированного uart, не открытого
  порта, ошибочный номер порта и прочие вещи не должны давать сбой программы,
  только тайм-ауты и нули. На низком уровне используются только стандартные
  средства Win32, поэтому надеюсь, что с переносимостью не будет проблем.
 *******************************************************************************
 Конфигурирование.
  Конфигурация порта задается при его открытии и не меняется до закрытия, это
  в данном круге задач не надо. Можно конфигурировать порт через INI-файл:
  uart[1].OpenConfig('example.cfg','[SerialPort-COM1]')
   [SerialPort-COM1]
   Port = COM1        ; идентификатор COM-порта
   BaudRate = 115200  ; скорость передачи, бод
   Parity = NONE      ; проверка на четность - NONE, ODD, EVEN , MARK, SPACE
   DataBits = 8       ; число бит данных
   StopBits = 1       ; число стоп-бит 1, 1.5, 2
   XonXoff = false    ; использовать ли протокол XON/XOFF
   BufSize = 8        ; размер буфера fifo в килобайтах
  Текущую конфигурацию можно прочитать через метод GetProperties. 
 *******************************************************************************
 Пример программирования.
  if uart[1].Open(9600,NOPARITY,8,ONESTOPBIT,false,4096) then begin
   Echo('Open COM1.');
   uart[1].WriteStr('Send this string to COM1.');
   Echo('Read from COM1:'+uart[1].ReadStr);
   Echo('Rx FIFO contains '+d2s(uart[1].RxCount)+' bytes.');
   Echo('Rx FIFO free space '+d2s(uart[1].RxSpace)+' bytes.');
   Echo('Received '+d2s(uart[1].RxTotal)+' bytes.');
   uart[1].Close;
  end;
 *******************************************************************************
 Справка по разъемам:
 Разьем COM2 (25pin):
  2 : TXD   Transmit Data                передатчик данных
  3 : RXD   Receive Data                 приемник данных
  4 : RTS   Request To Send              запрос на передачу данных
  5 : CTS   Clear To Send                открыт для передачи
  6 : DSR   Data Set Ready               готов к передаче данных
  7 : GND   GrouND                       общий (земля)
  8 : RLSD  Received Line Signal Detect  детектор сигнала приемной линии
  20: DTR   Data Terminal Ready          терминал данных готов
  22: RI    Ring Indicator
 Разьем COM1 (9pin):
  2 :RXD
  3 :TXD
  5 :GND
 Кабель для соединения 2-х машин должен быть крест-накрест
  шнур PC    - PC    ¦ GND - GND ¦  RXD - TXD ¦ TXD - RXD
  шнур PC 25 - PC 25 ¦  7  -  7  ¦  3  -  2   ¦  2  -  3
  шнур PC  9 - PC 25 ¦  5  -  7  ¦  2  -  2   ¦  3  -  3
 Кабель для соединения PC-ADAM4520 другой:
  шнур PC     - ADAM 4050  ¦ GND - GND ¦ TXD - TXD  ¦  RXD - RXD ¦
  шнур 25 pin - 9 pin      ¦  7  -  5  ¦  2  -  3   ¦   3  -  2  ¦
  (при режиме приемо-передачи RTS должен быть еще RTS-RTS:4-7)
 *******************************************************************************
 }

const
 MaxPortNum         = 250;       { Max number of ports, [1..255]. }
 RxBufferSize       = 1024;      { Size of buffer for Rx transfer }
 TxBufferSize       = 1024;      { Size of buffer for Tx transfer }
 RxQueueSize        = 4096;      { Size of Rx queue buffer }
 TxQueueSize        = 4096;      { Size of Tx queue buffer }
 UartFifoGrowFactor = 2;         { Grow factor for FIFO }
 UartFifoGrowLimit  = 1024*128;  { Max size of FIFO buffer }

const
 NOPARITY     = 0;
 ODDPARITY    = 1;
 EVENPARITY   = 2;
 MARKPARITY   = 3;
 SPACEPARITY  = 4;
 ONESTOPBIT   = 0;
 ONE5STOPBITS = 1;
 TWOSTOPBITS  = 2;

type
 TPortNum           = 1..MaxPortNum;
 TParity            = NOPARITY..SPACEPARITY;   {NOPARITY,ODDPARITY,EVENPARITY,MARKPARITY,SPACEPARITY}
 TDataBits          = 5..8;
 TStopBits          = ONESTOPBIT..TWOSTOPBITS; {ONESTOPBIT,ONE5STOPBITS,TWOSTOPBITS}
 TUartErrors        = (ue_TOTAL,        { All errors. }
                       ue_RXOVER,       { Receive Queue overflow. }
                       ue_OVERRUN,      { Receive Overrun Error. }
                       ue_RXPARITY,     { Receive Parity Error. }
                       ue_FRAME,        { Receive Framing error. }
                       ue_BREAK,        { Break Detected. }
                       ue_TXFULL,       { TX Queue is full. }
                       ue_IOE,          { An I/O error occurred during communications with the device. }
                       ue_MODE,         { The requested mode unsupported, or file handle is invalid.}
                       ue_RxFIFO_OVER,  { Receiver fifo overflow. }
                       ue_TxFIFO_OVER,  { Transmitter fifo overflow. }
                       ue_BLOCKMODE,    { Blocking mode }
                       ue_UNEXPECTED);  { Unexpected error. }
 TRequestStatus     = (rs_NoRequest,    { запрос не возникал или был обработан }
                       rs_WaitAnswer,   { ожидание ответа после запроса }
                       rs_Answer,       { пришел ответ после посылки запроса }
                       rs_TimeOut,      { ответ не пришел за указанное время }
                       rs_Error);       { ошибка-запрос невозможен или занят }
 {
 *******************************************************************************
 Warning:
  TUartPort is public component of TUart class and never should be use alone.
  Only TUart may create or destroy TUartPort object!
  TUartPort and should not be create or destroy in other way!
 *******************************************************************************
 }
type
 TUart = class;
 TUartPort = class(TLatch)
 private
  myUart      : TUart;
  myPortNum   : TPortNum;
  myPortName  : packed array[0..31] of char;
  myFileName  : packed array[0..31] of char;
  myCommFile  : TSerialHandle;
  mySerState  : TSerialState;
  myRxFifo    : TFifo;
  myTxFifo    : TFifo;
  myRxTotal   : Int64;
  myTxTotal   : Int64;
  myTxQueue   : LongInt;
  myRxBuff    : packed array[0..SerBuffSize-1] of Char;
  myTxBuff    : packed array[0..SerBuffSize-1] of Char;
  myErrors    : packed array[TUartErrors] of DWORD;
  myRequest   : packed record
   Inquiry    : ShortString;
   Answer     : ShortString;
   Timer      : TIntervalTimer;
   Delimiter  : Char;
  end;
  function    GetActive:Boolean;
  function    GetError(ErrorCode:TUartErrors):DWORD;
  function    GetRxCount:Integer;
  function    GetTxCount:Integer;
  function    GetRxSpace:Integer;
  function    GetTxSpace:Integer;

  function    GetRxTotal:Int64;
  function    GetTxTotal:Int64;
 protected
  procedure   FixHardwareError(lpError:DWORD);
  procedure   FixError(ErrorCode:TUartErrors);
  procedure   Poll;
 public { internally use only }
  constructor Create(aUart:TUart; aPortNum:TPortNum);
  destructor  Destroy; override;
 public { open / close port }
  function    Open(aBaudrate : LongInt   = 9600;
                   aParity   : TParity   = NOPARITY;
                   aDataBits : TDataBits = 8;
                   aStopBits : TStopBits = ONESTOPBIT;
                   aXonXoff  : Boolean   = false;
                   aFifoSize : LongInt   = 4096;
                   aDcbFlags : LongInt   = 0 ) : Boolean;
  function    OpenConfig(const IniFile,Section:LongString):Boolean;
  function    Ctrl(const param:LongString):LongString;
  procedure   Close;
 public { general input / output routines }
  function    WriteBuf(const Data:PChar; Count:Cardinal):Cardinal;
  function    ReadBuf(var Data:PChar; MaxCount:Cardinal):Cardinal;
  function    WriteStr(const Data:LongString):Boolean;
  function    ReadStr(MaxCount:Byte=255):LongString;
 public { miscellaneous routines }
  procedure   RxClear;
  procedure   TxClear;
  function    GetProperties(TheText:TText):TText;
 public { RS-485 host routines in style "request-answer" }
  function    RequestAvailable:Boolean;
  function    RaiseRequest(const aInquiry   : ShortString;
                                 aTimeOutMs : double;
                                 aDelimiter : Char = ASCII_CR):Boolean;
  function    AnswerRequest(var Inquiry     : ShortString;
                            var Answer      : ShortString;
                            var InquiryTime : double ) : TRequestStatus;
  procedure   ClearRequest;
  function    ModalAnswerRequest(const aInquiry   : ShortString;
                                       aTimeOutMs : double;
                                       aDelimiter : Char = ASCII_CR):ShortString;
 public { properties }
  property    Active:Boolean read GetActive;
  property    Errors[ErrorCode:TUartErrors]:DWORD read GetError;
  property    RxCount:Integer read GetRxCount;
  property    TxCount:Integer read GetTxCount;
  property    RxSpace:Integer read GetRxSpace;
  property    TxSpace:Integer read GetTxSpace;
  property    RxTotal:Int64   read GetRxTotal;
  property    TxTotal:Int64   read GetTxTotal;
 end;
 {
 *******************************************************************************
 Genegal communication ports class.
 Uart is one and only available TUart class object.
 *******************************************************************************
 Example:
  if uart[1].Open then begin                       // try open port COM1
   uart[1].WriteStr('Send this string to COM1.');  // write string to port
   Echo('Read from COM1:'+uart[1].ReadStr);        // read string from port
   uart[1].Close;                                  // close port
  end;                                             //
 *******************************************************************************
 }
 TUart = class(TLatch)
 private
  myPorts   : packed array[1..MaxPortNum] of TUartPort;
  myPollStr : ShortString;
  myPollMap : TByteSet;
  myPolling : TPolling;
  function    GetPort(Num:TPortNum):TUartPort;
  function    GetPolling:TPolling;
  function    GetPollMap:TByteSet;
  procedure   SetPollMap(const Map:TByteSet);
  procedure   GetPollStr(var Str:ShortString);
  procedure   EnablePolling(Num:Integer; Enable:boolean);
  procedure   Poll;
 protected
  property    PollMap : TByteSet read GetPollMap write SetPollMap;
 public
  constructor Create(aDelay    : Integer         = 1;
                     aPriority : TThreadPriority = tpHighest);
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
  destructor  Destroy; override;
  function    GetProperties(TheText : TText;
                      const Prefix  : LongString = 'SerialPort-'):TText;
  procedure   ReadConfig(const IniFile,Section:LongString);
 public
  property    Port[Num:TPortNum] : TUartPort read GetPort; default;
  property    Polling            : TPolling  read GetPolling;
 end;

 {
 *******************************************************************************
 Uart is one and only one instance of TUart class object.
 ALL working with communication ports we have to do via uart object.
 Never create or kill any other TUart objects!
 *******************************************************************************
 }
function uart:TUart;

 {
 *******************************************************************************
 Check sum utilites.
 Check sums uses to make data transfer more robust and stable. This set of
 check sum functions is similar with Advantec ADAM-4000 seria, I-7000 seria
 devices & etc. This devices have data package format DATA+CS+CR, where
 DATA is data chars, CS is check sum of DATA as 2-chars HEX string, CR is char(13).
 For example, package '$08MD9'+CR is '$08M' data, 'D9' checksum, and CR.
 FindCheckSum    - находит контрольную сумму строки, то есть сумму всех байтов
                   без учета переполнения.
 CatCheckSum     - добавляет в конец строки контрольную сумму в виде HEX - строки.
 CatCheckSumCR   - добавляет в конец строки перед символом CR контрольную сумму
                   в виде HEX - строки.
 TruncCheckSum   - делает проверку контрольной суммы и выделение исходной строки
                   без контрольной суммы. Если сумма не совпала, возвращается
                   пустая строка.
 TruncCheckSumCR - делает проверку контрольной суммы и выделение исходной строки
                   без контрольной суммы. Если сумма не совпала, возвращается
                   пустая строка. Если в конце строки CR, он подавляется.
 *******************************************************************************
 }
function FindCheckSum(Data:PChar; Length:Integer):Byte;
function CatCheckSum(const DataStr:LongString):LongString;
function CatCheckSumCR(const DataStr:LongString; CR:Char=ASCII_CR):LongString;
function TruncCheckSum(const DataStr:LongString):LongString;
function TruncCheckSumCR(const DataStr:LongString; CR:Char=ASCII_CR):LongString;

 {
 EnumComPorts returns CR,LF separated list of available COM ports.
 }
function EnumComPorts(const Delim:LongString=EOL):LongString;

const // WinApi ClearCommError
 CE_RXOVER   = 1;
 CE_OVERRUN  = 2;
 CE_RXPARITY = 4;
 CE_FRAME    = 8;
 CE_BREAK    = 16;
 CE_TXFULL   = 256;
 CE_PTO      = 512;
 CE_IOE      = 1024;
 CE_DNS      = 2048;
 CE_OOP      = 4096;
 CE_MODE     = 32768;

implementation

 {
 ************************
 TUartPort implementation
 ************************
 }

constructor TUartPort.Create(aUart:TUart; aPortNum:TPortNum);
begin
 inherited Create;
 Lock;
 try
  myUart:=aUart;
  myPortNum:=aPortNum;
  StrPCopy(myPortName,SerPortMap.ComName[myPortNum]);
  StrPCopy(myFileName,SerPortMap.PathName[myPortNum]);
  myCommFile:=INVALID_HANDLE_VALUE;
  myRxFifo:=nil;
  myTxFifo:=nil;
  myRxTotal:=0;
  myTxTotal:=0;
  myTxQueue:=0;
  SerClearState(mySerState);
  SafeFillChar(myErrors,sizeof(myErrors),0);
  myRequest.Inquiry:='';
  myRequest.Answer:='';
  myRequest.Timer:=nil;
  myRequest.Delimiter:=ASCII_CR;
 finally
  Unlock;
 end;
end;

destructor  TUartPort.Destroy;
begin
 try
  Lock;
  try
   myUart.EnablePolling(myPortNum,false);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Destroy');
 end;
 Close;
 inherited Destroy;
end;

function TUartPort.GetActive:Boolean;
begin
 Result:=false;
 if Assigned(Self) then begin
  Lock;
  Result:=SerValidHandle(myCommFile);
  Unlock;
 end;
end;

function TUartPort.GetError(ErrorCode:TUartErrors):DWORD;
begin
 Result:=0;
 if Assigned(Self) and (ErrorCode>=Low(myErrors)) and (ErrorCode<=High(myErrors)) then begin
  Lock;
  Result:=myErrors[ErrorCode];
  Unlock;
 end;
end;

function TUartPort.GetRxCount:Integer;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myRxFifo.Count;
  Unlock;
 end;
end;

function TUartPort.GetTxCount:Integer;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myTxFifo.Count;
  Unlock;
 end;
end;

function TUartPort.GetRxSpace:Integer;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myRxFifo.Space;
  Unlock;
 end;
end;

function TUartPort.GetTxSpace:Integer;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myTxFifo.Space;
  Unlock;
 end;
end;

function TUartPort.GetRxTotal:Int64;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myRxTotal;
  Unlock;
 end;
end;

function TUartPort.GetTxTotal:Int64;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myTxTotal;
  Unlock;
 end;
end;

procedure TUartPort.FixHardwareError(lpError:DWORD);
begin
 if lpError<>0 then begin
  if lpError and CE_RXOVER   <> 0 then FixError(ue_RXOVER);
  if lpError and CE_OVERRUN  <> 0 then FixError(ue_OVERRUN);
  if lpError and CE_RXPARITY <> 0 then FixError(ue_RXPARITY);
  if lpError and CE_FRAME    <> 0 then FixError(ue_FRAME);
  if lpError and CE_BREAK    <> 0 then FixError(ue_BREAK);
  if lpError and CE_TXFULL   <> 0 then FixError(ue_TXFULL);
  if lpError and CE_IOE      <> 0 then FixError(ue_IOE);
  if lpError and CE_MODE     <> 0 then FixError(ue_MODE);
 end;
end;

procedure TUartPort.FixError(ErrorCode:TUartErrors);
begin
 if Assigned(Self) and (ErrorCode>=Low(myErrors)) and (ErrorCode<=High(myErrors)) then begin
  Lock;
  inc(myErrors[ue_TOTAL]);
  inc(myErrors[ErrorCode]);
  Unlock;
 end;
end;

function TUartPort.Open(aBaudrate : LongInt   = 9600;
                        aParity   : TParity   = NOPARITY;
                        aDataBits : TDataBits = 8;
                        aStopBits : TStopBits = ONESTOPBIT;
                        aXonXoff  : Boolean   = false;
                        aFifoSize : LongInt   = 4096;
                        aDcbFlags : LongInt   = 0 ) : Boolean;
 function SetupCommPortParameters:Boolean;
 var RxQ,TxQ:Cardinal; Flags:TSerialFlags;
     aSerStopBits:TSerStopBits; aSerParity:TSerParityType;
 begin
  Result:=false;
  Flags:=[];
  DcbFlagsToSerFlags(aDcbFlags,Flags);
  aSerParity:=TSerParityType(aParity);
  aSerStopBits:=TSerStopBits(aStopBits);
  if not SerValidHandle(myCommFile) then Exit;
  if (GetFileType(myCommFile)<>FILE_TYPE_CHAR) then Exit;
  if not SerSetParams(mySerState,aBaudRate,aDataBits,aSerParity,aSerStopBits,Flags) then Exit;
  if not SerSetParams(myCommFile,mySerState) then Exit;
  if not SerHasNonBlockFlag(myCommFile) then
  if not SerSetNonBlockFlag(myCommFile) then Exit;
  if not SerFlushRxTx(myCommFile) then Exit;
  mySerState:=SerSaveState(myCommFile);
  Result:=true;
 end;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   Close;
   myCommFile:=SerOpen(myFileName,O_SERNOBLK);
   if SerValidHandle(myCommFile) then begin
    if SetupCommPortParameters then begin
     myRxFifo:=NewFifo(aFifoSize); myRxFifo.GrowFactor:=UartFifoGrowFactor; myRxFifo.GrowLimit:=UartFifoGrowLimit;
     myTxFifo:=NewFifo(aFifoSize); myTxFifo.GrowFactor:=UartFifoGrowFactor; myTxFifo.GrowLimit:=UartFifoGrowLimit;
     myRequest.Timer:=NewIntervalTimer;
     myRequest.Timer.AddIntervalMs(200,1);
     myUart.EnablePolling(myPortNum,true);
     Result:=true;
    end else Close;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Open');
 end;
end;

procedure TUartPort.Close;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myUart.EnablePolling(myPortNum,false);
   if SerValidHandle(myCommFile) then begin
    SerFlushRxTx(myCommFile);
    SerClose(myCommFile);
   end;
   Kill(myRxFifo);
   Kill(myTxFifo);
   myRxTotal:=0;
   myTxTotal:=0;
   myTxQueue:=0;
   SerClearState(mySerState);
   SafeFillChar(myErrors,sizeof(myErrors),0);
   myRequest.Inquiry:='';
   myRequest.Answer:='';
   Kill(myRequest.Timer);
   myRequest.Delimiter:=ASCII_CR;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Close');
 end;
end;

procedure TUartPort.Poll;
var RxData,TxData:LongString; RxCounter,TxCounter:LongInt;
 //lpStat:ComStat;
 procedure CheckCommErrors;
 {$IFDEF WINDOWS}var lpErrors:DWORD;{$ENDIF}
 begin
  {$IFDEF WINDOWS}
  if ClearCommError(myCommFile,lpErrors,nil)
  then FixHardwareError(lpErrors) else lpErrors:=0;
  {$ENDIF}
 end;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if SerValidHandle(myCommFile) then begin
    {
    Enforce nonblocking IO mode.
    }
    if not SerHasNonBlockFlag(myCommFile) then
    if not SerSetNonBlockFlag(myCommFile) then FixError(ue_BLOCKMODE);
    {
    Read from COMM
    }
    RxCounter:=SerRead(myCommFile,myRxBuff,SizeOf(myRxBuff));
    if (RxCounter>0) then begin
     if (myRxFifo.Put(@myRxBuff[0],RxCounter)=RxCounter)
     then Inc(myRxTotal,RxCounter)
     else FixError(ue_RxFIFO_OVER);
    end else
    if (RxCounter<0) then begin
     FixError(ue_UNEXPECTED);
     SerFlushRx(myCommFile);
    end;
    {
    Write to COMM
    }
    TxCounter:=SizeOf(myTxBuff)-myTxQueue;
    if (TxCounter>0) then begin
     TxCounter:=myTxFifo.Get(@myTxBuff[myTxQueue],TxCounter);
     if (TxCounter>0) then Inc(myTxQueue,TxCounter);
    end;
    if (myTxQueue>0) then begin
     TxCounter:=SerWrite(myCommFile,myTxBuff[0],myTxQueue);
     if (TxCounter>0) then begin
      Inc(myTxTotal,TxCounter);
      if (myTxQueue>TxCounter)
      then SafeMove(myTxBuff[TxCounter],myTxBuff[0],myTxQueue-TxCounter);
      Dec(myTxQueue,TxCounter);
     end else
     if (TxCounter<0) then begin
      FixError(ue_UNEXPECTED);
      SerFlushTx(myCommFile);
     end;
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function TUartPort.WriteBuf(const Data:PChar; Count:Cardinal):Cardinal;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myTxFifo.Put(@Data[0],Count);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'WriteBuf');
 end;
end;

function TUartPort.ReadBuf(var Data:PChar; MaxCount:Cardinal):Cardinal;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myRxFifo.Get(@Data[0],MaxCount);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function TUartPort.WriteStr(const Data:LongString):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myTxFifo.PutText(Data);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'WriteStr');
 end;
end;

function TUartPort.ReadStr(MaxCount:Byte=255):LongString;
begin
 Result:='';
 if Assigned(Self) then
 if (maxCount>0) then
 try
  Lock;
  try
   Result:=myRxFifo.GetText(MaxCount);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'ReadStr');
 end;
end;

procedure TUartPort.RxClear;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if SerValidHandle(myCommFile) then begin
    SerFlushRx(myCommFile);
    myRxFifo.Clear;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'RxClear');
 end;
end;

procedure TUartPort.TxClear;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if SerValidHandle(myCommFile) then begin
    SerFlushTx(myCommFile);
    myTxFifo.Clear;
    myTxQueue:=0;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'TxClear');
 end;
end;

function  TUartPort.RequestAvailable:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=SerValidHandle(myCommFile) and Assigned(myRequest.Timer) and not myRequest.Timer.isStart;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function TUartPort.RaiseRequest(const aInquiry   : ShortString;
                                      aTimeOutMs : double;
                                      aDelimiter : Char = ASCII_CR):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   if RequestAvailable then begin
    RxClear;
    TxClear;
    if WriteStr(aInquiry) then begin
     myRequest.Inquiry:=aInquiry;
     myRequest.Answer:='';
     myRequest.Timer.IntervalMs[0]:=aTimeOutMs;
     myRequest.Timer.Start;
     myRequest.Delimiter:=aDelimiter;
     Result:=true;
    end else begin
     myRequest.Inquiry:='';
     myRequest.Answer:='';
     myRequest.Delimiter:=ASCII_CR;
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function TUartPort.AnswerRequest(var Inquiry     : ShortString;
                                 var Answer      : ShortString;
                                 var InquiryTime : double ) : TRequestStatus;
var
 DelimPos : integer;
begin
 Result:=rs_Error;
 if Assigned(Self) then
 try
  Lock;
  try
   if SerValidHandle(myCommFile) and Assigned(myRequest.Timer) then begin
    {если возникал запрос}
    if myRequest.Timer.isStart then begin
     myRequest.Answer:=myRequest.Answer+ReadStr;
     { если пришел ответ, читаем его и очищаем запрос }
     DelimPos:=Pos(myRequest.Delimiter,myRequest.Answer);
     if (DelimPos>0) then begin
      Result:=rs_Answer;
      Inquiry:=myRequest.Inquiry;
      Answer:=Copy(myRequest.Answer,1,DelimPos-1);
      InquiryTime:=myRequest.Timer.StartTime;
      ClearRequest;
     end
     {если ответа нет - это или ожидание, или тайм аут}
     else begin
      { при обнаружении тайм аута очищаем запрос}
      if myRequest.Timer.Event then begin
       Result:=rs_TimeOut;
       Inquiry:=myRequest.Inquiry;
       Answer:='';
       InquiryTime:=myRequest.Timer.StartTime;
       ClearRequest;
      end
      {если нет тайм аута - продолжаем ожидание}
      else begin
       Result:=rs_WaitAnswer;
       Inquiry:=myRequest.Inquiry;
       Answer:='';
       InquiryTime:=myRequest.Timer.StartTime;
      end;
     end;
    end
    {запроса не возникало}
    else begin
     Result:=rs_NoRequest;
     Inquiry:='';
     Answer:='';
     InquiryTime:=0;
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

procedure TUartPort.ClearRequest;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   RxClear;
   TxClear;
   myRequest.Inquiry:='';
   myRequest.Answer:='';
   myRequest.Timer.Stop;
   myRequest.Delimiter:=ASCII_CR;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function TUartPort.ModalAnswerRequest(const aInquiry   : ShortString;
                                            aTimeOutMs : double;
                                            aDelimiter : Char = ASCII_CR):ShortString;
var
 Inquiry  : ShortString;
 Answer   : ShortString;
 TimeMsec : double;
begin
 Result:='';
 if RaiseRequest(aInquiry,aTimeOutMs,aDelimiter) then begin
  while true do
  case AnswerRequest(Inquiry,Answer,TimeMsec) of
   rs_NoRequest  : break;
   rs_WaitAnswer : Sleep(1);
   rs_Answer     : begin Result:=Answer; break; end;
   rs_TimeOut    : break;
   rs_Error      : break;
   else break;
  end;
 end;
end;

function TUartPort.GetProperties(TheText:TText):TText;
 procedure AddVal(const msg:LongString; val:LongInt);
 begin
  if (Val<>0) then TheText.Addln(msg+' : '+d2s(val));
 end;
begin
 Result:=TheText;
 if Assigned(Self) then
 try
  Lock;
  try
   if Active then with mySerState do begin
    TheText.AddLn('Port = '+StrPas(myPortName));
    TheText.Addln('BaudRate = '+d2s(DCB.BaudRate));
    case DCB.Parity of
     NOPARITY    : TheText.Addln('Parity = NONE');
     ODDPARITY   : TheText.Addln('Parity = ODD');
     EVENPARITY  : TheText.Addln('Parity = EVEN');
     MARKPARITY  : TheText.Addln('Parity = MARK');
     SPACEPARITY : TheText.Addln('Parity = SPACE');
    end;
    TheText.Addln('DataBits = '+d2s(DCB.ByteSize));
    case DCB.StopBits of
     ONESTOPBIT   : TheText.Addln('StopBits = 1');
     ONE5STOPBITS : TheText.Addln('StopBits = 1.5');
     TWOSTOPBITS  : TheText.Addln('StopBits = 2');
    end;
    TheText.Addln('XonXoff = '+d2s(ord(DCB.Flags and ((DWORD(1) shl fInX)+(DWORD(1) shl fOutX))<>0)));
    TheText.Addln('BufSize = '+d2s(myRxFifo.Size div 1024)+' KB');
    TheText.Addln('DcbFlags= $'+HexW(Dcb.Flags));
    TheText.Addln('TRAFFIC INFORMATION:');
    TheText.Addln(' Rx total, bytes    : '+d2s(RxTotal));
    TheText.Addln(' Tx total, bytes    : '+d2s(TxTotal));
    TheText.Addln(' Rx contains, bytes : '+d2s(RxCount));
    TheText.Addln(' Tx contains, bytes : '+d2s(TxCount));
    if Errors[ue_Total]<>0 then begin
     TheText.AddLn('ERRORS DETECTED:');
     AddVal('Total errors    ',Errors[ue_TOTAL]);
     AddVal('Rx overflow     ',Errors[ue_RXOVER]);
     AddVal('Rx overrun      ',Errors[ue_OVERRUN]);
     AddVal('Parity          ',Errors[ue_RXPARITY]);
     AddVal('Framing         ',Errors[ue_FRAME]);
     AddVal('Break           ',Errors[ue_BREAK]);
     AddVal('Tx overflow     ',Errors[ue_TXFULL]);
     AddVal('I/O error       ',Errors[ue_IOE]);
     AddVal('Мode unsupported',Errors[ue_MODE]);
     AddVal('Rx FmyPortNameIFO overflow',Errors[ue_RxFIFO_OVER]);
     AddVal('Tx FIFO overflow',Errors[ue_TxFIFO_OVER]);
     AddVal('Blocking Mode   ',Errors[ue_BLOCKMODE]);
     AddVal('Unexpected error',Errors[ue_UNEXPECTED]);
    end;
   end else begin
    TheText.Addln('Port is not accessible.');
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function TUartPort.OpenConfig(const IniFile,Section:LongString):Boolean;
var
 BaudRate  : LongInt;
 Parity    : TParity;
 DataBits  : LongInt;
 StopBits  : LongInt;
 XonXoff   : Boolean;
 BufSize   : LongInt;
 fStopBits : Double;
 s         : ShortString;
 DcbFlags  : LongInt;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   if ReadIniFileVariable(IniFile,Section,'Port%a',s) then
   if SameText(s,myPortName) then begin
    if not ReadIniFileVariable(IniFile,Section,'BaudRate%d',BaudRate) then BaudRate:=9600;
    if not ReadIniFileVariable(IniFile,Section,'Parity%a',s) then s:='NOPARITY';
    s:=UnifyAlias(s);
    if (s='NONE')  or (s='NOPARITY')    or (s='N') then Parity:=NOPARITY    else
    if (s='ODD')   or (s='ODDPARITY')   or (s='O') then Parity:=ODDPARITY   else
    if (s='EVEN')  or (s='EVENPARITY')  or (s='E') then Parity:=EVENPARITY  else
    if (s='MARK')  or (s='MARKPARITY')  or (s='M') then Parity:=MARKPARITY  else
    if (s='SPACE') or (s='SPACEPARITY') or (s='S') then Parity:=SPACEPARITY else Parity:=NOPARITY;
    if not ReadIniFileVariable(IniFile,Section,'DataBits%d',DataBits) then DataBits:=8;
    if ReadIniFileVariable(IniFile,Section,'StopBits%f',fStopBits) then begin
     if fStopBits=1.0 then StopBits:=ONESTOPBIT   else
     if fStopBits=1.5 then StopBits:=ONE5STOPBITS else
     if fStopBits=2.0 then StopBits:=TWOSTOPBITS  else StopBits:=ONESTOPBIT;
    end else StopBits:=ONESTOPBIT;
    if not ReadIniFileVariable(IniFile,Section,'XonXoff%b',XonXoff) then XonXoff:=false;
    if not ReadIniFileVariable(IniFile,Section,'BufSize%d',BufSize) then BufSize:=4;
    if not ReadIniFileVariable(IniFile,Section,'DcbFlags%d',DcbFlags) then DcbFlags:=0;
    Result:=Open(BaudRate,Parity,DataBits,StopBits,XonXoff,BufSize*1024,DcbFlags);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function TUartPort.Ctrl(const param:LongString):LongString;
var p,n:Integer; sn,sv:LongString; r:Double; SaveDcb:TDCB;
 function UpdateDcb:Boolean;
 begin
  Result:=false;
  with mySerState do begin
   if not SetCommState(myCommFile,DCB) then begin DCB:=SaveDcb; Exit; end;
   if not GetCommState(myCommFile,DCB) then begin DCB:=SaveDcb; Exit; end;
  end;
  Result:=true;
 end;
begin
 Result:='?';
 if Assigned(Self) then
 if Active then
 with mySerState do
 try
  Lock;
  try
   SaveDcb:=DCB;
   p:=System.Pos('=',param);
   if p=0 then begin
    sn:=SysUtils.Trim(param);
    sv:='';
   end else begin
    sn:=SysUtils.Trim(System.Copy(param,1,p-1));
    sv:=SysUtils.Trim(System.Copy(param,p+1,length(param)-p));
   end;
   if SameText(sn,'BaudRate') then begin
    if (p>0) and Str2Int(sv,n) then begin
     DCB.BaudRate:=n;
     if not UpdateDcb then Exit;
    end;
    Result:=d2s(DCB.BaudRate);
    Exit;
   end;
   if SameText(sn,'Parity') then begin
    if (p>0) then begin
     sv:=UpCaseStr(Trim(sv));
     if (sv='NONE')  or (sv='NOPARITY')    or (sv='N') then n:=NOPARITY    else
     if (sv='ODD')   or (sv='ODDPARITY')   or (sv='O') then n:=ODDPARITY   else
     if (sv='EVEN')  or (sv='EVENPARITY')  or (sv='E') then n:=EVENPARITY  else
     if (sv='MARK')  or (sv='MARKPARITY')  or (sv='M') then n:=MARKPARITY  else
     if (sv='SPACE') or (sv='SPACEPARITY') or (sv='S') then n:=SPACEPARITY else n:=-1;
    end else n:=-1;
    if (p>0) and (n>=0) then begin
     DCB.Parity:=n;
     if not UpdateDcb then Exit;
    end;
    case DCB.Parity of
     NOPARITY    : Result:='NONE';
     ODDPARITY   : Result:='ODD';
     EVENPARITY  : Result:='EVEN';
     MARKPARITY  : Result:='MARK';
     SPACEPARITY : Result:='SPACE';
    end;
    Exit;
   end;
   if SameText(sn,'DataBits') then begin
    if (p>0) and Str2Int(sv,n) then begin
     DCB.ByteSize:=n;
     if not UpdateDcb then Exit;
    end;
    Result:=d2s(DCB.ByteSize);
    Exit;
   end;
   if SameText(sn,'StopBits') then begin
    if (p>0) and Str2Real(sv,r) then begin
     if r=1.0 then DCB.StopBits:=ONESTOPBIT   else
     if r=1.5 then DCB.StopBits:=ONE5STOPBITS else
     if r=2.0 then DCB.StopBits:=TWOSTOPBITS;
     if not UpdateDcb then Exit;
    end;
    case DCB.StopBits of
     ONESTOPBIT   : Result:='1';
     ONE5STOPBITS : Result:='1.5';
     TWOSTOPBITS  : Result:='2';
    end;
    Exit;
   end;
   if SameText(sn,'DcbFlags') then begin
    if (p>0) and Str2Int(sv,n) then begin
     DCB.Flags:=n;
     if not UpdateDcb then Exit;
    end;
    Result:='$'+HexW(DCB.Flags);
    Exit;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

 {
 ********************
 TUart implementation
 ********************
 }
procedure UartPollAction(aPolling:TPolling; var Terminate:Boolean);
begin
 if (aPolling.LinkObject is TUart)
 then TUart(aPolling.LinkObject).Poll
 else Terminate:=true;
end;

constructor TUart.Create(aDelay    : Integer         = 1;
                         aPriority : TThreadPriority = tpHighest);
var i:Integer;
begin
 inherited Create;
 myPollStr:='';
 myPollMap:=[];
 for i:=Low(myPorts) to High(myPorts) do begin
  myPorts[i]:=TUartPort.Create(Self,i);
  myPorts[i].Master:=@myPorts[i];
 end;
 myPolling:=NewPolling(UartPollAction, aDelay, aPriority, false, 'System.Uart');
 myPolling.Master:=@myPolling;
 myPolling.LinkObject:=Self;
end;

procedure TUart.AfterConstruction;
begin
 inherited AfterConstruction;
 Polling.Enable(true);
end;

procedure TUart.BeforeDestruction;
begin
 Polling.Enable(false);
 inherited BeforeDestruction;
end;

destructor TUart.Destroy;
var i:Integer;
begin
 PollMap:=[];
 Kill(myPolling);
 for i:=Low(myPorts) to High(myPorts) do Kill(TObject(myPorts[i]));
 inherited Destroy;
end;

function TUart.GetPort(Num:TPortNum):TUartPort;
begin
 if Assigned(Self) and (Num>=Low(myPorts)) and (Num<=High(myPorts))
 then Result:=myPorts[Num]
 else Result:=nil;
end;

function TUart.GetPolling:TPolling;
begin
 if Assigned(Self) then Result:=myPolling else Result:=nil;
end;

function TUart.GetPollMap:TByteSet;
begin
 if (Self=nil) then begin Result:=[]; Exit; end;
 Lock;
 try
  Result:=myPollMap;
 finally
  Unlock;
 end;
end;

procedure TUart.SetPollMap(const Map:TByteSet);
var PortNum:Integer;
begin
 if (Self=nil) then Exit;
 Lock;
 try
  myPollMap:=Map;
  myPollStr:='';
  for PortNum:=Low(myPorts) to High(myPorts) do
  if (PortNum in myPollMap) then myPollStr:=myPollStr+Chr(PortNum);
 finally
  Unlock;
 end;
end;

procedure TUart.GetPollStr(var Str:ShortString);
begin
 if (Self=nil) then Exit;
 Lock;
 try
  Str:=myPollStr;
 finally
  Unlock;
 end;
end;

procedure TUart.EnablePolling(Num:Integer; Enable:boolean);
var Map:TByteSet;
begin
 if (Self=nil) then Exit;
 Lock;
 try
  Map:=PollMap;
  if Enable then Include(Map,Num) else Exclude(Map,Num);
  PollMap:=Map;
 finally
  Unlock;
 end;
end;

procedure TUart.Poll;
var i,PortNum:Integer; Str:ShortString;
begin
 if (Self=nil) then Exit;
 Str:=''; GetPollStr(Str);
 for i:=1 to Length(Str) do begin
  PortNum:=Ord(Str[i]);
  if (PortNum>=Low(myPorts)) and (PortNum<=High(myPorts)) then myPorts[PortNum].Poll;
 end;
end;

function TUart.GetProperties(TheText : TText;
                       const Prefix  : LongString = 'SerialPort-'):TText;
var PortNum:TPortNum;
begin
 Result:=TheText;
 if Assigned(Self) then begin
  TheText.Addln('[System]');
  TheText.AddLn(Format('UartPolling = %d, %s',[Polling.Delay,GetPriorityName(Polling.Priority)]));
  for PortNum:=Low(myPorts) to High(myPorts) do
  if Port[PortNum].Active then begin
   TheText.Addln('['+Prefix+'COM'+d2s(PortNum)+']');
   Port[PortNum].GetProperties(TheText);
  end;
 end;
end;

procedure TUart.ReadConfig(const IniFile,Section:LongString);
var D:Integer; P:TThreadPriority;
begin
 if Assigned(Self) then begin
  D:=10; P:=tpNormal;
  if ReadIniFilePolling(IniFile,Section,'UartPolling',D,P) then begin
   Polling.Delay:=D;
   Polling.Priority:=P;
  end;
 end;
end;

 {
 *******************************************************************************
 Check sum utilites implementation.
 *******************************************************************************
 }
function FindCheckSum(Data:PChar; Length:Integer):Byte;
var i:Integer;
begin
 Result:=0;
 for i:=0 to Length-1 do Inc(Result,Ord(Data[i]));
end;

function CatCheckSum(const DataStr:LongString):LongString;
begin
 Result:=DataStr+HexB(FindCheckSum(@DataStr[1],Length(DataStr)));
end;

function CatCheckSumCR(const DataStr:LongString; CR:Char=ASCII_CR):LongString;
var Len:integer;
begin
 Len:=Length(DataStr);
 if (StrFetch(DataStr,Len)=CR)
 then Result:=Copy(DataStr,1,Len-1)+HexB(FindCheckSum(@DataStr[1],Len-1))+CR
 else Result:=DataStr+HexB(FindCheckSum(@DataStr[1],Len));
end;

function TruncCheckSum(const DataStr:LongString):LongString;
var Len:integer;
begin
 Result:='';
 Len:=Length(DataStr);
 if (Len>2) and (HexB(FindCheckSum(@DataStr[1],Len-2))=Copy(DataStr,Len-1,2))
 then Result:=Copy(DataStr,1,Len-2);
end;

function TruncCheckSumCR(const DataStr:LongString; CR:Char=ASCII_CR):LongString;
var Len:Integer;
begin
 Result:='';
 Len:=Length(DataStr);
 if (StrFetch(DataStr,Len)=CR) then Dec(Len);
 if (Len>2) and (HexB(FindCheckSum(@DataStr[1],Len-2))=Copy(DataStr,Len-1,2))
 then Result:=Copy(DataStr,1,Len-2);
end;

function EnumComPorts(const Delim:LongString=EOL):LongString;
var Ports:TStringList; PortList:LongString; i,p: Integer; s:LongString;
begin
 Result:='';
 try
  PortList:=SerPortMap.ListPorts;
  if (PortList<>'') then begin
   Ports:=TStringList.Create;
   try
    for i:=1 to Length(PortList) do begin
     p:=Ord(PortList[i]);
     s:=SerPortMap.ComName[p];
     Ports.Add(s);
    end;
    Result:=Trim(Ports.Text);
   finally
    Ports.Free;
   end;
   if (Delim<>'') and (Delim<>EOL)
   then Result:=StringReplace(Result,EOL,Delim,[rfReplaceAll]);
  end;
 except
  on E:Exception do BugReport(E,nil,'EnumComPorts');
 end;
end;

 {
 *******************************************************************************
 The Uart instance.
 *******************************************************************************
 }
const
 TheUart:TUart=nil;

function uart:TUart;
begin
 if not Assigned(TheUart) then begin
  TheUart:=TUart.Create;
  TheUart.Master:=@TheUart;
 end;
 Result:=TheUart;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_uart;
begin
 uart.Ok;
end;

procedure Free_crw_uart;
begin
 Kill(TObject(TheUart));
end;

initialization

 Init_crw_uart;

finalization

 Free_crw_uart;

end.

//////////////
// END OF FILE
//////////////

