Simple class to work with serial channels

mychannel.pas

unit mychannel;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Serial;

const
  SEROUT_BUFFER_LENGTH_MYC = 128;   // Serial output buffer length
  SERIN_BUFFER_LENGTH_MYC = 128;    // Serial input buffer length

type
  EMyChannelErr = class(Exception);

  TMyChannel = class
  private
    FHandle: TSerialHandle;
    FPort: AnsiString;
    FSpeed: Integer;
    FActive: Boolean;

    procedure SetActive(AValue: Boolean);

  protected
    OutBuff: array [0..SEROUT_BUFFER_LENGTH_MYC - 1] of AnsiChar;
    OutDataLen, OutDataPos: LongInt;
    InBuff: array of Byte;

    procedure RefreshStatus; virtual; abstract;

  public
    constructor Create;
    destructor Destroy; override;

    procedure Open;
    procedure Close;

    function Get(ATimeout: LongInt): LongInt;
    function Get(out S: RawByteString; AMax, ATimeout: LongInt): LongInt;
    function FlushIn: Boolean;

    function Put(Ch: AnsiChar; NeedsFlush: Boolean = False): LongInt;
    function Put(S: AnsiString; NeedsFlush: Boolean = False): LongInt;
    function FlushOut: Boolean;

    property Port: AnsiString read FPort write FPort;
    property Speed: Integer read FSpeed write FSpeed;
    property Active: Boolean read FActive write SetActive;
  end;


implementation

uses
  Math;

{ TMyChannel }

procedure TMyChannel.SetActive(AValue: Boolean);
begin
  if AValue then
  begin
    if not Active then
      Open
  end
  else
    if Active then
      Close;
end;

constructor TMyChannel.Create;
begin
  inherited Create;
  SetLength(InBuff, SERIN_BUFFER_LENGTH_MYC);
end;

destructor TMyChannel.Destroy;
begin
  inherited Destroy;
end;

procedure TMyChannel.Open;
begin
  FHandle := Serial.SerOpen(FPort);
  Serial.SerSetParams(FHandle, FSpeed, 8, NoneParity, 1, []);
  if FHandle = 0 then
    raise EMyChannelErr.CreateFmt('Can''t open ''%s'' (%d)!', [FPort, 0]);
  OutDataLen := SizeOf(OutBuff);
  OutDataPos := 0;
  FActive := True;
end;

procedure TMyChannel.Close;
begin
  Serial.SerClose(FHandle);
  FActive := False;
end;

function TMyChannel.Get(ATimeout: LongInt): LongInt;
var
  Processed: Longint;
  Ch: AnsiChar;
begin
  Processed := Serial.SerReadTimeout(FHandle, Ch, ATimeout);
  if Processed > 0 then
    Result := LongInt(ch) else
    Result := -1;
end;

function TMyChannel.Get(out S: RawByteString; AMax, ATimeout: LongInt
  ): LongInt;
begin
  Result := Serial.SerReadTimeout(FHandle, InBuff, Min(AMax, SERIN_BUFFER_LENGTH_MYC), ATimeout);
  if Result > 0 then
  begin
    SetLength(S, Result);
    Move(InBuff[0], S[1], Result);
  end;
end;

function TMyChannel.FlushIn: Boolean;
begin
  SerFlushInput(FHandle);
  Result := True;
end;

function TMyChannel.Put(Ch: AnsiChar; NeedsFlush: Boolean): LongInt;
begin
  OutBuff[OutDataPos] := Ch;
  Inc(OutDataPos);

  // If output buffer full then flush
  if (OutDataPos >= OutDataLen) or NeedsFlush then
    Result := IfThen(FlushOut, 1, 0) else
    Result := 1;
end;

function TMyChannel.Put(S: AnsiString; NeedsFlush: Boolean): LongInt;
var
  I: Integer;
begin
  Result := Length(S);
  for I := 1 to Result do
    if Put(S[I]) < 1 then
      Exit(I);
  if NeedsFlush then
    FlushOut;
end;

function TMyChannel.FlushOut: Boolean;
var
  Sent: LongInt;
begin
  if OutDataPos < 1 then
    Exit(True);

  Sent := Serial.SerWrite(FHandle, OutBuff, OutDataPos);
  Result := OutDataPos = Sent;

  OutDataLen := SizeOf(OutBuff);
  OutDataPos := 0;
end;

end.