📄 awxmodem.pas
字号:
{Stay in state machine if data available}
txEotReply,
txDraining,
txReplyPending,
txHandshake : Finished := not CharReady;
{Finished with state machine}
txWaitFreeSpace,
txEndDrain,
txDone : Finished := True
else Finished := True;
end;
{Force data trigger if staying in state machine}
TriggerID := aDataTrigger;
except {!!.01}
on EAccessViolation do begin {!!.01}
Finished := True; {!!.01}
aProtocolError := ecAbortNoCarrier; {!!.01}
apSignalFinish(P); {!!.01}
end; {!!.01}
end; {!!.01}
until Finished;
end;
{$IFDEF Win32} {!!.01}
LeaveCriticalSection(P^.aProtSection); {!!.01}
{$ENDIF} {!!.01}
end;
end;
procedure xpTransmit(Msg, wParam : Cardinal; lParam : LongInt);
begin
xpTransmitPrim(Msg, wParam, lParam);
end;
procedure xpPrepareReceive(P : PProtocolData);
{-Starts Xmodem receive protocol}
begin
with P^ do begin
{Prepare state machine, show first status}
xXmodemState := rxInitial;
aDataBlock := nil;
apResetStatus(P);
apShowFirstStatus(P);
aForceStatus := False;
aTimerStarted := False;
end;
end;
function xpReceivePrim(Msg, wParam : Cardinal;
lParam : LongInt) : LongInt;
{-Performs one increment of an Xmodem receive}
label
ExitPoint;
var
TriggerID : Cardinal absolute wParam;
P : PProtocolData;
DataPtr : PDataBlock;
Finished : Boolean;
C : Char;
StatusTicks : LongInt;
ValidDispatcher : TApdBaseDispatcher;
procedure Cleanup(DisposeBuffers : Boolean);
{-Handle error reporting and other cleanup}
begin
with P^ do begin
if DisposeBuffers then
FreeMem(aDataBlock, SizeOf(TDataBlock)+XmodemOverhead);
if Msg <> apw_FromYmodem then begin
apShowLastStatus(P);
apSignalFinish(P);
end;
xXmodemState := rxDone;
Result := 1;
end;
end;
function CheckErrors : Boolean;
{-Increment block errors, return True if too many}
begin
with P^ do begin
Inc(aBlockErrors);
Inc(aTotalErrors);
if aBlockErrors > xMaxBlockErrors then begin
CheckErrors := True;
apProtocolError(P, ecTooManyErrors);
aProtocolStatus := psProtocolError;
aForceStatus := True;
end else
CheckErrors := False;
end;
end;
begin
Finished := False; {!!.01}
{Get the protocol pointer from data pointer 1}
try {!!.01}
ValidDispatcher := TApdBaseDispatcher(PortList[LH(lParam).H]);
with ValidDispatcher do
GetDataPointer(Pointer(P), ProtocolDataPtr);
except {!!.01}
on EAccessViolation do begin {!!.01}
{ There is no access to P^ so just exit } {!!.01}
Exit; {!!.01}
end; {!!.01}
end; {!!.01}
with P^ do begin
{$IFDEF Win32}
EnterCriticalSection(aProtSection);
{Exit if protocol was cancelled while waiting for crit section}
if xXmodemState = rxDone then begin
LeaveCriticalSection(aProtSection);
Result := 1;
Exit;
end;
{$ENDIF}
{Set TriggerID directly for TriggerAvail messages}
if Msg = apw_TriggerAvail then
TriggerID := aDataTrigger;
repeat
try {!!.01}
{Return 0 unless finished}
Result := 0;
if ValidDispatcher.Logging then
ValidDispatcher.AddDispatchEntry(
dtXModem,LogXModemState[xXmodemState],0,nil,0);
{Check for user abort}
if ((Integer(TriggerID) = aNoCarrierTrigger) and
not ValidDispatcher.CheckDCD) or
(Msg = apw_ProtocolCancel) then begin
if Msg = apw_ProtocolCancel then begin
xpCancel(P);
aProtocolStatus := psCancelRequested;
end else
aProtocolStatus := psAbortNoCarrier;
xXmodemState := rxFinished;
aForceStatus := True;
end;
{Show status periodically}
if (Integer(TriggerID) = aStatusTrigger) or aForceStatus then begin
if aTimerStarted then
aElapsedTicks := ElapsedTime(aTimer);
if ValidDispatcher.TimerTicksRemaining( aStatusTrigger,
StatusTicks) <> 0 then
StatusTicks := 0;
if StatusTicks <= 0 then begin
apShowStatus(P, 0);
ValidDispatcher.SetTimerTrigger(aStatusTrigger, aStatusInterval, True);
aForceStatus := False;
end;
end;
{Process current state}
case xXmodemState of
rxInitial :
begin
{Get a protocol DataBlock}
aDataBlock := AllocMem(SizeOf(TDataBlock)+XmodemOverhead);
{Pathname should already have name of file to receive}
if aPathname[0] = #0 then begin
apProtocolError(P, ecNoFilename);
xpCancel(P);
Cleanup(True);
{$IFDEF Win32}
LeaveCriticalSection(aProtSection);
{$ENDIF}
Exit;
end else if aUpcaseFileNames then
AnsiUpper(aPathName);
{Send file name to user's LogFile procedure}
apLogFile(P, lfReceiveStart);
{Accept this file}
if not apAcceptFile(P, aPathName) then begin
xpCancel(P);
aProtocolStatus := psFileRejected;
xXmodemState := rxFinishedSkip;
goto ExitPoint;
end;
{Prepare to write file}
apPrepareWriting(P);
if (aProtocolError <> ecOK) or
(aProtocolStatus = psCantWriteFile) then begin
if aProtocolStatus = psCantWriteFile then
aProtocolError := ecCantWriteFile;
xpCancel(P);
xXmodemState := rxFinishedSkip;
goto ExitPoint;
end;
{Start sending handshakes}
aFileOfs := 0;
xXmodemState := rxWaitForHSReply;
xHandshake := xpGetHandshakeChar(P);
xpSendHandshakeChar(P, xHandshake);
aBlockNum := 1;
xEotCounter := 0;
xCanCounter := 0;
ValidDispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
{Set overhead length based on check type}
if xCRCMode then
xOverheadLen := 4
else
xOverheadLen := 3;
end;
rxWaitForHSReply :
if TriggerID = aDataTrigger then begin
xXmodemState := rxWaitForBlockStart;
end else if Integer(TriggerID) = aTimeoutTrigger then begin
if CheckErrors then
xXmodemState := rxFinished
else begin
if (xHandshake = CrcReq) and
(aBlockErrors > MaxCrcTry) then begin
{Step down to Xmodem checksum}
aBlockErrors := 0;
aCheckType := bcChecksum1;
xHandshake := ChkReq;
xCRCMode := False;
Dec(xOverheadLen);
end;
ValidDispatcher.PutChar(xHandshake);
ValidDispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
end;
end;
rxWaitForBlockStart :
if TriggerID = aDataTrigger then begin
{Check for timer start}
if not aTimerStarted then begin
NewTimer(aTimer, 0);
aTimerStarted := True;
if xGMode then
xMaxBlockErrors := 0;
end;
{Process the received character}
if xpCheckForBlockStart(P, C) then begin
case xpProcessBlockStart(P, C) of
pbs128, pbs1024 :
begin
xXmodemState := rxCollectBlock;
ValidDispatcher.SetTimerTrigger(aTimeoutTrigger, xBlockWait, True);
end;
pbsCancel, pbsEOT :
xXmodemState := rxFinished;
end;
end;
end else if Integer(TriggerID) = aTimeoutTrigger then begin
{Timeout waiting for block start}
if xEotCounter <> 0 then begin
{Timeout waiting for second cEot, end normally}
ValidDispatcher.PutChar(cAck);
xXmodemState := rxFinished;
aProtocolStatus := psEndFile;
end else if CheckErrors or (xCanCounter <> 0) then begin
{Too many errors, quit the protocol}
if xCanCounter <> 0 then begin
aProtocolStatus := psCancelRequested;
aForceStatus := True;
end;
xXmodemState := rxFinished;
end else begin
{Simple timeout, resend handshake}
xXmodemState := rxWaitForHSReply;
xpSendHandshakeChar(P, xHandshake);
ValidDispatcher.SetTimerTrigger(aTimeoutTrigger, xBlockWait, True);
end;
end;
rxCollectBlock :
if TriggerID = aDataTrigger then begin
{Got data, collect into DataBlock}
if xpCollectBlock(P, aDataBlock^) then
xXmodemState := rxProcessBlock;
end else if Integer(TriggerID) = aTimeoutTrigger then begin
{Timeout out waiting for complete block, send nak}
ValidDispatcher.PutChar(cNak);
xXmodemState := rxWaitForBlockStart;
aProtocolStatus := psTimeout;
ValidDispatcher.SetTimerTrigger(aTimeoutTrigger, xBlockWait, True);
end;
rxProcessBlock :
begin
{Go process what's in DataBlock}
xpReceiveBlock(P, aDataBlock^, aLastBlockSize, xHandshake);
xpSendHandshakeChar(P, xHandshake);
if aProtocolStatus = psOK then begin
{Got block ok, go write it out (skip blocknum bytes)}
DataPtr := aDataBlock;
DataPtr := AddWordToPtr(DataPtr, 2);
apWriteProtocolBlock(P, DataPtr^, aLastBlockSize);
if aProtocolError <> ecOK then begin
{Failed to write the block, cancel protocol}
xpCancel(P);
xXmodemState := rxFinished;
end else begin
{Normal received block -- keep going}
Inc(aFileOfs, aLastBlockSize);
xXmodemState := rxWaitForBlockStart;
ValidDispatcher.SetTimerTrigger(aTimeoutTrigger, xBlockWait, True);
end;
end else begin
if (aProtocolError <> ecOK) or xGMode then begin
{Fatal error - cancel protocol}
xpCancel(P);
xXmodemState := rxFinished;
end else begin
{Failed to get block, go try again}
xXmodemState := rxWaitForHSReply;
ValidDispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
end;
end;
end;
rxFinishedSkip :
begin
apFinishWriting(P);
apLogFile(P, lfReceiveSkip);
Cleanup(True);
end;
rxFinished :
begin
apFinishWriting(P);
if (aProtocolStatus = psEndFile) then
apLogFile(P, lfReceiveOk)
else
apLogFile(P, lfReceiveFail);
Cleanup(True);
end;
end;
ExitPoint:
{Should we exit or not}
case xXmodemState of
{Stay in state machine}
rxProcessBlock,
rxFinishedSkip,
rxFinished : Finished := False;
{Stay in state machine if data available}
rxWaitForBlockStart,
rxCollectBlock : begin
Finished := not ValidDispatcher.CharReady;
TriggerID := aDataTrigger;
end;
{Finished with state machine}
rxInitial,
rxWaitForHSReply,
rxDone : Finished := True
else Finished := True;
end;
except {!!.01}
on EAccessViolation do begin {!!.01}
Finished := True; {!!.01}
aProtocolError := ecAbortNoCarrier; {!!.01}
apSignalFinish(P); {!!.01}
end; {!!.01}
end; {!!.01}
until Finished;
{$IFDEF Win32} {!!.01}
LeaveCriticalSection(P^.aProtSection); {!!.01}
{$ENDIF} {!!.01}
end;
end;
procedure xpReceive(Msg, wParam : Cardinal; lParam : LongInt);
begin
xpReceivePrim(Msg, wParam, lParam);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -