////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 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.)                                         //
// 20240521 - _UartPort log channel                                           //
// 20260204 - TUartPort.StopPolling                                           //
// 20260205 - TUartPort.NotifyIoSucceed,NotifyIoFailure,NotifyPortAction      //
// 20260206 - TUartPort.RxAsync,TxAsync (overlapped IO for Windows)           //
// 20260207 - TUart.CanUpdatePorts,UpdatePorts,ListAvailPorts,ListActivePorts //
////////////////////////////////////////////////////////////////////////////////

unit _crw_uart; // Universal Asyncronouse Receiver / Transmitter

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_fifo, _crw_rtc, _crw_str, _crw_fio, _crw_zm, _crw_hl,
 _crw_ef, _crw_polling, _crw_serio, _crw_sect, _crw_dbglog;

 {
 *******************************************************************************
 Назначение.
  Этот модуль предназначен для работы с последовательными портами (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 '+IntToStr(uart[1].RxCount)+' bytes.');
   Echo('Rx FIFO free space '+IntToStr(uart[1].RxSpace)+' bytes.');
   Echo('Received '+IntToStr(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]. }
 UartFifoGrowFactor = 2;         { Grow factor for FIFO }
 UartFifoGrowLimit  = 1024*128;  { Max size of FIFO buffer }

const
 DefUartPollPeriod  = 4;         { Default UART polling interval, ms. }
 DefUartPriority    = tpHighest; { Default UART polling thread priority.}

const                            { Parity control type }
 NOPARITY           = 0;
 ODDPARITY          = 1;
 EVENPARITY         = 2;
 MARKPARITY         = 3;
 SPACEPARITY        = 4;

const                            { ByteSize = DataBits }
 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,        { 0  All errors. }
                       ue_RXOVER,       { 1  Receive Queue overflow. }
                       ue_OVERRUN,      { 2  Receive Overrun Error. }
                       ue_RXPARITY,     { 3  Receive Parity Error. }
                       ue_FRAME,        { 4  Receive Framing error. }
                       ue_BREAK,        { 5  Break Detected. }
                       ue_TXFULL,       { 6  TX Queue is full. }
                       ue_IOE,          { 7  An I/O error occurred during communications with the device. }
                       ue_MODE,         { 8  The requested mode unsupported, or file handle is invalid.}
                       ue_RxFIFO_OVER,  { 9  Receiver fifo overflow. }
                       ue_TxFIFO_OVER,  { 10 Transmitter fifo overflow. }
                       ue_BLOCKMODE,    { 11 Blocking mode }
                       ue_UNEXPECTED);  { 12 Unexpected error. }
 TRequestStatus     = (rs_NoRequest,    { 0 запрос не возникал или был обработан }
                       rs_WaitAnswer,   { 1 ожидание ответа после запроса }
                       rs_Answer,       { 2 пришел ответ после посылки запроса }
                       rs_TimeOut,      { 3 ответ не пришел за указанное время }
                       rs_Error);       { 4 ошибка-запрос невозможен или занят }
 {
 *******************************************************************************
 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  : LongString;
  myFileName  : LongString;
  myCommFile  : TSerialHandle;
  mySerState  : TSerialState;
  myRxFifo    : TFifo;
  myTxFifo    : TFifo;
  myRxTotal   : Int64;
  myTxTotal   : Int64;
  myTxQueue   : LongInt;
  myAsyncIO   : Boolean;      // Overlapped IO for Windows
  myRxAsync   : TSerAsyncRec; // Overlapped IO for Windows
  myTxAsync   : TSerAsyncRec; // Overlapped IO for Windows
  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    : LongString;
   Answer     : LongString;
   Timer      : TIntervalTimer;
   Delimiter  : Char;
  end;
  function    GetActive:Boolean;
  function    GetPortNum:Integer;
  function    GetPortName:LongString;
  function    GetFileName:LongString;
  function    GetIsAvailable:Boolean;
  function    GetHandle:TSerialHandle;
  function    GetPollingEnabled:Boolean;
  function    GetError(ErrorCode:TUartErrors):DWORD;
  function    GetRxCount:Integer;
  function    GetTxCount:Integer;
  function    GetRxSpace:Integer;
  function    GetTxSpace:Integer;
  function    GetRxTotal:Int64;
  function    GetTxTotal:Int64;
  function    GetRxLost:Int64;
  function    GetTxLost:Int64;
  function    GetLineDTR:Boolean;
  procedure   SetLineDTR(aState:Boolean);
  function    GetLineRTS:Boolean;
  procedure   SetLineRTS(aState:Boolean);
  function    GetLineCTS:Boolean;
  function    GetLineDSR:Boolean;
  function    GetLineCD:Boolean;
  function    GetLineRI:Boolean;
 protected
  procedure   FixHardwareError(lpError:DWORD);
  procedure   FixError(ErrorCode:TUartErrors);
  procedure   UpdatePathName;
  procedure   Poll;
  function    StopPolling(aTimeOut:Integer=0; aNumLoop:Integer=0):Int64;
  procedure   NotifyIoFailure(const Head:LongString; ErrorCode:Integer);
  procedure   NotifyIoSucceed(const Head:LongString; Counter:LongInt; ms:Int64);
  procedure   NotifyPortAction(const Head:LongString);
  function    RxAsync:PSerAsyncRec;
  function    TxAsync:PSerAsyncRec;
 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(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;
  procedure   Clear(const What:LongString);
  function    GetProperties(TheText:TText):TText;
 public { RS-485 host routines in style "request-answer" }
  function    RequestAvailable:Boolean;
  function    RaiseRequest(const aInquiry   : LongString;
                                 aTimeOutMs : Double;
                                 aDelimiter : Char = ASCII_CR):Boolean;
  function    AnswerRequest(var Inquiry     : LongString;
                            var Answer      : LongString;
                            var InquiryTime : Double ) : TRequestStatus;
  procedure   ClearRequest;
  function    ModalAnswerRequest(const aInquiry   : LongString;
                                       aTimeOutMs : Double;
                                       aDelimiter : Char = ASCII_CR):LongString;
 public { properties }
  property    PortNum:Integer read GetPortNum;
  property    PortName:LongString read GetPortName;
  property    FileName:LongString read GetFileName;
  property    Handle:TSerialHandle read GetHandle;
  property    Active:Boolean read GetActive;
  property    IsAvailable:Boolean read GetIsAvailable;
  property    PollingEnabled:Boolean read GetPollingEnabled;
  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;
  property    RxLost:Int64    read GetRxLost;
  property    TxLost:Int64    read GetTxLost;
 public // Line status flags
  property    LineDTR:Boolean read GetLineDTR write SetLineDTR;
  property    LineRTS:Boolean read GetLineRTS write SetLineRTS;
  property    LineCTS:Boolean read GetLineCTS;
  property    LineDSR:Boolean read GetLineDSR;
  property    LineCD:Boolean  read GetLineCD;
  property    LineRI:Boolean  read GetLineRI;
 public
  function    BriefDescription(Prefix:LongString=''):LongString;
 public
  class var NumLoopForStop:Integer;
  class var TimeoutForStop:Integer;
  class var UseAsyncIO:Boolean;
 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 : LongString;
  myPollMap : TByteSet;
  myPolling : TPolling;
  function    GetSleepTime:Cardinal;
  procedure   SetSleepTime(aTime:Cardinal);
  function    GetPort(Num:TPortNum):TUartPort;
  function    GetPolling:TPolling;
  function    GetPollMap:TByteSet;
  procedure   SetPollMap(const Map:TByteSet);
  procedure   GetPollStr(var Str:LongString);
  procedure   EnablePolling(Num:Integer; Enable:boolean);
  procedure   Poll;
 protected
  property    PollMap : TByteSet read GetPollMap write SetPollMap;
 public
  constructor Create(aDelay    : Integer         = DefUartPollPeriod;
                     aPriority : TThreadPriority = DefUartPriority);
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
  destructor  Destroy; override;
 public
  function    GetProperties(TheText : TText;
                      const Prefix  : LongString = 'SerialPort-'):TText;
  procedure   ReadConfig(const IniFile,Section:LongString);
  function    ListActivePorts(const Delim:LongString=EOL):LongString;
  function    ListAvailPorts(Update:Boolean=False; const Delim:LongString=EOL):LongString;
  function    ListPortMap(Update:Boolean=False):LongString;
  function    NumAvailPorts:Integer;
  function    NumActivePorts:Integer;
  function    CanUpdatePorts:Boolean;
  function    UpdatePorts:Boolean;
  function    IsPortAvail(aPortNum:Integer):Boolean; overload;
  function    IsPortAvail(const aPortName:LongString):Boolean; overload;
 public
  property    Port[Num:TPortNum] : TUartPort read GetPort; default;
  property    Polling            : TPolling  read GetPolling;
  property    SleepTime          : Cardinal  read GetSleepTime write SetSleepTime;
 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;

function dlc_UartPort:Integer; // DebugLog Channel for COM Port open/close
function dlc_UartIO:Integer;   // DebugLog Channel for COM Port IO actions

implementation

 /////////////////////////////////////////////////////
 // Private Dictionary for fast string identification.
 /////////////////////////////////////////////////////
type
 TStringIdentifier = (
  sid_Unknown,
  ////////////////////// Properties ReadOnly
  sid_Connected,
  sid_Active,
  sid_Port,
  sid_PortNum,
  sid_PortName,
  sid_FileName,
  sid_PathName,
  sid_BaseName,
  sid_Handle,
  sid_RxLost,
  sid_TxLost,
  sid_RxTotal,
  sid_TxTotal,
  sid_RxLength,
  sid_TxLength,
  sid_RxFifoLimit,
  sid_TxFifoLimit,
  ////////////////////// Properties Writable
  sid_RxBuffSize,
  sid_TxBuffSize,
  sid_RxPipeSize,
  sid_TxPipeSize,
  sid_Polling,
  sid_Priority,
  sid_PollingDelay,
  sid_PollingPriority,
  sid_BaudRate,
  sid_Parity,
  sid_DataBits,
  sid_ByteSize,
  sid_StopBits,
  sid_DcbFlags,
  ////////////////////// Special IO
  sid_Clear,
  sid_RxRecv,
  sid_TxSend,
  ////////////////////// Properties End
  sid_Asterisk,
  sid_Question,
  sid_Unused
 );

const
 Dictionary:THashList=nil;

procedure FreeDictionary;
begin
 Kill(Dictionary);
end;

procedure InitDictionary;
 procedure AddSid(const key:LongString; sid:TStringIdentifier);
 begin
  Dictionary.KeyedLinks[key]:=Ord(sid);
 end;
begin
 if (Dictionary<>nil) then Exit;
 Dictionary:=NewHashList(false,HashList_DefaultHasher);
 Dictionary.Master:=@Dictionary;
 Dictionary.OwnsObjects:=false;
 /////////////////////////////////////////////
 // Dictionary for fast strings identification
 /////////////////////////////////////////////
 AddSid( 'Connected'           , sid_Connected);
 AddSid( 'Active'              , sid_Active);
 AddSid( 'Port'                , sid_Port);
 AddSid( 'PortName'            , sid_PortName);
 AddSid( 'FileName'            , sid_FileName);
 AddSid( 'PathName'            , sid_PathName);
 AddSid( 'BaseName'            , sid_BaseName);
 AddSid( 'Handle'              , sid_Handle);
 AddSid( 'RxLost'              , sid_RxLost);
 AddSid( 'TxLost'              , sid_TxLost);
 AddSid( 'RxTotal'             , sid_RxTotal);
 AddSid( 'TxTotal'             , sid_TxTotal);
 AddSid( 'RxLength'            , sid_RxLength);
 AddSid( 'TxLength'            , sid_TxLength);
 AddSid( 'RxFifoLimit'         , sid_RxFifoLimit);
 AddSid( 'TxFifoLimit'         , sid_TxFifoLimit);
 AddSid( 'RxBuffSize'          , sid_RxBuffSize);
 AddSid( 'TxBuffSize'          , sid_TxBuffSize);
 AddSid( 'RxPipeSize'          , sid_RxPipeSize);
 AddSid( 'TxPipeSize'          , sid_TxPipeSize);
 AddSid( 'Polling'             , sid_Polling);
 AddSid( 'Priority'            , sid_Priority);
 AddSid( 'PollingDelay'        , sid_PollingDelay);
 AddSid( 'PollingPriority'     , sid_PollingPriority);
 AddSid( 'BaudRate'            , sid_BaudRate);
 AddSid( 'Parity'              , sid_Parity);
 AddSid( 'DataBits'            , sid_DataBits);
 AddSid( 'ByteSize'            , sid_ByteSize);
 AddSid( 'StopBits'            , sid_StopBits);
 AddSid( 'DcbFlags'            , sid_DcbFlags);
 AddSid( 'Clear'               , sid_Clear);
 AddSid( 'RxRecv'              , sid_RxRecv);
 AddSid( 'TxSend'              , sid_TxSend);
 AddSid( '*'                   , sid_Asterisk);
 AddSid( '?'                   , sid_Question);
end;

function Identify(const key:LongString):TStringIdentifier;
var sid:Integer;
begin
 if (Dictionary=nil) then InitDictionary;
 sid:=Dictionary.KeyedLinks[key];
 if (sid>=Ord(Low(TStringIdentifier))) and (sid<=Ord(High(TStringIdentifier)))
 then Result:=TStringIdentifier(sid)
 else Result:=sid_Unknown;
end;

const
 sid_Ctrl_Hidden   = [sid_Clear..sid_TxSend];
 sid_Ctrl_Readable = [Succ(sid_Unknown)..Pred(sid_Asterisk)]-sid_Ctrl_Hidden;
 sid_Ctrl_Writable = [sid_RxBuffSize..Pred(sid_Asterisk)]-sid_Ctrl_Hidden;

function dlc_UartPort:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_UartPort');
 Result:=dlc;
end;

function dlc_UartIO:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_UartIO');
 Result:=dlc;
end;

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

constructor TUartPort.Create(aUart:TUart; aPortNum:TPortNum);
begin
 inherited Create;
 Lock;
 try
  myUart:=aUart;
  myPortNum:=aPortNum;
  myPortName:=SerPortMap.ComName[myPortNum];
  myFileName:=SerPortMap.PathName[myPortNum];
  myCommFile:=INVALID_HANDLE_VALUE;
  myRxFifo:=nil;
  myTxFifo:=nil;
  myRxTotal:=0;
  myTxTotal:=0;
  myTxQueue:=0;
  SerClearState(mySerState);
  myAsyncIO:=UseAsyncIO and IsWindows;
  myRxAsync:=Default(TSerAsyncRec);
  myTxAsync:=Default(TSerAsyncRec);
  SafeFillChar(myRxBuff,SizeOf(myRxBuff),0);
  SafeFillChar(myTxBuff,SizeOf(myTxBuff),0);
  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;
 myPortName:='';
 myFileName:='';
 Kill(myRxFifo);
 Kill(myTxFifo);
 myRequest.Answer:='';
 myRequest.Inquiry:='';
 Kill(myRequest.Timer);
 inherited Destroy;
end;

function TUartPort.GetHandle:TSerialHandle;
begin
 Result:=INVALID_HANDLE_VALUE;
 if Assigned(Self) then
 try
  Lock;
  Result:=myCommFile;
 finally
  Unlock;
 end;
end;

function TUartPort.GetPortNum:Integer;
begin
 if Assigned(Self)
 then Result:=myPortNum
 else Result:=0;
end;

function TUartPort.GetPortName:LongString;
begin
 if Assigned(Self)
 then Result:=myPortName
 else Result:='';
end;

function TUartPort.GetFileName:LongString;
begin
 if Assigned(Self)
 then Result:=myFileName
 else Result:='';
end;

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

function TUartPort.GetIsAvailable:Boolean;
begin
 if Assigned(Self)
 then Result:=IsNonEmptyStr(myFileName)
 else Result:=False;
end;

function TUartPort.GetPollingEnabled:Boolean;
begin
 if Assigned(Self)
 then Result:=(myPortNum in myUart.PollMap)
 else Result:=False;
end;

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

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

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

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

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

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

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

function TUartPort.GetRxLost:Int64;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  Result:=myRxFifo.Lost;
 finally
  Unlock;
 end;
end;

function TUartPort.GetTxLost:Int64;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  Result:=myTxFifo.Lost;
 finally
  Unlock;
 end;
end;

function TUartPort.GetLineDTR:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  Result:=SerGetDTR(myCommFile);
 finally
  Unlock;
 end;
end;

procedure TUartPort.SetLineDTR(aState:Boolean);
begin
 if Assigned(Self) then
 try
  Lock;
  SerSetDTR(myCommFile,aState);
 finally
  Unlock;
 end;
end;

function TUartPort.GetLineRTS:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  Result:=SerGetRTS(myCommFile);
 finally
  Unlock;
 end;
end;

procedure TUartPort.SetLineRTS(aState:Boolean);
begin
 if Assigned(Self) then
 try
  Lock;
  SerSetRTS(myCommFile,aState);
 finally
  Unlock;
 end;
end;

function TUartPort.GetLineCTS:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  Result:=SerGetCTS(myCommFile);
 finally
  Unlock;
 end;
end;

function TUartPort.GetLineDSR:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  Result:=SerGetDSR(myCommFile);
 finally
  Unlock;
 end;
end;

function TUartPort.GetLineCD:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  Result:=SerGetCD(myCommFile);
 finally
  Unlock;
 end;
end;

function TUartPort.GetLineRI:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  Result:=SerGetRI(myCommFile);
 finally
  Unlock;
 end;
end;

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

procedure TUartPort.UpdatePathName;
begin
 if Assigned(Self) then
 try
  Lock;
  if not Active then begin
   myPortName:=SerPortMap.ComName[myPortNum];
   myFileName:=SerPortMap.PathName[myPortNum];
  end;
 finally
  Unlock;
 end;
end;

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

function TUartPort.BriefDescription(Prefix:LongString=''):LongString;
begin
 Result:='';
 if Assigned(Self) then begin
  Result:=Prefix;
  if Active and PollingEnabled then begin
   Result:=Result+' '+Ctrl('Port');
   Result:=Result+' '+Ctrl('BaudRate');
   Result:=Result+' '+Ctrl('Parity');
   Result:=Result+' '+Ctrl('DataBits');
   Result:=Result+' '+Ctrl('StopBits');
   Result:=Result+' '+Ctrl('DcbFlags');
  end else begin
   Result:=Result+' '+PortName;
  end;
  Result:=Trim(Result);
 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 aFlags:TSerialFlags; aSerStopBits:TSerStopBits; aSerParity:TSerParityType;
 begin
  Result:=false;
  aFlags:=[];
  DcbFlagsToSerFlags(aDcbFlags,aFlags);
  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,aFlags,aDcbFlags) 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);
  myRxAsync.Stat:=mySerState;
  myTxAsync.Stat:=mySerState;
  Result:=true;
 end;
 function soFlags(Flags:LongInt):LongInt;
 begin
  Result:=Flags;
  if IsWindows and not myAsyncIO then Result:=0;
 end;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   Close;
   if IsNonEmptyStr(myFileName) then begin
    myCommFile:=SerOpen(myFileName,soFlags(O_SERNOBLK));
    if SerValidHandle(myCommFile) then begin
     if SetupCommPortParameters then begin
      myRxFifo:=NewFifo(aFifoSize);
      myRxFifo.GrowFactor:=UartFifoGrowFactor;
      myRxFifo.GrowLimit:=UartFifoGrowLimit;
      myRxFifo.Master:=@myRxFifo;
      myTxFifo:=NewFifo(aFifoSize);
      myTxFifo.GrowFactor:=UartFifoGrowFactor;
      myTxFifo.GrowLimit:=UartFifoGrowLimit;
      myTxFifo.Master:=@myTxFifo;
      myRequest.Timer:=NewIntervalTimer;
      myRequest.Timer.AddIntervalMs(200,1);
      myRequest.Timer.Master:=@myRequest.Timer;
      myUart.EnablePolling(myPortNum,true);
      Result:=true;
     end else Close;
    end;
   end;
  finally
   Unlock;
  end;
  if DebugLogEnabled(dlc_UartPort) then begin
   if Active
   then DebugLog(dlc_UartPort,BriefDescription('Opened Port:'))
   else DebugLog(dlc_UartPort,'Failed Port: COM'+IntToStr(PortNum));
  end;
 except
  on E:Exception do BugReport(E,Self,'Open');
 end;
end;

function TUartPort.StopPolling(aTimeOut:Integer=0; aNumLoop:Integer=0):Int64;
var ms,lc:Int64;
begin
 Result:=0;
 if Assigned(Self) then begin
  if (aTimeOut<=0) then aTimeout:=TimeoutForStop;
  if (aNumLoop<=0) then aNumLoop:=NumLoopForStop;
  if Active and PollingEnabled then begin
   myUart.EnablePolling(myPortNum,False);
   if myUart.Polling.Enabled then begin
    ms:=GetTickCount64;
    lc:=myUart.Polling.LoopCount;
    lc:=myUart.Polling.SyncLoop(aTimeout,aNumLoop)-lc;
    ms:=GetTickCount64-ms;
    if DebugLogEnabled(dlc_UartPort)
    then DebugLog(dlc_UartPort,Format('Stopping: %d ms, %d loop(s)',[ms,lc]));
    Result:=lc;
   end;
  end;
 end;
end;

procedure TUartPort.Close;
begin
 if Assigned(Self) then
 try
  if DebugLogEnabled(dlc_UartPort) then begin
   if Active then NotifyPortAction('Close Port');
  end;
  if (StopPolling>0)
  then NotifyPortAction('Stopped Port');
  Lock;
  try
   myUart.EnablePolling(myPortNum,False);
   if SerValidHandle(myCommFile) then begin
    SerFlushRxTx(myCommFile);
    if SerClose(myCommFile)
    then NotifyPortAction('Closed Port')
    else NotifyPortAction('Fail Close Port');
   end;
   Kill(myRxFifo);
   Kill(myTxFifo);
   myRxTotal:=0;
   myTxTotal:=0;
   myTxQueue:=0;
   SerClearState(mySerState);
   myRxAsync:=Default(TSerAsyncRec);
   myTxAsync:=Default(TSerAsyncRec);
   SafeFillChar(myRxBuff,SizeOf(myRxBuff),0);
   SafeFillChar(myTxBuff,SizeOf(myTxBuff),0);
   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.NotifyIoFailure(const Head:LongString; ErrorCode:Integer);
var dlc:Integer;
begin
 if Assigned(Self) then begin
  dlc:=dlc_UartIO;
  if DebugLogEnabled(dlc)
  then DebugLog(dlc,Format('%s: port %s error %d: %s',
                    [Head,PortName,ErrorCode,SysErrorMessage(ErrorCode)]));
 end;
end;

procedure TUartPort.NotifyIoSucceed(const Head:LongString; Counter:LongInt; ms:Int64);
var dlc:Integer;
begin
 if Assigned(Self) then begin
  dlc:=dlc_UartIO;
  if DebugLogEnabled(dlc)
  then DebugLog(dlc,Format('%s: port %s size %d delay %d ms',
                    [Head,PortName,Counter,ms]));
 end;
end;

procedure TUartPort.NotifyPortAction(const Head:LongString);
begin
 if Assigned(Self) then begin
  if DebugLogEnabled(dlc_UartPort)
  then DebugLog(dlc_UartPort,BriefDescription(Head+':'));
 end;
end;

function TUartPort.RxAsync:PSerAsyncRec;
begin
 if Assigned(Self) and myAsyncIO
 then Result:=@myRxAsync
 else Result:=nil;
end;

function TUartPort.TxAsync:PSerAsyncRec;
begin
 if Assigned(Self) and myAsyncIO
 then Result:=@myTxAsync
 else Result:=nil;
end;

procedure TUartPort.Poll;
var RxCounter,TxCounter:LongInt; ms:Int64;
 {$IFDEF WINDOWS}
 procedure CheckCommErrors;
 var lpErrors:DWORD;
 begin
  lpErrors:=0;
  if ClearCommError(myCommFile,lpErrors,nil)
  then FixHardwareError(lpErrors) else lpErrors:=0;
 end;
 {$ENDIF ~WINDOWS}
 procedure ClearAsyncPriv(var Async:TSerAsyncRec);
 begin
  SafeFillChar(Async.Priv,SizeOf(Async.Priv),0);
 end;
 procedure ApplyAsyncPriv(var Async:TSerAsyncRec; Fifo:TFifo);
 begin
  if (Async.Priv.Lost>0) then Fifo.Lost:=Fifo.Lost+Async.Priv.Lost;
  if (Async.Priv.HwError<>0) then FixHardwareError(Async.Priv.HwError);
  if InRange(Async.Priv.IoError,Ord(Succ(ue_TOTAL)),Ord(ue_UNEXPECTED))
  then FixError(TUartErrors(Async.Priv.IoError));
 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);
    {
    Preprocess AsyncIO
    }
    if myAsyncIO then begin
     ClearAsyncPriv(myRxAsync);
     ClearAsyncPriv(myTxAsync);
    end;
    {
    Read from COMM
    }
    ms:=GetTickCount64;
    RxCounter:=SerRead(myCommFile,myRxBuff,SizeOf(myRxBuff),RxAsync);
    ms:=GetTickCount64-ms;
    if (RxCounter>0) then begin
     if (myRxFifo.Put(@myRxBuff[0],RxCounter)=RxCounter)
     then Inc(myRxTotal,RxCounter)
     else FixError(ue_RxFIFO_OVER);
     NotifyIoSucceed('Read',RxCounter,ms);
    end else
    if (RxCounter<0) then begin
     NotifyIoFailure('Fail Read',GetLastOsError);
     SerFlushRx(myCommFile);
     FixError(ue_IOE);
    end;
    {
    Write to COMM
    }
    if not InRange(myTxQueue,0,SizeOf(myTxBuff)) then begin
     FixError(ue_UNEXPECTED);
     myTxQueue:=0;
    end;
    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
     ms:=GetTickCount64;
     TxCounter:=SerWrite(myCommFile,myTxBuff[0],myTxQueue,TxAsync);
     ms:=GetTickCount64-ms;
     if (TxCounter>0) then begin
      Inc(myTxTotal,TxCounter);
      if (myTxQueue>TxCounter)
      then SafeMove(myTxBuff[TxCounter],myTxBuff[0],myTxQueue-TxCounter);
      Dec(myTxQueue,TxCounter);
      NotifyIoSucceed('Send',TxCounter,ms);
     end else
     if (TxCounter<0) then begin
      NotifyIoFailure('Fail Send',GetLastOsError);
      SerFlushTx(myCommFile);
      FixError(ue_IOE);
      myTxQueue:=0;
     end;
    end;
    {
    Postprocess AsyncIO
    }
    if myAsyncIO then begin
     ApplyAsyncPriv(myRxAsync,myRxFifo);
     ApplyAsyncPriv(myTxAsync,myTxFifo);
    end;
    {
    Check Serial I/O Errors
    }
    {$IFDEF WINDOWS}
    CheckCommErrors;
    {$ENDIF ~WINDOWS}
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Poll');
 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,'ReadBuf');
 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,'RequestAvailable');
 end;
