awuser.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                    AWUSER.PAS 4.06                    *}
{*********************************************************}
{* Low-level dispatcher                                  *}
{*********************************************************}
{*      Thanks to David Hudder for his substantial       *}
{*  contributions to improve efficiency and reliability  *}
{*********************************************************}

{
  This unit defines the dispatcher, com and output threads. When
  a serial port is opened (Winsock does not use a multi-threaded
  architecture), these three threads are created. The dispatcher
  thread is the interface between your application and the port.
  The dispatcher thread synchronizes with the thread that opened
  the port via SendMessageTimeout, in case of timeout (usually 3
  seconds), we will discard whatever we were trying to notify you
  about and resume the thread.  For this reason, the thread that
  opened the port should not be blocked for more than a few ticks,
  and the event handler should get the data and return as quickly
  as possible. Do not do any DB or file access inside an OnTriggerXxx
  event, those actions can take too long. Instead, collect the data
  and process it later. A good approach is to collect the data,
  post a message to yourself, and process the data from the message
  handler.
  The dispatcher thread is the interface between the application
  layer and the port. The dispatcher thread runs in the context of
  the thread that opened the port. The com thread is tied to the
  serial port drivers to receive notification when things change.
  The com thread wakes the dispatcher thread, the dispatcher thread
  then generates the events. The output thread is there to process
  the internal output buffer.
  Be extrememly cautious when making changes here. The multi-threaded
  nature, and very strict timing requirements, can lead to very
  unpredictable results. Things as simple as doing a writeln to a
  console window can dramatically change the results.
}
{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);