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