//******************************************************************************
//                      VARIAN ASYNC32 COMPONENT
//               (c) VARIAN SOFTWARE SERVICES NL 1996-1998
//                          ALL RIGHTS RESERVED
//******************************************************************************

unit CommInt;
{$I define.pas}
interface
{.$DEFINE SAPP} { define just for debugging in SAPP applications }
uses
  Windows, Messages, SysUtils, Classes, CommObjs{v0.39}, ExeLogu{/v0.39}
  {v0.63}, IniFiles, UtlType, WinUtl, PropUtl{/v0.63}, BinHex
  {$IFDEF SAPP},SAppSysProc, SAppUtl{$ENDIF};

const
  DefaultDeviceName = 'Com2';

type
  {M}
  TCommOptionName = string[20];
  TCommEventName = string[10];
  TCommParityName = string[7];
  TCommFlowControlName = string[8];
  {/M}

  ECommError = class(Exception)
    ErrorCode: Integer;
  end;

  TCommEvent = procedure(Sender: TObject; Status: dword) of object;
  TCommEventType = (evBreak, evCts, evDsr, evError, evRing,
    evRlsd, evRxChar, evRxFlag, evTxEmpty);
  TCommEventTypes = set of TCommEventType;

  TCommEventThread = class(TThread)
  private
    FCommHandle: THandle;
    FEvent: TSimpleEvent;
    FEventMask: dWord;
    FOnSignal: TCommEvent;
    {v0.61}
    FDontSynchronize: boolean;
    {/v0.61}
    FTerminateOnError: boolean;
  protected
    procedure Execute; override;
    procedure Terminate;
    procedure DoOnSignal;
  public
    constructor Create(Handle: THandle; Events: TCommEventTypes);
    destructor Destroy; override;
    property OnSignal: TCommEvent read FOnSignal write FOnSignal;
    {v0.61}
    property DontSynchronize: boolean read FDontSynchronize write FDontSynchronize;
    {/v0.61}
    property Terminated;
  end;

  TCustomComm = class;

  TCommEventChars = class(TPersistent)
  private
    FOwner: TCustomComm;
    FXonChar: Char;
    FXoffChar: Char;
    FErrorChar: Char;
    FEofChar: Char;
    FEvtChar: Char;
    procedure SetEventChar(Index: Integer; Value: Char);
  public
    constructor Create(Owner: TCustomComm);
    procedure Assign(Source: TPersistent); override;
  published
    property XonChar: Char index 1 read FXOnChar write SetEventChar default #17;
    property XoffChar: Char index 2 read FXOffChar write SetEventChar default #19;
    property ErrorChar: Char index 3 read FErrorChar write SetEventChar default #0;
    property EofChar: Char index 4 read FEofChar write SetEventChar default #0;
    property EvtChar: Char index 5 read FEvtChar write SetEventChar default #0;
  end;

  TBaudrate = (br110, br300, br600, br1200, br2400, br4800, br9600, br14400,
    br19200, br38400, br56000, br57600, br115200, br128000, br256000,
    br345600, br460800, br576000, br691200, br806400, br921600
  );
  TParity = (paNone, paOdd, paEven, paMark, paSpace);
  TStopbits = (sb10, sb15, sb20);
  TDatabits= (da4, da5, da6, da7, da8);
  TFlowControl = (fcNone, fcCTS, fcDTR, fcSoftware, fcDefault, fcCTSDTR);

  TCommOption = (coParityCheck, coDsrSensitivity, coIgnoreXOff,
    coErrorChar, coNullStrip{M}, coAbortOnError{/M});

  {M}
  TAfterOpenState = (aoDefault, aoSpecified);
  TCommEscapeState = (esOff, esOn, esDefault);
  {/M}

  TCommOptions = set of TCommOption;

  TCommRxCharEvent = procedure(Sender: TObject; Count: Integer) of object;
  TCommErrorEvent = procedure(Sender: TObject; Errors: Integer) of object;
  TCustomComm = class(TComponent)
  private
    FHandle: THandle;
    FDCB: TDCB;
    FDeviceName: string;
    FWriteEvent: TSimpleEvent;
    FReadEvent: TSimpleEvent;
    FCriticalSection: TCriticalSection;
    FReadTimeout: Integer;
    FWriteTimeout: Integer;
    FReadBufSize: Integer;
    FWriteBufSize: Integer;
    FMonitorEvents: TCommEventTypes;
    FBaudRate: TBaudRate;
    FParity: TParity;
    FStopbits: TStopbits;
    FDatabits: TDatabits;
    FEventThread: TCommEventThread;
    FEventChars: TCommEventChars;
    FOptions: TCommOptions;
    FFlowControl: TFlowControl;
    FAfterOpenState: TAfterOpenState;
    FOnBreak: TNotifyEvent;
    FOnCts: TNotifyEvent;
    FOnDsr: TNotifyEvent;
    FOnError: TCommErrorEvent;
    FOnRing: TNotifyEvent;
    FOnRlsd: TNotifyEvent;
    FOnRxChar: TCommRxCharEvent;
    FOnRxFlag: TNotifyEvent;
    FOnTxEmpty: TNotifyEvent;

    FRTSOnOpen: TCommEscapeState;
    FDTROnOpen: TCommEscapeState;
    FXOnOnOpen: TCommEscapeState;
    FBreakOnOpen: TCommEscapeState;

    FRTSState: TCommEscapeState;
    FDTRState: TCommEscapeState;
    FXOnState: TCommEscapeState;
    FBreakState: TCommEscapeState;

    FCommCreateFileFlag: integer;

    FPortLogging: boolean;
    FLog: TExeLog;
    FLogSuff: string;
    FTerminateThreadOnError: boolean;

    procedure SetDeviceName(const Value: string);
    procedure SetMonitorEvents(Value: TCommEventTypes);
    procedure SetReadBufSize(Value: Integer);
    procedure SetWriteBufSize(Value: Integer);
    procedure SetBaudRate(Value: TBaudRate);
    procedure SetParity(Value: TParity);
    procedure SetStopbits(Value: TStopBits);
    procedure SetDatabits(Value: TDatabits);
    procedure SetOptions(Value: TCommOptions);
    procedure SetFlowControl(Value: TFlowControl);
    procedure SetAfterOpenState(Value: TAfterOpenState);
    function GetModemState(Index: Integer): Boolean;
    function GetComState(Index: Integer): Boolean;
    procedure Lock;
    procedure Unlock;
    procedure CheckOpen;
    procedure EscapeComm(Flag: Integer);
    procedure InitHandshaking(var DCB: TDCB);
    procedure UpdateCommTimeouts;
    {v0.64}
    function GetComMode: string;
    procedure SetComMode(const AMode: string);
    {/v0.64}
    function GetDCBFlags: string;
    function GetTerminateThreadOnError: boolean;
    procedure SetTerminateThreadOnError(OnOff: boolean);
    function GetHandleOverlapped: boolean;
  protected
    procedure CreateHandle; virtual;
    procedure DestroyHandle;
    procedure HandleCommEvent(Sender: TObject; Status: dword);
    procedure UpdateDataControlBlock;
    procedure DCBToProperties(const ADCB:TDCB);
    procedure PropertiesToDCB(var ADCB:TDCB);

    property DeviceName: string read FDeviceName write SetDeviceName;
    property ReadTimeout: Integer read FReadTimeout write FReadTimeout default 1000;
    property WriteTimeout: Integer read FWriteTimeout write FWriteTimeout default 1000;
    property ReadBufSize: Integer read FReadBufSize write SetReadBufSize default 4096;
    property WriteBufSize: Integer read FWriteBufSize write SetWriteBufSize default 2048;
    property MonitorEvents: TCommEventTypes read FMonitorEvents write SetMonitorEvents;
    property BaudRate: TBaudRate read FBaudRate write SetBaudRate default br9600;
    property Parity: TParity read FParity write SetParity default paNone;
    property Stopbits: TStopbits read FStopbits write SetStopbits default sb10;
    property Databits: TDatabits read FDatabits write SetDatabits default da8;
    property EventChars: TCommEventChars read FEventChars;
    property Options: TCommOptions read FOptions write SetOptions;
    property FlowControl: TFlowControl read FFlowControl write SetFlowControl default fcDefault;
    property AfterOpenState: TAfterOpenState read FAfterOpenState write SetAfterOpenState default aoSpecified;

    property RTSOnOpen: TCommEscapeState read  FRTSOnOpen write FRTSOnOpen default esOn;
    property DTROnOpen: TCommEscapeState read  FDTROnOpen write FDTROnOpen default esOn;
    property XOnOnOpen: TCommEscapeState read  FXOnOnOpen write FXOnOnOpen default esOn;
    property BreakOnOpen: TCommEscapeState read  FBreakOnOpen write FBreakOnOpen default esOff;

    property RTSState: TCommEscapeState read  FRTSState;
    property DTRState: TCommEscapeState read FDTRState;
    property XOnState: TCommEscapeState read FXOnState;
    property BreakState: TCommEscapeState read FBreakState;

    property OnBreak: TNotifyEvent read FOnBreak write FOnBreak;
    property OnCts: TNotifyEvent read FOnCts write FOnCts;
    property OnDsr: TNotifyEvent read FOnDsr write FOnDsr;
    property OnRing: TNotifyEvent read FOnRing write FOnRing;
    property OnRlsd: TNotifyEvent read FOnRlsd write FOnRlsd;
    property OnError: TCommErrorEvent read FOnError write FOnError;
    property OnRxChar: TCommRxCharEvent read FOnRxChar write FOnRxChar;
    property OnRxFlag: TNotifyEvent read FOnRxFlag write FOnRxFlag;
    property OnTxEmpty: TNotifyEvent read FOnTxEmpty write FOnTxEmpty;
    procedure lRaiseCommError(Msg: string; ErrCode: Integer);
    procedure Log(const Msg: string);
    property PortLogging: boolean read FPortLogging write FPortLogging;
    property HandleOverlapped: boolean read GetHandleOverlapped;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    function Enabled: Boolean;
    function Write(const Buf; Count: Integer): Integer;
    function Read(var Buf; Count: Integer): Integer;
    function InQueCount: Integer;
    function OutQueCount: Integer;
    procedure PurgeIn;
    procedure PurgeOut;

    {Comm escape functions}
    procedure SetDTRState(State: Boolean);
    procedure SetRTSState(State: Boolean);
    procedure SetBREAKState(State: Boolean);
    procedure SetXONState(State: Boolean);
    {v0.39}
    procedure Flush;
    {/v0.39}
    {Comm status flags}
    property CTS: Boolean index 1 read GetModemState;
    property DSR: Boolean index 2 read GetModemState;
    property RING: Boolean index 3 read GetModemState;
    property RLSD: Boolean index 4 read GetModemState;

    property CtsHold: Boolean index 1 read GetComState;
    property DsrHold: Boolean index 2 read GetComState;
    property RlsdHold: Boolean index 3 read GetComState;
    property XoffHold: Boolean index 4 read GetComState;
    property XOffSent: Boolean index 5 read GetComState;

    property Handle: THandle read FHandle;
    {v0.47}
    property Thread: TCommEventThread read FEventThread;
    {/v0.47}
    {v0.64}
      { [COMx:]baudrate,parity,databits,stopbits[,RTS[0|1],DTR[0|1]] }
    property ComMode: string read GetComMode write SetComMode;
    {/v0.64}
    property DCBFlags: string read GetDCBFlags;
    property LogSuff: string read FLogSuff write FLogSuff;
    property TerminateThreadOnError: boolean read GetTerminateThreadOnError write SetTerminateThreadOnError;
  end;

  TComm = class(TCustomComm)
  published
    property DeviceName;
    property ReadTimeout;
    property WriteTimeout;
    property ReadBufSize;
    property WriteBufSize;
    property MonitorEvents;
    property BaudRate;
    property Parity;
    property Stopbits;
    property Databits;
    property EventChars;
    property Options;
    property FlowControl;
    property AfterOpenState;
    property OnBreak;
    property OnCts;
    property OnDsr;
    property OnRing;
    property OnRlsd;
    property OnError;
    property OnRxChar;
    property OnRxFlag;
    property OnTxEmpty;

    property RTSOnOpen;
    property DTROnOpen;
    property XOnOnOpen;
    property BreakOnOpen;
    property RTSState;
    property DTRState;
    property XOnState;
    property BreakState;
  end;

  {M}
