⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 awuser.pas

📁 测试用例
💻 PAS
📖 第 1 页 / 共 5 页
字号:
          {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
        for I := 0 to Result-1 do
          AddTraceEntry('R', Block[I]);
    finally
      LeaveCriticalSection(DataSection);
    end;
  end;

  function TApdBaseDispatcher.PutChar(C : Char) : Integer;
    {-Route through PutBlock to transmit a single character}
  begin
    Result := PutBlock(C, 1);
  end;

  function TApdBaseDispatcher.PutString(S : String) : Integer;
    {-Send as a block}
  begin
    Result := PutBlock(S[1], Length(S));
  end;

  procedure TApdBaseDispatcher.AddStringToLog(S : string);
  begin
    if DLoggingOn then
      AddDispatchEntry(dtUser, dstNone, 0, @S[1], length(S))
  end;

  function TApdBaseDispatcher.PutBlock(const Block; Len : Cardinal) : Integer;
    {-Send Block to CommPort}
  var
    Avail    : Cardinal;
    I        : Cardinal;
    CharsOut : Integer;           {Chars transmitted from last block}
  begin
    {Exit immediately if nothing to do}
    Result := ecOK;
    if Len = 0 then
      Exit;

    EnterCriticalSection(OutputSection);
    try
      { Is there enough free space in the outbuffer? }
      LastError := GetComError(ComStatus);
      Avail := OutQue - ComStatus.cbOutQue;
      if Avail < Len then begin
        Result := ecOutputBufferTooSmall;
        Exit;
      end;
      if Avail = Len then
        OBufFull := True;

      { Raise RTS if in RS485 mode. In 32bit mode it will be lowered  }
      { by the output thread. }
      if Win32Platform <> VER_PLATFORM_WIN32_NT then
        if RS485Mode then begin
          if BaseAddress = 0 then begin
            Result := ecBaseAddressNotSet;
            Exit;
          end;
          SetRTS(True);
        end;

      {Send the data}
      CharsOut := WriteCom(PChar(@Block), Len);
      if CharsOut <= 0 then begin
        CharsOut := Abs(CharsOut);
        Result := ecPutBlockFail;
        LastError := GetComError(ComStatus);
      end;

      {Flag output trigger}
      OutSentPending := True;
    finally
      LeaveCriticalSection(OutputSection);
    end;

    EnterCriticalSection(DataSection);
    try
      if DLoggingOn then
        if CharsOut = 0 then
          AddDispatchEntry(dtDispatch, dstWriteCom, 0, nil, 0)
        else
          AddDispatchEntry(dtDispatch, dstWriteCom, CharsOut,
                            PChar(@Block), CharsOut);

      if TracingOn and (CharsOut <> 0) then
        for I := 0 to CharsOut-1 do
          AddTraceEntry('T', PChar(@Block)[I]);
    finally
      LeaveCriticalSection(DataSection);
    end;
  end;

  function TApdBaseDispatcher.InBuffUsed : Cardinal;
    {-Return number of bytes currently in input buffer}
  begin
    EnterCriticalSection(DispSection);
    try
      if DBufHead = DBufTail then
        if DispatchFull then
          Result := DispatchBufferSize
        else
          Result := 0
      else if DBufHead > DBufTail then
        Result := DBufHead-DBufTail
      else
        Result := (DBufHead+DispatchBufferSize)-DBufTail;

      if InAvailMessage then
        {In apw_TriggerAvail message so reduce by retrieved chars}
        Dec(Result, GetCount);
    finally
      LeaveCriticalSection(DispSection);
    end;
  end;

  function TApdBaseDispatcher.InBuffFree : Cardinal;
    {-Return number of bytes free in input buffer}
  begin
    EnterCriticalSection(DispSection);
    try
      if DBufHead = DBufTail then
        if DispatchFull then
          Result := 0
        else
          Result := DispatchBufferSize
      else if DBufHead > DBufTail then
        Result := (DBufTail+DispatchBufferSize)-DBufHead
      else
        Result := DBufTail-DBufHead;

      if InAvailMessage then
        {In apw_TriggerAvail message so reduce by retrieved chars}
        Inc(Result, GetCount);
    finally
      LeaveCriticalSection(DispSection);
    end;
  end;

  function TApdBaseDispatcher.OutBuffUsed : Cardinal;
    {-Return number of bytes currently in output buffer}
  begin
    EnterCriticalSection(OutputSection);
    try
      RefreshStatus;
      Result := ComStatus.cbOutQue;
    finally
      LeaveCriticalSection(OutputSection);
    end;
  end;

  function TApdBaseDispatcher.OutBuffFree : Cardinal;
    {-Return number of bytes free in output buffer}
  begin
    EnterCriticalSection(OutputSection);
    try
      RefreshStatus;
      Result := OutQue - ComStatus.cbOutQue;
    finally
      LeaveCriticalSection(OutputSection);
    end;
  end;

  function TApdBaseDispatcher.FlushOutBuffer : Integer;
    {-Flush the output buffer}
  begin
    Result := FlushCom(0);
  end;

  function TApdBaseDispatcher.FlushInBuffer : Integer;
  begin
    EnterCriticalSection(DispSection);
    try
      {Flush COMM buffer}
      Result := FlushCom(1);

      {Flush the dispatcher's buffer}
      if InAvailMessage then
        MaxGetCount := BuffCount(DBufHead, DBufTail, DispatchFull)
      else begin
        DBufTail := DBufHead;
        GetCount := 0;
      end;
      DispatchFull := False;

      {Reset data triggers}
      ResetDataTriggers;
    finally
      LeaveCriticalSection(DispSection);
    end;
  end;

  procedure TApdBaseDispatcher.BufferSizes(var InSize, OutSize : Cardinal);
    {-Return buffer sizes}
  begin
    InSize := InQue;
    OutSize := OutQue;
  end;

  function TApdBaseDispatcher.HWFlowOptions(
                         BufferFull, BufferResume : Cardinal;
                         Options : Cardinal) : Integer;
    {-Turn on hardware flow control}
  begin
    {Validate the buffer points}
    if (BufferResume > BufferFull) or
       (BufferFull > InQue) then begin
      Result := ecBadArgument;
      Exit;
    end;

    EnterCriticalSection(DataSection);
    try
      GetComState(DCB);
      with DCB do begin
        Flags := Flags and not (AllHdwFlow);
        Flags := Flags and not (dcb_DTRBit1 or dcb_RTSBit1);
        DtrAuto := False;
        RtsAuto := False;

        {Receive flow control, set requested signal(s)}
        if FlagIsSet(Options, hfUseDtr) then begin
          Flags := Flags or dcb_DTR_CONTROL_HANDSHAKE;
          DtrAuto := True;
        end else begin
          { If static DTR wanted }
          if DTRState then
            { then assert DTR }
            Flags := Flags or dcb_DTR_CONTROL_ENABLE;
        end;

        if FlagIsSet(Options, hfUseRts) then begin
          Flags := Flags or dcb_RTS_CONTROL_HANDSHAKE;
          RtsAuto := True;
        end else begin
          { If static RTS wanted }
          if RTSState then
            {  then assert RTS }
            Flags := Flags or dcb_RTS_CONTROL_ENABLE;
        end;

        if RS485Mode and (Win32Platform = VER_PLATFORM_WIN32_NT) then begin
          Flags := Flags or dcb_RTS_CONTROL_TOGGLE;
          RtsAuto := True;
        end;

        {Set receive flow buffer limits}
        XoffLim := InQue - BufferFull;
        XonLim := BufferResume;

        {Transmit flow control, set requested signal(s)}
        if FlagIsSet(Options, hfRequireDsr) then
          Flags := Flags or dcb_OutxDsrFlow;

        if FlagIsSet(Options, hfRequireCts) then
          Flags := Flags or dcb_OutxCtsFlow;

        {Set new DCB}
        Result := SetCommStateFix(DCB);
      end;
    finally
      LeaveCriticalSection(DataSection);
    end;
  end;

  function TApdBaseDispatcher.HWFlowState : Integer;
    {-Returns state of flow control}
  begin
    with DCB do begin
      EnterCriticalSection(DataSection);
      try
        if not FlagIsSet(Flags, AllHdwFlow) then begin
          Result := fsOff;
          Exit;
        end else
          Result := fsOn;

        if Flags and InHdwFlow <> 0 then begin
          {Get latest flow status}
          RefreshStatus;

          {Set appropriate flow state}
          if (Flags and dcb_OutxDsrFlow <> 0) and
             (fDsrHold in ComStatus.Flags) then
            Result := fsDsrHold;

          if (Flags and dcb_OutxCtsFlow <> 0) and
             (fCtlHold in ComStatus.Flags) then
            Result := fsCtsHold;
        end;
      finally
        LeaveCriticalSection(DataSection);
      end;
    end;
  end;

  function TApdBaseDispatcher.SWFlowEnable(
                         BufferFull, BufferResume : Cardinal;
                         Options : Cardinal) : Integer;
    {-Turn on software flow control}
  begin
    {Validate the buffer points}
    if (BufferResume > BufferFull) or
       (BufferFull > InQue) then begin
      Result := ecBadArgument;
      Exit;
    end;

    EnterCriticalSection(DataSection);
    try
      { Make sure we have an up-to-date DCB }
      GetComState(DCB);
      with DCB do begin
        if FlagIsSet(Options, sfReceiveFlow) then begin
          {Receive flow control}

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -