unit ComPort;{for Win32, using units from async32 from DSP }
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, IniFiles,
  tvtype, mytype, timer, showmsg, globals, mylib, conftype, confu, binhex,
  comtype, {v0.19}logtype, logu, portlog, {/v0.19}
  {$IFDEF WIN32}
  commint
  {$ELSE}
  comm
  {$ENDIF}
  ;
type
  PComPort = TComm;
{EXPORT}
function ComInit(AComNr:integer; var ACom:PComPort):boolean;
function ComPut(ACom:PComPort; AByte:byte):boolean;
function ComGet(ACom:PComPort):integer;
function ComWrite(ACom:PComPort; var Buf; Count:word):boolean;
function ComRead(ACom:PComPort; var Buf; var Count:word):boolean;
function ComGetWait(ACom:PComPort; ATimeout:longint):integer;
function ComSetPropInt(ACom:PComPort; cp:TComProperty; AValue:longint):boolean;
function ComGetPropInt(ACom:PComPort; cp:TComProperty):longint;
function ComClear(ACom:PComPort):boolean;
function ComDone(ACom:PComPort):boolean;

procedure ReadWriteComConfig(rw:TReadWrite; ACom:PComPort);
{/EXPORT}

implementation


{**************************}
function IsValidCom(ACom:PComPort):boolean;
begin
  IsValidCom := false;
  if ACom = nil then begin
    ShowMessage('Invalid COM handle used.', smError,0);
    exit;
  end;
  IsValidCom := true;
end;

procedure ReadWriteComConfig(rw:TReadWrite; ACom:PComPort);
var
  i:integer;
  sec:ShortString;

  lReadTimeout,
  lWriteTimeout,
  lWriteBufsize,
  lReadBufsize,
  lBaudRate:Longint;

  lParity:char;

  lStopBits, lDataBits:smallint;

{  lMonitorEvents,}
  lFlowControl:shortstring;
{  lFlags,
  lAfterOpenState:ShortString;}
  lUseIniPars:boolean;

  lParityCheck,
  lDsrSensitivity,
  lIgnoreXOff,
  lErrorChar,
  lNullStrip{M},
  lAbortOnError{/M}:boolean;
  lDtr,lRts,lXOn,lBreak:byte;

  procedure PropToUser;
  begin
    with ACom do begin
      lReadTimeout := ReadTimeout;
      lWriteTimeout := WriteTimeout;
      lReadBufSize := ReadBufSize;
      lWriteBufSize := WriteBufSize;
      lBaudRate := BaudRatePropToUser(BaudRate);
      lParity := ParityPropToUser(Parity);
      lStopBits := StopBitsPropToUser(StopBits);
      lDataBits := DataBitsPropToUser(DataBits);
      {lMonitorEvents := MonitorEventsPropToUser(MonitorEvents);}
      lFlowControl := FlowControlPropToUser(FlowControl);
      {lFlags := FlagsPropToUser(Options);
      lAfterOpenState := AfterOpenStateIToU(AfterOpenState);}
      lUseIniPars := boolean(AfterOpenState);
      lParityCheck := coParityCheck in Options;
      lDsrSensitivity := coDsrSensitivity in Options;
      lIgnoreXOff := coIgnoreXOff in Options;
      lErrorChar := coErrorChar in Options;
      lNullStrip := coNullStrip in Options;
      lAbortOnError := coAbortOnError in Options;
      lDtr := byte(DTRState);
      lRts := byte(RTSState);
      lXOn := byte(XOnState);
      lBreak := byte(BreakState);
    end;
  end;

  procedure UserToProp;
  var br:TBaudRate;
      pa:TParity;
      fc:TFlowControl;
      sb:TStopBits;
      db:TDataBits;
      op:TCommOptions;
  begin
    with ACom do begin
      ReadTimeout := lReadTimeout;
      WriteTimeout := lWriteTimeout;
      ReadBufSize := lReadBufSize;
      WriteBufSize := lWriteBufSize;
      BaudRateUserToProp(lBaudRate, br);
      BaudRate := br;
      ParityUserToProp(lParity, pa);
      Parity := pa;
      StopBitsUserToProp(lStopBits, sb);
      StopBits := sb;
      DataBitsUserToProp(lDataBits, db);
      DataBits := db;
      {lMonitorEvents := MonitorEventsPropToUser(MonitorEvents);}
      FlowControlUserToProp(lFlowControl, fc);
      FlowControl := fc;
      {lFlags := FlagsPropToUser(Options);
      lAfterOpenState := AfterOpenStateIToU(AfterOpenState);}
      if lUseIniPars then
        AfterOpenState := aoSpecified
      else
        AfterOpenState := aoDefault;
      op := [];
      if lParityCheck then
        Include(Op, coParityCheck);
      if lDsrSensitivity then
        Include(Op, coDsrSensitivity);
      if lIgnoreXOff then
        Include(Op, coIgnoreXOff);
      if lErrorChar then
        Include(Op, coErrorChar);
      if lNullStrip then
        Include(Op, coNullStrip);
      if lAbortOnError then
        Include(Op, coAbortOnError);
      Options := op;
      DTROnOpen := TCommEscapeState(lDtr);
      RTSOnOpen := TCommEscapeState(lRts);
      XOnOnOpen := TCommEscapeState(lXOn);
      BreakOnOpen := TCommEscapeState(lBreak);
    end;
  end;

