eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A27

This commit is contained in:
mysticbbs 2013-03-07 10:39:03 -05:00
parent 6df04fce4d
commit 2266061d05
2 changed files with 398 additions and 398 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
mdl/m_ops.pas
View File

@ -28,6 +28,8 @@
------------------------------------------------------------------------- -------------------------------------------------------------------------
} }
{.$DEFINE NEWEDITOR}
{.$DEFINE DEBUG} {.$DEFINE DEBUG}
{$DEFINE RELEASE} {$DEFINE RELEASE}
{.$DEFINE LOGGING} {.$DEFINE LOGGING}

604
mdl/m_prot_zmodem.pas
View File

@ -25,31 +25,31 @@ Const
ZMaxBlk : Array[Boolean] of Word = (1024, 8192); ZMaxBlk : Array[Boolean] of Word = (1024, 8192);
ZMaxWrk : Array[Boolean] of Word = (2048, 16384); ZMaxWrk : Array[Boolean] of Word = (2048, 16384);
ZPad = '*'; {Pad} ZPad = '*';
ZDle = ^X; {Data link escape} ZDle = ^X;
ZDleE = 'X'; {An escaped data link escape character} ZDleE = 'X';
ZBin = 'A'; {Binary header using Crc16} ZBin = 'A';
ZHex = 'B'; {Hex header using Crc16} ZHex = 'B';
ZBin32 = 'C'; {Binary header using Crc32} ZBin32 = 'C';
ZrQinit = #0; {Request init7 (to receiver)} ZrQinit = #0;
ZrInit = #1; {Init (to sender)} ZrInit = #1;
ZsInit = #2; {Init (to receiver) (optional)} ZsInit = #2;
ZAck = #3; {Acknowledge last frame} ZAck = #3;
ZFile = #4; {File info frame (to receiver)} ZFile = #4;
ZSkip = #5; {Skip to next file (to receiver)} ZSkip = #5;
ZNak = #6; {Error receiving last data subpacket} ZNak = #6;
ZAbort = #7; {Abort protocol} ZAbort = #7;
ZFin = #8; {Finished protocol} ZFin = #8;
ZRpos = #9; {Resume from this file position} ZRpos = #9;
ZData = #10; {Data subpacket(s) follows} ZData = #10;
ZEof = #11; {End of current file} ZEof = #11;
ZFerr = #12; {Error reading or writing file} ZFerr = #12;
ZCrc = #13; {Request for file CRC (to receiver)} ZCrc = #13;
ZChallenge = #14; {Challenge the sender} ZChallenge = #14;
ZCompl = #15; {Complete} ZCompl = #15;
ZCan = #16; {Cancel requested (to either)} ZCan = #16;
ZFreeCnt = #17; {Request diskfree} ZFreeCnt = #17;
ZCommand = #18; {Execute this command (to receiver)} ZCommand = #18;
// WriteNewerLonger = 1; {Transfer if new, newer or longer} // WriteNewerLonger = 1; {Transfer if new, newer or longer}
// WriteCrc = 2; {Not supported, same as WriteNewer} // WriteCrc = 2; {Not supported, same as WriteNewer}
@ -150,13 +150,13 @@ Type
AllowResume : Boolean; AllowResume : Boolean;
FinishWait : Word; {Wait time for ZFin response} FinishWait : Word; {Wait time for ZFin response}
FinishRetry : Byte; {Times to resend ZFin} FinishRetry : Byte; {Times to resend ZFin}
LastFrame : Char; {Holds last frame type for status} LastFrame : Char;
EscapeAll : Boolean; {True when escaping all ctl chrs} EscapeAll : Boolean;
Use8KBlocks : Boolean; {True when using 8K blocks} Use8KBlocks : Boolean;
TookHit : Boolean; {True if we got ZrPos packet} TookHit : Boolean; {True if we got ZrPos packet}
GoodAfterBad : Word; {Holds count of good blocks} GoodAfterBad : Word;
ZmodemState : ZmodemStateType; {Current Zmodem state} ZmodemState : ZmodemStateType;
HeaderState : HeaderStateType; {Current Header state} HeaderState : HeaderStateType;
ReplyTimer : LongInt; ReplyTimer : LongInt;
WorkSize : LongInt; {Index into working buffer} WorkSize : LongInt; {Index into working buffer}
LastBlock : Boolean; {True if no more blocks} LastBlock : Boolean; {True if no more blocks}
@ -164,7 +164,7 @@ Type
HexByte : Byte; {Used to assemble hex byte} HexByte : Byte; {Used to assemble hex byte}
HexPending : Boolean; {True for next char in hex pair} HexPending : Boolean; {True for next char in hex pair}
EscapePending : Boolean; {True for next char in esc pair} EscapePending : Boolean; {True for next char in esc pair}
ControlCharSkip : Boolean; {True when skipping ctl chars} {!!.01} ControlCharSkip : Boolean;
HeaderType : Char; {Current header type} HeaderType : Char; {Current header type}
HexHdrState : HexHeaderStates; {Current hex header state} HexHdrState : HexHeaderStates; {Current hex header state}
BinHdrState : BinaryHeaderStates; {Current binary header state} BinHdrState : BinaryHeaderStates; {Current binary header state}
@ -176,8 +176,8 @@ Type
LastStatus : Word; {Status to set in zpReceiveBlock} LastStatus : Word; {Status to set in zpReceiveBlock}
OCnt : Byte; {Count of O's recvd (for 'OO')} OCnt : Byte; {Count of O's recvd (for 'OO')}
DataInTransit : Word; {Bytes transmitted in window} DataInTransit : Word; {Bytes transmitted in window}
WasHex : Boolean; {True if last header was hex} {!!.03} WasHex : Boolean; {True if last header was hex}
DiscardCnt : Word; {Count chars before sendblock} {!!.03} DiscardCnt : Word; {Count chars before sendblock}
DataBlock : ^DataBlockType; {Standard data block} DataBlock : ^DataBlockType; {Standard data block}
DataBlockLen : Word; {Count of valid data in DataBlock} DataBlockLen : Word; {Count of valid data in DataBlock}
WorkBlock : ^WorkBlockType; {Holds fully escaped data block} WorkBlock : ^WorkBlockType; {Holds fully escaped data block}
@ -192,27 +192,27 @@ Type
Procedure SetFileMgmtOptions (Override, SkipNoFile: Boolean; FOpt: Byte); Procedure SetFileMgmtOptions (Override, SkipNoFile: Boolean; FOpt: Byte);
Procedure SetFinishWait (NewWait: Word; NewRetry: Byte); Procedure SetFinishWait (NewWait: Word; NewRetry: Byte);
procedure PrepareTransmitPart; Virtual; Procedure PrepareTransmitPart; Virtual;
function ProtocolTransmitPart : ProtocolStateType; virtual; Function ProtocolTransmitPart : ProtocolStateType; virtual;
procedure PrepareReceivePart; Virtual; Procedure PrepareReceivePart; Virtual;
function ProtocolReceivePart : ProtocolStateType; virtual; Function ProtocolReceivePart : ProtocolStateType; virtual;
procedure UpdateBlockCheck (CurByte: Byte); virtual; Procedure UpdateBlockCheck (CurByte: Byte); virtual;
procedure SendBlockCheck; Virtual; Procedure SendBlockCheck; Virtual;
function VerifyBlockCheck : Boolean; virtual; Function VerifyBlockCheck : Boolean; virtual;
procedure CancelTransfer; Virtual; Procedure CancelTransfer; Virtual;
procedure zpGetCharStripped (Var C: Char); Procedure GetCharStripped (Var C: Char);
procedure PutAttentionString; Procedure PutAttentionString;
procedure zpPutCharHex (C: Char); Procedure PutCharHex (C: Char);
procedure zpPutHexHeader (FrameType: Char); Procedure PutHexHeader (FrameType: Char);
procedure zpGetCharEscaped (Var C: Char); Procedure GetCharEscaped (Var C: Char);
procedure zpGetCharHex (Var C: Char); Procedure zpGetCharHex (Var C: Char);
function zpCollectHexHeader : Boolean; Function zpCollectHexHeader : Boolean;
function zpCollectBinaryHeader (Crc32: Boolean) : Boolean; Function zpCollectBinaryHeader (Crc32: Boolean) : Boolean;
procedure zpCheckForHeader; Procedure zpCheckForHeader;
procedure apPrepareWriting; Virtual; Procedure apPrepareWriting; Virtual;
procedure apFinishWriting; Virtual; Procedure apFinishWriting; Virtual;
procedure zpWriteDataBlock; Procedure WriteDataBlock;
function zpReceiveBlock (Var Block: DataBlockType; Var BlockSize: Word; Var Handshake: Char) : Boolean; Function ReceiveBlock (Var Block: DataBlockType; Var BlockSize: Word; Var Handshake: Char) : Boolean;
Procedure ExtractFileInfo; Procedure ExtractFileInfo;
Procedure InsertFileInfo; Virtual; Procedure InsertFileInfo; Virtual;
Procedure ExtractReceiverInfo; Procedure ExtractReceiverInfo;
@ -253,14 +253,14 @@ Const
ZRub0 = 'l'; {Translate to $7F} ZRub0 = 'l'; {Translate to $7F}
ZRub1 = 'm'; {Translate to $FF} ZRub1 = 'm'; {Translate to $FF}
ZF0 = 3; {Flag byte 3} ZF0 = 3;
ZF1 = 2; {Flag byte 2} ZF1 = 2;
ZF2 = 1; {Flag byte 1} ZF2 = 1;
ZF3 = 0; {Flag byte 0} ZF3 = 0;
ZP0 = 0; {Position byte 0} ZP0 = 0;
ZP1 = 1; {Position byte 1} ZP1 = 1;
ZP2 = 2; {Position byte 2} ZP2 = 2;
ZP3 = 3; {Position byte 3} ZP3 = 3;
CanFdx = $0001; CanFdx = $0001;
CanOvIO = $0002; CanOvIO = $0002;
@ -301,14 +301,14 @@ Begin
FinishRetry := DefFinishRetry; FinishRetry := DefFinishRetry;
EscapeAll := False; EscapeAll := False;
DataBlock := GetMem(ZMaxBlk[Use8KBlocks]); DataBlock := GetMem (ZMaxBlk[Use8KBlocks]);
WorkBlock := GetMem(ZMaxWrk[Use8KBlocks]); WorkBlock := GetMem (ZMaxWrk[Use8KBlocks]);
End; End;
Destructor ZmodemProtocol.Done; Destructor ZmodemProtocol.Done;
Begin Begin
FreeMem(DataBlock, ZMaxBlk[Use8KBlocks]); FreeMem (DataBlock, ZMaxBlk[Use8KBlocks]);
FreeMem(WorkBlock, ZMaxWrk[Use8KBlocks]); FreeMem (WorkBlock, ZMaxWrk[Use8KBlocks]);
AbstractProtocol.Done; AbstractProtocol.Done;
End; End;
@ -392,166 +392,160 @@ Begin
ProtocolStatus := ecCancelRequested; ProtocolStatus := ecCancelRequested;
End; End;
procedure ZmodemProtocol.zpGetCharStripped(var C : Char); Procedure ZmodemProtocol.GetCharStripped (Var C: Char);
{-Get next char, strip hibit, discard Xon/Xoff} Begin
begin Repeat
{Get a character, discard Xon and Xoff} With APort Do
repeat If DataWaiting Then
with APort do
if DataWaiting then
C := ReadChar C := ReadChar
else Else
ProtocolStatus := ecBufferIsEmpty ProtocolStatus := ecBufferIsEmpty
until not (C in [cXon, cXoff]) or (ProtocolStatus <> ecOk) or not APort.connected; Until Not (C in [cXon, cXoff]) or (ProtocolStatus <> ecOk) or not APort.Connected;
{Strip the high-order bit}
C := Char(Ord(C) and Ord(#$7F)); C := Char(Ord(C) and Ord(#$7F));
{Handle cancels} If C = cCan Then Begin
if C = cCan then begin Inc (CanCount);
Inc(CanCount);
if CanCount >= 5 then If CanCount >= 5 Then
ProtocolStatus := ecCancelRequested; ProtocolStatus := ecCancelRequested;
end else End Else
CanCount := 0; CanCount := 0;
end; End;
Procedure ZmodemProtocol.PutAttentionString; Procedure ZmodemProtocol.PutAttentionString;
Var Var
I : Word; Count : Word;
Begin Begin
I := 1; Count := 1;
While AttentionStr[I] <> 0 Do Begin While AttentionStr[Count] <> 0 Do Begin
Case AttentionStr[I] of Case AttentionStr[Count] of
$DD : ; $DD : ;
$DE : WaitMS(1000); $DE : WaitMS(1000);
Else Else
APort.BufWriteChar(Chr(AttentionStr[I])); APort.BufWriteChar(Chr(AttentionStr[Count]));
End; End;
Inc(I);
Inc (Count);
End; End;
APort.BufFlush; APort.BufFlush;
End; End;
procedure ZmodemProtocol.zpPutCharHex(C : Char); Procedure ZmodemProtocol.PutCharHex (C: Char);
{-Sends C as two hex ascii digits} Var
var B : Byte Absolute C;
B : Byte absolute C; Begin
begin
APort.BufWriteChar(HexDigits[B shr 4]); APort.BufWriteChar(HexDigits[B shr 4]);
APort.BufWriteChar(HexDigits[B and $0F]); APort.BufWriteChar(HexDigits[B and $0F]);
end; End;
procedure ZmodemProtocol.zpPutHexHeader(FrameType : Char); Procedure ZmodemProtocol.PutHexHeader (FrameType: Char);
{-Sends a hex header} Var
const
HexHeaderStr = ZPad+ZPad+ZDle+ZHex;
var
Check : Word; Check : Word;
I : Byte; Count : Byte;
C : Char;
SaveCrc32 : Boolean; SaveCrc32 : Boolean;
begin Begin
SaveCrc32 := UseCrc32; SaveCrc32 := UseCrc32;
UseCrc32 := False; UseCrc32 := False;
BlockCheck := 0; BlockCheck := 0;
ProtocolStatus := ecok; ProtocolStatus := ecOK;
APort.BufWriteStr(HexHeaderStr); APort.BufWriteStr (ZPAD + ZPAD + ZDLE + ZHEX);
zpPutCharHex(FrameType);
UpdateBlockCheck(Ord(FrameType));
for I := 0 to SizeOf(TransHeader)-1 do begin PutCharHex (FrameType);
zpPutCharHex(Char(TransHeader[I])); UpdateBlockCheck (Ord(FrameType));
UpdateBlockCheck(TransHeader[I]);
For Count := 0 to SizeOf(TransHeader) - 1 Do Begin
PutCharHex (Char(TransHeader[Count]));
UpdateBlockCheck (TransHeader[Count]);
end; end;
UpdateBlockCheck(0); UpdateBlockCheck (0);
UpdateBlockCheck(0); UpdateBlockCheck (0);
Check := Word(BlockCheck); Check := Word(BlockCheck);
zpPutCharHex(Char(Hi(Check)));
zpPutCharHex(Char(Lo(Check)));
APort.BufWriteChar(cCR); PutCharHex (Char(Hi(Check)));
C := Chr(Ord(cLF) or $80); PutCharHex (Char(Lo(Check)));
APort.BufWriteChar(C);
if (FrameType <> ZFin) and (FrameType <> ZAck) then APort.BufWriteChar (cCR);
APort.BufWriteChar(cXon); APort.BufWriteChar (Chr(Ord(cLF) or $80));
If (FrameType <> ZFIN) and (FrameType <> ZACK) Then
APort.BufWriteChar (cXON);
LastFrame := FrameType; LastFrame := FrameType;
UseCrc32 := SaveCrc32; UseCrc32 := SaveCrc32;
APort.BufFlush; APort.BufFlush;
end; End;
procedure ZmodemProtocol.zpGetCharEscaped(var C : Char); Procedure ZmodemProtocol.GetCharEscaped (Var C: Char);
label Label
Escape; Escape;
begin Begin
ControlCharSkip := False; ControlCharSkip := False;
ProtocolStatus := ecOK; ProtocolStatus := ecOK;
if EscapePending then If EscapePending Then
goto Escape; Goto Escape;
C := Aport.ReadChar; C := Aport.ReadChar;
case C of Case C of
cXon, cXON,
cXoff, cXOFF,
cXonHi, cXONHI,
cXoffHi : begin cXOFFHI : Begin
ControlCharSkip := True; ControlCharSkip := True;
Exit; Exit;
end; End;
ZDle : begin ZDLE : Begin
Inc(CanCount); Inc (CanCount);
if CanCount > 5 then begin
If CanCount > 5 Then Begin
ProtocolStatus := ecCancelRequested; ProtocolStatus := ecCancelRequested;
Exit; Exit;
end; End;
end; End;
else begin Else
CanCount := 0; CanCount := 0;
Exit; Exit;
end; End;
end;
Escape: Escape:
if APort.DataWaiting then begin
If APort.DataWaiting Then Begin
EscapePending := False; EscapePending := False;
C := APort.ReadChar; C := APort.ReadChar;
if C = cCan then begin If C = cCAN Then Begin
Inc(CanCount); Inc (CanCount);
if CanCount >= 5 then
If CanCount >= 5 Then
ProtocolStatus := ecCancelRequested; ProtocolStatus := ecCancelRequested;
end else begin End Else Begin
CanCount := 0; CanCount := 0;
case C of
ZCrcE : {Last DataSubpacket of file} Case C of
ProtocolStatus := ecGotCrcE; ZCrcE: ProtocolStatus := ecGotCrcE;
ZCrcG : {Normal DataSubpacket, no response necessary} ZCrcG: ProtocolStatus := ecGotCrcG;
ProtocolStatus := ecGotCrcG; ZCrcQ: ProtocolStatus := ecGotCrcQ;
ZCrcQ : {ZAck or ZrPos requested} ZCrcW: ProtocolStatus := ecGotCrcW;
ProtocolStatus := ecGotCrcQ; ZRub0: C := #$7F;
ZCrcW : {DataSubpacket contains file information} ZRub1: C := #$FF;
ProtocolStatus := ecGotCrcW; Else
ZRub0 : {Ascii delete}
C := #$7F;
ZRub1 : {Hibit Ascii delete}
C := #$FF;
else {Normal escaped character}
C := Char(Ord(C) xor $40) C := Char(Ord(C) xor $40)
end; End;
end; End;
end else End Else
EscapePending := True; EscapePending := True;
end; End;
procedure ZmodemProtocol.zpGetCharHex(var C : Char); procedure ZmodemProtocol.zpGetCharHex(var C : Char);
label label
@ -651,7 +645,7 @@ Hex:
zpCollectBinaryHeader := False; zpCollectBinaryHeader := False;
if APort.DataWaiting then begin if APort.DataWaiting then begin
zpGetCharEscaped(C); GetCharEscaped(C);
if EscapePending or ControlCharSkip then {!!.01} if EscapePending or ControlCharSkip then {!!.01}
Exit; Exit;
if ProtocolStatus = ecCancelRequested then if ProtocolStatus = ecCancelRequested then
@ -715,7 +709,7 @@ Hex:
case HeaderState of case HeaderState of
hsNone, hsGotZPad, hsGotZDle : hsNone, hsGotZPad, hsGotZDle :
begin begin
zpGetCharStripped(C); GetCharStripped(C); // only used here
if ProtocolStatus = ecCancelRequested then if ProtocolStatus = ecCancelRequested then
Exit; Exit;
end; end;
@ -737,7 +731,7 @@ Hex:
case C of case C of
ZBin : ZBin :
begin begin
WasHex := False; {!!.03} WasHex := False;
HeaderState := hsGotZBin; HeaderState := hsGotZBin;
BinHdrState := bhFrame; BinHdrState := bhFrame;
EscapePending := False; EscapePending := False;
@ -793,76 +787,75 @@ Hex:
end; end;
end; end;
function ZmodemProtocol.zpReceiveBlock(var Block : DataBlockType; Function ZmodemProtocol.ReceiveBlock (Var Block: DataBlockType; Var BlockSize: Word; Var Handshake: Char) : Boolean;
var BlockSize : Word; Var
var Handshake : Char) : Boolean;
var
C : Char; C : Char;
begin Begin
zpReceiveBlock := False; ReceiveBlock := False;
while APort.DataWaiting do begin While APort.DataWaiting Do Begin
if (DataBlockLen = 0) and (RcvBlockState = rbData) then begin If (DataBlockLen = 0) and (RcvBlockState = rbData) Then Begin
if UseCrc32 then If UseCrc32 Then
BlockCheck := LongInt($FFFFFFFF) BlockCheck := LongInt($FFFFFFFF)
else Else
BlockCheck := 0; BlockCheck := 0;
end; End;
zpGetCharEscaped(C); GetCharEscaped(C);
if EscapePending or ControlCharSkip then If EscapePending or ControlCharSkip Then
Exit; Exit;
if ProtocolStatus = ecCancelRequested then If ProtocolStatus = ecCancelRequested Then
Exit; Exit;
UpdateBlockCheck(Ord(C)); UpdateBlockCheck(Ord(C));
case RcvBlockState of Case RcvBlockState of
rbData : rbData : Case ProtocolStatus of
case ProtocolStatus of ecOk : Begin
ecOk : {Normal character} Inc (DataBlockLen);
begin
{Check for a long block}
Inc(DataBlockLen);
if DataBlockLen > BlockLen then begin If DataBlockLen > BlockLen Then Begin
ProtocolStatus := ecLongPacket; ProtocolStatus := ecLongPacket;
Inc(TotalErrors);
Inc(BlockErrors); Inc (TotalErrors);
zpReceiveBlock := True; Inc (BlockErrors);
ReceiveBlock := True;
Exit; Exit;
end; End;
{Store the character}
Block[DataBlockLen] := C; Block[DataBlockLen] := C;
end; End;
ecGotCrcE, ecGotCrcE,
ecGotCrcG, ecGotCrcG,
ecGotCrcQ, ecGotCrcQ,
ecGotCrcW : {End of DataSubpacket - get/check CRC} ecGotCrcW : Begin
begin
RcvBlockState := rbCrc; RcvBlockState := rbCrc;
CrcCnt := 0; CrcCnt := 0;
LastStatus := ProtocolStatus; LastStatus := ProtocolStatus;
end; End;
ecCancelRequested : ecCancelRequested : Exit;
Exit; Else Begin
else begin Inc (DataBlockLen);
Inc(DataBlockLen);
if DataBlockLen > BlockLen then begin If DataBlockLen > BlockLen Then Begin
ProtocolStatus := ecLongPacket; ProtocolStatus := ecLongPacket;
Inc(TotalErrors);
Inc(BlockErrors); Inc (TotalErrors);
zpReceiveBlock := True; Inc (BlockErrors);
ReceiveBlock := True;
Exit; Exit;
end; End;
Block[DataBlockLen] := C; Block[DataBlockLen] := C;
end; End;
end; End;
rbCrc : rbCrc :
begin begin
@ -874,11 +867,9 @@ Hex:
Inc(TotalErrors); Inc(TotalErrors);
ProtocolStatus := ecBlockCheckError; ProtocolStatus := ecBlockCheckError;
end else end else
{Show proper status}
ProtocolStatus := LastStatus; ProtocolStatus := LastStatus;
{Say block is ready for processing} ReceiveBlock := True;
zpReceiveBlock := True;
Exit; Exit;
end; end;
end; end;
@ -1075,23 +1066,25 @@ ExitPoint:
end; end;
end; end;
procedure ZmodemProtocol.zpWriteDataBlock; Procedure ZmodemProtocol.WriteDataBlock;
var Var
Failed : Boolean; Failed : Boolean;
TempStatus : Word; TempStatus : Word;
begin Begin
Failed := apWriteProtocolBlock(DataBlock^, DataBlockLen); Failed := apWriteProtocolBlock (DataBlock^, DataBlockLen);
if Failed then begin If Failed Then Begin
TempStatus := ProtocolStatus; TempStatus := ProtocolStatus;
CancelTransfer; CancelTransfer;
ProtocolStatus := TempStatus; ProtocolStatus := TempStatus;
end else begin End Else Begin
Inc (FileOfs, DataBlockLen); Inc (FileOfs, DataBlockLen);
Dec (BytesRemaining, DataBlockLen); Dec (BytesRemaining, DataBlockLen);
Inc (BytesTransferred, DataBlockLen); Inc (BytesTransferred, DataBlockLen);
end; End;
end; End;
Procedure ZmodemProtocol.PrepareReceivePart; Procedure ZmodemProtocol.PrepareReceivePart;
Begin Begin
@ -1111,18 +1104,17 @@ Begin
ProtocolStatus := ecOk; ProtocolStatus := ecOk;
End; End;
function ZmodemProtocol.ProtocolReceivePart : ProtocolStateType; Function ZmodemProtocol.ProtocolReceivePart : ProtocolStateType;
{-Perform one "increment" of a protocol receive} Label
label
ExitPoint; ExitPoint;
var Var
BlockSize : Word; BlockSize : Word;
Handshake : Char; Handshake : Char;
C : Char; C : Char;
begin Begin
ProtocolStatus := SaveStatus; ProtocolStatus := SaveStatus;
If {ForceStatus or} TimerUp(StatusTimer) then begin If {ForceStatus or} TimerUp(StatusTimer) Then Begin
If Not APort.Connected or (apHandleAbort and (ProtocolStatus <> ecCancelRequested)) Then Begin If Not APort.Connected or (apHandleAbort and (ProtocolStatus <> ecCancelRequested)) Then Begin
CancelTransfer; CancelTransfer;
@ -1133,72 +1125,73 @@ End;
StatusTimer := TimerSet(StatusInterval); StatusTimer := TimerSet(StatusInterval);
ForceStatus := False; ForceStatus := False;
end; End;
case ZmodemState of Case ZmodemState of
rzWaitFile, rzWaitFile,
rzStartData, rzStartData,
rzWaitEof : begin rzWaitEof : Begin
if not aport.datawaiting then aport.waitfordata(1000); If Not APort.DataWaiting Then
{Header might be present, try to get one} APort.WaitForData(1000);
if APort.DataWaiting then begin
If APort.DataWaiting Then Begin
zpCheckForHeader; zpCheckForHeader;
if ProtocolStatus = ecCancelRequested then
If ProtocolStatus = ecCancelRequested Then
ZmodemState := rzError; ZmodemState := rzError;
end else if TimerUp(ReplyTimer) then End Else If TimerUp(ReplyTimer) Then
ProtocolStatus := ecTimeout ProtocolStatus := ecTimeout
else Else
ProtocolStatus := ecNoHeader; ProtocolStatus := ecNoHeader;
end; End;
end; End;
// zlog('main rcv state loop: ' + strI2S(Ord(ZmodemState))); //zlog('main rcv state loop: ' + strI2S(Ord(ZmodemState)));
{Main state processor} Case ZmodemState of
case ZmodemState of
rzRqstFile : rzRqstFile:
begin
Begin
CanCount := 0; CanCount := 0;
{Init pos/flag bytes to zero}
LongInt(TransHeader) := 0; LongInt(TransHeader) := 0;
TransHeader[ZF0] := CanFDX or CanOVIO or CanFc32;{ or CanBrk;}
{Set our receive options}
TransHeader[ZF0] := CanFdx or {Full duplex}
CanOvIO or {Overlap I/O}
CanFc32;{ or
CanBrk;}
WaitMS(500); WaitMS(500);
zpPutHexHeader(HeaderType); PutHexHeader(HeaderType);
ZmodemState := rzWaitFile; ZmodemState := rzWaitFile;
HeaderState := hsNone; HeaderState := hsNone;
ReplyTimer := TimerSet(HandshakeWait); ReplyTimer := TimerSet(HandshakeWait);
end; End;
rzSendBlockPrep : rzSendBlockPrep:
if APort.DataWaiting then begin
{Discard the first two chars} If APort.DataWaiting then begin
C := APort.ReadChar; C := APort.ReadChar;
Inc(DiscardCnt);
if DiscardCnt = 2 then Inc (DiscardCnt);
If DiscardCnt = 2 Then
ZmodemState := rzSendBlock; ZmodemState := rzSendBlock;
end else if TimerUp(ReplyTimer) then begin
Inc(BlockErrors); End Else
Inc(TotalErrors); If TimerUp(ReplyTimer) Then Begin
if TotalErrors < HandshakeRetry then Inc (BlockErrors);
Inc (TotalErrors);
If TotalErrors < HandshakeRetry Then
ZmodemState := rzRqstFile ZmodemState := rzRqstFile
else Else
ZmodemState := rzCleanup; ZmodemState := rzCleanup;
end; End;
rzSendBlock:
rzSendBlock :
if APort.DataWaiting then begin if APort.DataWaiting then begin
{Collect the data subpacket}
if zpReceiveBlock(DataBlock^, BlockSize, Handshake) then if ReceiveBlock(DataBlock^, BlockSize, Handshake) then
if ProtocolStatus = ecBlockCheckError then if ProtocolStatus = ecBlockCheckError then
{Error receiving block, go try again} {Error receiving block, go try again}
ZmodemState := rzRqstFile ZmodemState := rzRqstFile
@ -1210,7 +1203,7 @@ End;
end else if TimerUp(ReplyTimer) then begin end else if TimerUp(ReplyTimer) then begin
Inc(BlockErrors); Inc(BlockErrors);
if BlockErrors < HandshakeRetry then begin if BlockErrors < HandshakeRetry then begin
zpPutHexHeader(ZNak); PutHexHeader(ZNak);
ReplyTimer := TimerSet(HandshakeWait); ReplyTimer := TimerSet(HandshakeWait);
ZmodemState := rzWaitFile; ZmodemState := rzWaitFile;
HeaderState := hsNone; HeaderState := hsNone;
@ -1224,7 +1217,7 @@ End;
EscapeAll := (RcvHeader[ZF0] and EscAll) = EscAll; EscapeAll := (RcvHeader[ZF0] and EscAll) = EscAll;
zpPutHexHeader(ZAck); PutHexHeader(ZAck);
ZmodemState := rzWaitFile; ZmodemState := rzWaitFile;
ReplyTimer := TimerSet(HandshakeWait); ReplyTimer := TimerSet(HandshakeWait);
@ -1278,12 +1271,12 @@ End;
ZFreeCnt : {Sender is requesting a count of our freespace} ZFreeCnt : {Sender is requesting a count of our freespace}
begin begin
LongInt(TransHeader) := DiskFree(0); LongInt(TransHeader) := DiskFree(0);
zpPutHexHeader(ZAck); PutHexHeader(ZAck);
end; end;
ZCommand : {Commands not implemented} ZCommand : {Commands not implemented}
begin begin
zpPutHexHeader(ZNak); PutHexHeader(ZNak);
end; end;
ZCompl, ZCompl,
@ -1314,8 +1307,7 @@ End;
rzCollectFile : rzCollectFile :
if APort.DataWaiting then begin if APort.DataWaiting then begin
{Collect the data subpacket} if ReceiveBlock(DataBlock^, BlockSize, Handshake) then
if zpReceiveBlock(DataBlock^, BlockSize, Handshake) then
if ProtocolStatus = ecBlockCheckError then if ProtocolStatus = ecBlockCheckError then
{Error getting block, go try again} {Error getting block, go try again}
ZmodemState := rzRqstFile ZmodemState := rzRqstFile
@ -1327,7 +1319,7 @@ End;
end else if TimerUp(ReplyTimer) then begin end else if TimerUp(ReplyTimer) then begin
Inc(BlockErrors); Inc(BlockErrors);
if BlockErrors < HandshakeRetry then begin if BlockErrors < HandshakeRetry then begin
zpPutHexHeader(ZNak); PutHexHeader(ZNak);
ReplyTimer := TimerSet(HandshakeWait); ReplyTimer := TimerSet(HandshakeWait);
end else end else
ZmodemState := rzCleanup; ZmodemState := rzCleanup;
@ -1391,7 +1383,7 @@ End;
LongInt(TransHeader) := FileOfs; LongInt(TransHeader) := FileOfs;
zpPutHexHeader(ZrPos); PutHexHeader(ZrPos);
BytesRemaining := SrcFileLen - FileOfs; BytesRemaining := SrcFileLen - FileOfs;
BytesTransferred := FileOfs; BytesTransferred := FileOfs;
@ -1403,27 +1395,32 @@ End;
case ProtocolStatus of case ProtocolStatus of
ecGotHeader : ecGotHeader :
case RcvFrame of case RcvFrame of
ZData : {One or more data subpackets follow} ZData :
begin begin
if FileOfs <> LastFileOfs then begin if FileOfs <> LastFileOfs then begin
Inc(BlockErrors); Inc (BlockErrors);
Inc(TotalErrors); Inc (TotalErrors);
if BlockErrors > MaxBadBlocks then begin
If BlockErrors > MaxBadBlocks Then Begin
CancelTransfer; CancelTransfer;
ProtocolStatus := ecTooManyErrors; ProtocolStatus := ecTooManyErrors;
ZmodemState := rzError; ZmodemState := rzError;
goto ExitPoint;
end; Goto ExitPoint;
End;
PutAttentionString; PutAttentionString;
ZmodemState := rzSync; ZmodemState := rzSync;
end else begin End Else Begin
BlockErrors := 0; BlockErrors := 0;
ZmodemState := rzCollectData; ZmodemState := rzCollectData;
DataBlockLen := 0; DataBlockLen := 0;
RcvBlockState := rbData; RcvBlockState := rbData;
ReplyTimer := TimerSet(HandshakeWait); ReplyTimer := TimerSet(HandshakeWait);
end; End;
end; End;
ZNak : {Nak received} ZNak : {Nak received}
begin begin
Inc(TotalErrors); Inc(TotalErrors);
@ -1481,7 +1478,7 @@ End;
ReplyTimer := TimerSet(HandshakeWait); ReplyTimer := TimerSet(HandshakeWait);
{Collect the data subpacket} {Collect the data subpacket}
if zpReceiveBlock(DataBlock^, BlockSize, Handshake) then begin if ReceiveBlock(DataBlock^, BlockSize, Handshake) then begin
SaveStatus := ProtocolStatus; SaveStatus := ProtocolStatus;
{Got a block or an error -- process it} {Got a block or an error -- process it}
case ProtocolStatus of case ProtocolStatus of
@ -1490,11 +1487,11 @@ End;
ecGotCrcW : {Send requests a wait} ecGotCrcW : {Send requests a wait}
begin begin
{Write this block} {Write this block}
zpWriteDataBlock; WriteDataBlock;
if ProtocolStatus = ecOk then begin if ProtocolStatus = ecOk then begin
{Acknowledge with the current file position} {Acknowledge with the current file position}
LongInt(TransHeader) := FileOfs; LongInt(TransHeader) := FileOfs;
zpPutHexHeader(ZAck); PutHexHeader(ZAck);
ZmodemState := rzStartData; ZmodemState := rzStartData;
HeaderState := hsNone; HeaderState := hsNone;
end else end else
@ -1503,10 +1500,10 @@ End;
ecGotCrcQ : {Zack requested} ecGotCrcQ : {Zack requested}
begin begin
{Write this block} {Write this block}
zpWriteDataBlock; WriteDataBlock;
if ProtocolStatus = ecOk then begin if ProtocolStatus = ecOk then begin
LongInt(TransHeader) := FileOfs; LongInt(TransHeader) := FileOfs;
zpPutHexHeader(ZAck); PutHexHeader(ZAck);
{Don't change state - will get next data subpacket} {Don't change state - will get next data subpacket}
end else end else
ZmodemState := rzError; ZmodemState := rzError;
@ -1514,14 +1511,14 @@ End;
ecGotCrcG : {Normal subpacket - no response necessary} ecGotCrcG : {Normal subpacket - no response necessary}
begin begin
{Write this block} {Write this block}
zpWriteDataBlock; WriteDataBlock;
if ProtocolStatus <> ecOk then if ProtocolStatus <> ecOk then
ZmodemState := rzError; ZmodemState := rzError;
end; end;
ecGotCrcE : {Last data subpacket} ecGotCrcE : {Last data subpacket}
begin begin
{Write this block} {Write this block}
zpWriteDataBlock; WriteDataBlock;
if ProtocolStatus = ecOk then begin if ProtocolStatus = ecOk then begin
ZmodemState := rzWaitEof; ZmodemState := rzWaitEof;
HeaderState := hsNone; HeaderState := hsNone;
@ -1552,10 +1549,13 @@ End;
ZmodemState := rzError ZmodemState := rzError
end else if TimerUp(ReplyTimer) then begin end else if TimerUp(ReplyTimer) then begin
Inc(BlockErrors); Inc(BlockErrors);
if BlockErrors < MaxBadBlocks then begin if BlockErrors < MaxBadBlocks then begin
PutAttentionString; PutAttentionString;
Inc(TotalErrors); Inc(TotalErrors);
Inc(BlockErrors); Inc(BlockErrors);
ZmodemState := rzSync; ZmodemState := rzSync;
end else end else
ZmodemState := rzError; ZmodemState := rzError;
@ -1628,7 +1628,7 @@ End;
begin begin
{Insert file position into header} {Insert file position into header}
LongInt(TransHeader) := FileOfs; LongInt(TransHeader) := FileOfs;
zpPutHexHeader(ZFin); PutHexHeader(ZFin);
ZmodemState := rzCollectFinish; ZmodemState := rzCollectFinish;
ReplyTimer := TimerSet(FinishWait); ReplyTimer := TimerSet(FinishWait);
OCnt := 0; OCnt := 0;
@ -1738,8 +1738,6 @@ End;
ExitPoint; ExitPoint;
const const
RZcommand : array[1..4] of Char = 'rz'+cCr+#0; RZcommand : array[1..4] of Char = 'rz'+cCr+#0;
var
NewInterval : Word;
begin begin
ProtocolStatus := SaveStatus; ProtocolStatus := SaveStatus;
@ -1792,7 +1790,7 @@ End;
{Send ZrQinit header (requests receiver's ZrInit)} {Send ZrQinit header (requests receiver's ZrInit)}
LongInt(TransHeader) := 0; LongInt(TransHeader) := 0;
zpPutHexHeader(ZrQInit); PutHexHeader(ZrQInit);
ReplyTimer := TimerSet(HandshakeWait); ReplyTimer := TimerSet(HandshakeWait);
ZmodemState := tzHandshake; ZmodemState := tzHandshake;
@ -1817,14 +1815,14 @@ End;
ZChallenge : {Receiver is challenging, respond with same number} ZChallenge : {Receiver is challenging, respond with same number}
begin begin
TransHeader := RcvHeader; TransHeader := RcvHeader;
zpPutHexHeader(ZAck); PutHexHeader(ZAck);
end; end;
ZCommand : {Commands not supported} ZCommand : {Commands not supported}
zpPutHexHeader(ZNak); PutHexHeader(ZNak);
ZrQInit : {Remote is trying to transmit also, do nothing} ZrQInit : {Remote is trying to transmit also, do nothing}
; ;
else {Unexpected reply, nak it} else {Unexpected reply, nak it}
zpPutHexHeader(ZNak); PutHexHeader(ZNak);
end; end;
ecNoHeader : ecNoHeader :
{Keep waiting for header} ; {Keep waiting for header} ;
@ -1838,7 +1836,7 @@ End;
ProtocolStatus := ecFailedToHandshake; ProtocolStatus := ecFailedToHandshake;
ZmodemState := tzError; ZmodemState := tzError;
end else begin end else begin
zpPutHexHeader(ZrQInit); PutHexHeader(ZrQInit);
ReplyTimer := TimerSet(HandshakeWait); ReplyTimer := TimerSet(HandshakeWait);
end; end;
end; end;
@ -1917,7 +1915,7 @@ End;
ZCrc : ZCrc :
begin begin
LongInt(TransHeader) := FileCRC32(PathName); LongInt(TransHeader) := FileCRC32(PathName);
zpPutHexHeader(ZCrc); PutHexHeader(ZCrc);
end; end;
ZSkip : {Receiver wants to skip this file} ZSkip : {Receiver wants to skip this file}
begin begin
@ -2201,7 +2199,7 @@ End;
tzSendFinish : tzSendFinish :
begin begin
LongInt(TransHeader) := FileOfs; LongInt(TransHeader) := FileOfs;
zpPutHexHeader(ZFin); PutHexHeader(ZFin);
ReplyTimer := TimerSet(FinishWait); ReplyTimer := TimerSet(FinishWait);
BlockErrors := 0; BlockErrors := 0;
ZmodemState := tzCheckFinish; ZmodemState := tzCheckFinish;