const
  CommOptionNames: array[TCommOption] of TCommOptionName =
  ('Parity Check        ',
   'DSR Sensitive       ',
   'TX Continue On XOff ',
   'Enable Error Char   ',
   'Strip 0             ',
   'Abort On Error      ');

  CommEventNames: array[TCommEventType] of TCommEventName =
  ('BREAK',
   'CTS',
   'DSR',
   'ERROR',
   'RING',
   'RLSD',
   'RXCHAR',
   'RXFLAG',
   'TXEMPTY');

  CommParityNames: array[TParity] of TCommParityName =
  ('NONE',
   'ODD',
   'EVEN',
   'MARK',
   'SPACE');

  CommFlowControlNames: array[TFlowControl] of TCommFlowControlName =
  ('NONE',
   'CTS',
   'DTR',
   'SOFTWARE',
   'DEFAULT',
   'CTSDTR');

function BaudRatePropToUser(BaudRate:TBaudRate):longint;
function BaudRateUserToProp(BaudRate:longint; var ABaudRate:TBaudRate):boolean;

function ParityPropToUser(Parity:TParity):char;
function ParityUserToProp(Parity:char; var AParity:TParity):boolean;

function StopBitsPropToUser(StopBits:TStopBits):integer;
function StopBitsUserToProp(StopBits:integer; var AStopBits:TStopBits):boolean;

function DataBitsPropToUser(DataBits:TDataBits):integer;
function DataBitsUserToProp(DataBits:integer; var ADataBits:TDataBits):boolean;

function FlowControlPropToUser(FlowControl:TFlowControl):shortstring;
function FlowControlUserToProp(FlowControl:shortstring; var AFlowControl:TFlowControl):boolean;
{v0.39}
function CommErrorsMsg(Errors: integer): string;
{/v0.39}

{v0.63}
procedure ReadWriteComConfig(rw:TReadWrite; ACom:TCustomComm);
{/v0.63}

