awuser.pas

Async Professional 4.04

{*********************************************************}
{*                    AWUSER.PAS 4.04                    *}
{*      Copyright (C) TurboPower Software 1996-2002      *}
{*                 All rights reserved.                  *}
{*********************************************************}
{*      Thanks to David Hudder for his substantial       *}
{*  contributions to improve efficiency and reliability  *}
{*********************************************************}

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

{Options required for this unit}
{$X+,B-,I-,T-,J+}

{.$DEFINE DebugThreads}

{$IFDEF CONSOLE}
{.$DEFINE DebugThreadConsole}
{$ENDIF}

{!!.02} { removed Win16 references }
unit AwUser;
  {-Basic API provided by APRO}

interface

uses
  WinTypes,
  WinProcs,
  Messages,
  SysUtils,
  Classes,
  MMSystem,
  OoMisc,
  AdExcept;

const
  FirstTriggerCounter = 1;
  MaxTriggerHandle = 65536 shr 4;{Highest trigger handle number (4096)}
  StatusTypeMask = $0007;
  ThreadStartWait = 3000;      {Milliseconds to wait for sub-threads to start}
type
  TApHandlerFlagUpdate = (fuKeepPort, fuEnablePort, fuDisablePort);  

  TApdBaseDispatcher = class;
  TApdDispatcherThread = class(TThread)
    private
      H : TApdBaseDispatcher;
      pMsg, pTrigger : Cardinal;
      plParam : LongInt;
      pTriggerEvent : TApdNotifyEvent;
      procedure SyncEvent;
    public
      constructor Create(Disp : TApdBaseDispatcher);
      procedure SyncNotify(Msg, Trigger : Cardinal; lParam : LongInt; Event : TApdNotifyEvent);
      procedure Sync(Method: TThreadMethod);
  end;

  TOutThread = class(TApdDispatcherThread)
    procedure Execute; override;
  end;

  TComThread = class(TApdDispatcherThread)
    procedure Execute; override;
  end;

  TDispThread = class(TApdDispatcherThread)
    procedure Execute; override;
  end;

  {Standard comm port record}
  TApdDispatcherClass = class of TApdBaseDispatcher;
  TApdBaseDispatcher = class
    protected
      fOwner            : TObject;
      fHandle           : Integer;    {Handle for this comm port}
      OpenHandle        : Boolean;
      CidEx             : Integer;    {Comm or other device ID}
      LastError         : Integer;    {Last error from COM API}
      InQue             : Cardinal;   {Size of device input buffer}
      OutQue            : Cardinal;   {Size of device output buffer}
      ModemStatus       : Cardinal;   {Modem status register}
      ComStatus         : TComStat;   {Results of last call for com status}
      DCB               : TDCB;       {Results of last call for DCB}
      LastBaud          : LongInt;    {Last baud set}
      Flags             : Cardinal;   {Option flags}
      DTRState          : Boolean;    {Last set DTR state}
      DTRAuto           : Boolean;    {True if in handshake mode}
      RTSState          : Boolean;    {Last set RTS state}
      RTSAuto           : Boolean;    {True if in handshake mode}
      fDispatcherWindow : Cardinal;   {Handle to dispatcher window}
      LastModemStatus   : Cardinal;   {Last modem status read}
      LastLineErr       : Cardinal;   {Last line error read}
      RS485Mode         : Boolean;    {True if in RS485 mode}
      BaseAddress       : Word;       {Base address of port}

      {Trigger stuff}
      PortHandlerInstalled : Boolean; {True if any of the comport's trigger handlers <> nil}
      HandlerServiceNeeded : Boolean; {True if handlers need to be serviced}                 
      WndTriggerHandlers   : TList;
      ProcTriggerHandlers  : TList;
      EventTriggerHandlers : TList;
      TimerTriggers  : TList;         {Timer triggers}
      DataTriggers   : TList;         {Data triggers}
      StatusTriggers : TList;         {Status triggers}             
      LastTailData   : Cardinal;      {Tail of last data checked for data}
      LastTailLen    : Cardinal;      {Tail of last data sent in len msg}
      LenTrigger     : Cardinal;      {Number of bytes before length trigger}
      GlobalStatHit  : Boolean;       {True if at least one status trigger hit}
      InAvailMessage : Boolean;       {True when within Avail msg}
      GetCount       : Cardinal;      {Chars looked at in Avail msg}
      MaxGetCount    : Cardinal;      {Max chars looked at in Avail}
      DispatchFull   : Boolean;       {True when dispatch buffer full}
      NotifyTail     : Cardinal;      {Position of last character notified}

      {Thread stuff}
      KillThreads    : Boolean;           {True to kill threads}
      ComThread      : TComThread;
      fDispThread    : TDispThread;
      OutThread      : TOutThread;
      ThreadBoost    : Byte;
      DataSection    : TRTLCriticalSection;    {For all routines}
      OutputSection  : TRTLCriticalSection;    {For output buffer and related data}
      DispSection    : TRTLCriticalSection;    {For dispatcher buffer and related data}
      ComEvent       : THandle;                {Signals com thread is ready}
      ReadyEvent     : THandle;                {Signals completion of com thread}
      GeneralEvent   : THandle;                {For general misc signalling}
      OutputEvent    : THandle;                {Signals output buf has data to send}
      SentEvent      : THandle;                {Signals completion of overlapped write}
      OutFlushEvent  : THandle;                {Signals request to flush output buffer}
      OutWaitObjects1: array[0..1] of THandle; {Output thread wait objects}
      OutWaitObjects2: array[0..1] of THandle; {More output thread wait objects}
      CurrentEvent   : DWORD;                  {Current communications event}
      RingFlag       : Boolean;                {True when ringte event received}

      { Output buffer -- protected by OutputSection }
      OBuffer       : POBuffer;          {Output buffer}
      OBufHead      : Cardinal;          {Head offset in OBuffer}
      OBufTail      : Cardinal;          {Tail offset in OBuffer}
      OBufFull      : Boolean;           {True when output buffer full}

      { Dispatcher stuff -- protected by DispSection }
      DBuffer       : PDBuffer;          {Dispatcher buffer}
      DBufHead      : Cardinal;          {Head offset in DBuffer}
      DBufTail      : Cardinal;          {Tail offset in DBuffer}
      fEventBusy    : Boolean;           {True if we're processing a COM event}
      DeletePending : Boolean;           {True if an event handler was deleted during a busy state}
      ClosePending  : Boolean;           {True if close pending}
      OutSentPending: Boolean;           {True if stOutSent trigger pending}

      {Tracing stuff}
      TracingOn     : Boolean;           {True if tracing is on}
      TraceQueue    : PTraceQueue;       {Circular trace buffer}
      TraceIndex    : Cardinal;          {Head of trace queue}
      TraceMax      : Cardinal;          {Number of trace entries}
      TraceWrapped  : Boolean;           {True if trace wrapped}

      {DispatchLogging stuff}
      DLoggingOn    : Boolean;           {True if dispatch logging is on}
      DLoggingQueue : PDispatchQueue;    {Circular dispatch logging buffer}
      DLoggingHead  : Cardinal;          {Head of queue}
      DLoggingTail  : Cardinal;          {Tail of queue}
      DLoggingFree  : Cardinal;          {Free space left in queue}
      DLoggingMax   : Cardinal;          {Number of bytes in logging buffer}
      DLogPopBuf    : PByteBuffer;       {Buffer for popping entries}
      TimeBase      : DWORD;             {Time dispatching was turned on}

      {DispatcherMode : Cardinal;}
      TimerID        : Cardinal;
      TriggerCounter : Cardinal; {Last allocated trigger handle}
      DispActive     : Boolean;
      {Protected virtual dispatcher functions:}

      DoDonePortPrim : Boolean;
      ActiveThreads : Integer;
      procedure ThreadGone(Sender: TObject);

      function EscapeComFunction(Func : Integer) : LongInt; virtual; abstract;
      function FlushCom(Queue : Integer) : Integer; virtual; abstract;
      function GetComError(var Stat : TComStat) : Integer; virtual; abstract;
      function GetComEventMask(EvtMask : Integer) : Cardinal; virtual; abstract;
      function GetComState(var DCB: TDCB): Integer; virtual; abstract;
      function ReadCom(Buf : PChar; Size: Integer) : Integer; virtual; abstract;
      function SetComState(var DCB : TDCB) : Integer; virtual; abstract;
      function WriteCom(Buf : PChar; Size: Integer) : Integer; virtual; abstract;
      function WaitComEvent(var EvtMask : DWORD;
        lpOverlapped : POverlapped) : Boolean; virtual; abstract;
      function SetupCom(InSize, OutSize : Integer) : Boolean; virtual; abstract;

      function CheckReceiveTriggers : Boolean;
      function CheckStatusTriggers : Boolean;
      function CheckTimerTriggers : Boolean;
      function CheckTriggers : Boolean;
      procedure CreateDispatcherWindow;
      procedure DonePortPrim; virtual;
      function DumpDispatchLogPrim(
                                  FName : PChar;
                                  AppendFile, InHex, AllHex : Boolean) : Integer;
      function DumpTracePrim(FName : PChar;
                          AppendFile, InHex, AllHex : Boolean) : Integer;
      function ExtractData : Boolean;
      function FindTriggerFromHandle(TriggerHandle : Cardinal; Delete : Boolean;
                                     var T : TTriggerType; var Trigger : Pointer) : Integer;
      function GetDispatchTime : DWORD;                               
      function GetModemStatusPrim(ClearMask : Byte) : Byte;
      function GetTriggerHandle : Cardinal;

      procedure MapEventsToMS(Events : Integer);
      function PeekBlockPrim(
                            Block : PChar;
                            Offset : Cardinal;
                            Len : Cardinal;
                            var NewTail : Cardinal) : Integer;
      function PeekCharPrim(var C : Char; Count : Cardinal) : Integer;
      function PopLastDLEntry(
                            var DR : TDispatchRecord;
                            Buffer : PByteBuffer;
                            var BufLen : Cardinal) : Boolean;
      function PushDLEntry(var Buffer; BufLen : Cardinal) : Boolean;
      procedure RefreshStatus;
      procedure ResetStatusHits;
      procedure ResetDataTriggers;
      function SendNotify(Msg, Trigger, Data: Cardinal) : Boolean;
      function SetCommStateFix(var DCB : TDCB) : Integer;
      procedure StartDispatcher; virtual; abstract;
      procedure StopDispatcher;  virtual; abstract;
      procedure WaitTxSent;
    public
      DataPointers  : TDataPointerArray; {Array of data pointers}
      DeviceName    : string; {Name of device being used, for log }

      property Active : Boolean read DispActive;
      property Logging : Boolean read DLoggingOn;
      procedure AddDispatchEntry(
                                 DT : TDispatchType;
                                 DST : TDispatchSubType;
                                 Data : Cardinal;
                                 Buffer : Pointer;
                                 BufferLen : Cardinal);
      procedure AddStringToLog(S : string);
      property ComHandle : Integer read CidEx;
      {Public virtual dispatcher functions:}
      function OpenCom(ComName: PChar; InQueue,
        OutQueue : Cardinal) : Integer; virtual; abstract;
      function CloseCom : Integer; virtual; abstract;

      property DispatcherWindow : Cardinal read fDispatcherWindow;
      property DispThread : TDispThread read fDispThread;
      property EventBusy : boolean read fEventBusy write fEventBusy;
      property Handle : Integer read fHandle;
      property Owner : TObject read fOwner;

      constructor Create(Owner : TObject);
      destructor Destroy; override;

      procedure AbortDispatchLogging;
      procedure AbortTracing;
      function AddDataTrigger(Data : PChar;
                               IgnoreCase : Boolean) : Integer;
      function AddDataTriggerLen(Data : PChar;
                              IgnoreCase : Boolean;
                              Len : Cardinal) : Integer;
      function AddStatusTrigger(SType : Cardinal) : Integer;
      function AddTimerTrigger : Integer;
      procedure AddTraceEntry(CurEntry : Char; CurCh : Char);
      function AppendDispatchLog(FName : PChar;
                                  InHex, AllHex : Boolean) : Integer;
      function AppendTrace(FName : PChar;
                            InHex, AllHEx : Boolean) : Integer;
      procedure BufferSizes(var InSize, OutSize : Cardinal);
      function ChangeBaud(NewBaud : LongInt) : Integer;
      procedure ChangeLengthTrigger(Length : Cardinal);
      function CheckCTS : Boolean;
      function CheckDCD : Boolean;
      function CheckDeltaCTS : Boolean;
      function CheckDeltaDSR : Boolean;
      function CheckDeltaRI : Boolean;
      function CheckDeltaDCD : Boolean;
      function CheckDSR : Boolean;
      function CheckLineBreak : Boolean;
      function CheckRI : Boolean;
      function ClassifyStatusTrigger(TriggerHandle : Cardinal) : Cardinal;
      procedure ClearDispatchLogging;
      class procedure ClearSaveBuffers(var Save : TTriggerSave);
      function ClearTracing : Integer;
      procedure DeregisterWndTriggerHandler(HW : TApdHwnd);
      procedure DeregisterProcTriggerHandler(NP : TApdNotifyProc);
      procedure DeregisterEventTriggerHandler(NP : TApdNotifyEvent);
      procedure DonePort;
      function DumpDispatchLog(FName : PChar; InHex, AllHex : Boolean) : Integer;
      function DumpTrace(FName : PChar; InHex, AllHex : Boolean) : Integer;
      function ExtendTimer(TriggerHandle : Cardinal;
        Ticks : LongInt) : Integer;
      function FlushInBuffer : Integer;
      function FlushOutBuffer : Integer;
      function CharReady : Boolean;
      function GetBaseAddress : Word;
      function GetBlock(Block : PChar; Len : Cardinal) : Integer;
      function GetChar(var C : Char) : Integer;
      function GetDataPointer(var P : Pointer; Index : Cardinal) : Integer;
      function GetFlowOptions(var HWOpts, SWOpts, BufferFull,
        BufferResume : Cardinal; var OnChar, OffChar : Char): Integer;
      procedure GetLine(var Baud : LongInt; var Parity : Word;
        var DataBits : TDatabits; var StopBits : TStopbits);
      function GetLineError : Integer;
      function GetModemStatus : Byte;
      function HWFlowOptions(BufferFull, BufferResume : Cardinal;
        Options : Cardinal) : Integer;
      function HWFlowState : Integer;
      function InBuffUsed : Cardinal;
      function InBuffFree : Cardinal;
      procedure InitDispatchLogging(QueueSize : Cardinal);
      function InitPort(AComName : PChar; Baud : LongInt;
        Parity : Cardinal; DataBits : TDatabits; StopBits : TStopbits;
        InSize, OutSize : Cardinal; FlowOpts : DWORD) : Integer;
      function InitSocket(InSize, OutSize : Cardinal) : Integer;
      function InitTracing(NumEntries : Cardinal) : Integer;
      function OptionsAreOn(Options : Cardinal) : Boolean;
      procedure OptionsOn(Options : Cardinal);
      procedure OptionsOff(Options : Cardinal);
      function OutBuffUsed : Cardinal;
      function OutBuffFree : Cardinal;
      function PeekBlock(Block : PChar; Len : Cardinal) : Integer;
      function PeekChar(var C : Char; Count : Cardinal) : Integer;
      function ProcessCommunications : Integer; virtual; abstract;
      function PutBlock(const Block; Len : Cardinal) : Integer;
      function PutChar(C : Char) : Integer;
      function PutString(S : String) : Integer;
      procedure RegisterWndTriggerHandler(HW : TApdHwnd);
      procedure RegisterProcTriggerHandler(NP : TApdNotifyProc);
      procedure RegisterSyncEventTriggerHandler(NP : TApdNotifyEvent);
      procedure RegisterEventTriggerHandler(NP : TApdNotifyEvent);
      procedure RemoveAllTriggers;
      function RemoveTrigger(TriggerHandle : Cardinal) : Integer;
      procedure RestoreTriggers( var Save : TTriggerSave);
      procedure SaveTriggers( var Save : TTriggerSave);
      procedure SetBaseAddress(NewBaseAddress : Word);
      procedure SendBreak(Ticks : Cardinal; Yield : Boolean);
      procedure SetBreak(BreakOn : Boolean);
      procedure SetThreadBoost(Boost : Byte); virtual;
      function SetDataPointer( P : Pointer; Index : Cardinal) : Integer;
      function SetDtr(OnOff : Boolean) : Integer;
      procedure SetEventBusy(var WasOn : Boolean; SetOn : Boolean);
      procedure SetRS485Mode(OnOff : Boolean);
      function SetRts(OnOff : Boolean) : Integer;
      function SetLine(Baud : LongInt; Parity : Cardinal;
        DataBits : TDatabits; StopBits : TStopbits) : Integer;
      function SetModem(DTR, RTS : Boolean) : Integer;
      function SetStatusTrigger(TriggerHandle : Cardinal;
        Value : Cardinal; Activate : Boolean) : Integer;
      function SetTimerTrigger(TriggerHandle : Cardinal;
        Ticks : LongInt; Activate : Boolean) : Integer;
      function SetCommBuffers(InSize, OutSize : Integer) : Integer;
      procedure StartDispatchLogging;
      procedure StartTracing;
      procedure StopDispatchLogging;
      procedure StopTracing;
      function SWFlowChars( OnChar, OffChar : Char) : Integer;
      function SWFlowDisable : Integer;
      function SWFlowEnable(BufferFull, BufferResume : Cardinal;
        Options : Cardinal) : Integer;
      function SWFlowState : Integer;
      function TimerTicksRemaining(TriggerHandle : Cardinal;
        var TicksRemaining : Longint) : Integer;
      procedure UpdateHandlerFlags(FlagUpdate : TApHandlerFlagUpdate); virtual;
  end;

function GetTComRecPtr(Cid : Integer; DeviceLayerClass : TApdDispatcherClass) : Pointer;

var
  PortList : TList;

procedure LockPortList;
procedure UnlockPortList;

implementation

{$IFDEF TRIALRUN}
  {$I TRIAL07.INC}
  {$I TRIAL03.INC}
  {$I TRIAL01.INC}
{$ENDIF}

var
  PortListSection : TRTLCriticalSection;

const
  { This should be the same in ADSOCKET.PAS }
  CM_APDSOCKETMESSAGE = WM_USER + $0711;

  {For setting stop bits}
  StopBitArray : array[TStopbits] of Byte = (OneStopbit, TwoStopbits, 0);

  {For quick checking and disabling of all flow control options}
  InHdwFlow  = dcb_DTRBit2 + dcb_RTSBit2;
  OutHdwFlow = dcb_OutxDSRFlow + dcb_OutxCTSFlow;
  AllHdwFlow = InHdwFlow + OutHdwFlow;
  AllSfwFlow = dcb_InX + dcb_OutX;

  {Mask of errors we care about}