adport.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 ***** *)

{*********************************************************}
{*                    ADPORT.PAS 4.06                    *}
{*********************************************************}
{* TApdComPort component                                 *}
{*********************************************************}

{
  This unit defines the TApdCustomComPort and TApdComPort components. Both
  of these are interfaces to the dispatcher, which is what does the actual
  port communication. The base dispatcher is defined in AwUser.pas, serial
  port dispatcher (Win32) is in AwWin32.pas, Winsock dispatcher is in
  AwWnSock.pas  The term dispatcher is used for the code that interfaces with
  the device.
}

{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;