SmartPort: bare-bones wrapper for a serial connection (with some USB support)

SmartPort.pas

unit SmartPort;

interface

uses Windows, SysUtils, Classes;

{$D-}

type
  TSmartPortParity=(ppParityEven,ppParityMark,ppParityNone,ppParityOdd,ppParitySpace);
  TSmartPortStopBits=(psStopBitOne,psStopBitOneAndAHalf,psStopBitTwo);
  TSmartPort=class(TObject)
  private
    FFakeIt: Boolean;
    FPort:THandleStream;
    FPortName: string;
    FCommTimeouts: TCommTimeouts;
    FGotSize: integer;
    FFlagsClear, FFlagsSet: LongInt;
    procedure SetPortName(const Value: string);
    function GetActive:boolean;
    procedure SetActive(const Value: boolean);
  public
    constructor Create;
    constructor CreateWithParams(AFakeIt: Boolean);
    destructor Destroy; override;

    property PortName:string read FPortName write SetPortName;
    property CommTimeouts:TCommTimeouts read FCommTimeouts write FCommTimeouts;
    property FlagsClear:LongInt read FFlagsClear write FFlagsClear;
    property FlagsSet:LongInt read FFlagsSet write FFlagsSet;
    property FakeIt: Boolean read FFakeIt;

    procedure Open;
    procedure Close;
    procedure Flush;

    procedure Send(x:string);
    procedure SendBlocks(x:string;BlockSize:integer);
    function Get:string;
    property GotSize:integer read FGotSize;
    property Active:boolean read GetActive write SetActive;

    procedure SetPortParameters(BaudRate:integer;DataBits:byte;
      Parity:TSmartPortParity;StopBits:TSmartPortStopBits;InQueue,OutQueue:cardinal);

    class function GetPortName(Prefix:string):string;
  end;

implementation

{ TSmartPort }

constructor TSmartPort.Create;
begin
  inherited Create;
  //
  FPort:=nil;
  FCommTimeouts.ReadIntervalTimeout:=cardinal(-1);
  FCommTimeouts.ReadTotalTimeoutMultiplier:=0;
  FCommTimeouts.ReadTotalTimeoutConstant:=2000;
  FCommTimeouts.WriteTotalTimeoutMultiplier:=0;
  FCommTimeouts.WriteTotalTimeoutConstant:=3000;
  FFlagsClear:=$000842;
  FFlagsSet:=$000081;
  // --
  FFakeIt:=False;
end;

constructor TSmartPort.CreateWithParams(AFakeit: Boolean);
begin
  Create;
  //
  FFakeIt:=AFakeIt;
end;

destructor TSmartPort.Destroy;
begin
  if not(FPort=nil) then Close;
  //
  inherited;
end;

procedure TSmartPort.Open;
var
  h:THandle;
  s:string;