end;

function TUartPort.RaiseRequest(const aInquiry   : LongString;
                                      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,'RaiseRequest');
 end;
end;

function TUartPort.AnswerRequest(var Inquiry     : LongString;
                                 var Answer      : LongString;
                                 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,'AnswerRequest');
 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,'ClearRequest');
 end;
end;

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

function TUartPort.GetProperties(TheText:TText):TText;
var BaudRate:LongInt; ByteSize:Integer; Parity:TSerParityType;
    StopBits:TSerStopBits; Flags:TSerialFlags; DcbFlags:DWord;
 procedure AddVal(const msg:LongString; val:LongInt);
 begin
  if (Val<>0) then TheText.Addln(msg+' : '+IntToStr(val));
 end;
begin
 Result:=TheText;
 if Assigned(Self) then
 if Assigned(TheText) then
 try
  Lock;
  try
   if Active then begin
    TheText.AddLn('Port = '+myPortName);
    BaudRate:=0; ByteSize:=0; Parity:=NoneParity;
    StopBits:=TSerStopBits(ONESTOPBIT); Flags:=[]; DcbFlags:=0;
    if SerGetParams(mySerState,BaudRate,ByteSize,Parity,StopBits,Flags,@DcbFlags) then begin
     TheText.Addln('BaudRate = '+IntToStr(BaudRate));
     case Ord(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 = '+IntToStr(ByteSize));
     case Ord(StopBits) of
      ONESTOPBIT   : TheText.Addln('StopBits = 1');
      ONE5STOPBITS : TheText.Addln('StopBits = 1.5');
      TWOSTOPBITS  : TheText.Addln('StopBits = 2');
     end;
     TheText.Addln('XonXoff  = '+IntToStr(ord((SF_IXON in Flags) or (SF_IXOFF in Flags))));
     TheText.Addln('BufSize  = '+IntToStr(myRxFifo.Size div 1024)+' KB');
     TheText.Addln('Flags    = '+SerFlagsToString(Flags));
     TheText.Addln('DcbFlags = $'+HexW(DcbFlags));
    end else TheText.AddLn('Fail on GetSerParams');
    TheText.Addln(Format('TRAFFIC INFO : %-20s %-20s',['Rx,Bytes','Tx,Bytes']));
    TheText.Addln(Format(' Total Count : %-20d %-20d',[RxTotal,TxTotal]));
    TheText.Addln(Format(' Queue Count : %-20d %-20d',[RxCount,TxCount]));
    TheText.Addln(Format(' Queue Space : %-20d %-20d',[RxSpace,TxSpace]));
    TheText.Addln(Format(' Bytes Lost  : %-20d %-20d',[RxLost,TxLost]));
    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 FIFO 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,'GetProperties');
 end;
