{$X+}

unit TCOMM_32;
{Version 1.4}
//><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><//
// Modification notes:                                                              //
// Modification marked '05.05.97 D.V.B.' are done by Dimitry to make user able      //
// define any comport and baud rate. ComPort and Baud property is changed to the    //
// string type with the same intention. Basic  ports and rates are hardcoded, but   //
// user can  assign value to the properties beside thees lists.                     //                             //
//><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><//

interface
{Version 1.31 - does not include the OnCTS event }
{Version 1.4 - has Baud rate and comport name as string properties. Now customer can
set any suitable value for thees properties, as long as it is valid for his system}
{
 Copyright 1996 By Amber Computer Systems Inc.
 14197 74 Ave Surrey BC, Canada V3W 7N2
 Ph. 604 599-9279
 FAX 604 599-9261
}


uses
  SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs,Windows,DsgnIntf;
{______________________________________________________________________________}

const

  Huge = 8192;
{______________________________________________________________________________}
type
{______________________________________________________________________________}

  aBuffer = array [ 0..Huge ] of byte;  {Buffer to read into}
  apBuffer = ^aBuffer;
  amExtRxHandler = procedure ( bufptr : apBuffer; size : dword ) of object;
  amExtTxNotify = procedure ( sent : dword ) of object;  {notifies completion}
  amCTSNotify = procedure ( sender : tObject) of object;

{______________________________________________________________________________}

  TPort     = (COM1,COM2,COM3,COM4,COM5,COM6,COM7,COM8);

  TParity   = (None,Odd,Even, Mark,Space);
  TByte     = (_6,_7,_8);
  TStop     = (_1,_1_5,_2);
  TRTSval   = (RTSDisable,RTSEnable,RTSHandShake, RTSToggle);
  TDTRval   = (DTRDisable,DTREnable,DTRHandShake);

  {______________________________________________________________________________}


    cCommsRxThread = class( TThread )   //read thred
    private
      mRSize, mRContents : dword;
      mpRB : apBuffer;
      mhPort : integer;
      mCTO : TCommTimeouts;
      mfReader : amExtRxHandler;
    protected
      procedure Execute; override;
      procedure SyncProcessData;
    public
      constructor Create( handle : integer; size : dword;
                          reader : amExtRxHandler );
      destructor  Destroy; override;
    end;
//end of the Rx thread declaration



  TCommPort = class(TComponent)

  private
    { Private declarations }
    //pCommPort : TPort; 05.05.97 D.V.B.
    pCommPort : String; //05.05.97 D.V.B.
//    pPort     : TPort; //05.05.97 D.V.B.
    fOnCTS    : amCTSNotify;
    fOnTx     : amExtTxNotify;
    fOnRx     : amExtRxHandler;
    pBAUD     : String; //05.05.97 D.V.B.
    //pBAUD     : TBAUD{Map}; 05.05.97 D.V.B.
    pParity   : TParity;
    pByte     : TByte;
    pStopBits : TStop;

    pRTS      : TRTSVal;
    pDTR      : TDTRVal;

    fRunRegardlessOS:Boolean;
    CommID    :      Integer;
    sTest     :      String;

{Flag - Windows packs these into 1 word}
{Lower Byte}
    fBINARY,      { True if sending Binary - i.e. blocks}
    fDSRSense,    {If True - Ignore any Data coming from MODEM}
    fParity,      { Enable Parity checking if true}
    fOutxCTSFlow, { CTS Hand shake - on TX}
    fOutxDSRFlow, { DSR Hand shake - on TX}
    {Next 2 bits are handled elsewhere DTR COntrol Bits 5&6}
    fDSRSensitivity,  {Don't send DTR at init if true}
    fTxContinueOnXoff, {Keep sending when true even if Receive Queue is full }
{Upper Byte}
    fOutX,     { Use XON/XOFF if True set with FInX}
    fInX,      { both bits are set to fOutX status}
    fPEChar,   { Allow PE Substitution }
    fNull,     { Allow Null Stripping}
    {Next 2 bits are for RTS Control - handled elsewhere bits 5&6}
    fTxOnXoff,
    fAbortOnError
    {Bit 8 not used}
                  : Boolean;
{ End of Flag Decalaration}

    sVersion : String;
    ParErrChar    : Char;
    EOFChar,
    XOnVal,
    XOffVal       : Byte;

    RLSTimeout,       {CD Timeout}
    CTSTimeout,
    DSRTimeout,
    BAUDRate,
    XOffLim,
    XOnLim,
    TxDelay      : word;


    MaxXOffLim,
    MinXOnLim    : LongInt;

    LXONXOFF     : Boolean;
    mRT : cCommsRxThread; //receive thread
    mTT : cCommsTxThread; // transmit thread
{    mThreads : integer;   //}
    mThreadRunning : integer;//# of running threads



  procedure ThreadDone(Sender: TObject);//creates a thread names pointing to nil
  procedure setBYTESize(Value: TByte);
  procedure setParity(Value: TParity);
  procedure SetStopBits(Value: TStop);

 // procedure SetBAUDRate(BAUDValue : TBAUD); 05.05.97 D.V.B.
  procedure SetBAUDRate(BAUDValue : String); //05.05.97 D.V.B.
//  function  GetBAUDRate: TBAUD;  05.05.97 D.V.B.
  function  GetBAUDRate: String; // 05.05.97 D.V.B.
  Procedure SetDSRSense(Value:Boolean);
  Procedure SetTXContinueOnXOFF(Value:Boolean);

  procedure SetXONVal(Value: Byte);
  procedure SetXOffVal(Value: Byte);
  procedure SetXOffRxLim(Value: Word);
  procedure SetXOnRxLim(Value: Word);

  procedure SetPEChar(Value: Char);
//  procedure SetCommPort(Value : TPort); 05.05.97 D.V.B.
  procedure SetCommPort(Value : string); //05.05.97 D.V.B.
  procedure SetRxBuffSize(Value: Word);
  procedure SetRTSControl(Value: TRTSVal);
  procedure SetDTRControl(Value: TDTRVal);

  procedure SetTxBuffSize(Value: Word);
  Function  lCheckOS:Boolean;

  { MODEM Control Functions - Added by DWR Dec 12, 1996}
  // These Functions read the CTS(5), DSR(6) Ring(22) and RLSD(8) Lines
  function GetMCTS:Boolean;
  function GetMDSR:Boolean;
  function GetMRing:Boolean;
  function GetMRLSD:Boolean;
  {********************}
  {Moved the following Functions to Private at V1.30}
  {Ensures that people must use the Object Inspector for most settings}

  procedure SetRxWaitTime(Value: Longint);
  {Procedure for low order bytes of TDCB Flag 1248 - 1xx8 x=unused bit}
  procedure SetAbortOnError(Value: Boolean);
  procedure SetBinaryMode(Value: Boolean);
  procedure SetCTSTx(Value:Boolean); //v1.3
  procedure SetDSRTx(Value:Boolean);

  procedure SetNullStrip(Value : Boolean);
  procedure SetParityCheck(Value:Boolean);
  procedure SetPESubOn(Value : Boolean);
  procedure SetXONOFF(Value: Boolean); {Sets Rx & Tx XON/XOFF bit 1&2}
  {Bit 8 of flag is dummy bit}

  {***************}


  protected
    { Protected declarations }
  public
    { Public declarations }
    DCB       : TDCB;
    ComStat   : TComStat;
    _ComStat  : pComstat; //Commstat structure to get error and status from the ClearCommError call
    sCommPort : String;
    lResult   : Boolean; //Local Errpr Result - Visible
    pCommErr  : pchar;
    pIn       : Pchar;

    RxBuffSize,
    TxBuffSize  : Word;
    cDebug      : Boolean;

    pOVSt        : Poverlapped; {Ovelapped structure for the read, Write operations}
    tOvSt        : TOverlapped;
    EVENT        : DWORD;
    RxEventHandle: Integer;
    CommProp     : TCommProp;
    {  Port Errors}
    strCommError : string;
    LastError   : Integer;


    RxWaitTime  :longInt;//ReadTotalTimeout property variable

// In Alphabetical Order

  Function CloseComm(Value: Word):Boolean;
  function CommError: Integer;

  procedure Open;//creates port handle and runs the read thread

  function RXFlush: Boolean;
  function TXFlush: Boolean;

  { ************************************************************************}
  { MODEM Control Procedures - Added by DWR Dec 12, 1996}
  // These Functions Set the DTR(20), RTS(6) False=Low-12) True=High(+12)
  Procedure SetMCDTR(Value:Boolean);
  Procedure SetMCRTS(Value:Boolean);
  // Writing False to these procedures clears the function
  // Writing true sets the function
  Procedure SetMCXOn(Value:Boolean); // acts like XON received if Value - true XOFF id False
  Procedure SetMCBreak(Value:Boolean); // suspends - breaks TX if set true, Clears BREAK if False

  function WriteCommString(strOut:String):Boolean;//writes to the commport
  function WriteToComm(DataToSend:apBuffer; Size:Integer):String;
  // Not used in this version.
  // Use in the case of write thread activation instead of WriteCommString
  procedure SetComPort(Value:String); {05.05.97 D.V.B.}
  procedure SetBaud(Value:String); {05.05.97 D.V.B.}


  constructor Create(AOwner : TComponent); override;
  destructor destroy {(AOwner : TComponent)}; override;

  property Version : String read sVersion;

  published
    { Published declarations }
    // In Alphabetical Order
    // New

    //property BAUD : TBAUD read pBAUD write pBAUD stored true default B9600; 05.05.97 D.V.B.
    property Baud     : string read pBAUD write SetBAUD ; //05.05.97 D.V.B.
    //stored true is default if not included in declaration.
    property ByteSize : TByte  read pByte write pByte stored true default _8;

   // property ComPort : TPort read pCommPort  write pCommPort stored true default Com1;
    property ComPort : String read pCommPort  write SetComPort ;//stored true; 05.05.97.D.V.B.
    //stored true is default if not included in declaration.

    {New Modem Status Properties added by DWR Dec 09, 1996}
    property MCTSOn : Boolean read GetMCTS;
    property MDSROn : Boolean read GetMDSR;
    property MRingOn : Boolean read GetMRing;
    property MRLSDOn : Boolean read GetMRLSD;

    property OnCTSChange: amCTSNotify    read fOnCTS;
    property OnReceive :amExtRxHandler read fOnRx write fOnRx;{New Event}

    property Parity : TParity read pParity write pParity stored true Default NONE;
    property ParityEnable : Boolean read fParity write fParity stored true default False;


    property ReadTotalTimeout : Longint read RxWaitTime write RxWaitTime{SetRxWaitTime} default 1000;
    property RunRegardlessOS: Boolean Read fRunRegardlessOS write fRunRegardlessOS stored true default False;

    property StopBits : TStop read pStopBits write pStopBits stored true Default _1;



    property _AbortOnError     : Boolean read fAbortOnError write SetAbortOnError stored true default False;
    property _CTSTxHndShake    : Boolean read fOutxCTSFlow write fOutxCTSFlow {SetCTSTx} default true; // V1.3
    property _DSRTxHndShake    : Boolean read fOutxDSRFlow write fOutxDSRFlow {SetDSRTx} default true; // V1.3
    property _DSRSensitivity   : Boolean read fDSRSense write fDSRSense {SetDSRSense} default false; // V1.3
    property _TxContinueOnXoff : Boolean read fTxOnXoff write fTxOnXoff {SetTxContinueOnXoff} default true; // V1.3

    property _DTRHandShake : TDTRVal read pDTR write pDTR {SetDTRControl} default DTRDisable; //V 1.3 New

    property _NullStrip : Boolean read fNull write fNull{SetNullStrip};

    property _ParityErrSub : Boolean read fPEChar write fPEChar{SetPESubOn} default True;
    property _ParityReplChar : char read ParErrChar write ParErrChar{SetPEChar};

    property _RTSHandShake : TRTSVal read pRTS write pRTS{SetRTSControl} DEFAULT RTSDisable;

    property WComID: Integer read CommID;
    property _XOnChar : Byte read XONVal write XONVal{SetXONVal};
    property _XOffChar : Byte read XOffVal write XOffVal{SetXOffVal};
    property _XOnRxLimit : word read XONLim write XONLim{SetXOnRxLim};
    property _XOffRxLimit : word read XOFFLim write XOFFLim{SetXOffRxLim};
    property _XOnXOff : Boolean read fOutX write fOutX{SetXONOFF} default false;
    // Binary Mode Must be True for 32 Bit
    property _BinaryMode : Boolean read fBinary write fBinary {SetBinaryMode} default True;
             {Sets both fOut and fInx}
  end;

// end of class declaration




implementation
{*********************************************************************}