begin
  if FakeIt then
    Exit;
  // --
  if FPort=nil then
   begin
    if Copy(FPortName,1,2)='\\' then s:=FPortName else s:='\\?\'+FPortName;
    h:=CreateFile(
      PChar(s),
      GENERIC_WRITE or GENERIC_READ,FILE_SHARE_WRITE or FILE_SHARE_READ,
      nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
    if h=INVALID_HANDLE_VALUE then RaiseLastOSError;
    FPort:=THandleStream.Create(h);
    SetCommTimeouts(FPort.Handle,FCommTimeouts);
   end;
end;

procedure TSmartPort.Close;
begin
  if FakeIt then
    Exit;
  // --
  if not(FPort=nil) then
   begin
    CloseHandle(FPort.Handle);
    FreeAndNil(FPort);
   end;
end;

procedure TSmartPort.SetPortName(const Value: string);
begin
  if not(FPort=nil) then Close;
  FPortName := Value;
end;

procedure TSmartPort.Send(x: string);
var
  l:integer;
begin
  if FakeIt then
    Exit;
  // --
  if FPort=nil then Open;
  l:=Length(x);
  if FPort.Write(x[1],l)<>l then raise Exception.Create('Failed to send over '+FPortName);//RaiseLastOSError?
end;

function TSmartPort.Get: string;
begin
  if FakeIt then
   begin
    FGotSize:=0;
    Result:='';
    Exit;
   end;
  if FPort=nil then Open;
  FGotSize:=$10000;
  SetLength(Result,FGotSize);
  FGotSize:=FPort.Read(Result[1],FGotSize);
  SetLength(Result,FGotSize);
end;

procedure TSmartPort.Flush;
begin
  if FakeIt then
    Exit;
  // --
  FlushFileBuffers(FPort.Handle);
end;

function TSmartPort.GetActive: boolean;
begin
  Result:=not (FPort=nil) or FakeIt;
end;

procedure TSmartPort.SetActive(const Value: boolean);
begin
  if Value and (FPort=nil) then Open;
  if not(Value) and not(FPort=nil) then Close;
end;

procedure TSmartPort.SetPortParameters(BaudRate: integer; DataBits: byte;
  Parity: TSmartPortParity; StopBits: TSmartPortStopBits;InQueue,OutQueue:cardinal);
var
  dcb:TDCB;
const
  ParityValue:array[TSmartPortParity] of integer=(EVENPARITY,MARKPARITY,NOPARITY,ODDPARITY,SPACEPARITY);
  StopBitValue:array[TSmartPortStopBits] of integer=(ONESTOPBIT,ONE5STOPBITS,TWOSTOPBITS);
begin
  if FakeIt then
    Exit;
  // --
  if FPort=nil then Open;
  if not(SetupComm(FPort.Handle,InQueue,OutQueue)) then RaiseLastOSError;
  ZeroMemory(@dcb,SizeOf(TDCB));
  dcb.DCBlength:=SizeOf(TDCB);
  if not(GetCommState(FPort.Handle,dcb)) then RaiseLastOSError;
  if (dcb.BaudRate<>DWORD(BaudRate)) or
     (dcb.ByteSize<>DataBits) or
     (dcb.Flags<>LongInt(dcb.Flags and not(FFlagsClear) or FFlagsSet)) or
     (dcb.Parity<>ParityValue[Parity]) or
     (dcb.StopBits<>StopBitValue[StopBits]) then
   begin
    dcb.BaudRate:=BaudRate;
    dcb.ByteSize:=DataBits;
    dcb.Flags:=dcb.Flags and not(FFlagsClear) or FFlagsSet;
    dcb.Parity:=ParityValue[Parity];
    dcb.StopBits:=StopBitValue[StopBits];
    if not(SetCommState(FPort.Handle,dcb)) then RaiseLastOSError;
   end;
end;

class function TSmartPort.GetPortName(Prefix: string): string;
var
  i,j,QueryLength:integer;
  DeviceNames,s:string;
  found:boolean;
begin
  i:=4096;
  QueryLength:=0;
  while QueryLength=0 do
   begin
    inc(i,4096);
    SetLength(DeviceNames,i);
    QueryLength:=QueryDosDevice(nil,PChar(DeviceNames),i);
   end;

  i:=1;
  found:=false;
  while (i<QueryLength) and not(found) do
   begin
    j:=i;
    while (i<QueryLength) and not(DeviceNames[i]=#0) do inc(i);
    s:=Copy(DeviceNames,j,i-j);
    inc(i);
    if UpperCase(Copy(s,1,Length(Prefix)))=UpperCase(Prefix) then
     begin
      Result:=s;
      found:=true;
     end;
   end;

  if not(found) then raise Exception.Create('No device found "'+Prefix+'"');
end;

procedure TSmartPort.SendBlocks(x: string; BlockSize: integer);
var
  i,j,l:integer;
begin
  if FakeIt then
    Exit;
  // --
  if FPort=nil then Open;
  i:=1;
  j:=BlockSize;
  l:=Length(x);
  while i<=l do
   begin
    if i+j>l then j:=l-i+1;
    if FPort.Write(x[i],j)<>j then raise Exception.Create('Failed to send over '+FPortName+' ['+IntToStr(i)+':'+IntToStr(j)+']');//RaiseLastOSError?
    Flush;
    inc(i,j);
   end;
end;

end.