awuser.pas

Async Professional 4.04

  end;

  function TApdBaseDispatcher.SetDtr(OnOff : Boolean) : Integer;
    {-Set DTR modem control line}
  begin
    if DtrAuto then begin
      { We can't change DTR if we're controlling it automatically }
      Result := 1;
      Exit;
    end;

    if (OnOff = True) then
      Result := EscapeComFunction(WinTypes.SETDTR)
    else
      Result := EscapeComFunction(WinTypes.CLRDTR);

    if (Result < ecOK) then
      Result := ecBadArgument;
    DTRState := OnOff;
  end;

  function TApdBaseDispatcher.SetRts(OnOff : Boolean) : Integer;
    {-Set RTS modem control line}
  begin
    if RtsAuto then begin
      { We can't change RTS if we're controlling it automatically }
      Result := 1;
      Exit;
    end;

    if (OnOff = True) then
      Result := EscapeComFunction(WinTypes.SETRTS)
    else
      Result := EscapeComFunction(WinTypes.CLRRTS);

    if (Result < ecOK) then
      Result := ecBadArgument;
    RTSState := OnOff;
  end;

  function TApdBaseDispatcher.GetModemStatusPrim(ClearMask : Byte) : Byte;
    {-Primitive to return the modem status and clear mask}
  var
    Data : DWORD;
  begin
    EnterCriticalSection(DataSection);
    try

      {Get the new absolute values}
      GetCommModemStatus(CidEx, Data);
      ModemStatus := (ModemStatus and $0F) or Byte(Data);

      {Special case, transfer RI bit to TERI bit}
      if RingFlag then begin
        RingFlag := False;
        ModemStatus := ModemStatus or $04;
      end;

      {Return the current ModemStatus value}
      Result := Lo(ModemStatus);

      {Clear specified delta bits}
      ModemStatus := ModemStatus and Clearmask;

    finally
      LeaveCriticalSection(DataSection);
    end;
  end;

  function TApdBaseDispatcher.GetModemStatus : Byte;
    {-Return the modem status byte and clear the delta bits}
  begin
    Result := GetModemStatusPrim(ClearDelta);
  end;

  function TApdBaseDispatcher.CheckCTS : Boolean;
    {-Returns True if CTS is high}
  begin
    Result := GetModemStatusPrim(ClearDeltaCTS) and CTSMask = CTSMask;
  end;

  function TApdBaseDispatcher.CheckDSR : Boolean;
    {-Returns True if DSR is high}
  begin
    Result := GetModemStatusPrim(ClearDeltaDSR) and DSRMask = DSRMask;
  end;

  function TApdBaseDispatcher.CheckRI : Boolean;
    {-Returns True if RI is high}
  begin
    Result := GetModemStatusPrim(ClearDeltaRI) and RIMask = RIMask;
  end;

  function TApdBaseDispatcher.CheckDCD : Boolean;
    {-Returns True if DCD is high}
  begin
    Result := GetModemStatusPrim(ClearDeltaDCD) and DCDMask = DCDMask;
  end;

  function TApdBaseDispatcher.CheckDeltaCTS : Boolean;
    {-Returns True if DeltaCTS is high}
  begin
    Result := GetModemStatusPrim(ClearDeltaCTS) and DeltaCTSMask = DeltaCTSMask;
  end;

  function TApdBaseDispatcher.CheckDeltaDSR : Boolean;
    {-Returns True if DeltaDSR is high}
  begin
    Result := GetModemStatusPrim(ClearDeltaDSR) and DeltaDSRMask = DeltaDSRMask;
  end;

  function TApdBaseDispatcher.CheckDeltaRI : Boolean;
    {-Returns True if DeltaRI is high}
  begin
    Result := GetModemStatusPrim(ClearDeltaRI) and DeltaRIMask = DeltaRIMask;
  end;

  function TApdBaseDispatcher.CheckDeltaDCD : Boolean;
    {-Returns True if DeltaDCD is high}
  begin
    Result := GetModemStatusPrim(ClearDeltaDCD) and DeltaDCDMask = DeltaDCDMask;
  end;

  function TApdBaseDispatcher.GetLineError : Integer;
    {-Return current line errors}
  const
    AllErrorMask = ce_RxOver +
                   ce_Overrun + ce_RxParity + ce_Frame;
  var
    GotError : Boolean;
  begin
    EnterCriticalSection(DataSection);
    try
      GotError := True;
      if FlagIsSet(LastError, ce_RxOver) then
        Result := leBuffer
      else if FlagIsSet(LastError, ce_Overrun) then
        Result := leOverrun
      else if FlagIsSet(LastError, ce_RxParity) then
        Result := leParity
      else if FlagIsSet(LastError, ce_Frame) then
        Result := leFraming
      else if FlagIsSet(LastError, ce_Break) then
        Result := leBreak
      else begin
        GotError := False;
        Result := leNoError;
      end;

      {Clear all error flags}
      if GotError then
        LastError := LastError and not AllErrorMask;
    finally
      LeaveCriticalSection(DataSection);
    end;
  end;

  function TApdBaseDispatcher.CheckLineBreak : Boolean;
  begin
    EnterCriticalSection(DataSection);
    try
      Result := FlagIsSet(LastError, ce_Break);
      LastError := LastError and not ce_Break;
    finally
      LeaveCriticalSection(DataSection);
    end;
  end;

  procedure TApdBaseDispatcher.SendBreak(Ticks : Cardinal; Yield : Boolean);
    {Send a line break of Ticks ticks, with yields}
  begin
    { raise RTS for RS485 mode }
    if RS485Mode then                                                    {!!.01}
      SetRTS(True);                                                      {!!.01}
    SetCommBreak(CidEx);
    DelayTicks(Ticks, Yield);
    ClearCommBreak(CidEx);
    { lower RTS only if the output buffer is empty }
    if RS485Mode and (OutBuffUsed = 0) then                              {!!.01}
      SetRTS(False);                                                     {!!.01}
  end;

  procedure TApdBaseDispatcher.SetBreak(BreakOn: Boolean);
    {Sets or clears line break condition}
  begin
    if BreakOn then begin                                                {!!.01}
      if RS485Mode then                                                  {!!.01}
        SetRTS(True);                                                    {!!.01}
      SetCommBreak(CidEx)
    end else begin                                                       {!!.01}
      ClearCommBreak(CidEx);
      if RS485Mode and (OutBuffUsed = 0) then                            {!!.01}
        SetRTS(False);                                                   {!!.01}
    end;                                                                 {!!.01}                                                                     
  end;

  function TApdBaseDispatcher.CharReady : Boolean;
    {-Return True if at least one character is ready at the device driver}
  var
    NewTail : Cardinal;
  begin
    EnterCriticalSection(DispSection);
    try
      if InAvailMessage then begin
        NewTail := DBufTail + GetCount;
        if NewTail >= DispatchBufferSize then
          Dec(NewTail, DispatchBufferSize);
        Result := (DBufHead <> NewTail)
          or (DispatchFull and (GetCount < DispatchBufferSize));
      end else
        Result := (DBufHead <> DBufTail) or DispatchFull;
    finally
      LeaveCriticalSection(DispSection);
    end;
  end;

  function TApdBaseDispatcher.PeekCharPrim(var C : Char; Count : Cardinal) : Integer;
    {-Return the Count'th character but don't remove it from the buffer}
  var
    NewTail : Cardinal;
    InCount : Cardinal;
  begin
    Result := ecOK;
    EnterCriticalSection(DispSection);
    try
      if DBufHead > DBufTail then
        InCount := DBufHead-DBufTail
      else if DBufHead <> DBufTail then
        InCount := ((DBufHead+DispatchBufferSize)-DBufTail)
      else if DispatchFull then
        InCount := DispatchBufferSize
      else
        InCount := 0;

      if InCount >= Count then begin
        {Calculate index of requested character}
        NewTail := DBufTail + (Count - 1);
        if NewTail >= DispatchBufferSize then
          NewTail := (NewTail - DispatchBufferSize);
        C := DBuffer^[NewTail];
      end else
        Result := ecBufferIsEmpty;
    finally
      LeaveCriticalSection(DispSection);
    end;
  end;

  function TApdBaseDispatcher.PeekChar(var C : Char; Count : Cardinal) : Integer;
    {-Return the Count'th character but don't remove it from the buffer}
    {-Account for GetCount}
  begin
    EnterCriticalSection(DispSection);
    try
      if InAvailMessage then
        Inc(Count, GetCount);
      Result := PeekCharPrim(C, Count);
    finally
      LeaveCriticalSection(DispSection);
    end;
  end;

  function TApdBaseDispatcher.GetChar(var C : Char) : Integer;
    {-Return next char and remove it from buffer}
  begin
    EnterCriticalSection(DispSection);
    try
      {If within an apw_TriggerAvail message then do not physically      }
      {extract the character. It will be removed by the dispatcher after }
      {all trigger handlers have seen it. If not within an               }
      {apw_TriggerAvail message then physically extract the character    }

      if InAvailMessage then begin
        Inc(GetCount);
        Result := PeekCharPrim(C, GetCount);
        if Result < ecOK then begin
          Dec(GetCount);
          Exit;
        end;
      end else begin
        Result := PeekCharPrim(C, 1);
        if Result >= ecOK then begin
          {Increment the tail index}
          Inc(DBufTail);
          if DBufTail = DispatchBufferSize then
            DBufTail := 0;
          DispatchFull := False;
        end;
      end;

      if TracingOn
      and (Result >= ecOK) then
        AddTraceEntry('R', C);
    finally
      LeaveCriticalSection(DispSection);
    end;
  end;

  function TApdBaseDispatcher.PeekBlockPrim(Block : PChar;
    Offset : Cardinal; Len : Cardinal; var NewTail : Cardinal) : Integer;
    {-Return Block from ComPort, return new tail value}
  var
    Count : Cardinal;
    EndCount : Cardinal;
    BeginCount : Cardinal;
  begin
    EnterCriticalSection(DispSection);
    try
      {Get count}
      Count := BuffCount(DBufHead, DBufTail, DispatchFull);

      {Set new tail value}
      NewTail := DBufTail + Offset;
      if NewTail >= DispatchBufferSize then
        Dec(NewTail, DispatchBufferSize);

      if Count >= Len then begin
        {Set begin/end buffer counts}
        if NewTail+Len < DispatchBufferSize then begin
          EndCount := Len;
          BeginCount := 0;
        end else begin
          EndCount := (DispatchBufferSize-NewTail);
          BeginCount := Len-EndCount;
        end;

        if EndCount <> 0 then begin
          {Move data from end of dispatch buffer}
          Move(DBuffer^[NewTail], Pointer(Block)^, EndCount);
          Inc(NewTail, EndCount);
        end;

        if BeginCount <> 0 then begin
          {Move data from beginning of dispatch buffer}
          Move(DBuffer^[0],
               PByteBuffer(Block)^[EndCount+1],
               BeginCount);
          NewTail := BeginCount;
        end;

        {Wrap newtail}
        if NewTail = DispatchBufferSize then
          NewTail := 0;

        Result := Len;
      end else
        Result := ecBufferIsEmpty;
    finally
      LeaveCriticalSection(DispSection);
    end;
  end;

  function TApdBaseDispatcher.PeekBlock(Block : PChar; Len : Cardinal) : Integer;
    {-Return Block from ComPort but don't set new tail value}
  var
    Tail : Cardinal;
    Offset : Cardinal;
  begin
    EnterCriticalSection(DispSection);
    try
      {Get block}
      if InAvailMessage then
        Offset := GetCount
      else
        Offset := 0;
      Result := PeekBlockPrim(Block, Offset, Len, Tail);
    finally
      LeaveCriticalSection(DispSection);
    end;
  end;

  function TApdBaseDispatcher.GetBlock(Block : PChar; Len : Cardinal) : Integer;
    {-Get Block from ComPort and set new tail}
  var
    Tail : Cardinal;
    I : Cardinal;
  begin
    EnterCriticalSection(DispSection);
    try
      { If within an apw_TriggerAvail message then do not physically }
      { extract the data. It will be removed by the dispatcher after }
      { all trigger handlers have seen it. If not within an          }
      { apw_TriggerAvail message, then physically extract the data   }

      if InAvailMessage then begin
        Result := PeekBlockPrim(Block, GetCount, Len, Tail);
        if Result > 0 then
          Inc(GetCount, Result);
      end else begin
        Result := PeekBlockPrim(Block, 0, Len, Tail);
        if Result > 0 then begin
          DBufTail := Tail;
          DispatchFull := False;
        end;
      end;
    finally
      LeaveCriticalSection(DispSection);
    end;

    EnterCriticalSection(DataSection);
    try
      if TracingOn and (Result > 0) then