adport.pas

Async Professional 4.04

{*********************************************************}
{*                    ADPORT.PAS 4.04                    *}
{*      Copyright (C) TurboPower Software 1996-2002      *}
{*                 All rights reserved.                  *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$G+,X+,F+. $J+}

{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}

{!!.02} { removed Win16 references }
unit AdPort;
  {-Delphi serial port component}

interface

uses
  WinTypes,
  WinProcs,
  SysUtils,
  Classes,
  Messages,
  Controls,
  Forms,
  OoMisc,
  AwUser,
  AwWin32,
  AdExcept,
  AdSelCom;

type
  {Parity type}
  TParity = (pNone, pOdd, pEven, pMark, pSpace);

  {Activation procedure type}
  TActivationProcedure = function(Owner : TObject) : TApdBaseDispatcher;

  {Device layer types}
  TDeviceLayer = (dlWin32, dlWinsock);

  TDeviceLayers = set of TDeviceLayer;

  {Baud type}
  TBaudRate = LongInt;

  {Tapi modes}
  TTapiMode = (tmNone, tmAuto, tmOn, tmOff);

  {Port state}
  TPortState = (psClosed, psShuttingDown, psOpen);                   

  {Hardware flow control types}
  THWFlowOptions = (
    hwfUseDTR,         {Use DTR for receive flow control}
    hwfUseRTS,         {Use RTS for receive flow control}
    hwfRequireDSR,     {Require DSR before transmitting}
    hwfRequireCTS);    {Require CTS before transmitting}

  THWFlowOptionSet = set of THWFlowOptions;

  {Software flow control types}
  TSWFlowOptions = (swfNone, swfReceive, swfTransmit, swfBoth);

  {For reporting flow states, note: no rcv hardware flow status is provided}
  TFlowControlState = (fcOff,        {No flow control is in use}
                       fcOn,         {Transmit blocked}
                       fcDsrHold,    {Transmit blocked by low DSR}
                       fcCtsHold,    {Transmit blocked by low CTS}
                       fcDcdHold,    {Transmit blocked by low DCD}
                       fcXOutHold,   {Transmit blocked by Xoff}
                       fcXInHold,    {Receive blocked by Xoff}
                       fcXBothHold); {Both are blocked by Xoff}

  {Tracing/logging states}
  TTraceLogState = (tlOff, tlOn, tlDump, tlAppend, tlClear, tlPause);

  {General trigger event handler}
  TTriggerEvent = procedure(CP : TObject;
                            Msg, TriggerHandle, Data : Word) of object;

  {Specific trigger event handlers}
  TTriggerAvailEvent = procedure(CP : TObject; Count : Word) of object;
  TTriggerDataEvent = procedure(CP : TObject; TriggerHandle : Word) of object;
  TTriggerStatusEvent = procedure(CP : TObject;
                                  TriggerHandle : Word) of object;
  TTriggerTimerEvent = procedure(CP : TObject; TriggerHandle : Word) of object;

  {Status event handlers}
  TTriggerLineErrorEvent   = procedure(CP : TObject;
                                       Error : Word;
                                       LineBreak : Boolean) of object;

  {WaitChar event handler}
  TWaitCharEvent = procedure(CP : TObject; C : Char) of object;


  {Port open/close callbacks}
  TPortCallback = procedure(CP : TObject; Opening : Boolean) of object;

  {Extended port open/closing/close callbacks}                           {!!.03}
  TApdCallbackType = (ctOpen, ctClosing, ctClosed);
  TPortCallbackEx = procedure(CP : TObject; CallbackType : TApdCallbackType) of object;

  {For keeping track of port users}
  PUserListEntry = ^TUserListEntry;
  TUserListEntry = record
    Handle     : THandle;
    OpenClose  : TPortCallback;
    OpenCloseEx: TPortCallbackEx;                                        {!!.03}
    IsEx       : Boolean;                                                {!!.03}
  end;

  TApThreadBoost = (tbNone, tbPlusOne, tbPlusTwo);

