awuser.pas

Async Professional 4.04

  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);
    if not RS485Mode then
      SetRts(RtsState);
  end;

  procedure TApdBaseDispatcher.ResetStatusHits;
  var
    i : Integer;
  begin
    for i := pred(StatusTriggers.Count) downto 0 do
      PStatusTrigger(StatusTriggers[i])^.StatusHit := False;
    GlobalStatHit := False;
  end;

  procedure TApdBaseDispatcher.ResetDataTriggers;
  var
    i : Integer;
  begin
    for i := pred(DataTriggers.Count) downto 0 do
      with PDataTrigger(DataTriggers[i])^ do
        FillChar(tChkIndex, SizeOf(TCheckIndex), 0);
  end;

  function TApdBaseDispatcher.InitPort(
                         AComName : PChar;
                         Baud : LongInt;
                         Parity : Cardinal;
                         DataBits : TDatabits;
                         StopBits : TStopbits;
                         InSize, OutSize : Cardinal;
                         FlowOpts : DWORD) : Integer;                  
  type
    OS = record
      O : Cardinal;
      S : Cardinal;
    end;
  var
    Error : Integer;
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
  begin
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
    RingFlag := False;

    {Required inits in case DonePort is called}
    DBuffer := nil;
    OBuffer := nil;
    fEventBusy := False;
    DeletePending := False;

    {Create event objects}
    ComEvent := CreateEvent(nil, False, False, nil);
    ReadyEvent := CreateEvent(nil, False, False, nil);
    GeneralEvent := CreateEvent(nil, False, False, nil);
    OutputEvent := CreateEvent(nil, False, False, nil);
    SentEvent := CreateEvent(nil, True, False, nil);
    OutFlushEvent := CreateEvent(nil, False, False, nil);
    {wake up xmit thread when it's waiting for data}
    OutWaitObjects1[0] := OutputEvent;
    OutWaitObjects1[1] := OutFlushEvent;
    {wake up xmit thread when it's waiting for i/o completion}
    OutWaitObjects2[0] := SentEvent;
    OutWaitObjects2[1] := OutFlushEvent;

    {Ask Windows to open the comm port}