end;

function TUartPort.OpenConfig(IniFile,Section:LongString):Boolean;
var BaudRate,DataBits,StopBits,BufSize,DcbFlags:LongInt; Parity:TParity;
var XonXoff:Boolean; fStopBits:Double; s:LongString;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   s:='';
   IniFile:=UnifyFileAlias(IniFile);
   fStopBits:=0; XonXoff:=false; BufSize:=0; DcbFlags:=0;
   BaudRate:=0; DataBits:=0; Parity:=NOPARITY; StopBits:=0;
   if ReadIniFileAlpha(IniFile,Section,'Port%a',s) then
   if SameText(s,myPortName) then begin
    if not ReadIniFileLongInt(IniFile,Section,'BaudRate%d',BaudRate) then BaudRate:=9600;
    if not ReadIniFileAlpha(IniFile,Section,'Parity%a',s) then s:='NOPARITY';
    s:=UnifyAlias(s);
    if (WordIndex(s,'NONE,NOPARITY,N',ScanSpaces)>0)     then Parity:=NOPARITY    else
    if (WordIndex(s,'ODD,ODDPARITY,O',ScanSpaces)>0)     then Parity:=ODDPARITY   else
    if (WordIndex(s,'EVEN,EVENPARITY,E',ScanSpaces)>0)   then Parity:=EVENPARITY  else
    if (WordIndex(s,'MARK,MARKPARITY,M',ScanSpaces)>0)   then Parity:=MARKPARITY  else
    if (WordIndex(s,'SPACE,SPACEPARITY,S',ScanSpaces)>0) then Parity:=SPACEPARITY else Parity:=NOPARITY;
    if not ReadIniFileLongInt(IniFile,Section,'DataBits%d',DataBits) then DataBits:=8;
    if ReadIniFileDouble(IniFile,Section,'StopBits%f',fStopBits) then begin
     if SameValue(fStopBits,1.0,MachEps) then StopBits:=ONESTOPBIT   else
     if SameValue(fStopBits,1.5,MachEps) then StopBits:=ONE5STOPBITS else
     if SameValue(fStopBits,2.0,MachEps) then StopBits:=TWOSTOPBITS  else StopBits:=ONESTOPBIT;
    end else StopBits:=ONESTOPBIT;
    if not ReadIniFileBoolean(IniFile,Section,'XonXoff%b',XonXoff) then XonXoff:=false;
    if not ReadIniFileLongInt(IniFile,Section,'BufSize%d',BufSize) then BufSize:=4;
    if not ReadIniFileLongInt(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,'OpenConfig');
 end;
