📄 awymodem.pas
字号:
{Manually reset status vars before getting a file header}
aSrcFileLen := 0;
aBytesRemaining := 0;
aBytesTransferred := 0;
aElapsedTicks := 0;
aBlockNum := 0;
aPathname[0] := #0;
aHandshakeAttempt := 0;
{Get a ymodem header block}
FillChar(yFileHeader^, SizeOf(yFileHeader^)+XmodemOverhead, 0);
x1KMode := False;
aCheckType := bcCrc16;
BlockSize := 128;
aBlockNum := 0;
xOverheadLen := 4;
{Testing shows a short delay is required here for Telix}
Dispatcher.SetTimerTrigger(aTimeoutTrigger, TelixDelay, True);
yYmodemState := ryDelay;
end;
ryDelay :
if Integer(TriggerID) = aTimeoutTrigger then begin
{Finished with Telix delay, send handshake}
xHandshake := xpGetHandshakeChar(P);
PutChar(xHandshake);
xEotCounter := 0;
xCanCounter := 0;
{Start waiting for handshake reply}
yYmodemState := ryWaitForHSReply;
Dispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
end;
ryWaitForHSReply :
if TriggerID = aDataTrigger then begin
{Got handshake reply, see if it's a block start}
yYmodemState := ryWaitForBlockStart;
if xGMode then
xMaxBlockErrors := 0;
{Force a fresh timer for each file}
aTimerStarted := False;
end else if Integer(TriggerID) = aTimeoutTrigger then begin
{Timeout waiting for handshake reply, resend or fail}
Inc (aHandshakeAttempt);
if aHandshakeAttempt > aHandshakeRetry then begin
apProtocolError(P, ecTimeout);
yYmodemState := ryFinished
end else begin
if aBlockErrors > xMaxBlockErrors then
xHandshake := ChkReq;
Dispatcher.PutChar(xHandshake);
Dispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
end;
end;
ryWaitForBlockStart :
if TriggerID = aDataTrigger then begin
{Got data, see if it's a block start character}
if xpCheckForBlockStart(P, C) then begin
case xpProcessBlockStart(P, C) of
pbs128, pbs1024 :
begin
if not aTimerStarted then begin
aTimerStarted := True;
NewTimer(aTimer, 1);
end;
yYmodemState := ryCollectBlock;
end;
pbsCancel, pbsEOT :
yYmodemState := ryFinished;
end;
end;
end else if Integer(TriggerID) = aTimeoutTrigger then
{Timeout out waiting for rest of block, quit or resend handshake}
if CheckErrors then
yYmodemState := ryFinished
else
yYmodemState := ryInitial;
ryCollectBlock :
if TriggerID = aDataTrigger then begin
{Collect new data into DataBlock}
if xpCollectBlock(P, yFileHeader^) then
yYmodemState := ryProcessBlock;
end else if Integer(TriggerID) = aTimeoutTrigger then
{Timeout out collecting initial block, quit or resend handshake}
if CheckErrors then
yYmodemState := ryFinished
else
yYmodemState := ryInitial;
ryProcessBlock :
begin
{Go process data already in DataBlock}
xpReceiveBlock(P, yFileHeader^, BlockSize, xHandshake);
xpSendHandshakeChar(P, xHandshake);
{Extract file info if we got block ok}
if aProtocolError = ecOK then begin
{Finished if entire block is null}
Finished := True;
I := 3;
while (I < 120) and Finished do begin
if yFileHeader^[I] <> #0 then
Finished := False;
Inc(I);
end;
{If finished, send last ack and exit}
if Finished then begin
yYmodemState := ryFinished;
goto ExitPoint;
end;
{$IFDEF HugeStr}
SetLength(S, 1024);
{$ENDIF}
{Extract the file name from the header}
BlockPos := 3;
I := 0;
while (yFileHeader^[BlockPos] <> #0) and
(BlockPos < fsPathName+2) do begin
Inc(I);
S[I] := yFileHeader^[BlockPos];
if S[I] = '/' then
S[I] := '\';
Inc(BlockPos);
end;
SLen := I;
if aUpcaseFileNames then begin
{$IFDEF HugeStr}
SetLength(S, SLen);
AnsiUpperBuff(PChar(S), SLen);
{$ELSE}
AnsiUpperBuff(@S[1], SLen);
{$ENDIF}
end;
StrPCopy(aPathname, S);
if not FlagIsSet(aFlags, apHonorDirectory) then begin
Name := ExtractFileName(S);
StrPCopy(NameExt, Name);
AddBackSlashZ(aPathName, aDestDir);
StrLCat(aPathName, NameExt, SizeOf(aPathName));
end;
{Extract the file size}
I := 1;
Inc(BlockPos);
while (yFileHeader^[BlockPos] <> #0) and
(yFileHeader^[BlockPos] <> ' ') and
(I <= 255) do begin
S1[I] := yFileHeader^[BlockPos];
Inc(I);
Inc(BlockPos);
end;
Dec(I);
S1Len := I;
if S1Len = 0 then
aSrcFileLen := 0
else begin
Val(S1, aSrcFileLen, Code);
if Code <> 0 then
aSrcFileLen := 0;
end;
aBytesRemaining := aSrcFileLen;
{Extract the file date/time stamp}
I := 1;
Inc(BlockPos);
while (yFileHeader^[BlockPos] <> #0) and
(yFileHeader^[BlockPos] <> ' ') and
(I <= 255) do begin
S1[I] := yFileHeader^[BlockPos];
Inc(I);
Inc(BlockPos);
end;
Dec(I);
S1Len := I;
if S1Len = 0 then
yNewDT := 0
else begin
yNewDT := apOctalStr2Long(S1);
if yNewDT = 0 then begin
{Invalid char in date/time stamp, show the error and continue}
yNewDT := 0;
aProtocolStatus := psInvalidDate;
apShowStatus(P, 0);
end;
end;
{Manually reset status vars before getting file}
aBytesTransferred := 0;
aElapsedTicks := 0;
{Receive the file using CRC and 1K blocks}
x1KMode := True;
aCheckType := bcCrc16;
aBlockLen := 1024;
ySaveLen := aSrcFileLen;
{Go prep Xmodem}
yYmodemState := ryPrepXmodem;
end else
{Error getting name block...}
if xGMode then
{Can't recover when in GMode, go quit}
yYmodemState := ryFinished
else begin
{Nak already sent, go get block again}
yYmodemState := ryWaitForHSReply;
Dispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
end;
end;
ryPrepXmodem :
begin
xXmodemState := rxInitial;
aDataBlock := nil;
apResetStatus(P);
aProtocolStatus := psProtocolHandshake;
yYmodemState := ryReceiveXmodem;
ExitStateMachine := False;
aSrcFileLen := ySaveLen;
end;
ryReceiveXmodem :
begin
ExitStateMachine := True;
XState := xpReceivePrim(apw_FromYmodem, TriggerID, lParam);
if XState = 1 then begin
if aProtocolError = ecOK then begin
{If this is a file, check for truncation and file date}
Assign(F, aPathname);
Reset(F, 1);
if IOResult = 0 then begin
{If a new file size was supplied, truncate to that length}
if ySaveLen <> 0 then begin
{Get the file size of the file (as received)}
CurSize := FileSize(F);
{If the requested file size is within one block, truncate the file}
if (CurSize - ySaveLen) < 1024 then begin
Seek(F, ySaveLen);
Truncate(F);
Res := IOResult;
if Res <> 0 then begin
apProtocolError(P, Res);
yYmodemState := ryFinished;
goto ExitPoint;
end;
end;
end;
{If a new date/time stamp was specified, update the file time}
if yNewDT <> 0 then begin
yNewDT := apYMTimeStampToPack(yNewDT);
FileSetDate(TFileRec(F).Handle, yNewDT);
end;
end;
Close(F);
if IOResult <> 0 then ;
{Go look for another file}
yYmodemState := ryInitial;
Dispatcher.SetTimerTrigger(aTimeoutTrigger, aHandshakeWait, True);
aForceStatus := True;
end else
yYmodemState := ryFinished;
end;
end;
ryFinished :
begin
apShowLastStatus(P);
apSignalFinish(P);
yYmodemState := ryDone;
end;
end;
ExitPoint:
{Set function result}
case yYmodemState of
{Stay in state machine}
ryInitial,
ryOpenFile,
ryProcessBlock,
ryFinished,
ryPrepXmodem : Finished := False;
{Leave only if no data waiting}
ryWaitForBlockStart,
ryCollectBlock : begin
Finished := not CharReady;
TriggerID := aDataTrigger;
end;
{Stay or leave as previously specified}
ryReceiveXmodem : Finished := ExitStateMachine;
{Leave state machine}
ryDone,
ryDelay,
ryWaitForHSReply : 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;
end;
{$IFDEF Win32} {!!.01}
LeaveCriticalSection(P^.aProtSection); {!!.01}
{$ENDIF} {!!.01}
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -