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

{*********************************************************}
{*                   ADPACKET.PAS 4.06                   *}
{*********************************************************}
{* TApdDataPacket component                              *}
{*********************************************************}

{
  When a TApdDataPacket is enabled, it creates an internal data packet
  manager. There is one manager per port, the manager is the class
  that collects the data from the port and passes it to the data packets.
  Once a data packet starts collecting, the manager passes all data to
  that one until the packet match conditions are met, timeout, or when
  the end match conditions are not met.
  A possible replacement would have a installable manager (limited to 1
  per port), with a TCollection of packets. The collection item would have
  a string to match (could use regex), a collected string, and a state
  (idle, active/waiting, collecting). The manager would hook into the
  port's OnTriggerAvail, each time that fires it would iterate through
  the collection, generating events when the string matches. To make
  things smoother, collect new data from the OnTriggerAvail and run
  the iteration/processing in a separate thread.
}

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

unit AdPacket;

interface

uses
  WinTypes,
  WinProcs,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  OoMisc,
  AdExcept,
  AdPort,
  AwUser;

type
  TPacketStartCond = (scString,scAnyData);
  TPacketEndCond = (ecString,ecPacketSize);
  TPacketEndSet = set of TPacketEndCond;

const
  EscapeCharacter = '\';   { Use \\ to specify an actual '\' in the match strings}
  WildCardCharacter = '?'; { Use \? to specify an actual '?' in the match strings} 
  adpDefEnabled = True;
  adpDefIgnoreCase = True;
  adpDefIncludeStrings = True;
  adpDefAutoEnable = True;
  adpDefStartCond = scString;
  adpDefTimeOut = 2184;
  apdDefFlushOnTimeout = True;                                           {!!.04}