end;

function TUartPort.Ctrl(const param:LongString):LongString;
var p,n,i,si,iv:Integer; sn,sv,par:LongString; r:Double; NewState,OldState:TSerialState;
 function UpdateSerState(const aState:TSerialState):Boolean;
 begin
  Result:=SerSetParams(myCommFile,aState);
  if Result
  then SerGetParams(myCommFile,mySerState)
  else mySerState:=OldState;
 end;
 function ValidateFifoSize(aSize:Integer):Integer;
 begin
  Result:=EnsureRange(aSize,KiloByte,MegaByte);
 end;
 function ValidateDelay(aDelay:Integer):Integer;
 begin
  Result:=EnsureRange(aDelay,1,100);
 end;
begin
 Result:='?';
 if Assigned(Self) then
 if Active then
 with mySerState do
 try
  Lock;
  try
   OldState:=mySerState;
   NewState:=mySerState;
   p:=ExtractNameValuePair(param,sn,sv);
   case Identify(sn) of
    sid_Connected:   Result:=IntToStr(Ord(Active));
    sid_Active:      Result:=IntToStr(Ord(Active));
    sid_Port:        Result:=PortName;
    sid_PortNum:     Result:=IntToStr(PortNum);
    sid_FileName:    Result:=FileName;
    sid_PortName:    Result:=SerPortMap.ComName[PortNum];
    sid_PathName:    Result:=SerPortMap.PathName[PortNum];
    sid_BaseName:    Result:=SerPortMap.BaseName[PortNum];
    sid_Handle:      Result:=IntToStr(Handle);
    sid_RxLost:      Result:=IntToStr(myRxFifo.Lost);
    sid_TxLost:      Result:=IntToStr(myTxFifo.Lost);
    sid_RxTotal:     Result:=IntToStr(myRxFifo.Total);
    sid_TxTotal:     Result:=IntToStr(myTxFifo.Total);
    sid_RxLength:    Result:=IntToStr(myRxFifo.Count);
    sid_TxLength:    Result:=IntToStr(myTxFifo.Count);
    sid_RxFifoLimit: Result:=IntToStr(myRxFifo.GrowLimit);
    sid_TxFifoLimit: Result:=IntToStr(myTxFifo.GrowLimit);
    sid_RxBuffSize,
    sid_RxPipeSize:  begin
     if (p>0) and TryStrToInt(Trim(sv),iv) then myRxFifo.Size:=ValidateFifoSize(iv);
     Result:=IntToStr(myRxFifo.Size);
    end;
    sid_TxBuffSize,
    sid_TxPipeSize:  begin
     if (p>0) and TryStrToInt(Trim(sv),iv) then myTxFifo.Size:=ValidateFifoSize(iv);
     Result:=IntToStr(myTxFifo.Size);
    end;
    sid_Polling,
    sid_PollingDelay: begin
     if (p>0) and TryStrToInt(Trim(sv),iv) then myUart.myPolling.Delay:=ValidateDelay(iv);
     Result:=IntToStr(myUart.myPolling.Delay);
    end;
    sid_Priority,
    sid_PollingPriority: begin
     if (p>0) and IsNonEmptyStr(sv) then myUart.myPolling.Priority:=StringToThreadPriority(Trim(sv),myUart.myPolling.Priority);
     Result:=ThreadPriorityToString(myUart.myPolling.Priority);
    end;
    sid_BaudRate: begin
     if (p>0) and Str2Int(sv,n) then begin
      if SerSetParamBaudRate(NewState,n) then
      if not UpdateSerState(NewState) then Exit;
     end;
     Result:=IntToStr(SerGetParamBaudRate(mySerState));
    end;
    sid_Parity: 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 in [NOPARITY..SPACEPARITY]) then begin
      if SerSetParamParity(NewState,TSerParityType(n)) then
      if not UpdateSerState(NewState) then Exit;
     end;
     case Ord(SerGetParamParity(mySerState)) of
      NOPARITY    : Result:='NONE';
      ODDPARITY   : Result:='ODD';
      EVENPARITY  : Result:='EVEN';
      MARKPARITY  : Result:='MARK';
      SPACEPARITY : Result:='SPACE';
     end;
    end;
    sid_DataBits,
    sid_ByteSize: begin
     if (p>0) and Str2Int(sv,n) then begin
      if SerSetParamByteSize(NewState,n) then
      if not UpdateSerState(NewState) then Exit;
     end;
     Result:=IntToStr(SerGetParamByteSize(mySerState));
    end;
    sid_StopBits: begin
     if (p>0) and Str2Real(sv,r) then begin
      if SameValue(r,1.0,MachEps) then SerSetParamStopBits(NewState,TSerStopBits(ONESTOPBIT))   else
      if SameValue(r,1.5,MachEps) then SerSetParamStopBits(NewState,TSerStopBits(ONE5STOPBITS)) else
      if SameValue(r,2.0,MachEps) then SerSetParamStopBits(NewState,TSerStopBits(TWOSTOPBITS))  else Exit;
      if not UpdateSerState(NewState) then Exit;
     end;
     case Ord(SerGetParamStopBits(mySerState)) of
      ONESTOPBIT   : Result:='1';
      ONE5STOPBITS : Result:='1.5';
      TWOSTOPBITS  : Result:='2';
     end;
    end;
    sid_DcbFlags: begin
     if (p>0) and Str2Int(sv,n) then begin
      if SerSetParamDcbFlags(NewState,n) then
      if not UpdateSerState(NewState) then Exit;
     end;
     Result:='$'+HexW(SerGetParamDcbFlags(mySerState));
    end;
    sid_Clear: begin
     if IsNonEmptyStr(sv) then Clear(Trim(sv));
     Result:='';
    end;
    sid_TxSend: begin
     if (p>0) then iv:=Ord(WriteStr(sv))*Length(sv) else iv:=0;
     Result:=IntToStr(iv);
    end;
    sid_RxRecv: begin
     iv:=MaxInt;
     if (p>0) then iv:=StrToIntDef(Trim(sv),iv);
     Result:=ReadStr(iv);
    end;
    sid_Asterisk,
    sid_Question: begin
     Result:='';
     if Assigned(Dictionary) then
     for i:=0 to Dictionary.Count-1 do begin
      si:=Dictionary.Links[i];
      if (si<=Ord(sid_Unknown)) then continue;
      if (si>=Ord(sid_Asterisk)) then continue;
      if not (TStringIdentifier(si) in sid_Ctrl_Readable) then continue;
      if (p>0) and not (TStringIdentifier(si) in sid_Ctrl_Writable) then continue;
      par:=Dictionary.Keys[i];
      if (sn='*') then Result:=Result+par+EOL;
      if (sn='?') then Result:=Result+par+'='+ctrl(par)+EOL;
     end;
    end;
   end;
   sn:=''; sv:='';
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Ctrl');
 end;
end;

procedure TUartPort.Clear(const What:LongString);
begin
 if Assigned(Self) then begin
  if (WordIndex('Rx',What,ScanSpaces)>0) then RxClear;
  if (WordIndex('Tx',What,ScanSpaces)>0) then TxClear;
  if (WordIndex('RxLost',What,ScanSpaces)>0) then myRxFifo.Lost:=0;
  if (WordIndex('TxLost',What,ScanSpaces)>0) then myTxFifo.Lost:=0;
  if (WordIndex('RxFifo',What,ScanSpaces)>0) then myRxFifo.Clear;
  if (WordIndex('TxFifo',What,ScanSpaces)>0) then myTxFifo.Clear;
  if (WordIndex('RxTotal',What,ScanSpaces)>0) then myRxFifo.Total:=0;
  if (WordIndex('TxTotal',What,ScanSpaces)>0) then myTxFifo.Total:=0;
 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         = DefUartPollPeriod;
                         aPriority : TThreadPriority = DefUartPriority);
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;

const
TheUartSleepTime:Cardinal=1;

function TUart.GetSleepTime:Cardinal;
begin
 Result:=TheUartSleepTime;
end;

procedure TUart.SetSleepTime(aTime:Cardinal);
begin
 if (aTime>=1)
 then TheUartSleepTime:=aTime
 else TheUartSleepTime:=1;
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:LongString);
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:LongString;
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(SectSystem);
  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'+IntToStr(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:=DefUartPollPeriod; P:=DefUartPriority;
  if ReadIniFilePolling(IniFile,Section,'UartPolling',D,P) then begin
   Polling.Delay:=D;
   Polling.Priority:=P;
  end;
 end;