const
  { Set to the directory where the ports' log files should be placed. }
  ComLogDir: string = '';
  { Set before creating a TComm instance, it will be used as a default
    during creation of the TCommEventThread. }
  GlobalDontSynchronize: boolean = false;
  { How long waits Event.WaitFor in CommEventThread.Execute for a bytes to arrived
    from commport. Set to e.g. 1000 to be sure the thread ends. }
  CommThreadTimeout: DWORD = INFINITE;

  { Set to 0 to use synchronous in WaitCommEvent function }
  CommCreateFileFlag: integer = FILE_FLAG_OVERLAPPED;

  { Should the CommThread be resumed in Create constructor? (set false if
    want to sent comm parameters after creation of the thread, then call Thread.Resume
    explicitely). Must set false if not using FILE_FLAG_OVERLAPPED. }
  ResumeCommThreadInCreate: boolean = true;
{/M}



procedure Register;

implementation
const
  sOpenError = 'Error accessing specified device';
  sInvalidHandle = 'Invalid device handle, access denied';
  sPortAlreadyOpen = 'Port already assigned (open)';
  sPortNotOpen = 'Port not open, unable to complete operation';
  sSetupCommErr = 'Error initializing Read/Write Buffers';
  sUpdateDCBErr = 'Error updating DataControlBlock';
  {M}
  sOpenDCBErr = 'Error getting DCB after open';
  {/M}
  sCommTimeoutsErr = 'Error updating CommTimeouts';
  sEscFuncError = 'EscapeCommFunction failure';
  sReadError = 'Read error';
  sWriteError = 'Write error';
  sMsgExtention = ' (Error: %d) ';

  PurgeRead      = PURGE_RXABORT + PURGE_RXCLEAR;
  PurgeWrite     = PURGE_TXABORT + PURGE_TXCLEAR;
  PurgeReadWrite = PurgeRead + PurgeWrite;

  fBinary              = $00000001;
    { Specifies whether binary mode is enabled. The Win32 API does
      not support nonbinary mode transfers, so this member should
      be TRUE. Trying to use FALSE will not work.
      Under Windows 3.1, if this member is FALSE, nonbinary mode
      is enabled, and the character specified by the EofChar member
      is recognized on input and remembered as the end of data.}
  fParity              = $00000002;
    { Specifies whether parity checking is enabled. If this member
      is TRUE, parity checking is performed and errors are reported. }
  fOutxCtsFlow         = $00000004;
    { Specifies whether the CTS (clear-to-send) signal is monitored
      for output flow control. If this member is TRUE and CTS is
      turned off, output is suspended until CTS is sent again. }
  fOutxDsrFlow         = $00000008;
    { Specifies whether the DSR (data-set-ready) signal is monitored
      for output flow control. If this member is TRUE and DSR is turned
      off, output is suspended until DSR is sent again. }
  fDtrControl          = $00000030;
    { Specifies the DTR (data-terminal-ready) flow control.
      This member can be one of the following values: }
    fDtrControlDisable   = $00000000;
      { DTR_CONTROL_DISABLE Disables the DTR line when the device
        is opened and leaves it disabled. }
    fDtrControlEnable    = $00000010;
      {  DTR_CONTROL_ENABLE Enables the DTR line when the device
         is opened and leaves it on. }
    fDtrControlHandshake = $00000020;
      { DTR_CONTROL_HANDSHAKE Enables DTR handshaking. If handshaking
        is enabled, it is an error for the application to adjust
        the line by using the EscapeCommFunction function. }
  fDsrSensitivity      = $00000040;
    { Specifies whether the communications driver is sensitive to the
      state of the DSR signal. If this member is TRUE, the driver ignores
      any bytes received, unless the DSR modem input line is high. }
  fTXContinueOnXoff    = $00000080;
    { Specifies whether transmission stops when the input buffer is full
      and the driver has transmitted the XoffChar character. If this
      member is TRUE, transmission continues after the input buffer has
      come within XoffLim bytes of being full and the driver has
      transmitted the XoffChar character to stop receiving bytes.
      If this member is FALSE, transmission does not continue until
      the input buffer is within XonLim bytes of being empty and
      the driver has transmitted the XonChar character to resume
      reception. }
  fOutX                = $00000100;
    { fOutX Specifies whether XON/XOFF flow control is used during
      transmission. If this member is TRUE, transmission stops when
      the XoffChar character is received and starts again when the
      XonChar character is received. }
  fInX                 = $00000200;
    { fInX Specifies whether XON/XOFF flow control is used during
      reception. If this member is TRUE, the XoffChar character is
      sent when the input buffer comes within XoffLim bytes of being
      full, and the XonChar character is sent when the input buffer
      comes within XonLim bytes of being empty. }
  fErrorChar           = $00000400;
    { Specifies whether bytes received with parity errors are replaced
      with the character specified by the ErrorChar member. If this
      member is TRUE and the fParity member is TRUE, replacement occurs. }
  fNull                = $00000800;
    { Specifies whether null bytes are discarded. If this member is TRUE,
      null bytes are discarded when received. }
  fRtsControl          = $00003000;
    { Specifies the RTS (request-to-send) flow control. If this value
      is zero, the default is RTS_CONTROL_HANDSHAKE. This member can
      be one of the following values: }
    fRtsControlDisable   = $00000000;
      { RTS_CONTROL_DISABLE Disables the RTS line when the device
        is opened and leaves it disabled. }
    fRtsControlEnable    = $00001000;
      { RTS_CONTROL_ENABLE  Enables the RTS line when the device is
        opened and leaves it on. }
    fRtsControlHandshake = $00002000;
      { RTS_CONTROL_HANDSHAKE Enables RTS handshaking. The driver
        raises the RTS line when the "type-ahead" (input) buffer is less
        than one-half full and lowers the RTS line when the buffer is more
        than three-quarters full. If handshaking is enabled, it is an error
        for the application to adjust the line by using the
        EscapeCommFunction function. }
    fRtsControlToggle    = $00003000;
     { RTS_CONTROL_TOGGLE	Specifies that the RTS line will be high
       if bytes are available for transmission. After all buffered bytes
       have been sent, the RTS line will be low. }
  fAbortOnError        = $00004000;
    { Specifies whether read and write operations are terminated
      if an error occurs. If this member is TRUE, the driver terminates
      all read and write operations with an error status if an error
      occurs. The driver will not accept any further communications
      operations until the application has acknowledged the error by
      calling the ClearCommError function. }
  fDummy2              = $FFFF8000;

  CommEventList: array[TCommEventType] of dword =
    ( EV_BREAK,
      EV_CTS,
      EV_DSR,
      EV_ERR,
      EV_RING,
      EV_RLSD,
      EV_RXCHAR,
      EV_RXFLAG,
      EV_TXEMPTY);

  CommBaudRates: array[TBaudRate] of Integer =
    ( CBR_110,
      CBR_300,
      CBR_600,
      CBR_1200,
      CBR_2400,
      CBR_4800,
      CBR_9600,
      CBR_14400,
      CBR_19200,
      CBR_38400,
      CBR_56000,
      CBR_57600,
      CBR_115200,
      CBR_128000,
      CBR_256000,
      345600,
      460800,
      576000,
      691200,
      806400,
      921600
      );

  CommOptions: array[TCommOption] of Integer =
    (fParity, fDsrSensitivity, fTXContinueOnXoff, fErrorChar, fNull
     {M},fAbortOnError{/M});

  CommDataBits: array[TDatabits] of Integer =
    ( 4, 5, 6, 7, 8);

  CommParity: array[TParity] of Integer =
    ( NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY);

  CommStopBits: array[TStopbits] of Integer =
    ( ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS );

{M}
function BaudRatePropToUser(BaudRate:TBaudRate):longint;
begin
  BaudRatePropToUser := CommBaudRates[BaudRate];
end;

function BaudRatePropToDCB(BaudRate:TBaudRate):longint;
begin
  BaudRatePropToDCB := CommBaudRates[BaudRate];
end;

function BaudRateUserToProp(BaudRate:longint; var ABaudRate:TBaudRate):boolean;
var br:TBaudRate;
begin
  BaudRateUserToProp := false;
  for br := low(br) to high(br) do begin
    if BaudRate <= CommBaudRates[br] then begin
      ABaudRate := br;
      BaudRateUserToProp := true;
      exit;
    end;
  end;
  ABaudRate := br9600;
end;

function BaudRateDCBToProp(BaudRate:longint; var ABaudRate:TBaudRate):boolean;
begin
  BaudRateDCBToProp := BaudRateUserToProp(BaudRate, ABaudRate);
end;


function ParityPropToUser(Parity:TParity):char;
begin
  ParityPropToUser := CommParityNames[Parity][1];
end;

function ParityPropToDCB(Parity:TParity):integer;
begin
  ParityPropToDCB := CommParity[Parity];
end;

function ParityUserToProp(Parity:char; var AParity:TParity):boolean;
var pa:TParity;
begin
  ParityUserToProp := false;
  for pa := low(pa) to high(pa) do begin
    if Upcase(Parity) = CommParityNames[pa]{v0.65}[1]{/v0.65} then begin
      AParity := pa;
      ParityUserToProp := true;
      exit;
    end;
  end;
  AParity := paNone;
end;

function ParityDCBToProp(Parity:integer; var AParity:TParity):boolean;
var pa:TParity;
begin
  ParityDCBToProp := false;
  for pa := low(pa) to high(pa) do begin
    if Parity = CommParity[pa] then begin
      AParity := pa;
      ParityDCBToProp := true;
      exit;
    end;
  end;
  AParity := paNone;
end;

function StopBitsPropToUser(StopBits:TStopBits):integer;
var i:integer;
begin
  i := 10;
  case StopBits of
    sb10: i := 10;
    sb15: i := 15;
    sb20: i := 20;
  end;
  if i <> 15 then
    i := i div 10;
  StopBitsPropToUser := i;
end;

function StopBitsPropToDCB(StopBits:TStopBits):integer;
begin
  StopBitsPropToDCB := CommStopbits[Stopbits];
end;

function StopBitsUserToProp(StopBits:integer; var AStopBits:TStopBits):boolean;
begin
  StopBitsUserToProp := true;
  if StopBits < 10 then
    StopBits := StopBits * 10;
  case StopBits of
    10: AStopBits := sb10;
    15: AStopBits := sb15;
    20: AStopBits := sb20;
  else
    AStopBits := sb10;
    StopBitsUserToProp := false;
  end;
end;

function StopBitsDCBToProp(StopBits:integer; var AStopBits:TStopBits):boolean;
var sb:TStopBits;
begin
  StopBitsDCBToProp := false;
  for sb := low(sb) to high(sb) do begin
    if StopBits = CommStopbits[sb] then begin
      AStopBits := sb;
      StopBitsDCBToProp := true;
      exit;
    end;
  end;
  AStopBits := sb10;
end;


function DataBitsPropToUser(DataBits:TDataBits):integer;
var
  i:integer;
begin
  i := 8;
  case DataBits of
    da4: i := 4;
    da5: i := 5;
    da6: i := 6;
    da7: i := 7;
    da8: i := 8;
  end;
  DataBitsPropToUser := i;
end;

function DataBitsUserToProp(DataBits:integer; var ADataBits:TDataBits):boolean;
begin
  DataBitsUserToProp := true;
  case DataBits of
    4: ADataBits := da4;
    5: ADataBits := da5;
    6: ADataBits := da6;
    7: ADataBits := da7;
    8: ADataBits := da8;
  else
    ADataBits := da8;
    DataBitsUserToProp := false;
  end;
end;

function DataBitsPropToDCB(DataBits:TDataBits):integer;
begin
  DataBitsPropToDCB := CommDataBits[DataBits];
end;

function DataBitsDCBToProp(DataBits:integer; var ADataBits:TDataBits):boolean;
var db:TDataBits;
begin
  DataBitsDCBToProp := false;
  for db := low(db) to high(db) do begin
    if DataBits = CommDataBits[db] then begin
      ADataBits := db;
      DataBitsDCBToProp := true;
      exit;
    end;
  end;
  ADataBits := da8;
end;

function FlowControlPropToUser(FlowControl:TFlowControl):shortstring;
begin
  FlowControlPropToUser := CommFlowControlNames[FlowControl];
end;

function FlowControlUserToProp(FlowControl:shortstring; var AFlowControl:TFlowControl):boolean;
var
  i:integer;
  fc:TFlowControl;
begin
  FlowControlUserToProp := false;
  for i := 1 to length(FlowControl) do
    FlowControl[i] := upcase(FlowControl[i]);
  for fc := low(fc) to high(fc) do begin
    if FlowControl = CommFlowControlNames[fc] then begin
      AFlowControl := fc;
      FlowControlUserToProp := true;
      exit;
    end;;
  end;
  AFlowControl := fcNone;
end;

{v0.39}
function CommErrorsMsg(Errors: integer): string;
begin
  Result := '';
  if (Errors and CE_BREAK) <> 0 then
    Result := Result + 'BREAK ';
  if (Errors and CE_DNS) <> 0 then
    Result := Result + 'DNS ';
  if (Errors and CE_FRAME) <> 0 then
    Result := Result + 'FRAME ';
  if (Errors and CE_IOE) <> 0 then
    Result := Result + 'IOE ';
  if (Errors and CE_MODE) <> 0 then
    Result := Result + 'MODE ';
  if (Errors and CE_OOP) <> 0 then
    Result := Result + 'OOP ';
  if (Errors and CE_OVERRUN) <> 0 then
    Result := Result + 'OVERRUN ';
  if (Errors and CE_PTO) <> 0 then
    Result := Result + 'PTO ';
  if (Errors and CE_RXOVER) <> 0 then
    Result := Result + 'RXOVER ';
  if (Errors and CE_RXPARITY) <> 0 then
    Result := Result + 'RXPARITY ';
  if (Errors and CE_TXFULL) <> 0 then
    Result := Result + 'TXFULL ';
{CE_BREAK	The hardware detected a break condition.
CE_DNS	Windows 95 only: A parallel device is not selected.
CE_FRAME	The hardware detected a framing error.
CE_IOE	An I/O error occurred during communications with the device.
CE_MODE	The requested mode is not supported, or the hFile parameter is invalid. If this value is specified, it is the only valid error.
CE_OOP	Windows 95 only: A parallel device signaled that it is out of paper.
CE_OVERRUN	A character-buffer overrun has occurred. The next character is lost.
CE_PTO	Windows 95 only: A time-out occurred on a parallel device.
CE_RXOVER	An input buffer overflow has occurred. There is either no room in the input buffer, or a character was received after the end-of-file (EOF) character.
CE_RXPARITY	The hardware detected a parity error.
CE_TXFULL	The application tried to transmit a character, but the output buffer was full.}





end;
{/v0.39}

{/M}
{ RaiseCommError }
procedure RaiseCommError(Msg: string; ErrCode: Integer);
var
  E: ECommError;
  s: string;
begin
  s := 'COM ' + Msg + Format(sMsgExtention, [ErrCode]);
  ExeLog.LogErr(s);
  E := ECommError.Create(s);
  E.ErrorCode := ErrCode;
  raise E;
end; { RaiseCommError }

{ TCommEventThread }

constructor TCommEventThread.Create(Handle: THandle; Events: TCommEventTypes);
var
  EvIndex: TCommEventType;
  AttrWord: dword;
begin
  inherited Create(true);
  Priority := tpHigher;
  //FreeOnTerminate := True;
  FreeOnTerminate := False;
  FCommHandle := Handle;
  AttrWord := $0;
  for EvIndex := evBreak to evTxEmpty do
    if EvIndex in Events then AttrWord := AttrWord or CommEventList[EvIndex];
  SetCommMask(FCommHandle, AttrWord);
  FEvent := TSimpleEvent.Create;
  DontSynchronize := GlobalDontSynchronize;
  {v0.65}
  if ResumeCommThreadInCreate then
    Resume;
  {/v0.65
  inherited Create(false);}
end;

destructor TCommEventThread.Destroy;
begin
  FreeAndNil(FEvent);
  //FEvent.Free;
  Inherited Destroy;
end;

procedure TCommEventThread.Execute;
var
  Overlapped: TOverlapped;
  WaitEventResult: Boolean;
  res: integer;

  ComStat: TComStat;
  Errors: dword;

begin
  FillChar(Overlapped, Sizeof(Overlapped), 0);
  Overlapped.hEvent := FEvent.Handle;
  //res := 0;
  while (not Terminated) do
  begin
    {$IFDEF SAPP}
    //if res <> 87 then
    LogPut(PutLogPref + 'CoomEventThread before WaitCommEvent');
    {$ENDIF}
    WaitEventResult := WaitCommEvent(FCommHandle, FEventMask, @Overlapped);
    if Terminated then
      break;
    res := GetLastError;
    //SetLastError(0);
    if (res = ERROR_IO_PENDING) then begin
      {$IFDEF SAPP}
      LogPut(PutLogPref + 'CoomEventThread before FEvent.WaitFor');
      {$ENDIF}
      WaitEventResult := (FEvent.WaitFor(CommThreadTimeout{INFINITE}) = wrSignaled);
      {$IFDEF SAPP}
      LogPut(PutLogPref + 'CoomEventThread after FEvent.WaitFor');
      {$ENDIF}
    end else begin
      {$IFDEF SAPP}
      //if res <> 87 then  //cancelio
      LogPut(PutLogPref + 'CoomEventThread after WaitCommEvent WaitEventResult=' + IntToStr(byte(WaitEventResult)) + ' res=' + IntToStr(res));
      {$ENDIF}
      if res = 87 then begin
        CancelIo(FCommHandle);// solves the res=87 problem and related excessive polling problem
        ClearCommError(FCommHandle, Errors, @ComStat);

        FEvent.ResetEvent;
      end;
      //FillChar(Overlapped, Sizeof(Overlapped), 0);
      //Overlapped.hEvent := FEvent.Handle;//windows

      if (res = 5) //ERROR_ACCESS_DENIED
      or (res = 998) // ERROR_NO_ACCESS
      then begin
        if FTerminateOnError then begin
          if not Terminated then
            Terminate;
          break;
        end;
      end;
    end;

    if WaitEventResult then
    begin
      {v0.43}
      if not Terminated then
      {/v0.43}
      begin
        {ulantype}
        {v0.61}
        if DontSynchronize then begin
          DoOnSignal;
        end else begin
        {/v0.61}
          Synchronize(DoOnSignal);
        end;
        if not Terminated then
          FEvent.ResetEvent;
      end;
      //FEvent.ResetEvent;
    end;

  end;
  {v0.47 - FCommHandle may not be available at this point }{/v0.47
  PurgeComm(FCommHandle, PurgeReadWrite);}
end;

procedure TCommEventThread.Terminate;
begin
  {PurgeComm(FCommHandle, PurgeReadWrite);
  FEvent.SetEvent;}
  inherited;
  FEvent.SetEvent;
  //FreeAndNil(FEvent);
  PurgeComm(FCommHandle, PurgeReadWrite);
end;

procedure TCommEventThread.DoOnSignal;
begin
  if Assigned(FOnSignal) then FOnSignal(Self, FEventMask);
end;

{TCommEventChars}

constructor TCommEventChars.Create(Owner: TCustomComm);
begin
  Inherited Create;
  FOwner := Owner;
  FXonChar := #17;
  FXoffChar := #19;
  FErrorChar := #0;
  FEofChar := #0;
  FEvtChar := #0;
end;

procedure TCommEventChars.SetEventChar(Index: Integer; Value: Char);
begin
  case Index of
    1: FXOnChar := Value;
    2: FXOffChar := Value;
    3: FErrorChar := Value;
    4: FEofChar := Value;
    5: FEvtChar := Value;
  end;
  if FOwner <> nil then
    FOwner.UpdateDataControlBlock;
end;

procedure TCommEventChars.Assign(Source: TPersistent);
begin
  if (Source <> nil) and (Source is TCommEventChars) then
  begin
    FXonChar := TCommEventChars(Source).FXonChar;
    FXoffChar := TCommEventChars(Source).FXoffChar;
    FErrorChar := TCommEventChars(Source).FErrorChar;
    FEofChar := TCommEventChars(Source).FEofChar;
    FEvtChar := TCommEventChars(Source).FEvtChar;
  end else inherited Assign(Source);
end;


{ TCustomComm }
constructor TCustomComm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHandle := INVALID_HANDLE_VALUE;
  FDeviceName := DefaultDeviceName;
  FReadTimeout := 1000;
  FWriteTimeout := 1000;
  FReadBufSize := 4096;
  FWriteBufSize := 2048;
  FMonitorEvents := [evBreak, evCts, evDsr, evError, evRing,
    evRlsd, evRxChar, evRxFlag, evTxEmpty];
  FBaudRate := br9600;
  FParity := paNone;
  FStopbits := sb10;
  FDatabits := da8;
  FOptions := [];
  FFlowControl := fcDefault;

  FRTSOnOpen := esOn;
  FDTROnOpen := esOn;
  FXOnOnOpen := esOn;
  FBreakOnOpen := esOff;

  FRTSState := esDefault;
  FDTRState := esDefault;
  FXOnState := esDefault;
  FBreakState := esDefault;

  FAfterOpenState := aoSpecified;
  FEventChars := TCommEventChars.Create(self);
  FReadEvent := TSimpleEvent.Create;
  FWriteEvent := TSimpleEvent.Create;
  FCriticalSection := TCriticalSection.Create;
end;

{v0.42}
procedure TCustomComm.lRaiseCommError(Msg: string; ErrCode: Integer);
var
  ComStat: TComStat;
  Errors: dword;
begin
  {}
  if Enabled then
    ClearCommError(FHandle, Errors, @ComStat);
  {}
  RaiseCommError(FDeviceName + ' ' + Msg, ErrCode);
end;
{/v0.42}

destructor TCustomComm.Destroy;
begin
  Close;
  //FReadEvent.SetEvent;
  //FWriteEvent.SetEvent;

  FEventChars.Free;
  FReadEvent.Free;
  FWriteEvent.Free;
  FCriticalSection.Free;
  FLog.Free;
  inherited Destroy;
end;

procedure TCustomComm.Lock;
begin
  FCriticalSection.Enter;
end;

procedure TCustomComm.Unlock;
begin
  FCriticalSection.Leave;
end;

function TCustomComm.Enabled: Boolean;
begin
  Result := FHandle <> INVALID_HANDLE_VALUE;
end;

procedure TCustomComm.CheckOpen;
begin
  if Enabled then lRaiseCommError(sPortAlreadyOpen, -1);
end;

procedure TCustomComm.CreateHandle;
begin
  FCommCreateFileFlag := CommCreateFileFlag;
  FHandle := CreateFile(PCHAR(FDeviceName),
    GENERIC_READ or GENERIC_WRITE,
    0, // share - can not share com port
    nil, // security - none
    OPEN_EXISTING,
    FCommCreateFileFlag, // overlapped
    0 //no templates for COM port
    );

  if not Enabled then
    lRaiseCommError(sOpenError, GetLastError);

  if GetFileType(FHandle) <> FILE_TYPE_CHAR then
  begin
    DestroyHandle;
    lRaiseCommError(sInvalidHandle, -1);
  end;
end;

procedure TCustomComm.DestroyHandle;
begin
  CloseHandle(FHandle);
  FHandle := INVALID_HANDLE_VALUE;
end;

procedure TCustomComm.Open;
{//http://www.edavies.nildram.co.uk/win32-serial-bug/
  SetupComm should be called BEFORE calling SetCommState to reflect required
  buffer sizes to handshaking limits }
begin
  CheckOpen;
  {v0.43}
  ExeLog.Log('Opening ' + ComMode);
  Log('Open');
  {/v0.43}
  CreateHandle;

  if Enabled then
  begin
    PurgeComm(FHandle, PurgeReadWrite);
    FEventThread := TCommEventThread.Create(FHandle, FMonitorEvents);
    FEventThread.FTerminateOnError := FTerminateThreadOnError;
    FEventThread.OnSignal := HandleCommEvent;

    UpdateCommTimeouts;
    { moved after SetupComm
    if AfterOpenState = aoSpecified then
      UpdateDataControlBlock
    else begin
      if not GetCommState(FHandle, FDCB) then
        lRaiseCommError(sUpdateDCBErr, GetLastError)
      else
        DCBToProperties(FDCB);
    end;
    }

    if not SetupComm(FHandle, FReadBufSize, FWriteBufSize) then
      lRaiseCommError(sSetupCommErr, GetLastError);
    if FRTSOnOpen <> esDefault then
      SetRTSState(FRTSOnOpen = esOn);
    if FDTROnOpen <> esDefault then
      SetDTRState(FDTROnOpen = esOn);
    if FXOnOnOpen <> esDefault then
      SetXOnState(FXOnOnOpen = esOn);
    if FBreakOnOpen <> esDefault then
      SetBreakState(FBreakOnOpen = esOn);

    {moved from above setupcom}
    if AfterOpenState = aoSpecified then
      UpdateDataControlBlock // calls setcommstate
    else begin
      if not GetCommState(FHandle, FDCB) then
        lRaiseCommError(sUpdateDCBErr, GetLastError)
      else
        DCBToProperties(FDCB);
    end;
    {/}

    FEventThread.Resume;
  end;
end;

procedure TCustomComm.Close;
begin
  if Enabled then
  begin
    ExeLog.Log('Closing ' + ComMode);
    Log('Close');
    Lock;
    try
      if FEventThread <> nil then
      begin
        if (not FEventThread.Terminated) then
          FEventThread.Terminate;
        FEventThread.OnSignal := nil;
        if not FEventThread.Suspended then
          FEventThread.WaitFor;
        FEventThread.Free;
        FEventThread := nil;
      end;
      DestroyHandle;
    finally
      Unlock;
    end;
  end;
end;

function TCustomComm.Write(const Buf; Count: Integer): Integer;
var
  Overlapped: TOverlapped;
  ErrorCode: Integer;
  res: integer;
begin
  if not Enabled then begin
    Result := -1;
    exit;
  end;
  Lock;
  try
    FillChar(Overlapped, Sizeof(Overlapped), 0);
    Overlapped.hEvent := FWriteEvent.Handle;
    if not WriteFile(FHandle, Buf, Count, dWord(Result), @Overlapped) then begin
      res := GetLastError;
      if (res <> ERROR_IO_PENDING) then
      begin
        ErrorCode := GetLastError;
        lRaiseCommError(sWriteError, ErrorCode);
      end;
    end;

    if HandleOverlapped then begin
      if FWriteEvent.WaitFor(FWriteTimeout) <> wrSignaled then begin
        Result := -1;
      //ErrorCode := GetLastError;// can happen for CTS handshaking
      end else begin
        GetOverlappedResult(Handle, Overlapped, dWord(Result), False);
        FWriteEvent.ResetEvent;
      end;
    end;

    if FPortLogging then
      Log('OUT: ' + RecToHex(Buf, Count));
  finally
    Unlock;
  end;
end;

function TCustomComm.Read(var Buf; Count: Integer): Integer;
var

  Overlapped: TOverlapped;
  ErrorCode: Integer;
begin
  Lock;
  try
    FillChar(Overlapped, Sizeof(Overlapped), 0);
    Overlapped.hEvent := FReadEvent.Handle;
    if not ReadFile(FHandle, Buf, Count, dWord(Result),
      @Overlapped) and (GetLastError <> ERROR_IO_PENDING) then
    begin
      ErrorCode := GetLastError;
      lRaiseCommError(sReadError, ErrorCode);
    end;
    if HandleOverlapped then begin
      if FReadEvent.WaitFor(FReadTimeout) <> wrSignaled then
        Result := -1
      else begin
        GetOverlappedResult(Handle, Overlapped, dWord(Result), False);
        FReadEvent.ResetEvent;
      end;
    end;
    if FPortLogging then
      Log(' IN: ' + RecToHex(Buf, Count));
  finally
    Unlock;
  end;
end;

function TCustomComm.InQueCount: Integer;
var
  ComStat: TComStat;
  Errors: dword;
begin
  if Enabled then
  begin
    ClearCommError(FHandle, Errors, @ComStat);
    Result := ComStat.cbInQue;
  end else Result := -1;
end;

function TCustomComm.OutQueCount: Integer;
var
  ComStat: TComStat;
  Errors: dword;
begin
  if Enabled then
  begin
    ClearCommError(FHandle, Errors, @ComStat);
    Result := ComStat.cbOutQue;
  end else Result := -1;
end;

procedure TCustomComm.PurgeIn;
begin
  if Enabled then
    PurgeComm(FHandle, PurgeRead);
end;

procedure TCustomComm.PurgeOut;
begin
  if Enabled then
    PurgeComm(FHandle, PurgeWrite);
end;

procedure TCustomComm.SetDeviceName(const Value: string);
begin
  if FDeviceName <> Value then
  begin
    CheckOpen;
    FDeviceName := Value;
  end;
end;

procedure TCustomComm.SetMonitorEvents(Value: TCommEventTypes);
begin
  if FMonitorEvents <> Value then
  begin
    CheckOpen;
    FMonitorEvents := Value;
  end;
end;

procedure TCustomComm.SetReadBufSize(Value: Integer);
begin
  if FReadBufSize <> Value then
  begin
    CheckOpen;
    FReadBufSize := Value;
  end;
end;

procedure TCustomComm.SetWriteBufSize(Value: Integer);
begin
  if FWriteBufSize <> Value then
  begin
    CheckOpen;
    FWriteBufSize := Value;
  end;
end;

procedure TCustomComm.SetBaudRate(Value: TBaudRate);
begin
  if FBaudRate <> Value then
  begin
    FBaudRate := Value;
    UpdateDataControlBlock;
  end;
end;

procedure TCustomComm.SetParity(Value: TParity);
begin
  if FParity <> Value then
  begin
    FParity := Value;
    UpdateDataControlBlock;
  end;
end;

procedure TCustomComm.SetStopbits(Value: TStopbits);
begin
  if FStopBits <> Value then
  begin
    FStopbits := Value;
    UpdateDataControlBlock;
  end;
end;

procedure TCustomComm.SetDataBits(Value: TDatabits);
begin
  if FDataBits <> Value then
  begin
    FDataBits:=Value;
    UpdateDataControlBlock;
  end;
end;

procedure TCustomComm.SetOptions(Value: TCommOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
    UpdateDataControlBlock;
  end;
end;

procedure TCustomComm.SetFlowControl(Value: TFlowControl);
begin
  if FFlowControl <> Value then
  begin
    FFlowControl := Value;
    UpdateDataControlBlock;
  end;
end;

procedure TCustomComm.SetAfterOpenState(Value: TAfterOpenState);
begin
  if FAfterOpenState <> Value then
  begin
    FAfterOpenState := Value;
  end;
end;

procedure TCustomComm.HandleCommEvent(Sender: TObject; Status: dword);
var
  ComStat: TComStat;
  Errors: dword;
begin
  if FCommCreateFileFlag = 0 then
    Lock;
  try
    ClearCommError(FHandle, Errors, @ComStat);
    if Status and EV_BREAK > 0 then
      if assigned(FOnBreak) then FOnBreak(self);
    if Status and EV_CTS > 0 then
      if assigned(FOnCts) then FOnCts(self);
    if Status and EV_DSR > 0 then
      if assigned(FOnDsr) then FOnDsr(self);
    if Status and EV_ERR > 0 then
      if assigned(FOnError) then FOnError(self, Errors);
    if Status and EV_RING > 0 then
      if assigned(FOnRing) then FOnRing(self);
    if Status and EV_RLSD > 0 then
      if assigned(FOnRlsd) then FOnRlsd(self);
    if Status and EV_RXCHAR > 0 then
      if ComStat.cbInQue > 0 then
        if assigned(FOnRxChar) then FOnRxChar(self, ComStat.cbInQue);
    if Status and EV_RXFLAG > 0 then
      if assigned(FOnRxFlag) then FOnRxFlag(self);
    if Status and EV_TXEMPTY > 0 then
      if assigned(FOnTxEmpty) then FOnTxEmpty(self);
  finally
    if FCommCreateFileFlag = 0 then
      Unlock;
  end;
end;

function TCustomComm.GetModemState(Index: Integer): boolean;
var
  Flag, State: dword;
begin
  case Index of
    1: State := MS_CTS_ON;
    2: State := MS_DSR_ON;
    3: State := MS_RING_ON;
    4: State := MS_RLSD_ON;
    else
      State := 0;
  end;
  Result := false;
  if Enabled then
    if GetCommModemStatus(FHandle, Flag) then
      Result := (Flag and State > 0);
end;

function TCustomComm.GetComState(Index: Integer): Boolean;
var
  Flag: TComStateFlag;
  ComStat: TComStat;
  Errors: dword;
begin
  case Index of
    1: Flag := fCtlHold;
    2: Flag := fDsrHold;
    3: Flag := fRlsHold;
    4: Flag := fXoffHold;
    5: Flag := fXOffSent;
    else
      Flag := fCtlHold;
  end;
  Result := false;
  if Enabled then
  begin
    ClearCommError(FHandle, Errors, @ComStat);
    Result := Flag in ComStat.Flags;
  end;
end;

{M}
procedure TCustomComm.DCBToProperties(const ADCB:TDCB);
var
  OptIndex: TCommOption;
{  br:TBaudRate;
  pa:TParity;
  sb:TStopBits;
  db:TDataBits;
  ok:boolean;}
begin
  if not BaudRateDCBToProp(ADCB.BaudRate, FBaudRate) then
    lRaiseCommError('DCBToProperties unknown BaudRate:' + IntToStr(ADCB.BaudRate), -1);

  if not ParityDCBToProp(ADCB.Parity, FParity) then
    lRaiseCommError('DCBToProperties unknown Parity:' + IntToStr(ADCB.Parity), -1);

  if not StopBitsDCBToProp(ADCB.StopBits, FStopBits) then
    lRaiseCommError('DCBToProperties unknown StopBits:' + IntToStr(ADCB.StopBits), -1);

  if not DataBitsDCBToProp(ADCB.ByteSize, FDataBits) then
    lRaiseCommError('DCBToProperties unknown DataBits:' + IntToStr(ADCB.ByteSize), -1);

  FEventChars.XonChar := ADCB.XonChar;
  FEventChars.XOffChar := ADCB.XoffChar;
  FEventChars.ErrorChar := ADCB.ErrorChar;
  FEventChars.EofChar := ADCB.EofChar;
  FEventChars.EvtChar := ADCB.EvtChar;

  {
  ADCB.XonLim := FReadBufSize div 4;
  ADCB.XoffLim := FReadBufSize div 4;
  }

  if (ADCB.Flags and (fOutX or fInX)) = (foutX or fInX) then
  begin
    FFlowControl := fcSoftware
  end else if (ADCB.Flags and (fOutxCtsFlow or fRTSControlHandshake))
    = (fOutxCtsFlow or fRTSControlHandshake) then begin
    FFlowControl := fcCTS
  end else if (ADCB.Flags and (fOutxDsrFlow or fDtrControlHandshake))
    = (fOutxDsrFlow or fDtrControlHandshake) then begin
    FFlowControl := fcDTR
  end else if (ADCB.Flags and (fOutxCtsFlow or fRTSControlHandshake) and
    (fOutxDsrFlow or fDtrControlHandshake)) = (fOutxCtsFlow or fRTSControlHandshake)
    or (fOutxDsrFlow or fDtrControlHandshake) then begin
    FFlowControl := fcCTSDTR;
  end else begin
    FFlowControl := fcDefault;
  end;
  (*
  case FFlowControl of
    fcNone: //Clear all flags
      DCB.Flags := fBinary;
    fcDefault:; //do nothing;
    fcCTS:
      DCB.Flags := DCB.Flags or fOutxCtsFlow or fRtsControlHandshake;
    fcDTR:
      DCB.Flags := DCB.Flags or fOutxDsrFlow or fDtrControlHandshake;
    fcSoftware:
      DCB.Flags := DCB.Flags or fOutX or fInX;
  end;
  *)
  FOptions := [];
  for OptIndex := Low(OptIndex) to High(OptIndex) do
  begin
    if (ADCB.Flags and CommOptions[OptIndex]) <> 0 then
      Include(FOptions, OptIndex);
  end;
end;

var
  xxx: integer;

procedure TCustomComm.PropertiesToDCB(var ADCB:TDCB);
{moved from UpdateDataControlBlock to this separate procedure}
var
  OptIndex: TCommOption;
begin
  ADCB.BaudRate := CommBaudRates[FBaudRate];
  ADCB.Parity := CommParity[FParity];
  ADCB.Stopbits := CommStopbits[FStopbits];
  ADCB.Bytesize := CommDatabits[FDatabits];
  ADCB.XonChar := FEventChars.XonChar;
  ADCB.XoffChar := FEventChars.XOffChar;
  ADCB.ErrorChar := FEventChars.ErrorChar;
  ADCB.EofChar := FEventChars.EofChar;
  ADCB.EvtChar := FEventChars.EvtChar;
  ADCB.XonLim := FReadBufSize div 4;
  ADCB.XoffLim := FReadBufSize div 4;

  InitHandshaking(ADCB);

  //ADCB.Flags := 0;          //???   4133
  for OptIndex := Low(OptIndex) to High(OptIndex) do begin
    if OptIndex in FOptions then begin
      ADCB.Flags := ADCB.Flags or CommOptions[OptIndex]
    end else begin
      ADCB.Flags := ADCB.Flags and (not CommOptions[OptIndex]);
    end;
  end;
  xxx := ADCB.Flags;
end;
{/M}

procedure TCustomComm.UpdateDataControlBlock;
begin
  if Enabled then
  begin
    GetCommState(FHandle, FDCB);{dcb}
    {M}
    PropertiesToDCB(FDCB);
    {/M}
    if not SetCommState(FHandle, FDCB) then
      lRaiseCommError(sUpdateDCBErr, GetLastError);
  end;
end;

function TCustomComm.GetDCBFlags: string;
var ADCB: TDCB;
begin
  if Enabled then begin
    GetCommState(FHandle, ADCB);
    Result := LongToHex(ADCB.Flags);
  end else begin
    Result := 'CLOSED';
  end;
end;
(*
The EscapeCommFunction function directs a specified communications device to perform an extended function.

BOOL EscapeCommFunction(

    HANDLE hFile,	// handle to communications device
    DWORD dwFunc 	// extended function to perform
   );


Parameters

hFile

Identifies the communications device. The CreateFile function returns this handle.

dwFunc

Specifies the code of the extended function to perform. This parameter can be one of the following values:

Value	Meaning
CLRDTR	Clears the DTR (data-terminal-ready) signal.
CLRRTS	Clears the RTS (request-to-send) signal.
SETDTR	Sends the DTR (data-terminal-ready) signal.
SETRTS	Sends the RTS (request-to-send) signal.
SETXOFF	Causes transmission to act as if an XOFF character has been received.
SETXON	Causes transmission to act as if an XON character has been received.
SETBREAK	Suspends character transmission and places the transmission line in a break state until the ClearCommBreak function is called (or EscapeCommFunction is called with the CLRBREAK extended function code). The SETBREAK extended function code is identical to the SetCommBreak function. Note that this extended function does not flush data that has not been transmitted.
CLRBREAK	Restores character transmission and places the transmission line in a nonbreak state. The CLRBREAK extended function code is identical to the ClearCommBreak function.


Return Values

If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

See Also

ClearCommBreak, CreateFile, SetCommBreak
*)

procedure TCustomComm.EscapeComm(Flag: Integer);
var
  Escaped: Boolean;
begin
  if Enabled then
  begin
    if FlowControl in [fcCTS, fcDTR, fcCTSDTR] then begin
      // EscapeCommFunction is not allowed to call in these cases
    end else begin
      Escaped := EscapeCommFunction(FHandle, Flag);
      if not Escaped then begin
        try
          lRaiseCommError(SEscFuncError, GetLastError);
        except
          { ignore the exception (win2000 gives it for no reason?) }
        end;
      end;
    end;
  end else lRaiseCommError(SPortNotOpen, -1);
end;

procedure TCustomComm.SetDTRState(State: boolean);
const
  DTR: array[boolean] of Integer = (CLRDTR, SETDTR);
begin
  EscapeComm(DTR[State]);
  FDTRState := TCommEscapeState(State);

end;

procedure TCustomComm.SetRTSState(State: boolean);
const
  RTS: array[boolean] of Integer = (CLRRTS, SETRTS);
begin
  EscapeComm(RTS[State]);
  FRTSState := TCommEscapeState(State);
end;

procedure TCustomComm.SetBREAKState(State: Boolean);
const
  BREAK: array[boolean] of Integer = (CLRBREAK, SETBREAK);
begin
  EscapeComm(BREAK[State]);
  if Enabled then
    PurgeComm(FHandle, PurgeReadWrite);
  FBreakState := TCommEscapeState(State);
end;

procedure TCustomComm.SetXONState(State: Boolean);
const
  XON: array[boolean] of Integer = (SETXOFF, SETXON);
begin
  EscapeComm(XON[State]);
  FXOnState := TCommEscapeState(State);
end;

procedure TCustomComm.UpdateCommTimeouts;
var
  CommTimeouts: TCommTimeouts;
begin
  FillChar(CommTimeOuts, Sizeof(CommTimeOuts), 0);
  CommTimeOuts.ReadIntervalTimeout := MAXDWORD;
  if not SetCommTimeOuts(FHandle, CommTimeOuts) then
    lRaiseCommError(sCommTimeoutsErr, GetLastError);
end;

procedure TCustomComm.InitHandshaking(var DCB: TDCB);
begin
  case FFlowControl of
    fcNone: begin
      DCB.Flags := fBinary; //Clear all flags
    end;
    fcDefault: begin
       //do nothing;
    end;
    fcCTS: begin
      DCB.Flags :=
      (DCB.Flags or
                (fOutxCtsFlow or fRtsControlHandshake)
       and (not (fOutxDsrFlow or fDtrControlHandshake or fOutX or fInX))
      );
    end;
    fcDTR: begin
      DCB.Flags :=
      (DCB.Flags or
                (fOutxDsrFlow or fDtrControlHandshake)
       and (not (fOutxCtsFlow or fRtsControlHandshake or fOutX or fInX))
       );
    end;
    fcSoftware: begin
      DCB.Flags :=
      (DCB.Flags or
                (fOutX or fInX)
       and (not (fOutxDsrFlow or fDtrControlHandshake or fOutxCtsFlow or fRtsControlHandshake))
      );
    end;
    fcCTSDTR: begin
      DCB.Flags :=
      (DCB.Flags or
                (fOutxCtsFlow or fRtsControlHandshake) or
                (fOutxDsrFlow or fDtrControlHandshake)
       and (not (fOutX or fInX))
      );
    end;
  end;
end;

{v0.39}
procedure TCustomComm.Flush;
begin
  if Enabled then
    FlushFileBuffers(FHandle);
end;
{v0.63}

{v0.64}
procedure TCustomComm.SetComMode(const AMode: string);
var
  i: integer;
  w, s: string;
  del: SetOfChar;
//  tr: boolean;

  br: TBaudRate;
  p: TParity;
  db: TDataBits;
  sb: TStopBits;

  function GetSt(const st: string): TCommEscapeState;
  begin
    Result := esOn;
    if st <> '' then begin
       case st[length(st)] of
        '0': Result := esOff;
        '1': Result := esOn;
        '2': Result := esDefault;
      end;
    end;
  end;

begin
  { [COMx:]baudrate,parity,databits,stopbits[,RTS[0|1],DTR[0|1]] }

  i := pos(':', AMode);
  if i > 0 then begin
    DeviceName := UpperCase(copy(AMode, 1, i - 1));
    s := copy(AMode, i + 1, length(AMode));
  end else begin
    if pos('COM', UpperCase(AMode)) = 1 then begin
      DeviceName := UpperCase(AMode);
      exit;
    end else begin
      s := AMode;
    end;
  end;

  {winutl}
  del := [','];
  if ExtractWord(del, w, s) then begin

    if BaudRateUserToProp(StrToInt(w), br) then
      BaudRate := br;

    if ExtractWord(del, w, s) then begin
      if ParityUserToProp(w[1], p) then
        Parity := p;

      if ExtractWord(del, w, s) then begin
        if DataBitsUserToProp(StrToInt(w), db) then
          DataBits := db;

        if ExtractWord(del, w, s) then begin
          if StopBitsUserToProp(StrToInt(w), sb) then
            StopBits := sb;

          while ExtractWord(del, w, s) do begin

            if pos('RT', w) = 1 then begin
              RTSOnOpen := GetSt(w);
            end;

            if pos('DT', w) = 1 then begin
              DTROnOpen := GetSt(w);
            end;

          end;
        end;
      end;
    end;
  end;
end;

function TCustomComm.GetComMode: string;
begin
  Result := DeviceName + ':' +
    IntToStr(BaudRatePropToUser(BaudRate)) + ',' +
    ParityPropToUser(Parity) + ',' +
    IntToStr(DataBitsPropToUser(DataBits)) + ',' +
    IntToStr(StopBitsPropToUser(StopBits)) + ',' +
    'RTS' + IntToStr(byte(RTSOnOpen)) + ',' +
    'DTR' + IntToStr(byte(DTROnOpen));
end;
{/v0.64}
procedure TCustomComm.Log(const Msg: string);
var d: string;
begin
  if not FPortLogging then
    exit;
  if FLog = nil then begin
    d := ComLogDir;
    if d <> '' then
      d := IncludeTrailingPathDelimiter(ComLogDir);
    FLog := TExeLog.Create(nil, d + DeviceName + 'Port' + LogSuff + '.log');
    FLog.Active := true;
  end;
  FLog.Log(Msg);
end;

procedure TCustomComm.SetTerminateThreadOnError(OnOff: boolean);
begin
  FTerminateThreadOnError := OnOff;
  if Thread <> nil then
    Thread.FTerminateOnError := OnOff;
end;

function TCustomComm.GetTerminateThreadOnError: boolean;
begin
  Result := FTerminateThreadOnError;
end;

function TCustomComm.GetHandleOverlapped: boolean;
begin
  Result := (FCommCreateFileFlag and FILE_FLAG_OVERLAPPED) <> 0;
end;

{/TCustomComm.}
{/v0.39}
procedure ReadWriteComConfig(rw:TReadWrite; ACom:TCustomComm);
var
  {v0.39}
  f: TIniFile;
  {/v0.39}
  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;
  lPortLogging: boolean;
  lComMode: shortstring;

  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;
      {v0.21}
      lDtr := byte(DTROnOpen);
      lRts := byte(RTSOnOpen);
      lXOn := byte(XOnOnOpen);
      lBreak := byte(BreakOnOpen);
      {/v0.21
        lDtr := byte(DTRState);
        lRts := byte(RTSState);
        lXOn := byte(XOnState);
        lBreak := byte(BreakState); }
      lPortLogging := PortLogging;
    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);
      PortLogging := lPortLogging;
    end;
  end;

begin
  {v0.21}
  {v0.39}
  f := TIniFile.Create(FindIniFile);
  try
  {/v0.39
  if ConfigOpen then begin}
  {/v0.21}
    with ACom do begin
      if rw = rwWrite then
        lComMode := ACom.ComMode
      else
        lComMode := '';
      {v0.39}
      sec := ACom.DeviceName;
      {/v0.39
      sec := '[' + ACom.DeviceName + ']';}
      for i := 1 to length(sec) do
        sec[i] := upcase(sec[i]);
      PropToUser; {confu}
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'ReadTimeout',@lReadTimeout, ptLongint);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'WriteTimeout',@lWriteTimeout, ptLongint);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'ReadBufSize',@lReadBufSize, ptLongint);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'WriteBufSize',@lWriteBufSize, ptLongint);
      {ConfigReadWriteValue(sec,'MonitorEvents',@lMonitorEvents, ptString);}
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'bps', @lBaudRate, ptLongint);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'parity', @lParity, ptChar);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'stopbits', @lStopBits, ptInteger);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'databits', @lDatabits, ptInteger);
      {ConfigReadWriteValue(sec,'flags',@lFlags, ptString);}
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'FlowControl',@lFlowControl, ptString);

      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'ParityCheck',@lParityCheck, ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'DsrSensitivity',@lDsrSensitivity, ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'IgnoreXOff',@lIgnoreXOff, ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'UseErrorChar',@lErrorChar, ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'NullStrip',@lNullStrip, ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'AbortOnError',@lAbortOnError,ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'UseIniPars',@lUseIniPars,ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'DTROnOpen',@lDtr, ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'RTSOnOpen',@lRts, ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'XOnOnOpen',@lXOn, ptByte);
      ConfigReadWriteValue({v0.39}f,{/v0.39}rw, sec,'BreakOnOpen',@lBreak, ptByte);
      {ConfigReadWriteValue(sec, 'afteropenstate',@lAfterOpenState, ptString);}

      ConfigReadWriteValue(f, rw, sec,'PortLogging',@lPortLogging, ptByte);

     ConfigReadWriteValue(f, rw, sec, 'ComMode', @lComMode, ptString);

      if rw = rwRead then begin
        UserToProp;
        if lComMode <> '' then
          ACom.ComMode := lComMode;
      end;
    end;
    {v0.21}
  {v0.39}
  finally
    f.Free
    {/v0.39
    ConfigClose;}
    {/v0.21}
  end;
end;
{/v0.63}

procedure Register;
begin
  RegisterComponents('Varian Freeware', [TComm]);
end;

end.