type
  TApdDataPacket = class;
  TApdDataPacketManager = class;
  TApdDataPacketManagerList = class
    {Maintains a list of packet managers so that a packet can
     locate the current packet manager for its comport.
     If no packet manager currently exists for the port, the
     packet will create one. When the last packet dis-connects
     itself from the packet manager, the packet manager self-
     destructs.}
  private
    ManagerList : TList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Insert(Value : TApdDataPacketManager);
    procedure Remove(Value : TApdDataPacketManager);
    function GetPortManager(ComPort : TApdCustomComPort) : TApdDataPacketManager;
  end;

  TApdDataPacketManager = class
    {Packet manager. One instance of these exists per com port using
     packets. The packet manager does the actual data buffering for
     all packets attached to its port.}
  private
    PacketList : TList;
    fComPort : TApdCustomComPort;
    HandlerInstalled : Boolean;
    fEnabled : Boolean;
    BufferPtr : Integer;
    fDataBuffer : pChar;
    dpDataBufferSize : Integer;
    fCapture : TApdDataPacket;
    Timer : Integer;
    fInEvent : Boolean;
    NotifyPending : Boolean;
    NotifyStart : Integer;
    EnablePending : Boolean;
    FKeepAlive : Boolean;

    FWindowHandle : HWND;
  protected
    procedure WndProc(var Msg: TMessage);
    procedure DisposeBuffer;
     {- Get rid of any pending data and release any buffer space}
    procedure NotifyData(NewDataStart : Integer);
     {- Notify the attached packet(s) that new data is available}
    procedure EnablePackets;
     {- Initialize all enabled packets for data capture}
    procedure DisablePackets;
     {- Shut off data capture for all attached packets}
    procedure PacketTriggerHandler(Msg, wParam : Cardinal;
                                 lParam : Longint);
     {- process messages from dispatcher}
    procedure PortOpenClose(CP : TObject; Opening : Boolean);
     {- Event handler for the port open/close event}
    procedure PortOpenCloseEx(CP: TObject; CallbackType: TApdCallbackType);{!!.03}
     {- Extended event handler for the port open/close event}

    procedure SetInEvent(Value : Boolean);
     {- Property write method for the InEvent property}
    procedure SetEnabled(Value : Boolean);
     {- Proporty write method for the Enabled property}
  public
    constructor Create(ComPort : TApdCustomComPort);
    destructor Destroy; override;
    procedure Enable;
     {- Install com port event handlers}
    procedure EnableIfPending;
     {- Enable after form load}
    procedure Disable;
     {- Remove com port event handlers}
    procedure Insert(Value : TApdDataPacket);
     {- Add a packet to the list}
    procedure Remove(Value : TApdDataPacket);
     {- Remove a packet to the list}
    procedure RemoveData(Start,Size : Integer);
     {- Remove packet data from the data buffer}
    procedure SetCapture(Value : TApdDataPacket; TimeOut : Integer);
     {- Set ownership of incoming data to a particular packet}
    procedure ReleaseCapture(Value : TApdDataPacket);
     {- Opposite of SetCapture, see above}
    property DataBuffer : pChar read fDataBuffer;
     {- The packet data buffer for the port. Only packets should access this}
    property ComPort : TApdCustomComPort read fComPort;
     {- The com port associated with this packet manager}
    property Enabled : Boolean read fEnabled write SetEnabled;
     {- Controls whether the packet manager is active
        set/reset when the com port is opened or closed}
    property InEvent : Boolean read fInEvent write SetInEvent;
     {- Event flag set by packets to prevent recursion issues}
    property KeepAlive : Boolean read FKeepAlive write FKeepAlive;
  end;

  TPacketMode = (dpIdle,dpWaitStart,dpCollecting);
  TPacketNotifyEvent = procedure(Sender: TObject; Data : Pointer; Size : Integer) of object;
  TStringPacketNotifyEvent = procedure(Sender: TObject; Data : string) of object;
  TApdDataPacket = class(TApdBaseComponent)
  private
    fManager : TApdDataPacketManager;
    fStartCond : TPacketStartCond;
    fEndCond : TPacketEndSet;
    fStartString,fEndString : string;
    fComPort : TApdCustomComPort;
    fMode : TPacketMode;
    fPacketSize : Integer;
    fOnPacket : TPacketNotifyEvent;
    fOnStringPacket : TStringPacketNotifyEvent;
    fOnTimeOut : TNotifyEvent;
    fTimeOut : Integer;
    fDataSize : Integer;
    fBeginMatch : Integer;
    fAutoEnable : Boolean;
    fIgnoreCase : Boolean;
    fEnabled : Boolean;
    fIncludeStrings : Boolean;

    PacketBuffer : pChar;
    StartMatchPos,EndMatchPos,EndMatchStart : Integer;
    LocalPacketSize : Integer;
    WildStartString,
    WildEndString,
    InternalStartString,
    InternalEndString : string;
    WillCollect : Boolean;
    EnablePending : Boolean;
    HaveCapture : Boolean;
    FSyncEvents : Boolean;
    FDataMatch,
    FTimedOut : Boolean;
    FEnableTimeout: Integer;                                             {!!.04}
    FEnableTimer : Integer;                                              {!!.04}
    FFlushOnTimeout : Boolean;                                           {!!.04}
  protected
    procedure SetComPort(const NewComPort : TApdCustomComPort);
    procedure Notification(AComponent : TComponent; Operation : TOperation); override;
    procedure SetEnabled(Value : Boolean);
    procedure SetMode(Value : TPacketMode);
    procedure SetEndCond(const Value: TPacketEndSet);
    procedure SetEndString(Value : String);
    procedure SetFlushOnTimeout (const v : Boolean);                     {!!.04}
    procedure ProcessData(StartPtr : Integer);
     {- Processes incoming data, collecting and/or looking for a match}
    procedure Packet(Reason : TPacketEndCond);
     {- Set up parameters and call DoPacket to generate an event}
    procedure TimedOut;
     {- Set up parameters and call DoTimeout to generate an event}
    procedure DoTimeout;
     {- Generate an OnTimeOut event}
    procedure DoPacket;
     {- Generate an OnPacket event}
    procedure NotifyRemove(Data : Integer);
     {- Called by the packet manager to cancel any partial matches}
    procedure Resync;
     {- Look for a match starting beyond the first character.
        Called when a partial match fails, or when data has
        been removed by another packet.}
    procedure CancelMatch;
     {- Cancel any pending partial match. Called by the packet manager
        when another packet takes capture.}
    procedure Loaded; override;
    procedure LogPacketEvent(Event : TDispatchSubType;
      Data : Pointer; DataSize : Integer);
     {- add packet specific events to log file, if logging is requested}

    property BeginMatch : Integer read fBeginMatch;
     {- Beginning of the current match. -1 if no match yet}
    property Manager : TApdDataPacketManager read fManager write fManager;
     {- The packet manager controlling this packet}
    property Mode : TPacketMode read fMode write SetMode;
     {- Current mode. Can be either Idle = not currently enabled,
        WaitStart = trying to match the start string, or
        Collecting = start condition has been met; collecting data}

    procedure Enable;
     {- Enable the packet}
    procedure Disable;
     {- Disable the packet}

    procedure TriggerHandler(Msg, wParam : Cardinal; lParam : Longint);  {!!.04}
     {- process messages from dispatcher, only used for the EnableTimeout}
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure GetCollectedString(var Data : String);
     {- Returns data collected in OnStringPacket format}
    procedure GetCollectedData(var Data : Pointer; var Size : Integer);
     {- Returns data collected in OnPacket format}
    property InternalManager : TApdDataPacketManager read FManager;
      { - Internal use only!  Do not touch }
    property EnableTimeout : Integer                                     {!!.04}
      read FEnableTimeout write FEnableTimeout default 0;                {!!.04}
      {- A timeout that starts when the packet is enabled }
    property FlushOnTimeout : Boolean                                    {!!.04}
      read FFlushOnTimeout Write SetFlushOnTimeout default True;         {!!.04}
      {- Determines whether the packet buffer is flushed on timeout }

    property SyncEvents : Boolean read FSyncEvents write FSyncEvents;
     {- Controls whether packet events are synchronized to the main VCL thread.
        Default is True.}
    property PacketMode : TPacketMode read fMode;
     {- Read-only property to show if we are idle, waiting, or collecting }
    function WaitForString(var Data : string) : Boolean;                 {!!.01}
     {- Waits for the data match condition or a timeout, return the collected string }
    function WaitForPacket(var Data : Pointer; var Size : Integer) : Boolean;{!!.01}
     {- Waits for the data match condition or a timeout, return the collected string }
  published
    property Enabled : Boolean read fEnabled write SetEnabled nodefault;
     {- Is the packet enabled.}
    property AutoEnable : Boolean read fAutoEnable write fAutoEnable default adpDefAutoEnable;
     {- Fire only first time, or fire whenever the conditions are met.}
    property StartCond : TPacketStartCond read fStartCond write fStartCond default adpDefStartCond;
     {- Conditions for this packet to start collecting data}
    property EndCond : TPacketEndSet read fEndCond write SetEndCond default [];
     {- Conditions for this packet to stop collecting data}
    property StartString : string read fStartString write fStartString;
     {- Packet start string}
    property EndString : string read fEndString write SetEndString;
     {- Packet end string}
    property IgnoreCase : Boolean read fIgnoreCase write fIgnoreCase default adpDefIgnoreCase;
     {- Ignore case when matching StartString and EndString}
    property ComPort : TApdCustomComPort read FComPort write SetComPort;
     {- The com port for which data is being read}
    property PacketSize : Integer read fPacketSize write fPacketSize;
     {- Size of a packet with packet size as part of the end conditions}
    property IncludeStrings : Boolean read fIncludeStrings write fIncludeStrings default adpDefIncludeStrings;
     {- Controls whether any start and end strings should be included in the
        data buffer passed to the event handler}
    property TimeOut : Integer read fTimeOut write fTimeOut default adpDefTimeOut;
     {- Number of ticks that can pass from when the packet goes into data
        collection mode until the packet is complete. 0 = no timeout}
    property OnPacket : TPacketNotifyEvent read fOnPacket write fOnPacket;
     {- Event fired when a complete packet is received}
    property OnStringPacket : TStringPacketNotifyEvent read fOnStringPacket write fOnStringPacket;
     {- Event fired when a complete packet is received}
    property OnTimeout : TNotifyEvent read fOnTimeout write fOnTimeout;
     {- Event fired when a packet times out}
  end;