const
  {Parity strings}
  ParityName : array[TParity] of string[5] =
    ('None', 'Odd', 'Even', 'Mark', 'Space');

  {Property defaults}
  adpoDefDeviceLayer = dlWin32;
  adpoDefPromptForPort = True;
  adpoDefComNumber = 0;
  adpoDefBaudRt    = 19200;
  adpoDefParity    = pNone;
  adpoDefDatabits  = 8;
  adpoDefStopbits  = 1;
  adpoDefInSize    = 4096;
  adpoDefOutSize   = 4096;
  adpoDefOpen      = False;
  adpoDefAutoOpen  = True;
  adpoDefBaseAddress = 0;
  adpoDefTapiMode  = tmAuto;
  adpoDefDTR       = True;
  adpoDefRTS       = True;
  adpoDefTracing   = tlOff;
  adpoDefTraceSize = 10000;
  adpoDefTraceName = 'APRO.TRC';
  adpoDefTraceHex  = True;
  adpoDefTraceAllHex  = False;
  adpoDefLogging   = tlOff;
  adpoDefLogSize   = 10000;
  adpoDefLogName   = 'APRO.LOG';
  adpoDefLogHex    = True;
  adpoDefLogAllHex = False;
  adpoDefUseMSRShadow = True;
  adpoDefUseEventWord = True;
  adpoDefSWFlowOptions = swfNone;
  adpoDefXonChar   = #17;
  adpoDefXoffChar  = #19;
  adpoDefBufferFull = 0;
  adpoDefBufferResume = 0;
  adpoDefTriggerLength = 1;
  adpoDefCommNotificationLevel = 10;
  adpoDefRS485Mode = False;

