adpacket.pas

Async Professional 4.04

begin
  fCapture := Value;
  if TimeOut <> 0 then
    fComPort.Dispatcher.SetTimerTrigger(Timer,TimeOut,True);
  Value.HaveCapture := True;
  for i := 0 to pred(PacketList.Count) do
    if PacketList[i] <> fCapture then
      TApdDataPacket(PacketList[i]).CancelMatch;
end;

procedure TApdDataPacketManager.ReleaseCapture(Value : TApdDataPacket);
begin
  if Timer <> 0 then begin                                               {!!.02}
    CheckException(fCapture, fComPort.Dispatcher.SetTimerTrigger(Timer,0,False));
    {Timer := 0;}                                                        {!!.04}
  end;                                                                   {!!.02}
  fCapture := nil;
  Value.HaveCapture := False;
  NotifyData(0);
end;

procedure TApdDataPacketManager.SetInEvent(Value : Boolean);
var
  i : Integer;
begin
  if Value <> fInEvent then begin
    fInEvent := Value;
    if Value then begin
      for i := 0 to pred(PacketList.Count) do
        with TApdDataPacket(PacketList[i]) do
          if fEnabled then
            Disable;
    end else begin
      for i := 0 to pred(PacketList.Count) do
        with TApdDataPacket(PacketList[i]) do
          if fEnabled then
            Enable;
      if NotifyPending then begin
        if assigned(fDataBuffer) then
          NotifyData(NotifyStart);
        NotifyPending := False;
      end;
    end;
  end;
end;

procedure TApdDataPacketManager.NotifyData(NewDataStart : Integer);
var
  i : integer;
  Interest : Boolean;
begin
  if InEvent then begin
    NotifyPending := True;
    NotifyStart := NewDataStart;
    exit;
  end;
  if BufferPtr > 0 then
    if assigned(fCapture) then
      fCapture.ProcessData(NewDataStart)
    else begin
      for i := 0 to pred(PacketList.Count) do begin
        TApdDataPacket(PacketList[i]).ProcessData(NewDataStart);
        if assigned(fCapture) then break;
        if not assigned(fDataBuffer) then
          exit;
      end;
      if not assigned(fCapture) then begin
        Interest := False;
        for i := 0 to pred(PacketList.Count) do
          with TApdDataPacket(PacketList[i]) do
            if Enabled and (Mode <> dpIdle) and (BeginMatch <> -1) then begin
              Interest := True;
              break;
            end;
        if not Interest then
          DisposeBuffer;
      end;
    end;
end;

procedure TApdDataPacketManager.EnablePackets;
var
  i : integer;
begin
  for i := 0 to pred(PacketList.Count) do
    with TApdDataPacket(PacketList[i]) do
      if Enabled then
        Enable;
end;

procedure TApdDataPacketManager.DisablePackets;
var
  i : integer;
begin
  for i := 0 to pred(PacketList.Count) do
    with TApdDataPacket(PacketList[i]) do
      Disable;
end;

procedure TApdDataPacketManager.PortOpenClose(CP : TObject; Opening : Boolean);
begin
  if Opening then begin
    Enabled := True;
    EnablePackets;
  end else begin
    DisablePackets;
    Enabled := False;
  end;
end;

procedure TApdDataPacketManager.PortOpenCloseEx(CP: TObject;             {!!.03}
  CallbackType: TApdCallbackType);
begin
  if CallbackType = ctOpen then begin
    Enabled := True;
    EnablePackets;
  end else begin
    DisablePackets;
    Enabled := False;
  end;
end;

procedure TApdDataPacketManager.PacketTriggerHandler(Msg, wParam : Cardinal;
                                 lParam : Longint);
var
  NewDataStart : Integer;
begin
  if Msg = apw_TriggerAvail then begin
    NewDataStart := BufferPtr;
    if (BufferPtr+Integer(wParam)) >= dpDataBufferSize then begin
      inc(dpDataBufferSize,DispatchBufferSize);
      ReAllocMem(fDataBuffer,dpDataBufferSize);
    end;
    wParam := fComPort.Dispatcher.GetBlock(pChar(@fDataBuffer[BufferPtr]),wParam);
    inc(BufferPtr,wParam);
    NotifyData(NewDataStart);
  end else if (Msg = apw_TriggerTimer) and
    (Integer(wParam) = Timer) and
    Assigned(fCapture) then
      fCapture.TimedOut;
