awuser.pas

测试用例

      procedure SendBreak(Ticks : Cardinal; Yield : Boolean);
      procedure SetBreak(BreakOn : Boolean);
      procedure SetThreadBoost(Boost : Byte); virtual;
      function SetDataPointer( P : Pointer; Index : Cardinal) : Integer;
      function SetDtr(OnOff : Boolean) : Integer;
      procedure SetEventBusy(var WasOn : Boolean; SetOn : Boolean);
      procedure SetRS485Mode(OnOff : Boolean);
      function SetRts(OnOff : Boolean) : Integer;
      function SetLine(Baud : LongInt; Parity : Cardinal;
        DataBits : TDatabits; StopBits : TStopbits) : Integer;
      function SetModem(DTR, RTS : Boolean) : Integer;
      function SetStatusTrigger(TriggerHandle : Cardinal;
        Value : Cardinal; Activate : Boolean) : Integer;
      function SetTimerTrigger(TriggerHandle : Cardinal;
        Ticks : LongInt; Activate : Boolean) : Integer;
      function SetCommBuffers(InSize, OutSize : Integer) : Integer;
      procedure StartDispatchLogging;
      procedure StartTracing;
      procedure StopDispatchLogging;
      procedure StopTracing;
      function SWFlowChars( OnChar, OffChar : Char) : Integer;
      function SWFlowDisable : Integer;
      function SWFlowEnable(BufferFull, BufferResume : Cardinal;
        Options : Cardinal) : Integer;
      function SWFlowState : Integer;
      function TimerTicksRemaining(TriggerHandle : Cardinal;
        var TicksRemaining : Longint) : Integer;
      procedure UpdateHandlerFlags(FlagUpdate : TApHandlerFlagUpdate); virtual;
  end;

function GetTComRecPtr(Cid : Integer; DeviceLayerClass : TApdDispatcherClass) : Pointer;

var
  PortList : TList;

procedure LockPortList;
procedure UnlockPortList;

implementation

var
  PortListSection : TRTLCriticalSection;

const
  { This should be the same in ADSOCKET.PAS }
  CM_APDSOCKETMESSAGE = WM_USER + $0711;

  {For setting stop bits}
  StopBitArray : array[TStopbits] of Byte = (OneStopbit, TwoStopbits, 0);

  {For quick checking and disabling of all flow control options}
  InHdwFlow  = dcb_DTRBit2 + dcb_RTSBit2;
  OutHdwFlow = dcb_OutxDSRFlow + dcb_OutxCTSFlow;
  AllHdwFlow = InHdwFlow + OutHdwFlow;
  AllSfwFlow = dcb_InX + dcb_OutX;

  {Mask of errors we care about}
  ValidErrorMask =
    ce_RXOver   +  {receive queue overflow}
    ce_Overrun  +  {receive overrun error}
    ce_RXParity +  {receive parity error}
    ce_Frame    +  {receive framing error}
    ce_Break;      {break detected}

  {For clearing modem status}
  ClearDelta    = $F0;
  ClearNone     = $FF;
  ClearDeltaCTS = Byte(not DeltaCTSMask);
  ClearDeltaDSR = Byte(not DeltaDSRMask);
  ClearDeltaRI  = Byte(not DeltaRIMask);
  ClearDeltaDCD = Byte(not DeltaDCDMask);

  {Use these event bits for fast checking of serial events}
  DefEventMask = ev_CTS + ev_DSR + ev_RLSD + ev_Ring + ev_RingTe +
                 ev_RxChar + ev_Err + ev_Break;

{General purpose routines}

const
  LastCID : Integer = -1;
  LastDispatcher : TApdBaseDispatcher = nil;

function GetTComRecPtr(Cid : Integer; DeviceLayerClass : TApdDispatcherClass) : Pointer;
  {-Find the entry into the port array which has the specified Cid}
var
  i : Integer;
begin
  LockPortList;
  try
    {find the correct com port record}
    if (LastCID = Cid) and (LastDispatcher <> nil) then
      Result := LastDispatcher
    else begin
      for i := 0 to pred(PortList.Count) do
        if PortList[i] <> nil then
          with TApdBaseDispatcher(PortList[i]) do
            if (CidEx = Cid) and (TObject(PortList[i]) is DeviceLayerClass) then begin
              Result := TApdBaseDispatcher(PortList[i]);
              LastCID := Cid;
              LastDispatcher := Result;
              exit;
            end;
      Result := nil;
    end;
  finally
    UnlockPortList;
  end;
end;

