编写delphi串口类

自己动手编写 delphi 的串口类

    --date=2020-03-28

    --group="笔记草稿"

---------

TODO 暂存未完

unit uSerialPort;

{ 串口
  ---------
  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
    private
      FCommHandle : THandle;

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

      // 超时
      FReadTimeOut : Integer;
      FWriteTimeOut : Integer;

      // for property
      procedure SetCommName(const ACommName : String);
      procedure SetBaudRate(const ABaudRate : Integer);
      procedure SetParity(const AParity : Integer);
      procedure SetDataBits(const ADataBits : Integer);
      procedure SetStopBit(const AStopBit : Integer);

      procedure SetReadTimeOut(const ATimeOut : Integer);
      procedure SetWriteTimeOut(const ATimeOut : Integer);

      procedure SetHandleInvalid();

    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();

      class function GetPortNames() : TArray<String>;

      property PortName : String read FCommName write SetCommName;
      property BaudRate : Integer read FBaudRate write SetBaudRate;
      property Parity : Integer read FParity write SetParity;
      property DataBits : Integer read FDataBits write SetDataBits;
      property StopBit : Integer read FStopBit write SetStopBit;

      property ReadTimeOut : Integer read FReadTimeOut write SetReadTimeOut;
      property WriteTimeOut : Integer read FWriteTimeOut write SetWriteTimeOut;
  end;

  ESerialPort = class(Exception);

  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 IsValidBaudRate(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 IsValidParity(const AParity : Integer) : Boolean; static;
  end;

  TDataBitsTool = record
    public const
      SupportedValues : array[0..3] of Integer = (5, 6, 7, 8);
    public
      class function IsValidDataBits(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 IsValidStopBit(const AStopBit : Integer) : Boolean; static;
  end;


implementation

uses
  System.Classes,
  System.Win.Registry;



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

constructor TSerialPort.Create(const AComName: string);
begin
  Create(AComName, CBR_9600, NOPARITY, 8, ONESTOPBIT);
end;

constructor TSerialPort.Create(const AComName: string; const ABaudRate, AParity, ADataBits, AStopBit: Integer);
begin
  inherited Create();

  self.SetHandleInvalid();

  self.SetCommName(AComName);
  self.SetBaudRate(ABaudRate);
  self.SetParity(AParity);
  self.SetDataBits(ADataBits);
  self.SetStopBit(AStopBit);



  // TODO
end;

destructor TSerialPort.Destroy();
begin
  if not self.IsOpen() then begin
    Exit;
  end;

  try
    self.Close()
  except
    // 如果执行到了这里, 能做什么呢
  end;
end;


function TSerialPort.IsOpen() : Boolean;
begin
  Result := (self.FCommHandle <> INVALID_HANDLE_VALUE);
end;

procedure TSerialPort.SetHandleInvalid();
begin
  self.FCommHandle := INVALID_HANDLE_VALUE;
end;


procedure TSerialPort.Open();
begin
  // TODO
end;

procedure TSerialPort.Close();
begin
  // TODO
  self.SetHandleInvalid();
end;


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('HARDWARE\DEVICEMAP\SERIALCOMM') 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;


procedure TSerialPort.SetCommName(const ACommName: string);
begin
  self.FCommName := ACommName;
end;

procedure TSerialPort.SetBaudRate(const ABaudRate: Integer);
begin
  if not TBaudRateTool.IsValidBaudRate(ABaudRate) then begin
    raise ESerialPort.CreateFmt('Unsupported bardrate %d', [ABaudRate]);
  end;

  self.FBaudRate := ABaudRate;
end;

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

  self.FParity := AParity;
end;

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

  self.FDataBits := ADataBits;
end;

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

  self.FStopBit := AStopBit;
end;

procedure TSerialPort.SetReadTimeOut(const ATimeOut: Integer);
begin
  // TODO check

  self.FReadTimeOut := ATimeOut;
end;

procedure TSerialPort.SetWriteTimeOut(const ATimeOut: Integer);
begin
  // TODO check
  self.FWriteTimeOut := ATimeOut;
end;





// --- 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.IsValidBaudRate(const ABaudRate : Integer) : Boolean;
begin
  Result := Contains(ABaudRate, SupportedValues);
end;

// --- TPairtyTool ---

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

// --- TDataBitsTool ---

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

// --- TStopBitTool ---

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


end.

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