type
  {Port component}
  TApdCustomComPort = class(TApdBaseComponent)
  private
  protected {private}
    {.Z+}
    {Internal stuff}
    Force            : Boolean;             {True to force property setting}
    PortState        : TPortState;          {State of the physical port/dispatcher}
    OpenPending      : Boolean;             {True if Open := True while shutting down}
    ForceOpen        : Boolean;             {Force open after loading}
    UserList         : TList;               {List of comport users}
    CopyTriggers     : Boolean;             {Copy triggers on open}
    SaveTriggerBuffer: TTriggerSave;        {Triggers to copy}
    BusyBeforeWait   : Boolean;             {True if EventBusy before Wait}
    WaitPrepped      : Boolean;             {True if PrepareWait called}
    fComWindow       : THandle;             {Hidden window handle}
    fCustomDispatcher: TActivationProcedure;{Custom device layer activation}
    FMasterTerminal  : TWinControl;         {The terminal that replies to requests}

    {Port info}
    FDeviceLayer     : TDeviceLayer;        {Device layer for this port}
    FDeviceLayers    : TDeviceLayers;
    FDispatcher      : TApdBaseDispatcher;  {Handle to comm object}
    FComNumber       : Word;                {Com1 - ComWhatever}
    FBaud            : LongInt;             {Baud rate}
    FParity          : TParity;             {Parity}
    FDatabits        : Word;                {Data bits}
    FStopbits        : Word;                {Stop bits}
    FInSize          : Word;                {Input buffer size}
    FOutSize         : Word;                {Output buffer size}
    FOpen            : Boolean;             {True if the port is open}
    FPromptForPort   : Boolean;
			{True to display the com port selection dialog if no port is selected}
    FAutoOpen        : Boolean;             {True to do implicit opens}
    FCommNotificationLevel : Word;          {Comm notify level}
    FTapiCid         : Word;                {Cid from TAPI}
    FTapiMode        : TTapiMode;           {True if using TAPI}
    FRS485Mode       : Boolean;             {True if in RS485 mode}  
    FThreadBoost     : TApThreadBoost;      {Boost for dispatcher threads}

    {Modem control/status}
    FDTR             : Boolean;             {DTR control state}
    FRTS             : Boolean;             {RTS control state}

    {Flow control}
    FBufferFull      : Word;                {Flow control cutoff}
    FBufferResume    : Word;                {Flow control resume}
    FHWFlowOptions   : THWFlowOptionSet;    {Hardware flow control}
    FSWFlowOptions   : TSWFlowOptions;      {Software flow control}
    FXOnChar         : Char;                {Xon character}
    FXOffChar        : Char;                {Xoff character}

    {Debugging}
    FTracing         : TTraceLogState;      {Controls Tracing state}
    FTraceSize       : Cardinal;            {Number of tracing entries}
    FTraceName       : TPassString;         {Name of trace file}
    FTraceHex        : Boolean;             {True to dump trace non-printables in hex}
    FTraceAllHex     : Boolean;             {True to dump all trace chars in hex}
    FLogging         : TTraceLogState;      {Controls DispatchLogging state}
    FLogSize         : Cardinal;            {Size, in bytes, of log buffer}
    FLogName         : TPassString;         {Name of log file}
    FLogHex          : Boolean;             {True to dump log non-printables in hex}
    FLogAllHex       : Boolean;             {True to dump all log chars in hex}

    {Options}
    FUseMSRShadow    : Boolean;             {True to use MSR shadow reg}
    FUseEventWord    : Boolean;             {True to use the EventWord}

    {Triggers}
    FTriggerLength   : Word;                {Number of bytes for avail trigger}

    FOnTrigger       : TTriggerEvent;       {All-encompassing event handler}
    FOnTriggerAvail  : TTriggerAvailEvent;  {APW_TRIGGERAVAIL events}
    FOnTriggerData   : TTriggerDataEvent;   {APW_TRIGGERDATA events}
    FOnTriggerStatus : TTriggerStatusEvent; {APW_TRIGGERSTATUS events}
    FOnTriggerTimer  : TTriggerTimerEvent;  {APW_TRIGGERTIMER events}
    FOnTriggerLineError   : TTriggerLineErrorEvent;  {Got line error}
    FOnTriggerModemStatus : TNotifyEvent;   {Got modem status change}
    FOnTriggerOutbuffFree : TNotifyEvent;   {Outbuff free above mark}
    FOnTriggerOutbuffUsed : TNotifyEvent;   {Outbuff used above mark}
    FOnTriggerOutSent     : TNotifyEvent;   {Data was transmitted}

    FOnPortOpen      : TNotifyEvent;        {Port just opened}
    FOnPortClose     : TNotifyEvent;        {Port just closed}
    FOnWaitChar      : TWaitCharEvent;      {Received char during wait}

    {Property read/write methods}
    procedure SetDeviceLayer(const NewDevice : TDeviceLayer);
    procedure SetComNumber(const NewNumber : Word);
    procedure SetBaud(const NewBaud : Longint);
    procedure SetParity(const NewParity : TParity);
    procedure SetDatabits(const NewBits : Word);
    procedure SetStopbits(const NewBits : Word);
    procedure SetInSize(const NewSize : Word);
    procedure SetOutSize(const NewSize : Word);
    procedure SetTracing(const NewState : TTraceLogState);
    procedure SetTraceSize(const NewSize : Cardinal);
    procedure SetLogging(const NewState : TTraceLogState);
    procedure SetLogSize(const NewSize : Cardinal);                   
    procedure SetOpen(const Enable : Boolean);
    procedure SetHWFlowOptions(const NewOpts : THWFlowOptionSet);
    function GetFlowState : TFlowControlState;
    procedure SetSWFlowOptions(const NewOpts : TSWFlowOptions);
    procedure SetXonChar(const NewChar : Char);
    procedure SetXoffChar(const NewChar : Char);
    procedure SetBufferFull(const NewFull : Word);
    procedure SetBufferResume(const NewResume : Word);
    procedure SetTriggerLength(const NewLength : Word);
    procedure SetDTR(const NewDTR : Boolean);
    procedure SetRTS(const NewRTS : Boolean);

    {Trigger write methods}
    procedure SetOnTrigger(const Value : TTriggerEvent);
    procedure SetOnTriggerAvail(const Value : TTriggerAvailEvent);
    procedure SetOnTriggerData(const Value : TTriggerDataEvent);
    procedure SetOnTriggerStatus(const Value : TTriggerStatusEvent);
    procedure SetOnTriggerTimer(const Value : TTriggerTimerEvent);
    procedure SetOnTriggerLineError(const Value : TTriggerLineErrorEvent);
    procedure SetOnTriggerModemStatus(const Value : TNotifyEvent);
    procedure SetOnTriggerOutbuffFree(const Value : TNotifyEvent);
    procedure SetOnTriggerOutbuffUsed(const Value : TNotifyEvent);
    procedure SetOnTriggerOutSent(const Value : TNotifyEvent);

    function GetBaseAddress : Word;                                
    function GetDispatcher : TApdBaseDispatcher;
    function GetModemStatus : Byte;
    function GetDSR : Boolean;
    function GetCTS : Boolean;
    function GetRI : Boolean;
    function GetDCD : Boolean;
    function GetDeltaDSR : Boolean;
    function GetDeltaCTS : Boolean;
    function GetDeltaRI : Boolean;
    function GetDeltaDCD : Boolean;
    function GetLineError : Word;
    function GetLineBreak : Boolean;
    function GetInBuffUsed : Word;
    function GetInBuffFree : Word;
    function GetOutBuffUsed : Word;
    function GetOutBuffFree : Word;
    procedure SetUseEventWord(NewUse : Boolean);
    procedure SetCommNotificationLevel(NewLevel : Word);
    procedure SetRS485Mode(NewMode : Boolean);
    procedure SetBaseAddress(NewBaseAddress : Word);
    procedure SetThreadBoost(NewBoost : TApThreadBoost);

  protected
    {Misc}
    function ActivateDeviceLayer : TApdBaseDispatcher; virtual;
    procedure DeviceLayerChanged; virtual;
    function InitializePort : integer; virtual;
    procedure Loaded; override;
    procedure RegisterComPort(Enabling : Boolean); virtual;
    procedure ValidateComport; virtual;
    procedure SetUseMSRShadow(NewUse : Boolean); virtual;

    {Trigger event methods}
    procedure Trigger(Msg, TriggerHandle, Data : Word); virtual;
    procedure TriggerAvail(Count : Word); virtual;
    procedure TriggerData(TriggerHandle : Word); virtual;
    procedure TriggerStatus(TriggerHandle : Word); virtual;
    procedure TriggerTimer(TriggerHandle : Word); virtual;
    procedure UpdateHandlerFlag; virtual;

    {Port open/close/change event methods}
    procedure PortOpen; dynamic;
    procedure PortClose; dynamic;
    procedure PortClosing; dynamic;                                      {!!.03}

    {Status trigger methods}
    procedure TriggerLineError(const Error : Word;
                               const LineBreak : Boolean); virtual;
    procedure TriggerModemStatus; virtual;
    procedure TriggerOutbuffFree; virtual;
    procedure TriggerOutbuffUsed; virtual;
    procedure TriggerOutSent; virtual;

    {Wait trigger method}
    procedure WaitChar(C : Char); virtual;

    {Tracing}
    procedure InitTracing(const NumEntries : Cardinal);
    procedure DumpTrace(const FName : ShortString; const InHex : Boolean);
    procedure AppendTrace(const FName : ShortString; const InHex : Boolean);
    procedure ClearTracing;
    procedure AbortTracing;
    procedure StartTracing;
    procedure StopTracing;

    {DispatchLogging}
    procedure InitLogging(const Size : Cardinal);
    procedure DumpLog(const FName : ShortString; const InHex : Boolean);
    procedure AppendLog(const FName : ShortString; const InHex : Boolean);
    procedure ClearLogging;
    procedure AbortLogging;
    procedure StartLogging;
    procedure StopLogging;

  public
    OverrideLine     : Boolean;     {True to override line parms}
    {Creation/destruction}
    constructor Create(AOwner : TComponent); override;
      {-Create a TApdComPort component}
    destructor Destroy; override;
      {-Destroy a TApdComPort component}

    {General}
    procedure InitPort; dynamic;
      {-Physically open the serial port}
    procedure DonePort; virtual;
      {-Physically close the serial port}
    procedure Assign(Source: TPersistent); override;
      {-Assign fields from TApdComPort object specified by Source}
    procedure ForcePortOpen;
      {-Force the port open after it is loaded}
    procedure SendBreak(Ticks : Word; Yield : Boolean);
      {-Send a line break of ticks duration}
    procedure SetBreak(BreakOn : Boolean);
      {-Sets or clears line break condition}