diff --git a/mdl/m_prot_zmodem.pas b/mdl/m_prot_zmodem.pas new file mode 100644 index 0000000..103ac76 --- /dev/null +++ b/mdl/m_prot_zmodem.pas @@ -0,0 +1,2507 @@ +Unit m_Prot_Zmodem; + +{$I M_OPS.PAS} + +Interface + +Uses + Dos, + m_CRC, + m_FileIO, + m_DateTime, + m_Strings, + m_IO_Base, + m_Prot_Base; + +Const + MaxAttentionLen = 32; + ZMaxBlockSize = 8192; + ZHandshakeWait = 3000; + + DefFinishWait : Word = 100; {Wait time for ZFins, 10 secs} + DefFinishRetry : Word = 3; {Retry ZFin 3 times} + MaxBadBlocks : Byte = 20; {Quit if this many bad blocks} + + 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)} + +// WriteNewerLonger = 1; {Transfer if new, newer or longer} +// WriteCrc = 2; {Not supported, same as WriteNewer} + WriteAppend = 3; {Transfer if new, append if exists} + WriteClobber = 4; {Transfer regardless} + WriteNewer = 5; {Transfer if new or newer} + WriteDifferent = 6; {Transfer if new or diff dates/lens} + WriteProtect = 7; {Transfer only if new} + +Type + Str2 = String[2]; + + ZmodemStateType = ( + tzInitial, {0 Allocates buffers, sends zrqinit} + tzHandshake, {1 Wait for hdr (zrinit), rsend zrqinit on timout} + tzGetFile, {2 Call NextFile, build ZFile packet} + tzSendFile, {3 Send ZFile packet} + tzCheckFile, {4 Wait for hdr (zrpos), set next state to tzData} + tzStartData, {5 Send ZData and next data subpacket} + tzEscapeData, {6 Check for header, escape next block} + tzSendData, {7 Wait for free space in buffer, send escaped block} + tzSendEof, {8 Send eof} + tzWaitAck, {9 Wait for Ack on ZCRCW packets} + tzDrainEof, {10 Wait for output buffer to drain} + tzCheckEof, {11 Wait for hdr (zrinit)} + tzSendFinish, {12 Send zfin} + tzCheckFinish, {13 Wait for hdr (zfin)} + tzError, {14 Cleanup after errors} + tzCleanup, {15 Release buffers and other cleanup} + tzDone, {16 Signal end of protocol} + + {Receive states} + rzRqstFile, {17 Send zrinit} + rzWaitFile, {19 Waits for hdr (zrqinit, zrfile, zsinit, etc)} + rzCollectFile, {20 Collect file info into work block} + rzSendInit, {21 Extract send init info} + rzSendBlockPrep, {22 Collect post-hexhdr chars} {!!.03} + rzSendBlock, {23 Collect sendinit block} + rzSync, {24 Send ZrPos with current file position} + rzStartFile, {25 Extract file info, prepare writing, etc., put zrpos} + rzStartData, {26 Wait for hdr (zrdata)} + rzCollectData, {27 Collect data subpacket} + rzGotData, {28 Got dsp, put it} + rzWaitEof, {29 Wait for hdr (zreof)} + rzEndOfFile, {30 Close file, log it, etc} + rzSendFinish, {31 Send ZFin, goto rzWaitOO} + rzCollectFinish, {32 Check for OO, goto rzFinish} + rzError, {33 Handle errors while file was open} + rzCleanup, {35 Clean up buffers, etc.} + rzDone); {36 Signal end of protocol} + + HeaderStateType = ( + hsNone, {Not currently checking for a header} + hsGotZPad, {Got initial or second asterisk} + hsGotZDle, {Got ZDle} + hsGotZBin, {Got start of binary header} + hsGotZBin32, {Got start of binary 32 header} + hsGotZHex, {Got start of hex header} + hsGotHeader); {Got complete header} + + HexHeaderStates = ( + hhFrame, {Processing frame type char} + hhPos1, {Processing 1st position info byte} + hhPos2, {Processing 2nd position info byte} + hhPos3, {Processing 3rd position info byte} + hhPos4, {Processing 4th position info byte} + hhCrc1, {Processing 1st CRC byte} + hhCrc2); {Processing 2nd CRC byte} + + BinaryHeaderStates = ( + bhFrame, {Processing frame type char} + bhPos1, {Processing 1st position info byte} + bhPos2, {Processing 2nd position info byte} + bhPos3, {Processing 3rd position info byte} + bhPos4, {Processing 1th position info byte} + bhCrc1, {Processing 1st CRC byte} + bhCrc2, {Processing 2nd CRC byte} + bhCrc3, {Processing 3rd CRC byte} + bhCrc4); {Processing 4th CRC byte} + + ReceiveBlockStates = ( + rbData, {Receiving data bytes} + rbCrc); {Receiving block check bytes} + + WorkBlockType = Array[1..2 * ZMaxBlockSize] of Char; + + PosFlagsType = Array[0..3] of Byte; + + ZmodemProtocolPtr = ^ZmodemProtocol; + + ZmodemProtocol = object(AbstractProtocol) + UseCrc32 : Boolean; {True when using 32bit CRCs} + CanCrc32 : Boolean; {True when Crc32 capable} + LastFileOfs : LongInt; {File position reported by remote} + AttentionStr : Array[1..MaxAttentionLen] of Byte; {Attn string value} + FileMgmtOpts : Byte; {File mgmt opts rqst by sender} + FileMgmtOverride : Boolean; {True to override senders file mg opts} + 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} + 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} + ReplyTimer : LongInt; + WorkSize : LongInt; {Index into working buffer} + LastBlock : Boolean; {True if no more blocks} + Terminator : Char; {Current block 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} + HeaderType : Char; {Current header type} + HexHdrState : HexHeaderStates; {Current hex header state} + BinHdrState : BinaryHeaderStates; {Current binary header state} + RcvBlockState : ReceiveBlockStates; {Current receive block state} + FilesSent : Boolean; {True if at least one file sent} + CanCount : Byte; {Track contiguous } + SaveStatus : Word; {Maintain status across parts} + CrcCnt : Byte; {Number of CRC chars expected} + 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} + DataBlock : ^DataBlockType; {Standard data block} + DataBlockLen : Word; {Count of valid data in DataBlock} + WorkBlock : ^WorkBlockType; {Holds fully escaped data block} + RcvHeader : PosFlagsType; {Received header} + RcvFrame : Char; {Type of last received frame} + TransHeader : PosFlagsType; {Header to transmit} + RcvBuffLen : Word; + LastChar : Char; + + Constructor Init (C: TIOBase; Use8K: Boolean); + Destructor Done; Virtual; + + 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 ExtractFileInfo; + Procedure InsertFileInfo; Virtual; + Procedure ExtractReceiverInfo; + Procedure PutCharEscaped (C: Char); + Function EscapeCharacter (C: Char) : Str2; + Procedure zpPutBinaryHeader (FrameType : Char); + Procedure EscapeBlock (Var Block: DataBlockType; BLen: Word); + Procedure TransmitBlock; + End; + +Implementation + +(* +procedure zlog (s: string); +var + t : text; +begin + assign (t, '\dev\code\mystic\zm.log'); + {$I-}append(t); {$I+} + if ioresult <> 0 then rewrite(t); + writeln (t, s); + close (t); +end; +*) + +Const + HexDigits : Array[0..15] of Char = '0123456789abcdef'; + + FileMgmtMask = 7; {Isolate file mgmnt values} + FileSkipMask = $80; {Skip file if dest doesn't exist} + +// FileRecover = $03; {Resume interrupted file transfer} + + ZCrcE = 'h'; {End - last data subpacket of file} + ZCrcG = 'i'; {Go - no response necessary} + ZCrcQ = 'j'; {Ack - requests ZACK or ZRPOS} + ZCrcW = 'k'; {Wait - sender waits for answer} + 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} + + CanFdx = $0001; + CanOvIO = $0002; + CanBrk = $0004; + CanFc32 = $0020; + EscAll = $0040; + Hibit = $80; + cDleHi = Char(Ord(cDle) + HiBit); + cXonHi = Char(Ord(cXon) + HiBit); + cXoffHi = Char(Ord(cXoff) + HiBit); + +Constructor ZmodemProtocol.Init (C: TIOBase; Use8K: Boolean); +Begin + DataBlock := NIL; + WorkBlock := NIL; + + AbstractProtocol.Init(C); + + Use8KBlocks := Use8K; + + FillChar(AttentionStr, MaxAttentionLen, 0); + + FileOfs := 0; + LastFileOfs := 0; + UseCrc32 := True; + CanCrc32 := True; + AllowResume := True; + BlockLen := ZMaxBlk[Use8KBlocks]; + FileMgmtOpts := WriteNewer; + FileMgmtOverride := False; + FileOpen := False; + HandshakeWait := ZHandshakeWait; + TookHit := False; + GoodAfterBad := 0; + EscapePending := False; + HexPending := False; + FinishWait := DefFinishWait; + FinishRetry := DefFinishRetry; + EscapeAll := False; + + DataBlock := GetMem(ZMaxBlk[Use8KBlocks]); + WorkBlock := GetMem(ZMaxWrk[Use8KBlocks]); +End; + +Destructor ZmodemProtocol.Done; +Begin + FreeMem(DataBlock, ZMaxBlk[Use8KBlocks]); + FreeMem(WorkBlock, ZMaxWrk[Use8KBlocks]); + + AbstractProtocol.Done; +End; + +Procedure ZmodemProtocol.SetFileMgmtOptions (Override, SkipNoFile: Boolean; FOpt: Byte); +Var + SkipMask : Byte; +Begin + FileMgmtOverride := Override; + + If SkipNoFile Then + SkipMask := $80 + else + SkipMask := 0; + + FileMgmtOpts := (FOpt and FileMgmtMask) or SkipMask; +End; + +Procedure ZModemProtocol.SetFinishWait (NewWait: Word; NewRetry: Byte); +Begin + If NewWait <> 0 Then + FinishWait := NewWait; + + FinishRetry := NewRetry; +End; + +Procedure ZmodemProtocol.UpdateBlockCheck (CurByte: Byte); +Begin + If UseCrc32 Then + BlockCheck := Crc32(CurByte, BlockCheck) + Else + BlockCheck := Crc16(CurByte, BlockCheck); +End; + +Procedure ZmodemProtocol.SendBlockCheck; +Type + QB = array[1..4] of char; +Var + I : Byte; +Begin + If UseCrc32 Then Begin + BlockCheck := Not BlockCheck; + + For I := 1 to 4 Do + PutCharEscaped (QB(BlockCheck)[I]); + End Else Begin + UpdateBlockCheck (0); + UpdateBlockCheck (0); + + PutCharEscaped (Char(Hi(SmallInt(BlockCheck)))); + PutCharEscaped (Char(Lo(SmallInt(BlockCheck)))); + End; +End; + +Function ZmodemProtocol.VerifyBlockCheck : Boolean; +Begin + Result := False; + + If UseCrc32 Then Begin + If BlockCheck <> LongInt($DEBB20E3) Then + Exit + End Else Begin + UpdateBlockCheck (0); + UpdateBlockCheck (0); + + If BlockCheck <> 0 Then + Exit; + End; + + Result := True; +End; + +Procedure ZmodemProtocol.CancelTransfer; +Const + CancelStr = #24#24#24#24#24#24#24#24#8#8#8#8#8#8#8#8#8#8; +Begin + APort.PurgeOutputData; + APort.BufWriteStr(CancelStr); + APort.BufFlush; + + 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 + C := ReadChar + else + ProtocolStatus := ecBufferIsEmpty + 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 + ProtocolStatus := ecCancelRequested; + end else + CanCount := 0; + end; + + Procedure ZmodemProtocol.PutAttentionString; + Var + I : Word; + Begin + I := 1; + + While AttentionStr[I] <> 0 Do Begin + Case AttentionStr[I] of + $DD : ; + $DE : WaitMS(1000); + Else + APort.BufWriteChar(Chr(AttentionStr[I])); + End; + Inc(I); + End; + + APort.BufFlush; + End; + + procedure ZmodemProtocol.zpPutCharHex(C : Char); + {-Sends C as two hex ascii digits} + var + B : Byte absolute C; + begin + APort.BufWriteChar(HexDigits[B shr 4]); + APort.BufWriteChar(HexDigits[B and $0F]); + end; + + procedure ZmodemProtocol.zpPutHexHeader(FrameType : Char); + {-Sends a hex header} + const + HexHeaderStr = ZPad+ZPad+ZDle+ZHex; + var + Check : Word; + I : Byte; + C : Char; + SaveCrc32 : Boolean; + begin + SaveCrc32 := UseCrc32; + UseCrc32 := False; + BlockCheck := 0; + ProtocolStatus := ecok; + + APort.BufWriteStr(HexHeaderStr); + zpPutCharHex(FrameType); + UpdateBlockCheck(Ord(FrameType)); + + for I := 0 to SizeOf(TransHeader)-1 do begin + zpPutCharHex(Char(TransHeader[I])); + UpdateBlockCheck(TransHeader[I]); + end; + + 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); + + if (FrameType <> ZFin) and (FrameType <> ZAck) then + APort.BufWriteChar(cXon); + + LastFrame := FrameType; + + UseCrc32 := SaveCrc32; + + APort.BufFlush; + end; + + procedure ZmodemProtocol.zpGetCharEscaped(var C : Char); + label + Escape; + begin + ControlCharSkip := False; + ProtocolStatus := ecOK; + + if EscapePending then + goto Escape; + + C := Aport.ReadChar; + + case C of + cXon, + cXoff, + cXonHi, + cXoffHi : begin + ControlCharSkip := True; + Exit; + end; + ZDle : begin + Inc(CanCount); + if CanCount > 5 then begin + ProtocolStatus := ecCancelRequested; + Exit; + end; + end; + else begin + CanCount := 0; + Exit; + end; + end; + +Escape: + if APort.DataWaiting then begin + EscapePending := False; + C := APort.ReadChar; + + if C = cCan then begin + Inc(CanCount); + if CanCount >= 5 then + ProtocolStatus := ecCancelRequested; + 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} + C := Char(Ord(C) xor $40) + end; + end; + end else + EscapePending := True; + end; + + procedure ZmodemProtocol.zpGetCharHex(var C : Char); + label + Hex; + + function NextHexNibble : Byte; + var + B : Byte; + C : Char; + begin + NextHexNibble := 0; + ProtocolStatus := ecok; + + C := APort.ReadChar; + + if C = cCan then begin + Inc(CanCount); + if CanCount >= 5 then begin + ProtocolStatus := ecCancelRequested; + Exit; + end; + end else + CanCount := 0; + + B := Pos(C, HexDigits); + if B <> 0 then + Dec(B); + + if B <> 0 then + NextHexNibble := B + else + NextHexNibble := 0; + end; + + begin + if HexPending then + goto Hex; + HexByte := NextHexNibble shl 4; +Hex: + if APort.DataWaiting then begin + HexPending := False; + HexByte := HexByte + NextHexNibble; + C := Chr(HexByte); + end else + HexPending := True; + end; + + function ZmodemProtocol.zpCollectHexHeader : Boolean; + var + C : Char; + begin + zpCollectHexHeader := False; + + if APort.DataWaiting then begin + zpGetCharHex(C); + if HexPending then + Exit; + if ProtocolStatus = ecCancelRequested then + Exit; + + if HexHdrState = hhFrame then + BlockCheck := 0; + + UseCrc32 := False; + + UpdateBlockCheck(Ord(C)); + + case HexHdrState of + hhFrame : + RcvFrame := C; + hhPos1..hhPos4 : + RcvHeader[Ord(HexHdrState)-1] := Ord(C); + hhCrc1 : + {just keep going} ; + hhCrc2 : + if not VerifyBlockCheck then begin + ProtocolStatus := ecBlockCheckError; + Inc(TotalErrors); + HeaderState := hsNone; + end else begin + {Say we got a good header} + zpCollectHexHeader := True; + end; + end; + + if (HexHdrState < High(HexHdrState)) then + Inc(HexHdrState) + else HexHdrState := Low(HexHdrState); + + end; + end; + + function ZmodemProtocol.zpCollectBinaryHeader(Crc32 : Boolean) : Boolean; + var + C : Char; + begin + zpCollectBinaryHeader := False; + + if APort.DataWaiting then begin + zpGetCharEscaped(C); + if EscapePending or ControlCharSkip then {!!.01} + Exit; + if ProtocolStatus = ecCancelRequested then + Exit; + + {Init block check on startup} + if BinHdrState = bhFrame then begin + UseCrc32 := Crc32; + if UseCrc32 then + BlockCheck := LongInt($FFFFFFFF) + else + BlockCheck := 0; + end; + + {Always update the block check} + UpdateBlockCheck(Ord(C)); + + {Process this character} + case BinHdrState of + bhFrame : + RcvFrame := C; + bhPos1..bhPos4 : + RcvHeader[Ord(BinHdrState)-1] := Ord(C); + bhCrc2 : + if not UseCrc32 then begin + if not VerifyBlockCheck then begin + ProtocolStatus := ecBlockCheckError; + Inc(TotalErrors); + HeaderState := hsNone; + end else begin + {Say we got a good header} + zpCollectBinaryHeader := True; + end; + end; + bhCrc4 : + {Check the Crc value} + if not VerifyBlockCheck then begin + ProtocolStatus := ecBlockCheckError; + Inc(TotalErrors); + HeaderState := hsNone; + end else begin + {Say we got a good header} + zpCollectBinaryHeader := True; + end; + end; + + if (BinHdrState < High(BinHdrState)) then + Inc(BinHdrState) + else BinhdrState := Low(BinHdrState); + end; + end; + + procedure ZmodemProtocol.zpCheckForHeader; + var + C : Char; + begin + ProtocolStatus := ecNoHeader; + + while APort.DataWaiting do begin + {Only get the next char if we don't know the header type yet} + case HeaderState of + hsNone, hsGotZPad, hsGotZDle : + begin + zpGetCharStripped(C); + if ProtocolStatus = ecCancelRequested then + Exit; + end; + end; + + ProtocolStatus := ecNoHeader; + + case HeaderState of + hsNone : + if C = ZPad then + HeaderState := hsGotZPad; + hsGotZPad : + case C of + ZPad : ; + ZDle : HeaderState := hsGotZDle; + else HeaderState := hsNone; + end; + hsGotZDle : + case C of + ZBin : + begin + WasHex := False; {!!.03} + HeaderState := hsGotZBin; + BinHdrState := bhFrame; + EscapePending := False; + if zpCollectBinaryHeader(False) then + HeaderState := hsGotHeader; + end; + ZBin32 : + begin + WasHex := False; + HeaderState := hsGotZBin32; + BinHdrState := bhFrame; + EscapePending := False; + if zpCollectBinaryHeader(True) then + HeaderState := hsGotHeader; + end; + ZHex : + begin + WasHex := True; + HeaderState := hsGotZHex; + HexHdrState := hhFrame; + HexPending := False; + if zpCollectHexHeader then + HeaderState := hsGotHeader; + end; + else + HeaderState := hsNone; + end; + hsGotZBin : + if zpCollectBinaryHeader(False) then + HeaderState := hsGotHeader; + hsGotZBin32 : + if zpCollectBinaryHeader(True) then + HeaderState := hsGotHeader; + hsGotZHex : + if zpCollectHexHeader then + HeaderState := hsGotHeader; + end; + + if HeaderState = hsGotHeader then begin + ProtocolStatus := ecGotHeader; + case LastFrame of + ZrPos, ZAck, ZData, ZEof : + LastFileOfs := LongInt(RcvHeader); + end; + + LastFrame := RcvFrame; + + Exit; + end; + + if (ProtocolStatus <> ecOk) and (ProtocolStatus <> ecNoHeader) then + Exit; + end; + end; + + function ZmodemProtocol.zpReceiveBlock(var Block : DataBlockType; + var BlockSize : Word; + var Handshake : Char) : Boolean; + var + C : Char; + begin + zpReceiveBlock := False; + + while APort.DataWaiting do begin + if (DataBlockLen = 0) and (RcvBlockState = rbData) then begin + if UseCrc32 then + BlockCheck := LongInt($FFFFFFFF) + else + BlockCheck := 0; + end; + + zpGetCharEscaped(C); + + if EscapePending or ControlCharSkip then + Exit; + + 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); + + if DataBlockLen > BlockLen then begin + ProtocolStatus := ecLongPacket; + Inc(TotalErrors); + Inc(BlockErrors); + zpReceiveBlock := True; + Exit; + end; + {Store the character} + + Block[DataBlockLen] := C; + end; + + ecGotCrcE, + ecGotCrcG, + ecGotCrcQ, + ecGotCrcW : {End of DataSubpacket - get/check CRC} + begin + RcvBlockState := rbCrc; + CrcCnt := 0; + LastStatus := ProtocolStatus; + end; + ecCancelRequested : + Exit; + else begin + Inc(DataBlockLen); + + if DataBlockLen > BlockLen then begin + ProtocolStatus := ecLongPacket; + Inc(TotalErrors); + Inc(BlockErrors); + zpReceiveBlock := True; + Exit; + end; + Block[DataBlockLen] := C; + end; + end; + + rbCrc : + begin + Inc(CrcCnt); + if (UseCrc32 and (CrcCnt = 4)) or + (not UseCrc32 and (CrcCnt = 2)) then begin + if not VerifyBlockCheck then begin + Inc(BlockErrors); + Inc(TotalErrors); + ProtocolStatus := ecBlockCheckError; + end else + {Show proper status} + ProtocolStatus := LastStatus; + + {Say block is ready for processing} + zpReceiveBlock := True; + Exit; + end; + end; + end; + end; + end; + +Procedure ZmodemProtocol.ExtractFileInfo; +Var + Tmp : Word = 1; + Str : String = ''; +Begin + PathName := ''; + + While DataBlock^[Tmp] <> #0 Do Begin + PathName := PathName + DataBlock^[Tmp]; + + Inc (Tmp); + End; + + PathName := DestDir + JustFile(PathName); + + Inc (Tmp); + + While (DataBlock^[Tmp] <> #32) and (DataBlock^[Tmp] <> #0) Do Begin + Str := Str + DataBlock^[Tmp]; + + Inc (Tmp); + End; + + SrcFileLen := strS2I(Str); + BytesRemaining := SrcFileLen; + BytesTransferred := 0; +End; + + procedure ZmodemProtocol.apPrepareWriting; + {-Prepare to save protocol blocks (usually opens a file)} + var + Result : Word; + FileExists : Boolean; + FileLen : LongInt; +// FileDate : LongInt; + FileOpt : Byte; + FileSkip : Boolean; + SeekPoint : LongInt; + FileStartOfs : LongInt; + + + label + ExitPoint; + + begin + ProtocolStatus := ecOk; + + {Set file mgmt options} + FileSkip := (FileMgmtOpts and FileSkipMask) = FileSkipMask; + FileOpt := FileMgmtOpts and FileMgmtMask; + + {Does the file exist already?} + SaveMode := FileMode; {!!.02} + FileMode := 66; {!!.02}{!!.03} + Assign(WorkFile, PathName); + {$i-} + Reset(WorkFile, 1); + FileMode := SaveMode; {!!.02} + Result := IOResult; + + {Exit on errors other than FileNotFound} + if (Result <> 0) and (Result <> 2) and (Result <> 110) then begin + ProtocolStatus := Result; + goto ExitPoint; + end; + + {Note if file exists, its size and timestamp} + FileExists := (Result = 0); + if FileExists then begin + FileLen := FileSize(WorkFile); +// GetFTime(WorkFile, FileDate); +// FileDate := apPackToYMTimeStamp(FileDate); + end; + Close(WorkFile); + if IOResult = 0 then ; + + if FileExists and (SrcFileLen > FileLen) and (AllowResume) then begin + SeekPoint := FileLen; + FileStartOfs := FileLen; + InitFilePos := FileLen; + end else begin + InitFilePos := 0; + + if FileSkip and not FileExists then begin + ProtocolStatus := ecFileDoesntExist; + goto ExitPoint; + end; + + SeekPoint := 0; + FileStartOfs := 0; + + case FileOpt of +(* + WriteNewerLonger : {Transfer only if new, newer or longer} + if FileExists then + if (SrcFileDate <= FileDate) and + (SrcFileLen <= FileLen) then begin + ProtocolStatus := ecCantWriteFile; + goto ExitPoint; + end; +*) + WriteAppend : {Transfer regardless, append if exists} + if FileExists then + SeekPoint := FileLen; + WriteClobber : {Transfer regardless, overwrite} ; + {Nothing to do, this is the normal behavior} + WriteDifferent : {Transfer only if new, size diff, or dates diff} + if FileExists then + if {(SrcFileDate = FileDate) and} + (SrcFileLen = FileLen) then begin + ProtocolStatus := ecCantWriteFile; + goto ExitPoint; + end; + WriteProtect : {Transfer only if dest file doesn't exist} + if FileExists then begin + ProtocolStatus := ecCantWriteFile; + goto ExitPoint; + end; +(* + WriteCrc, {Not supported, treat as WriteNewer} + WriteNewer : {Transfer only if new or newer} + if FileExists then + if SrcFileDate <= FileDate then begin + ProtocolStatus := ecCantWriteFile; + goto ExitPoint; + end; +*) + end; + end; + + {Rewrite or append to file} + Assign(WorkFile, Pathname); + if SeekPoint = 0 then begin + {New or overwriting destination file} + Rewrite(WorkFile, 1); + end else begin + {Appending to file} + {$i-} + Reset(WorkFile, 1); + Seek(WorkFile, SeekPoint); + end; + Result := IOResult; + if Result <> 0 then begin + ProtocolStatus := Result; + goto ExitPoint; + end; + + {Initialized the buffer management vars} + FileOfs := FileStartOfs; + StartOfs := FileStartOfs; + LastOfs := FileStartOfs; + EndOfs := StartOfs + FileBufferSize; + FileOpen := True; + Exit; + +ExitPoint: + Close(WorkFile); + if IOResult <> 0 then ; + {FreeMemCheck(FileBuffer, FileBufferSize);} {!!.01} + end; + + procedure ZmodemProtocol.apFinishWriting; + {-Cleans up after saving all protocol blocks} + var + BytesToWrite : Word; + BytesWritten : LongInt; + Result : Word; +// PackTime : LongInt; + begin + if FileOpen then begin + {Error or end-of-file, commit buffer} + BytesToWrite := FileOfs - StartOfs; + BlockWrite(WorkFile, FileBuffer^, BytesToWrite, BytesWritten); + Result := IOResult; + if (Result <> 0) or (BytesToWrite <> BytesWritten) then + ProtocolStatus := Result; + + {Set the timestamp to that of the source file} +// PackTime := apYMTimeStampToPack(SrcFileDate); +// SetFTime(WorkFile, PackTime); + + {Clean up} + Close(WorkFile); + if IOResult <> 0 then ; + {FreeMemCheck(FileBuffer, FileBufferSize);} {!!.01} + FileOpen := False; + end; + end; + + procedure ZmodemProtocol.zpWriteDataBlock; + var + Failed : Boolean; + TempStatus : Word; + begin + Failed := apWriteProtocolBlock(DataBlock^, DataBlockLen); + + if Failed then begin + TempStatus := ProtocolStatus; + CancelTransfer; + ProtocolStatus := TempStatus; + end else begin + Inc (FileOfs, DataBlockLen); + Dec (BytesRemaining, DataBlockLen); + Inc (BytesTransferred, DataBlockLen); + end; + end; + +Procedure ZmodemProtocol.PrepareReceivePart; +Begin + GotOneFile := False; + + apResetStatus; + apShowFirstStatus; + + StatusTimer := TimerSet(StatusInterval); + + APort.PurgeInputdata(0); + + HeaderType := ZrInit; + ZmodemState := rzRqstFile; + HeaderState := hsNone; + SaveStatus := ecOk; + ProtocolStatus := ecOk; +End; + + function ZmodemProtocol.ProtocolReceivePart : ProtocolStateType; + {-Perform one "increment" of a protocol receive} + label + ExitPoint; + var + BlockSize : Word; + Handshake : Char; + C : Char; + begin + ProtocolStatus := SaveStatus; + + If {ForceStatus or} TimerUp(StatusTimer) then begin + If Not APort.Connected or (apHandleAbort and (ProtocolStatus <> ecCancelRequested)) Then Begin + CancelTransfer; + + ZmodemState := rzError; + End; + + apUserStatus(False, False); + + StatusTimer := TimerSet(StatusInterval); + ForceStatus := False; + end; + + 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 + zpCheckForHeader; + if ProtocolStatus = ecCancelRequested then + ZmodemState := rzError; + end else if TimerUp(ReplyTimer) then + ProtocolStatus := ecTimeout + else + ProtocolStatus := ecNoHeader; + end; + end; + +// zlog('main rcv state loop: ' + strI2S(Ord(ZmodemState))); + + {Main state processor} + 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;} + + WaitMS(500); + + zpPutHexHeader(HeaderType); + + ZmodemState := rzWaitFile; + HeaderState := hsNone; + ReplyTimer := TimerSet(HandshakeWait); + end; + + rzSendBlockPrep : + if APort.DataWaiting then begin + {Discard the first two chars} + C := APort.ReadChar; + Inc(DiscardCnt); + if DiscardCnt = 2 then + ZmodemState := rzSendBlock; + end else if TimerUp(ReplyTimer) then begin + Inc(BlockErrors); + Inc(TotalErrors); + if TotalErrors < HandshakeRetry then + ZmodemState := rzRqstFile + else + ZmodemState := rzCleanup; + end; + + rzSendBlock : + if APort.DataWaiting then begin + {Collect the data subpacket} + + if zpReceiveBlock(DataBlock^, BlockSize, Handshake) then + if ProtocolStatus = ecBlockCheckError then + {Error receiving block, go try again} + ZmodemState := rzRqstFile + else + {Got block OK, go process} + ZmodemState := rzSendInit + else if ProtocolStatus = ecCancelRequested then + ZmodemState := rzError; + end else if TimerUp(ReplyTimer) then begin + Inc(BlockErrors); + if BlockErrors < HandshakeRetry then begin + zpPutHexHeader(ZNak); + ReplyTimer := TimerSet(HandshakeWait); + ZmodemState := rzWaitFile; + HeaderState := hsNone; + end else + ZmodemState := rzCleanup; + end; + + rzSendInit : + begin + Move(DataBlock^, AttentionStr, MaxAttentionLen); + + EscapeAll := (RcvHeader[ZF0] and EscAll) = EscAll; + + zpPutHexHeader(ZAck); + ZmodemState := rzWaitFile; + + ReplyTimer := TimerSet(HandshakeWait); + end; + + rzWaitFile : begin +// zlog('rzWaitFile -> start'); +// zlog('rzWaitFile -> status=' + stri2s(ProtocolStatus)); + case ProtocolStatus of + ecGotHeader : + begin + case RcvFrame of + ZrQInit : {Go send ZrInit again} + ZmodemState := rzRqstFile; + ZFile : {Beginning of file transfer attempt} + begin +// zlog('rzWaitFile --> got zFile'); + {Save conversion and transport options} +// ConvertOpts := RcvHeader[ZF0]; +// TransportOpts := RcvHeader[ZF2]; + + {Save file mgmt options (if not overridden)} + if not FileMgmtOverride then + FileMgmtOpts := RcvHeader[ZF1]; + + {Set file mgmt default if none specified} + if FileMgmtOpts = 0 then + FileMgmtOpts := WriteNewer; + + {Start collecting the ZFile's data subpacket} + ZmodemState := rzCollectFile; + BlockErrors := 0; + DataBlockLen := 0; + RcvBlockState := rbData; + ReplyTimer := TimerSet(HandShakeWait); + end; + + ZSInit : + begin + BlockErrors := 0; + DataBlockLen := 0; + RcvBlockState := rbData; + ReplyTimer := TimerSet(HandShakeWait); + if WasHex then begin + ZmodemState := rzSendBlockPrep; + DiscardCnt := 0; + end else + ZmodemState := rzSendBlock; + end; + + ZFreeCnt : {Sender is requesting a count of our freespace} + begin + LongInt(TransHeader) := DiskFree(0); + zpPutHexHeader(ZAck); + end; + + ZCommand : {Commands not implemented} + begin + zpPutHexHeader(ZNak); + end; + + ZCompl, + ZFin: {Finished} + begin + ZmodemState := rzSendFinish; + BlockErrors := 0; + end; + end; + ReplyTimer := TimerSet(HandshakeWait); + end; + ecNoHeader : + {Keep waiting for a header} ; + ecBlockCheckError, + ecTimeout : + begin + Inc(BlockErrors); + if BlockErrors < HandshakeRetry then + ZmodemState := rzRqstFile + else begin + {Failed to handsake} + ProtocolStatus := ecFailedToHandshake; + ZmodemState := rzCleanup; + end; + end; + end; + end; + + rzCollectFile : + if APort.DataWaiting then begin + {Collect the data subpacket} + if zpReceiveBlock(DataBlock^, BlockSize, Handshake) then + if ProtocolStatus = ecBlockCheckError then + {Error getting block, go try again} + ZmodemState := rzRqstFile + else + {Got block OK, go extract file info} + ZmodemState := rzStartFile + else if ProtocolStatus = ecCancelRequested then + ZmodemState := rzError; + end else if TimerUp(ReplyTimer) then begin + Inc(BlockErrors); + if BlockErrors < HandshakeRetry then begin + zpPutHexHeader(ZNak); + ReplyTimer := TimerSet(HandshakeWait); + end else + ZmodemState := rzCleanup; + end; + + rzStartFile : + begin + {Got the data subpacket to the ZFile, extract the file information} + ExtractFileInfo; + + {Call user's LogFile function} + LogFile(@Self, lfReceiveStart); + + {Accept this file} + if not AcceptFile(@Self) then begin + HeaderType := ZSkip; + LogFile(@Self, lfReceiveSkip); + ZmodemState := rzRqstFile; + ProtocolStatus := ecCantWriteFile; + + apUserStatus(False, False); +// ForceStatus := True; + + goto ExitPoint; + end; + + {Prepare to write this file} + apPrepareWriting; + + case ProtocolStatus mod 10000 of + 0 : {Fall thru} ; + ecCantWriteFile, + ecFileDoesntExist : {Skip this file} + begin + HeaderType := ZSkip; + LogFile(@Self, lfReceiveSkip); + ZmodemState := rzRqstFile; + ForceStatus := True; + goto ExitPoint; + end; + else begin {Fatal error opening file} + SaveStatus := ProtocolStatus; + CancelTransfer; + ProtocolStatus := SaveStatus; + ZModemState := rzError; + goto ExitPoint; + end; + end; + + {Go send the initial ZrPos} + ZmodemState := rzSync; + ForceStatus := True; + StartTimer := TimerSeconds; + end; + + rzSync : + begin + APort.PurgeInputData(0); + + ReplyTimer := TimerSet(HandshakeWait); + + LongInt(TransHeader) := FileOfs; + + zpPutHexHeader(ZrPos); + + BytesRemaining := SrcFileLen - FileOfs; + BytesTransferred := FileOfs; + ZmodemState := rzStartData; + HeaderState := hsNone; + end; + + rzStartData : + case ProtocolStatus of + ecGotHeader : + case RcvFrame of + ZData : {One or more data subpackets follow} + begin + if FileOfs <> LastFileOfs then begin + Inc(BlockErrors); + Inc(TotalErrors); + if BlockErrors > MaxBadBlocks then begin + CancelTransfer; + ProtocolStatus := ecTooManyErrors; + ZmodemState := rzError; + goto ExitPoint; + end; + PutAttentionString; + ZmodemState := rzSync; + end else begin + BlockErrors := 0; + ZmodemState := rzCollectData; + DataBlockLen := 0; + RcvBlockState := rbData; + ReplyTimer := TimerSet(HandshakeWait); + end; + end; + ZNak : {Nak received} + begin + Inc(TotalErrors); + Inc(BlockErrors); + if BlockErrors > MaxBadBlocks then begin + CancelTransfer; + ProtocolStatus := ecTooManyErrors; + ZmodemState := rzError; + end else + {Resend ZrPos} + ZmodemState := rzSync; + end; + ZFile : {File frame} + {Already got a File frame, just go send ZrPos again} + ZmodemState := rzSync; + ZEof : {End of current file} + begin + GotOneFile := True; + ProtocolStatus := ecEndFile; + ZmodemState := rzEndOfFile; + end; + else begin + {Error during GetHeader} + Inc(TotalErrors); + Inc(BlockErrors); + if BlockErrors > MaxBadBlocks then begin + CancelTransfer; + ProtocolStatus := ecTooManyErrors; + ZmodemState := rzError; + goto ExitPoint; + end; + PutAttentionString; + ZmodemState := rzSync; + end; + end; + ecNoHeader : + {Just keep waiting for header} ; + ecBlockCheckError, + ecTimeout : + begin + Inc(BlockErrors); + Inc(TotalErrors); + if BlockErrors > HandshakeRetry then begin + {Never got ZData header} + ProtocolStatus := ecFailedToHandshake; + ZmodemState := rzError; + end else + {Timeout out waiting for ZData, go send ZrPos} + ZmodemState := rzSync; + end; + end; + + rzCollectData : + if APort.DataWaiting then begin + ReplyTimer := TimerSet(HandshakeWait); + {Collect the data subpacket} + + if zpReceiveBlock(DataBlock^, BlockSize, Handshake) then begin + SaveStatus := ProtocolStatus; + {Got a block or an error -- process it} + case ProtocolStatus of + ecCancelRequested : {Cancel requested} + ZmodemState := rzError; + ecGotCrcW : {Send requests a wait} + begin + {Write this block} + zpWriteDataBlock; + if ProtocolStatus = ecOk then begin + {Acknowledge with the current file position} + LongInt(TransHeader) := FileOfs; + zpPutHexHeader(ZAck); + ZmodemState := rzStartData; + HeaderState := hsNone; + end else + ZmodemState := rzError; + end; + ecGotCrcQ : {Zack requested} + begin + {Write this block} + zpWriteDataBlock; + if ProtocolStatus = ecOk then begin + LongInt(TransHeader) := FileOfs; + zpPutHexHeader(ZAck); + {Don't change state - will get next data subpacket} + end else + ZmodemState := rzError; + end; + ecGotCrcG : {Normal subpacket - no response necessary} + begin + {Write this block} + zpWriteDataBlock; + if ProtocolStatus <> ecOk then + ZmodemState := rzError; + end; + ecGotCrcE : {Last data subpacket} + begin + {Write this block} + zpWriteDataBlock; + if ProtocolStatus = ecOk then begin + ZmodemState := rzWaitEof; + HeaderState := hsNone; + BlockErrors := 0; + end else + ZmodemState := rzError; + end; + else begin {Error during ReceiveBlock} + if BlockErrors < MaxBadBlocks then begin + PutAttentionString; + ZmodemState := rzSync; + end else begin + ProtocolStatus := ecGarbage; + ZmodemState := rzError; + end; + end; + end; + + {Restore ProtocolStatus so user status routine can see it} + if ProtocolStatus = ecOk then + ProtocolStatus := SaveStatus; + + {Prepare to collect next block} +// ForceStatus := True; + DataBlockLen := 0; + RcvBlockState := rbData; + end else if ProtocolStatus = ecCancelRequested then + 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; + end; + + rzWaitEof : + case ProtocolStatus of + ecGotHeader : + case RcvFrame of + ZEof : {End of current file} + begin + GotOneFile := True; + ProtocolStatus := ecEndFile; + apUserStatus(False, False); + apFinishWriting; + if ProtocolStatus = ecEndFile then + LogFile(@Self, lfReceiveOk) + else + LogFile(@Self, lfReceiveFail); + + {Go get the next file} + ZmodemState := rzRqstFile; + end; + else begin + {Error during GetHeader} + Inc(TotalErrors); + Inc(BlockErrors); + if BlockErrors > MaxBadBlocks then begin + CancelTransfer; + ProtocolStatus := ecTooManyErrors; + ZmodemState := rzError; + goto ExitPoint; + end; + PutAttentionString; + ZmodemState := rzSync; + end; + end; + ecNoHeader : + {Just keep waiting for header} ; + ecBlockCheckError, + ecTimeout : + begin + Inc(BlockErrors); + Inc(TotalErrors); + if BlockErrors > HandshakeRetry then begin + {Never got ZData header} + ProtocolStatus := ecFailedToHandshake; + ZmodemState := rzError; + end else + {Timeout out waiting for ZData, go send ZrPos} + ZmodemState := rzSync; + end; + end; + + rzEndOfFile : + if FileOfs = LastFileOfs then begin + apFinishWriting; + + {Send Proper status to user logging routine} + if ProtocolStatus = ecEndFile then + LogFile(@Self, lfReceiveOk) + else + LogFile(@Self, lfReceiveFail); + + ZmodemState := rzRqstFile; + end else + ZmodemState := rzSync; + + rzSendFinish : + begin + {Insert file position into header} + LongInt(TransHeader) := FileOfs; + zpPutHexHeader(ZFin); + ZmodemState := rzCollectFinish; + ReplyTimer := TimerSet(FinishWait); + OCnt := 0; + end; + + rzCollectFinish : + begin + if APort.DataWaiting then begin + C := APort.ReadChar; + if C = 'O' then begin + Inc(OCnt); + if OCnt = 2 then + ZmodemState := rzCleanup; + end; + end else if TimerUp(ReplyTimer) then begin + {Retry 3 times only (same as DSZ)} + Inc(BlockErrors); + if BlockErrors < FinishRetry then + {Go send ZFin again} + ZmodemState := rzSendFinish + else + {Cleanup anyway} + ZmodemState := rzCleanup; + end; + end; + + rzError : + begin + if FileOpen then begin + SaveStatus := ProtocolStatus; + apFinishWriting; + ProtocolStatus := SaveStatus; + LogFile(@Self, lfReceiveFail); + end; + ZmodemState := rzCleanup; + + APort.BufFlush; + ZModemState := rzCleanup; + end; + +// rzWaitCancel : +// ZmodemState := rzCleanup; + + rzCleanup : + begin + apShowLastStatus; + APort.PurgeInputData(0); + ZmodemState := rzDone; + end; + end; + +ExitPoint: + {Set function result} + case ZmodemState of + rzRqstFile, + rzSendInit, + rzSendBlockPrep, {!!.03} + rzSendBlock, + rzSync, + rzStartFile, + rzGotData, + rzEndOfFile, + rzSendFinish, + rzError, + rzCleanup : ProtocolReceivePart := psReady; + + rzCollectFinish, +// rzDelay, +// rzWaitCancel, + rzWaitFile, + rzCollectFile, + rzStartData, + rzCollectData, + rzWaitEof : ProtocolReceivePart := psWaiting; + + rzDone : ProtocolReceivePart := psFinished; + end; + + {Clear header state if we just processed a header} + if (ProtocolStatus = ecGotHeader) or (ProtocolStatus = ecNoHeader) then + ProtocolStatus := ecOk; + if HeaderState = hsGotHeader then + HeaderState := hsNone; + + {Store ProtocolStatus} + SaveStatus := ProtocolStatus; + end; + +Procedure ZmodemProtocol.PrepareTransmitPart; +Begin + FileListIndex := 0; + HeaderState := hsNone; + + apResetStatus; + apShowFirstStatus; + + StatusTimer := TimerSet(StatusInterval); + ForceStatus := False; + ZmodemState := tzInitial; + FilesSent := False; + SaveStatus := ecOk; + ProtocolStatus := ecOk; +End; + + function ZmodemProtocol.ProtocolTransmitPart : ProtocolStateType; + label + ExitPoint; + const + RZcommand : array[1..4] of Char = 'rz'+cCr+#0; + var + NewInterval : Word; + begin + ProtocolStatus := SaveStatus; + + if {ForceStatus or} TimerUp(StatusTimer) then begin + If Not APort.Connected or (apHandleAbort and (ProtocolStatus <> ecCancelRequested)) Then Begin + CancelTransfer; + + ZmodemState := tzError; + End; + + apUserStatus(False, False); + + StatusTimer := TimerSet(StatusInterval); + ForceStatus := False; + end; + + {Preprocess header requirements} + case ZmodemState of + tzHandshake, + tzCheckFile, + tzCheckEOF, + tzCheckFinish, + tzSendData, + tzWaitAck : begin + if (zmodemstate <> tzsenddata) and not aport.datawaiting then aport.waitfordata(1000); + {Header might be present, try to get one} + if APort.DataWaiting then begin + zpCheckForHeader; + + if ProtocolStatus = ecCancelRequested then + ZmodemState := tzError; + + end else if TimerUp(ReplyTimer) then + ProtocolStatus := ecTimeout + else + ProtocolStatus := ecNoHeader; + end; + end; + + {Process the current state} + case ZmodemState of + tzInitial : + begin + CanCount := 0; + + {Send RZ command (via the attention string)} + Move(RZcommand, AttentionStr, SizeOf(RZcommand)); + PutAttentionString; + FillChar(AttentionStr, SizeOf(AttentionStr), 0); + + {Send ZrQinit header (requests receiver's ZrInit)} + LongInt(TransHeader) := 0; + zpPutHexHeader(ZrQInit); + + ReplyTimer := TimerSet(HandshakeWait); + ZmodemState := tzHandshake; + HeaderState := hsNone; + +// zlog('tzInitial -> sent ZRQINIT'); + end; + + tzHandshake : begin + +// zlog('tzHandshake -> ProtocolStatus = ' + stri2s(ProtocolStatus)); +// zlog('tzHandshake -> rcvFrame = ' + stri2s(ord(rcvframe))); + + case ProtocolStatus of + ecGotHeader : + case RcvFrame of + ZrInit : {Got ZrInit, extract info} + begin + ExtractReceiverInfo; + ZmodemState := tzGetFile; + end; + ZChallenge : {Receiver is challenging, respond with same number} + begin + TransHeader := RcvHeader; + zpPutHexHeader(ZAck); + end; + ZCommand : {Commands not supported} + zpPutHexHeader(ZNak); + ZrQInit : {Remote is trying to transmit also, do nothing} + ; + else {Unexpected reply, nak it} + zpPutHexHeader(ZNak); + end; + ecNoHeader : + {Keep waiting for header} ; + ecBlockCheckError, + ecTimeout : {Send another ZrQinit} + begin + Inc(BlockErrors); + Inc(TotalErrors); + if BlockErrors > HandshakeRetry then begin + {Never got ZrInit} + ProtocolStatus := ecFailedToHandshake; + ZmodemState := tzError; + end else begin + zpPutHexHeader(ZrQInit); + ReplyTimer := TimerSet(HandshakeWait); + end; + end; + end; + end; + + tzGetFile : + begin +// zlog('tzGetFile -> start'); + {Get the next file to send} + if not NextFile(@Self, Pathname) then begin +// zlog('tzGetFile -> no next file'); + ZmodemState := tzSendFinish; + goto ExitPoint; + end else + FilesSent := True; + + {Show file name to user logging routine} + LogFile(@Self, lfTransmitStart); + + {Prepare to read file blocks} + apPrepareReading; + + if ProtocolStatus <> ecOk then begin + SaveStatus := ProtocolStatus; + CancelTransfer; + ProtocolStatus := SaveStatus; + LogFile(@Self, lfTransmitFail); + ZmodemState := tzCleanup; + goto ExitPoint; + end; + + StartTimer := TimerSeconds; + + LongInt(TransHeader) := 0; + TransHeader[ZF1] := FileMgmtOpts; + + if AllowResume then + TransHeader[ZF0] := $03; + + {Insert file information into header} + InsertFileInfo; + ForceStatus := True; + ZmodemState := tzSendFile; + + BlockErrors := 0; + end; + + tzSendFile : + begin +// zlog('tzSendFile -> start'); + {Send the ZFile header and data subpacket with file info} + + zpPutBinaryHeader(ZFile); + Terminator := ZCrcW; + EscapeBlock(DataBlock^, DataBlockLen); + TransmitBlock; + + {Clear status vars that zpTransmitBlock changed} + BytesTransferred := 0; + BytesRemaining := 0; + + {Go wait for response} + ReplyTimer := TimerSet(HandshakeWait); + ZmodemState := tzCheckFile; + HeaderState := hsNone; + end; + + tzCheckFile : begin +// zlog('tzCheckFile -> status=' + stri2s(ProtocolStatus)); +// zlog('tzCheckFile -> rcvframe=' + stri2s(ord(rcvframe))); + case ProtocolStatus of + ecGotHeader : + case RcvFrame of + ZrInit : ; + ZCrc : + begin + LongInt(TransHeader) := FileCRC32(PathName); + zpPutHexHeader(ZCrc); + end; + ZSkip : {Receiver wants to skip this file} + begin + ProtocolStatus := ecSkipFile; + apUserStatus(False, False); + ProtocolStatus := ecOk; + + {Close file and log skip} + apFinishReading; + LogFile(@Self, lfTransmitSkip); + + {Go look for another file} + ZmodemState := tzGetFile; + end; + ZrPos : {Receiver tells us where to seek in our file} + begin + {Get file offset} + FileOfs := LongInt(RcvHeader); + BytesTransferred := FileOfs; + InitFilePos := FileOfs; + BytesRemaining := SrcFileLen - BytesTransferred; + + {Go send the data subpackets} + ZModemState := tzStartData; + end; + end; + ecNoHeader : ;// zlog('tzCheckFile -> no header');{Keep waiting for header} + ecBlockCheckError, + ecTimeout : {Timeout waiting for response to ZFile} + begin + Inc(BlockErrors); + Inc(TotalErrors); + if BlockErrors > HandshakeRetry then begin + {Never got response to ZFile} + ProtocolStatus := ecTimeout; + ZmodemState := tzError; + end else begin + {Resend ZFile} + ZmodemState := tzSendFile; + end; + end; + end; + end; + + tzStartData : + begin +// zlog('tzStartData -> start'); + {Get ready} + DataInTransit := 0; + BlockErrors := 0; + + {Send ZData header} + LongInt(TransHeader) := FileOfs; + zpPutBinaryHeader(ZData); + + ZmodemState := tzEscapeData; + end; + + tzEscapeData : + begin + {Get a block to send} + if TookHit then begin + Inc(GoodAfterBad); + if GoodAfterBad > 4 then begin + TookHit := False; + if BlockLen < ZMaxBlk[Use8KBlocks] then + BlockLen := ZMaxBlk[Use8KBlocks]; + end; + end; + DataBlockLen := BlockLen; + LastBlock := apReadProtocolBlock(DataBlock^, DataBlockLen); + if ProtocolStatus <> ecOk then begin + SaveStatus := ProtocolStatus; + CancelTransfer; + ProtocolStatus := SaveStatus; + ZmodemState := tzError; + goto ExitPoint; + end; + + {Show the new data on the way} + if RcvBuffLen <> 0 then + Inc(DataInTransit, DataBlockLen); + + {Set the terminator} + if LastBlock then + {Tell receiver its the last subpacket} + Terminator := ZCrcE + else if (RcvBuffLen <> 0) and (DataInTransit >= RcvBuffLen) then begin + {Receiver's buffer is nearly full, wait for acknowledge} + Terminator := ZCrcW; + {NoFallBack := True;} + end else + {Normal data subpacket, no special action} + Terminator := ZCrcG; + + EscapeBlock(DataBlock^, DataBlockLen); + + ZmodemState := tzSendData; + ReplyTimer := TimerSet(TransTimeout); + BlockErrors := 0; + end; + + tzSendData : + case ProtocolStatus of + ecNoHeader : {Nothing from receiver, keep going} + begin + {Wait for buffer free space} +// if APort.OutBuffFree > WorkSize + FreeMargin then begin + TransmitBlock; + if LastBlock then begin + ZmodemState := tzSendEof; + BlockErrors := 0; + end else if Terminator = ZCrcW then begin + ReplyTimer := TimerSet(TransTimeout); + ZmodemState := tzWaitAck; + end else + ZmodemState := tzEscapeData; + ForceStatus := True; +// end else + {Timeout will be handled at top of state machine} + end; + + ecGotHeader : {Got a header from the receiver, process it} + begin + case RcvFrame of + ZCan, ZAbort : {Receiver says quit} + begin + ProtocolStatus := ecCancelRequested; + ZmodemState := tzError; + end; + ZrPos : {Receiver is sending its desired file position} + begin + FileOfs := LongInt(RcvHeader); + BytesTransferred := FileOfs; + BytesRemaining := SrcFileLen - BytesTransferred; + + Inc(TotalErrors); + {We got a hit, reduce block size by 1/2} + if BlockLen > 256 then + BlockLen := BlockLen shr 1; + TookHit := True; + GoodAfterBad := 0; + APort.PurgeOutputData; + ZModemState := tzStartData; + end; + ZAck : {Response to last CrcW data subpacket} + ; + ZSkip, ZrInit : {Finished with this file} + ; + else begin + {Garbage, send Nak} + zpPutBinaryHeader(ZNak); + end; + end; + end; + + ecBlockCheckError : + zpPutBinaryHeader(ZNak); + + ecTimeout : + if TimerUp(ReplyTimer) then begin + ProtocolStatus := ecBufferIsFull; + ZmodemState := tzError; + end; + end; + + tzWaitAck : + case ProtocolStatus of + ecGotHeader : + case RcvFrame of + ZCan, ZAbort : {Receiver says quit} + begin + ProtocolStatus := ecCancelRequested; + ZmodemState := tzError; + end; + ZAck : + ZmodemState := tzStartData; + ZrPos : {Receiver is sending its desired file position} + begin + FileOfs := LongInt(RcvHeader); + BytesTransferred := FileOfs; + BytesRemaining := SrcFileLen - BytesTransferred; + Inc(TotalErrors); + if BlockLen > 256 then + BlockLen := BlockLen shr 1; + TookHit := True; + GoodAfterBad := 0; + APort.PurgeOutputData; + ZmodemState := tzStartData; + end; + else begin + {Garbage, send Nak} + zpPutBinaryHeader(ZNak); + end; + end; + ecBlockCheckError, + ecTimeout : + begin + Inc(TotalErrors); + if TotalErrors > MaxBadBlocks then + ZmodemState := tzError + else + ZmodemState := tzStartData; + end; + end; + + tzSendEof : + begin + {Send the eof} + LongInt(TransHeader) := FileOfs; + zpPutBinaryHeader(ZEof); + ReplyTimer := TimerSet(TransTimeout); + ZModemState := tzDrainEof; +// NewTimer(StatusTimer, DrainingStatusInterval); + end; + + tzDrainEof : + begin + APort.BufFlush; + zmodemstate := tzCheckEof; + HeaderState := hsNone; + ReplyTimer := TimerSet(FinishWait); + End; + + tzCheckEof : + case ProtocolStatus of + ecGotHeader : + begin + case RcvFrame of + ZCan, ZAbort : {Receiver says quit} + begin + ProtocolStatus := ecCancelRequested; + ZmodemState := tzError; + end; + ZrPos : {Receiver is sending its desired file position} + begin + FileOfs := LongInt(RcvHeader); + BytesTransferred := FileOfs; + BytesRemaining := SrcFileLen - BytesTransferred; + + {We got a hit, reduce block size by 1/2} + if BlockLen > 256 then + BlockLen := BlockLen shr 1; + TookHit := True; + GoodAfterBad := 0; + APort.PurgeOutputData; + ZModemState := tzStartData; + end; + ZAck : {Response to last CrcW data subpacket} + ; + ZSkip, ZrInit : {Finished with this file} + begin + {Close file and log success} + apFinishReading; + ProtocolStatus := ecOk; + LogFile(@Self, lfTransmitOk); + + {Go look for another file} + ZmodemState := tzGetFile; + end; + else begin + {Garbage, send Nak} + zpPutBinaryHeader(ZNak); + end; + end; + end; + ecNoHeader : + {Keep waiting for header} ; + ecBlockCheckError, + ecTimeout : + begin + Inc(BlockErrors); + Inc(TotalErrors); + if BlockErrors > MaxBadBlocks then + ZmodemState := tzError + else + ZmodemState := tzSendEof; + end; + end; + + tzSendFinish : + begin + LongInt(TransHeader) := FileOfs; + zpPutHexHeader(ZFin); + ReplyTimer := TimerSet(FinishWait); + BlockErrors := 0; + ZmodemState := tzCheckFinish; + HeaderState := hsNone; + end; + + tzCheckFinish : + case ProtocolStatus of + ecGotHeader : + case RcvFrame of + ZFin : + begin + APort.BufWriteChar('O'); + APort.BufWriteChar('O'); + APort.BufFlush; + ZmodemState := tzCleanup; + end; + else begin + ProtocolStatus := ecOk; + ZmodemState := tzCleanup; + end; + end; + ecNoHeader : + {Keep waiting for header} ; + ecBlockCheckError, + ecTimeout : + begin + {Just give up} + ZmodemState := tzCleanup; + ProtocolStatus := ecOk; + end; + end; + + tzError : + begin + if FileOpen then begin + apFinishReading; + LogFile(@Self, lfTransmitFail); + end; + ZmodemState := tzCleanup; + APort.PurgeOutputData; + end; + + tzCleanup: + begin + apShowLastStatus; + + APort.PurgeInputData(0); + + ZmodemState := tzDone; + end; + end; + +ExitPoint: + case ZmodemState of + tzHandshake, + tzCheckFile, + tzEscapeData, + tzSendData, + tzWaitAck, + tzDrainEof, + tzCheckEof, + tzCheckFinish : ProtocolTransmitPart := psWaiting; + + tzInitial, + tzGetFile, + tzSendFile, + tzStartData, + tzSendEof, + tzSendFinish, + tzError, + tzCleanup : ProtocolTransmitPart := psReady; + + tzDone : ProtocolTransmitPart := psFinished; + end; + + {Clear header state if we just processed a header} + if (ProtocolStatus = ecGotHeader) or (ProtocolStatus = ecNoHeader) then + ProtocolStatus := ecOk; + + if HeaderState = hsGotHeader then + HeaderState := hsNone; + + {Store ProtocolStatus} + SaveStatus := ProtocolStatus; + end; + +Procedure ZmodemProtocol.PutCharEscaped (C: Char); +Var + C1: Char; + C2: Char; +Begin + ProtocolStatus := ecOK; + + If EscapeAll and ((Byte(C) and $60) = 0) Then Begin + APort.BufWriteChar(ZDLE); + + LastChar := Char(Byte(C) XOR $40); + End Else If ((Byte(C) AND $11) = 0) Then + LastChar := C + Else Begin + C1 := Char(Byte(C) AND $7F); + C2 := Char(Byte(LastChar) AND $7F); + + Case C of + cXON, + cXOFF, + cDLE, + cXONHI, + cXOFFHI, + cDLEHI, + ZDLE : Begin + APort.BufWriteChar(ZDle); + + LastChar := Char(Byte(C) XOR $40); + End; + #255 : Begin + APort.BufWriteChar (ZDLE); + + LastChar := ZRUB1; + End; + Else + If ((C1 = cCR) AND (C2 = #$40)) Then Begin + APort.BufWriteChar (ZDLE); + + LastChar := Char(Byte(C) XOR $40); + End Else + LastChar := C; + End; + End; + + APort.BufWriteChar (LastChar); +End; + +Procedure ZmodemProtocol.zpPutBinaryHeader (FrameType: Char); +Var + I : Integer; +Begin + UseCrc32 := CanCrc32; + + With APort Do Begin + BufWriteChar (ZPAD); + BufWriteChar (ZDLE); + + If UseCrc32 Then Begin + PutCharEscaped(ZBIN32); + + BlockCheck := LongInt($FFFFFFFF); + End Else Begin + PutCharEscaped(ZBIN); + + BlockCheck := 0; + End; + + PutCharEscaped (FrameType); + UpdateBlockCheck (Ord(FrameType)); + + For I := 0 to 3 Do Begin + PutCharEscaped (Char(TransHeader[I])); + UpdateBlockCheck (Ord(TransHeader[I])) + End; + + SendBlockCheck; + End; + + LastFrame := FrameType; +End; + +Function ZmodemProtocol.EscapeCharacter (C: Char) : Str2; +Var + C1 : Char; + C2 : Char; +Begin + If EscapeAll and ((Byte(C) and $60) = 0) Then Begin + Result := ZDLE + Char(Byte(C) XOR $40); + + Exit; + End Else If ((Byte(C) and $11) = 0) Then + LastChar := C + Else Begin + C1 := Char(Byte(C) AND $7F); + C2 := Char(Byte(LastChar) AND $7F); + + Case C of + cXON, + cXOFF, + cDLE, + cXONHI, + cXOFFHI, + cDLEHI, + ZDLE : Begin + LastChar := Char(Byte(C) XOR $40); + Result := ZDLE + LastChar; + + Exit; + End; + #255 : Begin + LastChar := ZRUB1; + Result := ZDLE + ZRUB1; + + Exit; + End; + Else + If ((C1 = cCR) and (C2 = #$40)) Then Begin + LastChar := Char(Byte(C) XOR $40); + Result := ZDLE + LastChar; + + Exit; + End Else + LastChar := C; + End; + End; + + Result := LastChar; +End; + +Procedure ZmodemProtocol.EscapeBlock (Var Block: DataBlockType; BLen: Word); +Var + I : Word; + S2 : String[2]; +Begin + If CanCrc32 Then Begin + UseCrc32 := True; + BlockCheck := LongInt($FFFFFFFF); + End Else Begin + UseCrc32 := False; + BlockCheck := 0; + End; + + If BLen > 0 Then Begin + WorkSize := 1; + I := 1; + + Repeat + S2 := EscapeCharacter(Block[I]); + + UpdateBlockCheck(Byte(Block[I])); + + Move(S2[1], WorkBlock^[WorkSize], Length(S2)); + + Inc (I); + Inc (WorkSize, Length(S2)); + Until I > BLen; + + Dec (WorkSize); + End Else + WorkSize := 0; +End; + +Procedure ZmodemProtocol.TransmitBlock; +Var + Count : LongInt; +Begin + For Count := 1 to WorkSize Do + APort.BufWriteChar(WorkBlock^[Count]); + + UpdateBlockCheck (Byte(Terminator)); + + APort.BufWriteChar (ZDLE); + APort.BufWriteChar (Terminator); + + SendBlockCheck; + + If Terminator = ZCrcW Then + APort.BufWriteChar(cXon); + + Inc (FileOfs, DataBlockLen); + Inc (BytesTransferred, DataBlockLen); + Dec (BytesRemaining, DataBlockLen); + + APort.BufFlush; +End; + +Procedure ZmodemProtocol.InsertFileInfo; +Var + PacketStr : String; + PacketLen : Byte; +Begin + FillChar (DataBlock^, ZMaxBlk[Use8KBlocks] , 0); + + PacketStr := JustFile(PathName); + + If ConvertToLower Then + PacketStr := strLower(PacketStr); + + PacketStr := PacketStr + #0 + strI2S(SrcFileLen); + PacketLen := Length(PacketStr); + + Move(PacketStr[1], DataBlock^, PacketLen); + + DataBlockLen := PacketLen; + BytesRemaining := SrcFileLen; + BytesTransferred := 0; +End; + +Procedure ZmodemProtocol.ExtractReceiverInfo; +Begin + RcvBuffLen := RcvHeader[ZP0] + ((RcvHeader[ZP1]) SHL 8); + CanCrc32 := (RcvHeader[ZF0] and CanFC32) = CanFC32; + EscapeAll := (RcvHeader[ZF0] and EscAll) = EscAll; +End; + +End.