begin
  with ACom do begin
    sec := '[' + ACom.DeviceName + ']';
    for i := 1 to length(sec) do
      sec[i] := upcase(sec[i]);
    PropToUser;
    ConfigReadWriteValue(rw, sec,'ReadTimeout',@lReadTimeout, ptLongint);
    ConfigReadWriteValue(rw, sec,'WriteTimeout',@lWriteTimeout, ptLongint);
    ConfigReadWriteValue(rw, sec,'ReadBufSize',@lReadBufSize, ptLongint);
    ConfigReadWriteValue(rw, sec,'WriteBufSize',@lWriteBufSize, ptLongint);
    {ConfigReadWriteValue(sec,'MonitorEvents',@lMonitorEvents, ptString);}
    ConfigReadWriteValue(rw, sec,'bps', @lBaudRate, ptLongint);
    ConfigReadWriteValue(rw, sec,'parity', @lParity, ptChar);
    ConfigReadWriteValue(rw, sec,'stopbits', @lStopBits, ptInteger);
    ConfigReadWriteValue(rw, sec,'databits', @lDatabits, ptInteger);
    {ConfigReadWriteValue(sec,'flags',@lFlags, ptString);}
    ConfigReadWriteValue(rw, sec,'FlowControl',@lFlowControl, ptString);

    ConfigReadWriteValue(rw, sec,'ParityCheck',@lParityCheck, ptByte);
    ConfigReadWriteValue(rw, sec,'DsrSensitivity',@lDsrSensitivity, ptByte);
    ConfigReadWriteValue(rw, sec,'IgnoreXOff',@lIgnoreXOff, ptByte);
    ConfigReadWriteValue(rw, sec,'UseErrorChar',@lErrorChar, ptByte);
    ConfigReadWriteValue(rw, sec,'NullStrip',@lNullStrip, ptByte);
    ConfigReadWriteValue(rw, sec,'AbortOnError',@lAbortOnError,ptByte);
    ConfigReadWriteValue(rw, sec,'UseIniPars',@lUseIniPars,ptByte);
    ConfigReadWriteValue(rw, sec,'DTROnOpen',@lDtr, ptByte);
    ConfigReadWriteValue(rw, sec,'RTSOnOpen',@lRts, ptByte);
    ConfigReadWriteValue(rw, sec,'XOnOnOpen',@lXOn, ptByte);
    ConfigReadWriteValue(rw, sec,'BreakOnOpen',@lBreak, ptByte);

    {ConfigReadWriteValue(sec, 'afteropenstate',@lAfterOpenState, ptString);}
    if rw = rwRead then
      UserToProp;
  end;
end;

function ComInit(AComNr:integer; var ACom:PComPort):boolean;
var ok:boolean;
begin
  ok := false;
  ACom := nil;
  try
    try
      ACom := TComm.Create(nil);
      ACom.DeviceName := 'COM' + IntToStr(AComNr);
      ReadWriteComConfig(rwRead, ACom);
      ACom.Open;
      {ACom.ReadTimeout := 1;}
      ok := true;
    except
      on Exception {ECommError} do ;{just ignore}
    end;
  finally
    if not ok then begin
      if ACom <> nil then begin
        ACom.Free;
        ACom := nil;
      end;
    end;
  end;
  ComInit := ok;
end;

function ComPut(ACom:PComPort; AByte:byte):boolean;
begin
  ComPut := ACom.Write(AByte,1) >= 0;
end;

function ComGet(ACom:PComPort):integer;
var i:integer;b:byte;
begin
  i := ACom.Read(b, 1);
  if i >= 0 then
    i := b;
  ComGet := i;{ACom.GetWait(ACom.FReadTimeout);}
end;

function ComWrite(ACom:PComPort; var Buf; Count:word):boolean;
begin
  ComWrite := (ACom.Write(Buf, Count) >=0);
end;

function ComRead(ACom:PComPort; var Buf; var Count:word):boolean;
begin
  ComRead := (ACom.Read(Buf, Count) >= 0);
end;

function ComGetWait(ACom:PComPort; ATimeout:longint):integer;
var ot,i:longint; b:byte;
begin
  ot := ACom.ReadTimeout;
  ACom.ReadTimeout := ATimeout;
  i := ACom.Read(b, 1);
  if i >= 0 then
    i := b;
  ACom.ReadTimeout := ot;
  ComGetWait := i;
end;

function ComSetPropInt(ACom:PComPort; cp:TComProperty; AValue:longint):boolean;
begin
  ComSetPropInt := false;
  if not IsValidCom(ACom) then
    exit;
{  ComSetPropInt := ACom.SetPropInt(cp, AValue);}
end;

function ComGetPropInt(ACom:PComPort; cp:TComProperty):longint;
begin
  ComGetPropInt := 0;
  if not IsValidCom(ACom) then
    exit;
{  ComGetPropInt := ACom.GetPropInt(cp);}
end;

function ComClear(ACom:PComPort):boolean;
begin
  ComClear := false;
  if not IsValidCom(ACom) then
    exit;
{  ACom.Reset;
  ComClear := true;}
end;

function ComDone(ACom:PComPort):boolean;
begin
  ComDone := false;
  if not IsValidCom(ACom) then
    exit;
  ReadWriteComConfig(rwWrite, ACom);
  ACom.Free;
  ComDone := true;
end;

end.
