📄 awuser.pas
字号:
{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 + -