编写delphi串口类

自己动手编写 delphi 的串口类

    --date=2020-03-28

    --group="笔记草稿"

---------

TODO 当前状态=玩具状态 --date=2020-05-24

unit uSerialPort;

{ 串口
  ---------
  NOTE
  从行为上来看, 这个串口类的读写貌似是阻塞的, 所以使用 Overlapped 有必要么,
  如果需要非阻塞的行为, 需要怎样组织呢

  没有对 C# 中的 Handshake 作处理, 所有注意到的与 Handshake 有关的地方都按None处理
  也有其他地方按默认值处理的, 但忘了有哪些了
  目前在端口 Open 状态时, 修改波特率什么的没效果, C# 中这些常用参数看上去是可以修改的
  还忽略了许多其他事情, 需要具体对比 C# 才知道还有哪些
  仅使用 USB-RS485 转换器测试收发了 10 几个字节,
  所以仅能在玩具程序中使用, 要想能够真正的使用还有很长的路
  ---------
  TODO
  关于 GetLastError 返回的结果, 至少做一下说明, 不然单纯的数字根本不知道发生了什么
  ---------
  Windows API 参考:
  https://docs.microsoft.com/zh-cn/windows/win32/devio/communications-resources
  https://docs.microsoft.com/zh-cn/windows/win32/api/fileapi/nf-fileapi-createfilea

  关于 \. 和 \?: https://docs.microsoft.com/zh-cn/windows/win32/fileio/naming-a-file
  Namespaces 节的 Win32 Device Namespaces

  同步和异步IO
  https://docs.microsoft.com/zh-cn/windows/win32/fileio/synchronous-and-asynchronous-i-o

  学习串口工具的编写请参阅:
  https://github.com/dotnet/runtime/blob/master/src/libraries/System.IO.Ports/src/System/IO/Ports/SerialPort.cs
  https://github.com/dotnet/runtime/blob/master/src/libraries/System.IO.Ports/src/System/IO/Ports/SerialStream.Windows.cs
}
interface

uses
  System.Generics.Collections,
  System.SysUtils,
  WinApi.Windows;

type
  TSerialPort = class
  // 串口
    // @Section private type
    private
      type TEventLoop = class
        // 处理 WaitCommEvent
        // TODO 这个事件循环现在什么都没做, 有空再处理
        private
          FHandle : THandle;
        public
          constructor Create(AHandle : THandle);
          destructor Destroy; override;

          procedure Start();
          procedure Stop();
      end;

    // @Section public type

    // @Section public const

    // @Section private
    private
      FCommHandle : THandle;   // 串口句柄

      FCommName : String;    // COM口名称 COM1
      FBaudRate : Integer;   // 波特率
      FParity   : Integer;   // 奇偶校验
      FDataBits : Integer;   // 数据位
      FStopBit  : Integer;   // 停止位

      // 超时, 毫秒, 取值范围[0,MAX Integer], 如果设置为 0 表示不使用超时
      FReadTimeOut : Integer;
      FWriteTimeOut : Integer;

      // 读写缓冲区大小
      FReadBufferSize : Integer;
      FWriteBufferSize : Integer;

      FParityReplace : AnsiChar;

      // TODO 考虑是否需要这些结构
      // DCB TimeOuts 等结构
      // FDcb : TDCB;
      // FTimeouts : TCommTimeouts;

      FEventLoop : TEventLoop;

      // for property
      procedure SetPropCommName(const ACommName : String);
      procedure SetPropBaudRate(const ABaudRate : Integer);
      procedure SetPropParity(const AParity : Integer);
      procedure SetPropDataBits(const ADataBits : Integer);
      procedure SetPropStopBit(const AStopBit : Integer);

      procedure SetPropReadTimeOut(const ATimeOut : Integer);
      procedure SetPropWriteTimeOut(const ATimeOut : Integer);

      procedure SetPropReadBufferSize(const ASize : Integer);
      procedure SetPropWriteBufferSize(const ASize : Integer);

      // about comm config
      procedure ConfigEvents();
      procedure ConfigDCB(ACommProp : TCommProp);
      procedure ConfigTimeouts();
      procedure ConfigBufferSizes();

      // about DCB.Flags
      function  GetDcbFlag(const ADcb : TDCB; AWhichFlag : Integer) : Integer;
      procedure SetDcbFlag(var ADcb : TDCB; AWhichFlag : Integer; ASetting : Integer);

      procedure SetHandleInvalid();
      function  IsInvalidHandle(const AHandle : THandle) : Boolean;

      function CheckAndGetComNumber(const AComName : String) : Integer;
      procedure CheckReadWriteArguments(const AArr : TArray<Byte>; const AOffset, ACount : Integer);

    // @Section public
    public
      constructor Create(); overload;
      constructor Create(const AComName : String); overload;
      constructor Create(const AComName : String;
              const ABaudRate, AParity, ADataBits, AStopBit : Integer); overload;

      destructor Destroy(); override;

      function IsOpen() : Boolean;

      procedure Open();
      procedure Close();

      function  ReadBytes(ABuff : TArray<Byte>; const AOffset, ACount : Integer) : Integer;
      procedure WriteBytes(ABuff : TArray<Byte>; const AOffset, ACount : Integer);

      property PortName : String read FCommName write SetPropCommName;
      property BaudRate : Integer read FBaudRate write SetPropBaudRate;
      property Parity : Integer read FParity write SetPropParity;
      property DataBits : Integer read FDataBits write SetPropDataBits;
      property StopBit : Integer read FStopBit write SetPropStopBit;

      property ReadTimeOut : Integer read FReadTimeOut write SetPropReadTimeOut;
      property WriteTimeOut : Integer read FWriteTimeOut write SetPropWriteTimeOut;

      property ReadBufferSize : Integer read FReadBufferSize write SetPropReadBufferSize;
      property WriteBufferSize : Integer read FWriteBufferSize write SetPropWriteBufferSize;

      property ParityReplace : AnsiChar read FParityReplace write FParityReplace;

    // @Section public class
    public
      class function GetPortNames() : TArray<String>;
  end;


  // 串口异常
  ESerialPort = class(Exception);

  // 串口读或写超时
  ESerialPortTimeOut = class(ESerialPort);


  // 别名, 辅助用
  TBaudRateTool = record
    public const
      // aliases
      BR_110  = CBR_110;
      BR_300  = CBR_300;
      BR_600  = CBR_600;
      BR_1200 = CBR_1200;
      BR_2400 = CBR_2400;
      BR_4800 = CBR_4800;
      BR_9600 = CBR_9600;
      BR_14400  = CBR_14400;
      BR_19200  = CBR_19200;
      BR_38400  = CBR_38400;
      BR_56000  = CBR_56000;
      BR_57600  = CBR_57600;
      BR_115200 = CBR_115200;
      BR_128000 = CBR_128000;
      BR_256000 = CBR_256000;

      SupportedValues : array[0..14] of Integer
                      = (BR_110,   BR_300,   BR_600,    BR_1200,   BR_2400,
                         BR_4800,  BR_9600,  BR_14400,  BR_19200,  BR_38400,
                         BR_56000, BR_57600, BR_115200, BR_128000, BR_256000);
    public
      class function IsSupportedBaudRate(const ABaudRate : Integer) : Boolean; static;
  end;

  TParityTool = record
    public const
      // aliases
      None = NOPARITY;   // 无校验
      Odd  = ODDPARITY;  // 奇校验
      Even = EVENPARITY; // 偶校验

      SupportedValues : array[0..2] of Integer = (None, Odd, Even);
    public
      class function IsSupportedParity(const AParity : Integer) : Boolean; static;
  end;

  TDataBitsTool = record
    public const
      SupportedValues : array[0..3] of Integer = (5, 6, 7, 8);
    public
      class function IsSupportedDataBits(const ADataBits : Integer) : Boolean; static;
  end;

  TStopBitTool = record
    public const
      // aliases
      One  = ONESTOPBIT;    // 1
      One5 = ONE5STOPBITS;  // 1.5
      Two  = TWOSTOPBITS;   // 2

      SupportedValues : array[0..2] of Integer = (One, One5, Two);
    public
      class function IsSupportedStopBit(const AStopBit : Integer) : Boolean; static;
  end;


implementation

uses
  System.Classes,
  System.Math,
  System.Win.Registry;



// --- types from C# ---

type
  DCBFlags = class
  // 没仔细看, 想来应该是偏移量
  // --see-also=https://github.com/dotnet/runtime/blob/master/src/libraries/Common/src/Interop/Windows/Kernel32/Interop.DCB.cs
    public
      const FBINARY      = 0;
      const FPARITY      = 1;
      const FOUTXCTSFLOW = 2;
      const FOUTXDSRFLOW = 3;
      const FDTRCONTROL  = 4;
      const FDSRSENSITIVITY = 6;
      const FOUTX = 8;
      const FINX  = 9;
      const FERRORCHAR = 10;
      const FNULL = 11;
      const FRTSCONTROL = 12;
      const FABORTONOERROR = 14;
      const FDUMMY2 = 15;
  end;

  DCBDTRFlowControl = class
    public
      const DTR_CONTROL_DISABLE = $00;
      const DTR_CONTROL_ENABLE  = $01;
  end;

  DCBRTSFlowControl = class
    public
      const RTS_CONTROL_DISABLE   = $00;
      const RTS_CONTROL_ENABLE    = $01;
      const RTS_CONTROL_HANDSHAKE = $02;
      const RTS_CONTROL_TOGGLE    = $03;
  end;

  TDCBTool = class
    public
      const EOFCHAR = AnsiChar(26);

      const DEFAULTXONCHAR  = AnsiChar(17);
      const DEFAULTXOFFCHAR = AnsiChar(19);
  end;



// --- TSerialPort ---

// --- class functions

class function TSerialPort.GetPortNames() : TArray<String>;
// 获取当前计算机的串行端口名的数组
var
  LRegistry : TRegistry;
  LValNames : TStrings;  // 注册表键下值的名称
  LIndex : Integer;
begin
  LRegistry := nil;
  LValNames := nil;
  try
    LValNames := TStringList.Create();
    LRegistry := TRegistry.Create();

    LRegistry.RootKey := HKEY_LOCAL_MACHINE;
    if not LRegistry.OpenKeyReadOnly('HARDWAREDEVICEMAPSERIALCOMM') then
    begin
      Result := nil;
      Exit;
    end;

    LRegistry.GetValueNames(LValNames);

    SetLength(Result, LValNames.Count);

    for LIndex := 0 to (LValNames.Count - 1) do begin
      Result[LIndex] := LRegistry.ReadString(LValNames[LIndex]);
    end;
  finally
    FreeAndNil(LRegistry);
    FreeAndNil(LValNames);
  end;
end;


// --- functions

constructor TSerialPort.Create();
begin
  Create('COM1');
end;

constructor TSerialPort.Create(const AComName: string);
// 默认 9600波特率 无校验 8数据位 1停止位
begin
  Create(AComName, CBR_9600, NOPARITY, 8, ONESTOPBIT);
end;

constructor TSerialPort.Create(const AComName: string; const ABaudRate, AParity, ADataBits, AStopBit: Integer);
const
  LDefaultBufferSize = 2048;
  LDefaultParityReplace = '?';
begin
  inherited Create();

  self.SetHandleInvalid();

  self.FEventLoop := nil;

  self.FReadBufferSize  := LDefaultBufferSize;
  self.FWriteBufferSize := LDefaultBufferSize;

  self.FReadTimeOut  := 0;
  self.FWriteTimeOut := 0;

  self.FParityReplace := LDefaultParityReplace;

  self.SetPropCommName(AComName);
  self.SetPropBaudRate(ABaudRate);
  self.SetPropParity(AParity);
  self.SetPropDataBits(ADataBits);
  self.SetPropStopBit(AStopBit);
end;


destructor TSerialPort.Destroy();
begin
  if self.IsOpen() then begin
    try
      self.Close();
    except
      // 如果执行到了这里, 能做什么呢
    end;
  end;

  inherited;
end;



function TSerialPort.IsOpen() : Boolean;
// 判断端口是否已被打开
begin
  Result := not self.IsInvalidHandle(self.FCommHandle);
end;

procedure TSerialPort.SetHandleInvalid();
// 将串口句柄设置为无效句柄
begin
  self.FCommHandle := INVALID_HANDLE_VALUE;
end;

function TSerialPort.IsInvalidHandle(const AHandle: NativeUInt) : Boolean;
// 判断串口句柄是否有效
begin
  Result := (AHandle = INVALID_HANDLE_VALUE);
end;



procedure TSerialPort.Open();
// 打开端口, 如果有问题会抛出异常
var
  LPortNumber : Integer;
  LTmpHandle : THandle;
  LErrCode  : Cardinal;
  LFileType : Integer;
  LErrors   : Cardinal;
  LCommProp : TCommProp;
  // only for function parameter
  LPinStatus : Cardinal;
  LComStat  : ComStat;
begin
  if self.IsOpen() then begin
    raise ESerialPort.Create('SerialPort is already open');
  end;

  LPortNumber := self.CheckAndGetComNumber(self.FCommName);

  // 创建句柄, 使用 tmpHandle 保存
  LTmpHandle := CreateFile(
            PChar('\?COM' + Integer.ToString(LPortNumber)),
            GENERIC_READ or GENERIC_WRITE,  // 读写访问
            0,                              // comm devices must be opened w/exclusive-access
            nil,                            // 安全属性 default security attributes
            OPEN_EXISTING,                  // comm devices must use OPEN_EXISTING
            FILE_FLAG_OVERLAPPED,           // 异步
            0);                             // hTemplate must be NULL for comm devices

  if self.IsInvalidHandle(LTmpHandle) then begin
    LErrCode := GetLastError();
    raise ESerialPort.CreateFmt('Open port failed invalied_handle_value, caused by error %d', [LErrCode]);
  end;

  try
    LFileType := GetFileType(LTmpHandle);

    // Allowing FILE_TYPE_UNKNOWN for legitimate serial device such as USB to serial adapter device
    if ((LFileType <> FILE_TYPE_CHAR) and (LFileType <> FILE_TYPE_UNKNOWN)) then begin
      raise ESerialPort.CreateFmt('The given port name (%s) does not resolve to a valid serial port',
                                  [self.FCommName]);
    end;

    // 把 tmpHandle 的值赋到 字段 FCommHandle 上来,
    // 但 tmpHandle 的值不动, 上面抛出异常或下面发生错误时 close tmpHandle
    self.FCommHandle := LTmpHandle;

    if   (not(GetCommProperties(LTmpHandle, LCommProp)))
       or(not(GetCommModemStatus(LTmpHandle, LPinStatus)))
    then begin
      // If the portName they have passed in is a FILE_TYPE_CHAR but not a serial port,
      // for example "LPT1", this API will fail.  For this reason we handle the error message specially.
      LErrCode := GetLastError();
      if ((LErrCode = ERROR_INVALID_PARAMETER) or (LErrCode = ERROR_INVALID_HANDLE)) then begin
        raise ESerialPort.CreateFmt('The given port name (%s) is invalid. It may be a valid port, but not a serial port.', [self.FCommName]);
      end
      else begin
        // Win32Marshal.GetExceptionForWin32Error(errorCode, string.Empty);
        raise ESerialPort.CreateFmt('Open port failed, caused by error %d', [LErrCode]);
      end;
    end;

    if ((LCommProp.dwMaxBaud <> 0) and (Cardinal(self.BaudRate) > LCommProp.dwMaxBaud)) then begin
      raise ESerialPort.CreateFmt('The maximum baud rate for the device is %d.', [LCommProp.dwMaxBaud]);
    end;

    self.ConfigDCB(LCommProp);
    self.ConfigEvents();
    self.ConfigTimeouts();
    self.ConfigBufferSizes();

    // TODO process errors
    PurgeComm(self.FCommHandle, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
    ClearCommError(self.FCommHandle, LErrors, @LComStat);

    // 启动事件循环
    self.FEventLoop := TSerialPort.TEventLoop.Create(self.FCommHandle);
    self.FEventLoop.Start();
  except
    self.SetHandleInvalid();

    CloseHandle(LTmpHandle);
    raise;
  end;
end;


procedure TSerialPort.Close();
// 关闭串口
var
  LTmpHandle : THandle;
begin
  if not self.IsOpen() then begin
    Exit;
  end;

  // 停止事件循环
  self.FEventLoop.Stop();
  FreeAndNil(self.FEventLoop);

  // 处理串口句柄
  LTmpHandle := self.FCommHandle;
  self.SetHandleInvalid();

  // TODO  process errors
  SetCommMask(LTmpHandle, 0); // 禁止所有事件
  EscapeCommFunction(LTmpHandle, CLRDTR); // 清除信号
  // 丢弃未完成的内容, 终止所有操作
  PurgeComm(LTmpHandle, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);

  CloseHandle(LTmpHandle);
end;


// --- read and write

function TSerialPort.ReadBytes(ABuff: TArray<Byte>; const AOffset: Integer; const ACount: Integer) : Integer;
// 读操作
// TODO 方法的实现需要仔细检查
var
  LReadResult : Boolean;
  LLenReaded  : Cardinal;
  LLastErr : Cardinal;
  LWaitResult : Cardinal;
  LReadOv : TOverlapped;
begin
  if not self.IsOpen() then begin
    raise ESerialPort.Create('The serialPort is closed');
  end;

  self.CheckReadWriteArguments(ABuff, AOffset, ACount);

  if (ACount = 0) then begin
    Result := 0;
    Exit;
  end;

  FillChar(LReadOv, SizeOf(LReadOv), 0);
  LReadOv.hEvent := CreateEvent(nil, True, False, nil);

  if (LReadOv.hEvent = 0) then begin
    LLastErr := GetLastError();
    raise ESerialPort.CreateFmt('Create event failed in read bytes, %d', [LLastErr]);
  end;

  LReadResult := ReadFile(self.FCommHandle,
                          ABuff[AOffset],
                          ACount,
                          LLenReaded,
                          @LReadOv);

  if LReadResult then begin
    Result := LLenReaded;
    Exit;
  end;

  LLastErr := GetLastError();
  if not(LLastErr = ERROR_IO_PENDING) then begin
    // TODO error description
    raise ESerialPort.CreateFmt('Read failed, caused by %d', [LLastErr]);
  end;

  // TODO 观察 C# 对这里超时是怎样处理的
  LWaitResult := WaitForSingleObject(LReadOv.hEvent, INFINITE);

  // TODO 考虑下面需要做哪些事情
  if (LWaitResult = WAIT_OBJECT_0) then begin
    if GetOverlappedResult(self.FCommHandle, LReadOv, LLenReaded, False) then begin
      Result := LLenReaded;
      //Break;
    end
    else begin
      Result := 0;
      //Break;
    end;
  end
  else if (LWaitResult = WAIT_TIMEOUT) then begin
    CancelIO(self.FCommHandle);

    Result := 0;
    // TODO timeout
  end
  else begin
    Result := 0;
  end;
end;

procedure TSerialPort.WriteBytes(ABuff: TArray<System.Byte>; const AOffset: Integer; const ACount: Integer);
// 写操作
// TODO 方法的实现需要仔细检查,
// 当前的实现不能保证把所有的数据都发送出去, 所以这里还需要更多处理
var
  LWriteResult : Boolean;
  LWriteOv : TOverlapped;
  LLenSent : Cardinal;
  LWriteErr   : Cardinal;
  LWaitResult : Cardinal;
begin
  if not self.IsOpen() then begin
    raise ESerialPort.Create('The serialPort is closed');
  end;

  self.CheckReadWriteArguments(ABuff, AOffset, ACount);

  FillChar(LWriteOv, SizeOf(LWriteOv), 0);

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

  if (LWriteOv.hEvent = 0) then begin
    raise ESerialPort.CreateFmt('Write failed, cuased by create event error %d.', [GetLastError()]);
  end;

  try
    LWriteResult := WriteFile( self.FCommHandle,
                               ABuff[AOffSet],
                               ACount,
                               LLenSent,
                               @LWriteOv);

    if LWriteResult then begin
      Exit;  // 发送完, 退出
    end;

    LWriteErr := GetLastError();
    if (LWriteErr <> ERROR_IO_PENDING) then begin
      // TODO error description
      raise ESerialPort.CreateFmt('Write failed, error %d.', [LWriteErr]);
    end;

    // TODO configure wait timeout
    LWaitResult := WaitForSingleObject(LWriteOv.hEvent, INFINITE);

    if (LWaitResult = WAIT_OBJECT_0) then begin
      if GetOverlappedResult(self.FCommHandle, LWriteOv, LLenSent, False) then begin
        Exit;
      end
      else begin
        // TODO type an exception
        raise ESerialPort.CreateFmt('Write failed, error %d.', [GetLastError()]);
      end;
    end
    else if (LWaitResult = WAIT_TIMEOUT) then begin
      // TODO timeout
      raise ESerialPort.Create('Write failed, timeout.');
    end
    else begin
      raise ESerialPort.CreateFmt('Write failed, Wait result %d.', [LWaitResult]);
    end;
    // write finished
  finally
    CloseHandle(LWriteOv.hEvent);
  end;
end;


procedure TSerialPort.CheckReadWriteArguments(const AArr: TArray<System.Byte>; const AOffset, ACount: Integer);
// 检查读写操作的输入参数
var
  LLen : Integer;
begin
  LLen := Length(AArr);
  if (LLen <= 0) then begin
    raise ESerialPort.Create('Null bytes buffer');
  end;

  if (AOffset < 0) then begin
    raise ESerialPort.Create('Non-negative number required, offset');
  end;

  if (ACount < 0) then begin
    raise ESerialPort.Create('Non-negative number required, count');
  end;

  if (LLen - AOffset < ACount) then begin
    raise ESerialPort.Create('Offset and length were out of bounds for the array '
            + 'or count is greater than the number of elements from index to the end of the source collection');
  end;
end;


function TSerialPort.CheckAndGetComNumber(const AComName: string) : Integer;
// 检查和串口名是不是 COM后面跟着数字 的格式, 如果是则返回数字, 否则抛出异常
const
  LStrInvalidPortNameFmt = 'The given port name (%s) does not resolve to a valid serial port';
begin
  if (not AComName.StartsWith('COM', True))
      or (not Integer.TryParse(AComName.Substring(3), Result))
      or (not Result > 0)
  then begin
    raise ESerialPort.CreateFmt(LStrInvalidPortNameFmt, [AComName]);
  end;
end;


// --- about comm config

procedure TSerialPort.ConfigEvents();
// 配置事件
const
  LEV_ALL = (   EV_BREAK or EV_CTS    or EV_DSR    or EV_ERR or EV_RING
             or EV_RLSD  or EV_RXCHAR or EV_RXFLAG or EV_TXEMPTY);
var
  LErrCode : Cardinal;
begin
  // 设置事件, 把所有的事件都设置了, 虽然没有处理这些事件
  if not SetCommMask(self.FCommHandle, LEV_ALL) then begin
    LErrCode := GetLastError();
    raise ESerialPort.CreateFmt('SetCommMask failed, caused by %d', [LErrCode]);
  end;
end;


procedure TSerialPort.ConfigDCB(ACommProp : TCommProp);
// 配置 设备控制块
// TODO 完善
var
  LDcb : TDCB;
  LErrCode : Cardinal;
begin
  if not GetCommState(self.FCommHandle, LDcb) then begin
    LErrCode := GetLastError();
    raise ESerialPort.CreateFmt('Get DCB failed, caused by %d', [LErrCode]);
  end;

  // TODO others
  //LDcb.DCBlength := SizeOf(TDCB);

  LDcb.BaudRate := self.FBaudRate;
  LDcb.Parity   := self.FParity;
  LDcb.ByteSize := self.FDataBits;
  LDcb.StopBits := self.FStopBit;

  // always true for communications resources
  SetDcbFlag(LDcb, DCBFlags.FBINARY, 1);
  //LDcb.Flags := 1;

  if (self.FParity = TParityTool.None) then begin
    SetDcbFlag(LDcb, DCBFlags.FPARITY, 0);
  end
  else begin
    SetDcbFlag(LDcb, DCBFlags.FPARITY, 1);
  end;

  // Note-1
  // 不支持这个东西, 不了解它, C# 默认Handshake.None
  SetDcbFlag(LDcb, DCBFlags.FOUTXCTSFLOW, 0);

  SetDcbFlag(LDcb, DCBFlags.FOUTXDSRFLOW, 0); // dsrTimeout is always set to 0.
  SetDcbFlag(LDcb, DCBFlags.FDTRCONTROL, DCBDTRFlowControl.DTR_CONTROL_DISABLE);
  SetDcbFlag(LDcb, DCBFlags.FDSRSENSITIVITY, 0); // this should remain off

  // 同 Note-1
  SetDcbFlag(LDcb, DCBFlags.FINX, 0);
  SetDcbFlag(LDcb, DCBFlags.FOUTX, 0);


  // if no parity, we have no error character (i.e. ErrorChar = '' or null character)
  if (self.FParity = TParityTool.None) then begin
    SetDcbFlag(LDcb, DCBFlags.FERRORCHAR, 0);
    LDcb.ErrorChar := #0;
  end
  else begin
    if (Ord(self.FParityReplace) = 0) then begin
      SetDcbFlag(LDcb, DCBFlags.FERRORCHAR, 0);
    end
    else begin
      SetDcbFlag(LDcb, DCBFlags.FERRORCHAR, 1);
    end;

    LDcb.ErrorChar := self.FParityReplace;
  end;

  // Note-2 默认 C# 默认 false
  SetDcbFlag(LDcb, DCBFlags.FNULL, 0);

  // SerialStream does not handle the fAbortOnError behaviour, so we must make sure it's not enabled
  // C# 的 SerialStream
  SetDcbFlag(LDcb, DCBFlags.FABORTONOERROR, 0);

  // Setting RTS control, which is RTS_CONTROL_HANDSHAKE if RTS / RTS-XOnXOff handshaking
  // used, RTS_ENABLE (RTS pin used during operation) if rtsEnable true but XOnXoff / No handshaking
  // used, and disabled otherwise.
  // C# 这里有与 Handshake 有关的处理
  if (GetDcbFlag(LDcb, DCBFlags.FRTSCONTROL) = DCBRTSFlowControl.RTS_CONTROL_HANDSHAKE) then begin
    SetDcbFlag(LDcb, DCBFlags.FRTSCONTROL, DCBRTSFlowControl.RTS_CONTROL_DISABLE);
  end;

  LDcb.XonChar  := TDCBTool.DEFAULTXONCHAR;      // may be exposed later but for now, constant
  LDcb.XoffChar := TDCBTool.DEFAULTXOFFCHAR;

  // minimum number of bytes allowed in each buffer before flow control activated
  // heuristically, this has been set at 1/4 of the buffer size
  LDcb.XonLim  := (ACommProp.dwCurrentRxQueue div 4);
  LDcb.XoffLim := (ACommProp.dwCurrentRxQueue div 4);

  LDcb.EofChar := TDCBTool.EOFCHAR;

  // OLD MSCOMM: dcb.EvtChar = (byte) 0;
  // now changed to make use of RXFlag WaitCommEvent event => Eof WaitForCommEvent event
  LDcb.EvtChar := TDCBTool.EOFCHAR;


  if not SetCommState(self.FCommHandle, LDcb) then begin
    LErrCode := GetLastError();
    raise ESerialPort.CreateFmt('Set DCB failed, caused by %d.', [LErrCode]);
  end;
end;


procedure TSerialPort.ConfigTimeouts();
// 配置超时
var
  LTimeouts : TCommTimeouts;
  LErrCode : Cardinal;
begin
  if not GetCommTimeouts(self.FCommHandle, LTimeouts) then begin
    LErrCode := GetLastError();
    raise ESerialPort.CreateFmt('Get timeouts failed, caused by %d', [LErrCode]);
  end;

  if (self.FReadTimeOut = 0) then begin
    // 不使用超时, 读操作总是立即返回
    LTimeouts.ReadIntervalTimeout := MAXDWORD;
    LTimeouts.ReadTotalTimeoutMultiplier := 0;
    LTimeouts.ReadTotalTimeoutConstant := 0;
  end
  else begin
    // 固定超时
    LTimeouts.ReadIntervalTimeout := MAXDWORD;
    LTimeouts.ReadTotalTimeoutMultiplier := MAXDWORD;
    LTimeouts.ReadTotalTimeoutConstant := self.FReadTimeOut;
  end;

  LTimeouts.WriteTotalTimeoutMultiplier := 0;
  // 如果 FWriteTimeout 设置为 0, 则不使用写超时
  LTimeouts.WriteTotalTimeoutConstant   := self.FWriteTimeOut;

  if not SetCommTimeouts(self.FCommHandle, LTimeouts) then begin
    LErrCode := GetLastError();
    raise ESerialPort.CreateFmt('Set timeouts failed, caused by %d.', [LErrCode]);
  end;
end;


procedure TSerialPort.ConfigBufferSizes;
// 配置缓冲区
var
  LErrCode : Cardinal;
begin
  if not(SetupComm(self.FCommHandle, self.FReadBufferSize, self.FWriteBufferSize)) then begin
    LErrCode := GetLastError();
    raise ESerialPort.CreateFmt('Set buffer sizes failed, caused by %d', [LErrCode]);
  end;
end;



// --- about Dcb.Flags

function TSerialPort.GetDcbFlag(const ADcb : TDCB; AWhichFlag : Integer) : Integer;
// from C#
var
  LMask : Cardinal;
begin
  if ((AWhichFlag = DCBFlags.FDTRCONTROL) or (AWhichFlag = DCBFlags.FRTSCONTROL)) then begin
    LMask := $03;
  end
  else if (AWhichFlag = DCBFlags.FDUMMY2) then begin
    LMask := $1FFFF;
  end
  else begin
    LMask := $01;
  end;

  Result := ADcb.Flags and (LMask shl AWhichFlag);
  Result := Result shr AWhichFlag;
end;


procedure TSerialPort.SetDcbFlag(var ADcb : TDCB; AWhichFlag : Integer; ASetting : Integer);
// from C#
var
  LMask : Cardinal;
begin
  ASetting := ASetting shl AWhichFlag;

  if ((AWhichFlag = DCBFlags.FDTRCONTROL) or (AWhichFlag = DCBFlags.FRTSCONTROL)) then begin
    LMask := $03;
  end
  else if (AWhichFlag = DCBFlags.FDUMMY2) then begin
    LMask := $1FFFF;
  end
  else begin
    LMask := $01;
  end;

  // clear the region
  ADcb.Flags := ADcb.Flags and (not (LMask shl ADcb.Flags));

  // set the region
  ADcb.Flags := ADcb.Flags or ASetting;
end;


// --- for properties

procedure TSerialPort.SetPropCommName(const ACommName: string);
begin
  if Trim(ACommName) = '' then begin
    raise ESerialPort.Create('The port name can not be empty');
  end;

  if self.IsOpen() then begin
    raise ESerialPort.CreateFmt('"%s" can not be set while the port is open', [self.FCommName]);
  end;

  self.FCommName := ACommName;
end;

procedure TSerialPort.SetPropBaudRate(const ABaudRate: Integer);
begin
  // if not TBaudRateTool.IsSupportedBaudRate(ABaudRate) then begin
  if (ABaudRate <= 0) then begin
    raise ESerialPort.CreateFmt('Unsupported bardrate %d', [ABaudRate]);
  end;

  self.FBaudRate := ABaudRate;
end;

procedure TSerialPort.SetPropParity(const AParity: Integer);
begin
  if not TParityTool.IsSupportedParity(AParity) then begin
    raise ESerialPort.CreateFmt('Unsupported parity %d', [AParity]);
  end;

  self.FParity := AParity;
end;

procedure TSerialPort.SetPropDataBits(const ADataBits: Integer);
begin
  if not TDataBitsTool.IsSupportedDataBits(ADataBits) then begin
    raise ESerialPort.CreateFmt('Unsupported dataBits %d', [ADataBits]);
  end;

  self.FDataBits := ADataBits;
end;

procedure TSerialPort.SetPropStopBit(const AStopBit: Integer);
begin
  if not TStopBitTool.IsSupportedStopBit(AStopBit) then begin
    raise ESerialPort.CreateFmt('Unsupported stopBit %d', [AStopBit]);
  end;

  self.FStopBit := AStopBit;
end;


procedure TSerialPort.SetPropReadTimeOut(const ATimeOut: Integer);
// 设置读超时
// timeout == 0 表示不使用超时, 无论有没有数据总是立即返回
var
  LOldTimeout : Integer;
begin
  if (ATimeOut < 0) then begin
    raise ESerialPort.CreateFmt('ReadTimeout %d out of range, timeout can not less than 0.', [ATimeOut]);
  end;

  LOldTimeOut := self.FReadTimeOut;
  try
    self.FReadTimeOut := ATimeOut;

    if self.IsOpen() then begin
      self.ConfigTimeouts();
    end;
  except
    self.FReadTimeOut := LOldTimeout;
    raise;
  end;
end;

procedure TSerialPort.SetPropWriteTimeOut(const ATimeOut: Integer);
// 设置写超时
// timeout == 0 表示不使用写超时
var
  LOldTimeOut : Integer;
begin
  if (ATimeOut < 0) then begin
    raise ESerialPort.CreateFmt('ReadTimeout %d out of range, timeout can not less than 0.', [ATimeOut]);
  end;

  LOldTimeOut := self.FWriteTimeOut;
  try
    self.FWriteTimeOut := ATimeOut;

    if self.IsOpen() then begin
      self.ConfigTimeouts();
    end;
  except
    self.FWriteTimeOut := LOldTimeout;
    raise;
  end;
end;


procedure TSerialPort.SetPropReadBufferSize(const ASize: Integer);
// 设置 读缓冲区
begin
  if (ASize <= 0) then begin
    raise ESerialPort.Create('ReadBufferSize must greater than 0.');
  end;

  if self.IsOpen() then begin
    raise  ESerialPort.Create('ReadBufferSize cannot be set while the port is open.');
  end;

  self.FReadBufferSize := ASize;
end;

procedure TSerialPort.SetPropWriteBufferSize(const ASize: Integer);
// 设置 写缓冲区
begin
  if (ASize <= 0) then begin
    raise ESerialPort.Create('WriteBufferSize must greater than 0.');
  end;

  if self.IsOpen() then begin
    raise  ESerialPort.Create('WriteBufferSize cannot be set while the port is open.');
  end;

  self.FWriteBufferSize := ASize;
end;



// --- TSerialPort.TEventLoop ---
// TODO

constructor TSerialPort.TEventLoop.Create(AHandle : THandle);
begin
  inherited Create();

  self.FHandle := AHandle;
  // TODO
end;

destructor TSerialPort.TEventLoop.Destroy;
begin
  // TODO

  inherited;
end;


procedure TSerialPort.TEventLoop.Start();
begin
  // TODO
end;


procedure TSerialPort.TEventLoop.Stop();
begin
  // TODO
end;




// --- unit private sequential search ---

function Contains(const AItem : Integer; const AArray : array of Integer) : Boolean;
var
  LElem : Integer;
begin
  for LElem in AArray do begin
    if (AItem = LElem) then begin
      Result := True;
      Exit;
    end;
  end;

  Result := False;
end;


// --- TBaudRateTool ---

class function TBaudRateTool.IsSupportedBaudRate(const ABaudRate : Integer) : Boolean;
begin
  Result := Contains(ABaudRate, SupportedValues);
end;

// --- TPairtyTool ---

class function TParityTool.IsSupportedParity(const AParity : Integer) : Boolean;
begin
  Result := Contains(AParity, SupportedValues);
end;

// --- TDataBitsTool ---

class function TDataBitsTool.IsSupportedDataBits(const ADataBits : Integer) : Boolean;
begin
  Result := Contains(ADataBits, SupportedValues);                                     
end;

// --- TStopBitTool ---

class function TStopBitTool.IsSupportedStopBit(const AStopBit : Integer) : Boolean;
begin
  Result := Contains(AStopBit, SupportedValues);
end;


end.

--------- THE END ---------