{$IFDEF DebugThreadConsole}
  type
    TThreadStatus = (ComStart, ComWake, ComSleep, ComKill,
                     DispStart, DispWake, DispSleep, DispKill,
                     OutStart, OutWake, OutSleep, OutKill);
  var
    C, D, O : Char;                                                      {!!.02}
  function ThreadStatus(Stat : TThreadStatus) : string;
  begin
    C := '.';                                                            {!!.02}
    D := '.';                                                            {!!.02}
    O := '.';                                                            {!!.02}
    case Stat of
      ComStart,
      ComWake    : C := 'C';
      ComSleep   : C := 'c';
      ComKill    : C := 'x';
      DispStart,
      DispWake   : D := 'D';
      DispSleep  : D := 'd';
      DispKill   : D := 'x';
      OutStart,
      OutWake    : O := 'O';
      OutSleep   : O := 'o';
      OutKill    : O := 'x';
    end;
    Result := C + D + O + ' ' + IntToStr(AdTimeGetTime);
  end;
{$ENDIF}

  function BuffCount(Head, Tail: Cardinal; Full : Boolean) : Cardinal;
    {-Return number of chars between Tail and Head}
  begin
    if Head = Tail then
      if Full then
        BuffCount := DispatchBufferSize
      else
        BuffCount := 0
    else if Head > Tail then
      BuffCount := Head-Tail
    else
      BuffCount := (Head+DispatchBufferSize)-Tail;
  end;

  procedure TApdBaseDispatcher.ThreadGone(Sender: TObject);
  begin
    if Sender = ComThread then
      ComThread := nil;

    if Sender = OutThread then
      OutThread := nil;

    if Sender = fDispThread then begin
      fDispThread := nil;
      if DoDonePortPrim then begin
        DonePortPrim;
        DoDonePortPrim := False;
      end;
    end;

    if (InterLockedDecrement(ActiveThreads) = 0) then begin
      DispActive := False;
    end;
  end;

  procedure TApdBaseDispatcher.SetThreadBoost(Boost : Byte);
  begin
    if Boost <> ThreadBoost then begin
      ThreadBoost := Boost;

      if Assigned(ComThread) then
        ComThread.Priority := TThreadPriority(Ord(tpNormal) + Boost);

      if Assigned(fDispThread) then
        fDispThread.Priority := TThreadPriority(Ord(tpNormal) + Boost);

      if Assigned(fDispThread) then
        if RS485Mode then
          OutThread.Priority := TThreadPriority(Ord(tpHigher) + Boost)
        else
          OutThread.Priority := TThreadPriority(Ord(tpNormal) + Boost);
    end;
  end;

  constructor TApdBaseDispatcher.Create(Owner : TObject);
  var
    i : Integer;
  begin
    inherited Create;
    fOwner := Owner;
    ComEvent := INVALID_HANDLE_VALUE;
    ReadyEvent := INVALID_HANDLE_VALUE;
    GeneralEvent := INVALID_HANDLE_VALUE;
    OutputEvent := INVALID_HANDLE_VALUE;
    SentEvent := INVALID_HANDLE_VALUE;
    OutFlushEvent := INVALID_HANDLE_VALUE;

    LockPortList;
    try
    {Find a free slot in PortListX or append if none found (see Destroy) }
      fHandle := -1;
      for i := 0 to pred(PortList.Count) do
        if PortList[i] = nil then begin
          PortList[i] := Self;
          fHandle := i;
          break;
        end;
      if fHandle = -1 then
        fHandle := PortList.Add(Self);
    finally
      UnlockPortList;
    end;
    {Allocate critical section objects}
    FillChar(DataSection, SizeOf(DataSection), 0);
    InitializeCriticalSection(DataSection);

    FillChar(OutputSection, SizeOf(OutputSection), 0);
    InitializeCriticalSection(OutputSection);

    FillChar(DispSection, SizeOf(DispSection), 0);
    InitializeCriticalSection(DispSection);
    WndTriggerHandlers := TList.Create;
    ProcTriggerHandlers := TList.Create;
    EventTriggerHandlers := TList.Create;
    TimerTriggers := TList.Create;
    DataTriggers  := TList.Create;
    StatusTriggers:= TList.Create;
    TriggerCounter := FirstTriggerCounter;
  end;

  destructor TApdBaseDispatcher.Destroy;
  var
    i : Integer;
  begin
    if ClosePending then begin
      DonePortPrim
    end else
      DonePort;

    { it's possible for the main VCL thread (or whichever thread opened }
    { the port) to destroy the dispatcher while we're still waiting for }
    { our Com, Output and Dispatcher threads to terminate, we'll spin   }
    { here waiting for the threads to terminate.                        }
    while ActiveThreads > 0 do                                           {!!.02}
      SafeYield;                                                         {!!.02}

    LockPortList;
    try
      { We can't just call Remove since there may be other ports open where }
      { we use the index into the PortListX array as a handle }
      PortList[PortList.IndexOf(Self)] := nil;
      for i := PortList.Count - 1 downto 0 do
        if PortList[i] = nil then
          PortList.Delete(i)
        else
          break;
      if LastDispatcher = Self then begin
        LastDispatcher := nil;
        LastCID := -1;
      end;
    finally
      UnlockPortList;
    end;

    while TimerTriggers.Count > 0 do begin
      Dispose(PTimerTrigger(TimerTriggers[0]));
      TimerTriggers.Delete(0);
    end;
    TimerTriggers.Free;

    while DataTriggers.Count > 0 do begin
      Dispose(PDataTrigger(DataTriggers[0]));
      DataTriggers.Delete(0);
    end;
    DataTriggers.Free;

    while StatusTriggers.Count > 0 do begin
      Dispose(PStatusTrigger(StatusTriggers[0]));
      StatusTriggers.Delete(0);
    end;
    StatusTriggers.Free;

    while WndTriggerHandlers.Count > 0 do begin
      Dispose(PWndTriggerHandler(WndTriggerHandlers[0]));
      WndTriggerHandlers.Delete(0);
    end;
    WndTriggerHandlers.Free;

    while ProcTriggerHandlers.Count > 0 do begin
      Dispose(PProcTriggerHandler(ProcTriggerHandlers[0]));
      ProcTriggerHandlers.Delete(0);
    end;
    ProcTriggerHandlers.Free;

    while EventTriggerHandlers.Count > 0 do begin
      Dispose(PEventTriggerHandler(EventTriggerHandlers[0]));
      EventTriggerHandlers.Delete(0);
    end;
    EventTriggerHandlers.Free;

    {Free the critical sections}
    DeleteCriticalSection(DataSection);
    DeleteCriticalSection(OutputSection);
    DeleteCriticalSection(DispSection);

    inherited Destroy;
  end;

  procedure TApdBaseDispatcher.RefreshStatus;
    {-Get current ComStatus}
  var
    NewError : Integer;
  begin
    {Get latest ComStatus and LastError}
    NewError := GetComError(ComStatus);

    {Mask off those bits we don't care about}
    LastError := LastError or (NewError and ValidErrorMask);
  end;

  procedure TApdBaseDispatcher.MapEventsToMS(Events : Integer);
    {-Set bits in ModemStatus according to flags in Events}
  var
    OldMS : Byte;
    Delta : Byte;
  begin
    {Note old, get new}
    OldMS := ModemStatus;
    GetModemStatusPrim($FF);

    {Set delta bits}
    Delta := (OldMS xor ModemStatus) and $F0;
    ModemStatus := ModemStatus or (Delta shr 4);
  end;

{Routines used by constructor}

  procedure TApdBaseDispatcher.RemoveAllTriggers;
    {-Remove all triggers}
  begin
    EnterCriticalSection(DataSection);
    try
      LenTrigger := 0;
      while TimerTriggers.Count > 0 do begin
        Dispose(PTimerTrigger(TimerTriggers[0]));
        TimerTriggers.Delete(0);
      end;
      while DataTriggers.Count > 0 do begin
        Dispose(PDataTrigger(DataTriggers[0]));
        DataTriggers.Delete(0);
      end;
      while StatusTriggers.Count > 0 do begin
        Dispose(PStatusTrigger(StatusTriggers[0]));
        StatusTriggers.Delete(0);
      end;

      TriggerCounter := FirstTriggerCounter;
    finally
      LeaveCriticalSection(DataSection);
    end;
  end;

  function TApdBaseDispatcher.SetCommStateFix(var DCB : TDCB) : Integer;
    {-Preserve DTR and RTS states}
  begin
    if not DTRAuto then begin
      DCB.Flags := DCB.Flags and not (dcb_DTRBit1 or dcb_DTRBit2);
      if DTRState then begin
        { Assert DTR }
        DCB.Flags := DCB.Flags or dcb_DTR_CONTROL_ENABLE;
      end;
    end;
    if not RTSAuto then begin
      DCB.Flags := DCB.Flags and not (dcb_RTSBit1 or dcb_RTSBit2);
      if RTSState then begin
        { Assert RTS }
        DCB.Flags := DCB.Flags or dcb_RTS_CONTROL_ENABLE;
      end;
    end;
    Result := SetComState(DCB);
    LastBaud := DCB.BaudRate;
    SetDtr(DtrState);