implementation

var
  PacketManagerList : TApdDataPacketManagerList;

constructor TApdDataPacketManagerList.Create;
begin
  inherited Create;
  ManagerList := TList.Create;
end;

destructor TApdDataPacketManagerList.Destroy;
begin
  while ManagerList.Count > 0 do
    with TApdDataPacketManager(ManagerList[pred(ManagerList.Count)]) do begin
      { we're only being destroyed from the Finalization block, it's OK to   }
      { set fComPort to nil here since that will be destroyed shortly anyway }
      fComPort := nil;                                                   {!!.06}
      Free;                                                              {!!.06}
    end;
  ManagerList.Free;
  inherited Destroy;
end;

procedure TApdDataPacketManagerList.Insert(Value : TApdDataPacketManager);
begin
  ManagerList.Add(Value);
end;

procedure TApdDataPacketManagerList.Remove(Value : TApdDataPacketManager);
begin
  ManagerList.Remove(Value);
end;

function TApdDataPacketManagerList.GetPortManager(ComPort : TApdCustomComPort) : TApdDataPacketManager;
var
  i : integer;
begin
  Result := nil;
  for i := 0 to pred(ManagerList.Count) do
    if TApdDataPacketManager(ManagerList[i]).ComPort = ComPort then begin
      Result := TApdDataPacketManager(ManagerList[i]);
      exit;
    end;
