adpacket.pas

Async Professional 4.04

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

{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

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

var
  PacketManagerList : TApdDataPacketManagerList;

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

destructor TApdDataPacketManagerList.Destroy;
begin
  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);
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
begin
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
  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}
  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
    {FWindowHandle := AllocateHWnd(WndProc);}                            {!!.02}
    PostMessage(FWindowHandle, CM_RELEASE, 0, 0);
  end;
end;

procedure TApdDataPacketManager.RemoveData(Start,Size : Integer);
var
  NewStart,i : Integer;
begin
  NewStart := Start+Size;
  dec(BufferPtr,NewStart);
  if BufferPtr > 0 then begin
    move(fDataBuffer[NewStart],fDataBuffer[0],BufferPtr);
  end else
    DisposeBuffer;
  for i := 0 to pred(PacketList.Count) do
    TApdDataPacket(PacketList[i]).NotifyRemove(NewStart);
end;

procedure TApdDataPacketManager.SetCapture(Value : TApdDataPacket; TimeOut : Integer);
var
  i : integer;