end;

procedure TApdDataPacketManager.WndProc(var Msg: TMessage);
begin
  { this WndProc is installed when the TApdDataPacketManager's last }
  { TApdDataPacket has been removed from the packet list }
  if Msg.Msg = CM_RELEASE then
    if fInEvent then begin
      { we're still in an event, repost the message }
      PostMessage(FWindowHandle, CM_RELEASE, 0, 0)
    end else begin
      { we're not in any event not, close ourselves }
      Free;
    end;
end;

procedure TApdDataPacketManager.DisposeBuffer;
begin
  if Assigned(fDataBuffer) then begin
    FreeMem(fDataBuffer,dpDataBufferSize);
    fDataBuffer := nil;
  end;
  dpDataBufferSize := 0;
  BufferPtr := 0;
end;

procedure TApdDataPacketManager.SetEnabled(Value : Boolean);
begin
  if Value <> fEnabled then begin
    if Value then
      Enable
    else
      Disable;
    fEnabled := Value;
  end;
end;

procedure TApdDataPacketManager.Enable;
begin
  if not HandlerInstalled then begin
    if Assigned(fComPort) then begin
      fComPort.Dispatcher.RegisterEventTriggerHandler(PacketTriggerHandler);
      HandlerInstalled := True;
      Timer := fComPort.Dispatcher.AddTimerTrigger;
    end;
  end;
end;

procedure TApdDataPacketManager.Disable;
begin
  if HandlerInstalled then begin
    if Assigned(fComPort.Dispatcher) then begin                          {!!.02}
      fComPort.Dispatcher.RemoveTrigger(Timer);
      Timer := 0;                                                        {!!.04}
      fComPort.Dispatcher.DeregisterEventTriggerHandler(PacketTriggerHandler);
    end;                                                                 {!!.02}
    HandlerInstalled := False;
    DisposeBuffer;                                                  
  end;
end;

constructor TApdDataPacket.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FSyncEvents := True;                                               
  {Search for comport}
  if (csDesigning in ComponentState) then
    ComPort := SearchComPort(Owner);

  fIgnoreCase := adpDefIgnoreCase;
  if csDesigning in ComponentState then
    fEnabled := adpDefEnabled
  else
    fEnabled := False;                                              
  fIncludeStrings := adpDefIncludeStrings;
  fEndCond := [];
  fAutoEnable := adpDefAutoEnable;
  fStartCond := adpDefStartCond;
  fTimeOut := adpDefTimeOut;
  FFlushOnTimeout := apdDefFlushOnTimeout;                               {!!.04}

  Mode := dpIdle;
end;

destructor TApdDataPacket.Destroy;
begin
  ComPort := nil;
  inherited Destroy;
end;

procedure TApdDataPacket.SetMode(Value : TPacketMode);
begin
  if Value <> fMode then begin
    if Value = dpCollecting then
      Manager.SetCapture(Self,TimeOut)
    else if HaveCapture then
      Manager.ReleaseCapture(Self);
    fMode := Value;
    case fMode of
    dpIdle :
      LogPacketEvent(dstIdle,nil,0);
    dpWaitStart :
      LogPacketEvent(dstWaiting,nil,0);
    else
      LogPacketEvent(dstCollecting,nil,0);
    end;
  end;
end;

procedure TApdDataPacket.Notification(AComponent : TComponent;
                                        Operation : TOperation);
  {Link/unlink comport when dropped or removed from form}
begin
  inherited Notification(AComponent, Operation);

  if (Operation = opRemove) then begin
    {See if our com port is going away}
    if (AComponent = FComPort) then
      ComPort := nil;
  end else if (Operation = opInsert) then
    {Check for a com port being installed}
    if not Assigned(FComPort) and (AComponent is TApdCustomComPort) then
      ComPort := TApdCustomComPort(AComponent);
end;

procedure TApdDataPacket.SetComPort(const NewComPort : TApdCustomComPort);
var
  Manager : TApdDataPacketManager;
begin
  if NewComPort <> fComPort then begin
    if Assigned(fComPort) then
      PacketManagerList.GetPortManager(fComPort).Remove(Self);
    FComPort := NewComPort;
    if Assigned(fComPort) then begin
      Manager := PacketManagerList.GetPortManager(fComPort);
      if Manager = nil then
        Manager := TApdDataPacketManager.Create(fComPort);
      Manager.Insert(Self);
    end;
  end;
end;

procedure TApdDataPacket.SetEnabled(Value : Boolean);
begin
  if Value <> fEnabled then begin
    if Value then
      Enable
    else
      Disable;
    fEnabled := Value;
  end;
end;

procedure TApdDataPacket.Resync;
var
  Match : Boolean;
begin
  repeat
    inc(fBeginMatch);
    StartMatchPos := 1;
    Match := True;
    while Match and (BeginMatch <= Manager.BufferPtr - 1)
    and (StartMatchPos <= length(InternalStartString)) do begin
      if (WildStartString[StartMatchPos] = '1')
      or (not IgnoreCase
        and (Manager.DataBuffer[BeginMatch+StartMatchPos - 1]
          = InternalStartString[StartMatchPos]))
      or (IgnoreCase
        and (UpCase(Manager.DataBuffer[BeginMatch+StartMatchPos - 1])
          = InternalStartString[StartMatchPos])) then
        inc(StartMatchPos)
      else
        Match := False;
    end;
    if Match and (BeginMatch <= Manager.BufferPtr-1) then begin
      if StartMatchPos >= length(InternalStartString) then
        if (EndCond = []) then begin
          fDataSize := length(InternalStartString);
          Packet(ecPacketSize);
          exit;
        end else
          Mode := dpCollecting;
      break;
    end;
  until BeginMatch > Manager.BufferPtr - 1;
  if BeginMatch > Manager.BufferPtr - 1 then begin
    fBeginMatch := -1;
    StartMatchPos := 1;
  end;
end;

procedure TApdDataPacket.ProcessData(StartPtr : Integer);
var
  I,J : Integer;
  C : Char;
  Match : Boolean;
begin
  if Enabled then begin
    I := StartPtr;
    while (Assigned(Manager)) and (I < Manager.BufferPtr) do begin
      if Mode = dpIdle then
        if WillCollect then begin
          Mode := dpCollecting;
          WillCollect := False;
        end else
          break;
      C := Manager.DataBuffer[I];
      if Mode <> dpCollecting then
        begin
          if (WildStartString[StartMatchPos] = '1')
          or (not IgnoreCase and (C = InternalStartString[StartMatchPos]))
          or (IgnoreCase and (UpCase(C) = InternalStartString[StartMatchPos])) then begin
            if BeginMatch = -1 then
              fBeginMatch := I;
            if StartMatchPos = length(InternalStartString) then begin
              if (EndCond = []) then begin
                fDataSize := I - BeginMatch + 1;
                Packet(ecPacketSize);
                I := BeginMatch + 1;
                StartMatchPos := 1;
                continue;
              end else
                Mode := dpCollecting;
            end else
              inc(StartMatchPos);
          end else if BeginMatch <> -1 then begin
            I := BeginMatch + 1;
            StartMatchPos := 1;
            fBeginMatch := -1;
            continue;                                               
          end;
        end
      else
        begin
          if BeginMatch = -1 then
            fBeginMatch := I;
          if (ecPacketSize in EndCond)
          and ((I - BeginMatch) + 1 >= LocalPacketSize) then begin
            fDataSize := (I - BeginMatch) + 1;
            Packet(ecPacketSize);
            exit;
          end else
          if (ecString in EndCond) then begin
              if (WildEndString[EndMatchPos] = '1')
              or (not IgnoreCase and (C = InternalEndString[EndMatchPos]))
              or (IgnoreCase and (UpCase(C) = InternalEndString[EndMatchPos])) then begin
                if EndMatchPos = length(InternalEndString) then begin
                  fDataSize := I - BeginMatch + 1;
                  Packet(ecString);
                  exit;
                end else
                  inc(EndMatchPos);
              end else begin
                {No match here, but we may already have seen part of the string}
                if EndMatchPos > 1 then begin
                  Match := False;
                  EndMatchStart := I-1;                             
                  for j := 2 to EndMatchPos do begin
                    EndMatchPos := J - 1;
                    Match := True;
                    repeat
                      if (WildEndString[EndMatchPos] = '1')
                      or (not IgnoreCase
                          and (Manager.DataBuffer[EndMatchStart + EndMatchPos]
                            = InternalEndString[EndMatchPos]))