end;

constructor TApdDataPacketManager.Create(ComPort : TApdCustomComPort);
begin
  inherited Create;
  fComPort := ComPort;
  {fComPort.RegisterUserCallback(PortOpenClose);}                        {!!.03}
  FComPort.RegisterUserCallbackEx(PortOpenCloseEx);                      {!!.03}
  PacketList := TList.Create;
  FKeepAlive := False;
  PacketManagerList.Insert(Self);
  Enabled := fComPort.Open
    and ([csDesigning, csLoading] * fComPort.ComponentState = []);
  EnablePending :=
    not (csDesigning in fComPort.ComponentState) and
    not Enabled and fComPort.Open;
  FWindowHandle := AllocateHWnd(WndProc);                                {!!.02}
end;

destructor TApdDataPacketManager.Destroy;
begin
  FKeepAlive := True;
  PacketManagerList.Remove(Self);
  Enabled := False;
  {fComPort.DeregisterUserCallback(PortOpenClose);}                      {!!.03}
  if Assigned(FComPort) then                                             {!!.05}
    FComPort.DeregisterUserCallbackEx(PortOpenCloseEx);                  {!!.03}
  DisposeBuffer;
  PacketList.Free;
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TApdDataPacketManager.EnableIfPending;
begin
  if EnablePending then begin
    Enabled := True;
    EnablePending := False;
  end;
end;

procedure TApdDataPacketManager.Insert(Value : TApdDataPacket);
begin
  PacketList.Add(Value);
  Value.Manager := Self;
end;

procedure TApdDataPacketManager.Remove(Value : TApdDataPacket);
begin
  PacketList.Remove(Value);
  if fInEvent then exit;
  Value.Manager := nil;
  if (PacketList.Count = 0) and (not FKeepAlive) then begin