end;

function TUart.ListActivePorts(const Delim:LongString=EOL):LongString;
var PortNum:TPortNum;
begin
 Result:='';
 if Assigned(Self) then
 try
  for PortNum:=Low(myPorts) to High(myPorts) do
  if Port[PortNum].Active then Result:=Result+Port[PortNum].PortName+EOL;
  if (Delim<>'') and (Delim<>EOL) then Result:=StringReplace(Trim(Result),EOL,Delim,[rfReplaceAll]);
 except
  on E:Exception do BugReport(E,Self,'ListActivePorts');
 end;
end;

function TUart.ListAvailPorts(Update:Boolean=False; const Delim:LongString=EOL):LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  if Update then
  if CanUpdatePorts
  then UpdatePorts;
  Result:=EnumComPorts(Delim);
 except
  on E:Exception do BugReport(E,Self,'ListAvailPorts');
 end;
end;

function TUart.ListPortMap(Update:Boolean=False):LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  if Update then
  if CanUpdatePorts
  then UpdatePorts;
  Result:=SerPortMap.Table;
 except
  on E:Exception do BugReport(E,Self,'ListPortMap');
 end;
end;

function TUart.NumAvailPorts:Integer;
var PortNum:TPortNum;
begin
 Result:=0;
 if Assigned(Self) then
 try
  for PortNum:=Low(myPorts) to High(myPorts) do
  if Port[PortNum].IsAvailable then Result:=Result+1;
 except
  on E:Exception do BugReport(E,Self,'NumAvailPorts');
 end;
end;

function TUart.NumActivePorts:Integer;
var PortNum:TPortNum;
begin
 Result:=0;
 if Assigned(Self) then
 try
  for PortNum:=Low(myPorts) to High(myPorts) do
  if Port[PortNum].Active then Result:=Result+1;
 except
  on E:Exception do BugReport(E,Self,'NumActivePorts');
 end;
end;

function TUart.CanUpdatePorts:Boolean;
begin
 if Assigned(Self)
 then Result:=(NumActivePorts=0)
 else Result:=False;
end;

function TUart.UpdatePorts:Boolean;
var PortNum:TPortNum;
begin
 Result:=False;
 if Assigned(Self) then
 try
  if CanUpdatePorts then begin
   SerPortMap.Update;
   for PortNum:=Low(myPorts) to High(myPorts) do Port[PortNum].UpdatePathName;
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Self,'UpdatePorts');
 end;
end;

function TUart.IsPortAvail(aPortNum:Integer):Boolean;
begin
 if Assigned(Self) and InRange(aPortNum,Low(myPorts),High(myPorts))
 then Result:=Port[aPortNum].IsAvailable
 else Result:=False;
end;

function TUart.IsPortAvail(const aPortName:LongString):Boolean;
var PortNum:TPortNum;
begin
 Result:=False;
 if Assigned(Self) and IsNonEmptyStr(aPortName) then
 try
  for PortNum:=Low(myPorts) to High(myPorts) do
  if IsSameText(Port[PortNum].PortName,aPortName) then
  if Port[PortNum].IsAvailable then Exit(True);
 except
  on E:Exception do BugReport(E,Self,'IsPortAvail');
 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
 InitDictionary;
 TUartPort.UseAsyncIO:=True;
 TUartPort.NumLoopForStop:=1;
 TUartPort.TimeoutForStop:=1000;
 dlc_UartPort;
 dlc_UartIO;
 uart.Ok;
end;

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

initialization

 Init_crw_uart;

finalization

 Free_crw_uart;

end.

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

