1684 lines
40 KiB
ObjectPascal
1684 lines
40 KiB
ObjectPascal
Unit m_Protocol_Zmodem;
|
|
|
|
{$I M_OPS.PAS}
|
|
|
|
{$DEFINE ZDEBUG}
|
|
|
|
Interface
|
|
|
|
Uses
|
|
DOS,
|
|
m_CRC,
|
|
m_DateTime,
|
|
m_FileIO,
|
|
m_Strings,
|
|
m_Input,
|
|
m_Socket_Class,
|
|
m_Protocol_Base,
|
|
m_Protocol_Queue;
|
|
|
|
Const
|
|
ZBufSize = 1024; // 1024 only maybe 8k ZEDZAP someday
|
|
ZAttnLen = 32;
|
|
RxTimeOut : Word = 500;
|
|
|
|
Type
|
|
ZHdrType = Array[0..3] of Byte;
|
|
ZBufType = Array[0..ZBUFSIZE - 1] of Byte;
|
|
|
|
TProtocolZmodem = Class(TProtocolBase)
|
|
UseCRC32 : Boolean;
|
|
EscapeAll : Boolean;
|
|
LastSent : Byte;
|
|
Attn : String[ZAttnLen];
|
|
TxHdr : ZHdrType;
|
|
TxBuf : ZBufType;
|
|
RxBuf : ZBufType;
|
|
RxFrameIdx : SmallInt;
|
|
RxType : Byte;
|
|
TxPos : LongInt;
|
|
RxPos : LongInt;
|
|
RxHdr : ZHdrType;
|
|
RxBufLen : SmallInt;
|
|
WrkFile : File;
|
|
RxBytes : LongInt;
|
|
RxCount : LongInt;
|
|
|
|
Constructor Create (Var C: TSocketClass; Var Q: TProtocolQueue); Override;
|
|
Destructor Destroy; Override;
|
|
|
|
Procedure QueueReceive; Override;
|
|
Procedure QueueSend; Override;
|
|
|
|
Function ZInitReceiver : SmallInt;
|
|
Function ZGetByte : SmallInt;
|
|
Function ZDLRead : SmallInt;
|
|
Function ZGetHex : SmallInt;
|
|
Function ZSendFile : SmallInt;
|
|
Function ZInitSender : SmallInt;
|
|
Function ZReceiveFile : SmallInt;
|
|
Procedure ZPutHex (B: Byte);
|
|
Procedure ZPutLong (Pos: LongInt);
|
|
Procedure ZSendHexHeader (FrameType: Byte);
|
|
Function ZGetHeader (Var Hdr: ZHdrType) : SmallInt;
|
|
Function ZReceiveHexHeader (Var Hdr: ZHdrType) : SmallInt;
|
|
Function ZReceiveBinaryHeader (Var Hdr: ZHdrType) : SmallInt;
|
|
Function ZReceiveBinaryHeader32 (Var Hdr: ZHdrType) : SmallInt;
|
|
Function ZGetLong (Var Hdr: ZHdrType) : LongInt;
|
|
Procedure ZSendBinaryHeader (FrameType: Byte);
|
|
Procedure SendEscaped (B: SmallInt);
|
|
Procedure ZSendData (BufSize : SmallInt; FrameEnd : Byte);
|
|
Function ZReceiveData (Var Buf: ZBufType; Len: SmallInt): SmallInt;
|
|
Procedure ZAckBiBi;
|
|
Procedure ZEndSender;
|
|
Procedure DoAbortSequence;
|
|
End;
|
|
|
|
Implementation
|
|
|
|
Const
|
|
CANBRK = 4;
|
|
EscAll = $0040;
|
|
ZCRC = 13;
|
|
ZABORT = 7;
|
|
ZRQINIT = 0;
|
|
ZPAD = 42;
|
|
ZDLE = 24;
|
|
ZHEX = 66;
|
|
ZACK = 3;
|
|
ZFIN = 8;
|
|
ZERROR = -1;
|
|
ZTIMEOUT = -2;
|
|
RCDO = -3;
|
|
ZBIN32 = 67;
|
|
XON = 17;
|
|
XOFF = 19;
|
|
CAN = 24;
|
|
ZCAN = 16;
|
|
CDLE = 16;
|
|
ZBIN = 65;
|
|
GOTCAN = 272;
|
|
ZCRCE = 104;
|
|
ZCRCG = 105;
|
|
ZCRCQ = 106;
|
|
ZCRCW = 107;
|
|
GOTOR = 256;
|
|
ZRUB0 = 108;
|
|
ZRUB1 = 109;
|
|
ZP0 = 0;
|
|
ZP1 = 1;
|
|
ZP2 = 2;
|
|
ZP3 = 3;
|
|
CANFDX = 1;
|
|
CANOVIO = 2;
|
|
CANBREAK = 4;
|
|
CANFC32 = 32;
|
|
ZCHALLENGE = 14;
|
|
ZRINIT = 1;
|
|
ZF0 = 3;
|
|
ZOK = 0;
|
|
ZSKIP = 5;
|
|
ZCRESUM = 3;
|
|
ZDATA = 10;
|
|
ZFILE = 4;
|
|
ZRPOS = 9;
|
|
ZEOF = 11;
|
|
ZCOMMAND = 18;
|
|
ZNAK = 6;
|
|
GOTCRCE = 360;
|
|
GOTCRCG = 361;
|
|
GOTCRCQ = 362;
|
|
GOTCRCW = 363;
|
|
ZSINIT = 2;
|
|
ZFREECNT = 17;
|
|
ZCOMPL = 15;
|
|
cDleHi = cDle + $80;
|
|
cXonHi = Xon + $80;
|
|
cXoffHi = Xoff + $80;
|
|
|
|
CancelStr : String = #24#24#24#24#24#24#24#24#8#8#8#8#8#8#8#8;
|
|
|
|
{$IFDEF ZDEBUG}
|
|
Function HeaderType (B: SmallInt) : String;
|
|
Begin
|
|
Case B of
|
|
ZERROR : Result := 'ZERROR';
|
|
RCDO : Result := 'RCDO';
|
|
ZTIMEOUT: Result := 'ZTIMEOUT';
|
|
ZBIN : Result := 'ZBIN';
|
|
ZBIN32 : Result := 'ZBIN32';
|
|
ZHEX : Result := 'ZHEX';
|
|
CAN : Result := 'CAN';
|
|
ZRQINIT : Result := 'ZRQINIT';
|
|
ZEOF : Result := 'ZEOF';
|
|
ZFILE : Result := 'ZFILE';
|
|
ZRPOS : Result := 'ZRPOS';
|
|
ZRINIT : Result := 'ZRINIT';
|
|
ZSINIT : Result := 'ZSINIT';
|
|
ZFREECNT: Result := 'ZFREECNT';
|
|
ZCOMMAND: Result := 'ZCOMMAND';
|
|
ZCOMPL : Result := 'ZCOMPL';
|
|
ZFIN : Result := 'ZFIN';
|
|
ZCAN : Result := 'ZCAN';
|
|
ZDATA : Result := 'ZDATA';
|
|
GOTCRCE : Result := 'GOTCRCE';
|
|
GOTCRCG : Result := 'GOTCRCG';
|
|
GOTCRCQ : Result := 'GOTCRCQ';
|
|
GOTCRCW : Result := 'GOTCRCW';
|
|
Else
|
|
Result := 'UNKNOWN:' + strI2S(Ord(B));
|
|
End;
|
|
End;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF ZDEBUG}
|
|
Procedure ZLOG (Str: String);
|
|
Var
|
|
T : Text;
|
|
Begin
|
|
Assign (T, 'zlog.txt');
|
|
{$I-} Append(T); {$I+}
|
|
|
|
If IoResult <> 0 Then ReWrite(T);
|
|
|
|
WriteLn(T, Str);
|
|
|
|
Close(T);
|
|
End;
|
|
{$ENDIF}
|
|
|
|
Constructor TProtocolZmodem.Create (Var C: TSocketClass; Var Q: TProtocolQueue);
|
|
Begin
|
|
Inherited Create (C, Q);
|
|
|
|
Status.Protocol := 'Zmodem';
|
|
LastSent := 0;
|
|
EscapeAll := False;
|
|
Attn := '';
|
|
End;
|
|
|
|
Destructor TProtocolZmodem.Destroy;
|
|
Begin
|
|
Inherited Destroy;
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.ZPutLong (Pos : LongInt);
|
|
Begin
|
|
TxHdr[ZP0] := Byte(Pos);
|
|
TxHdr[ZP1] := Byte(Pos SHR 8);
|
|
TxHdr[ZP2] := Byte(Pos SHR 16);
|
|
TxHdr[ZP3] := Byte(Pos SHR 24);
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.ZPutHex (B: Byte);
|
|
Const
|
|
Digits : Array[0..15] of Char = '0123456789abcdef';
|
|
Begin
|
|
Client.BufWriteChar (Digits[B SHR 4]);
|
|
Client.BufWriteChar (Digits[B AND $0F]);
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.ZSendHexHeader (FrameType: Byte);
|
|
Var
|
|
CRC : SmallInt;
|
|
Count : Byte;
|
|
Begin
|
|
Client.BufWriteChar (Char(ZPAD));
|
|
Client.BufWriteChar (Char(ZPAD));
|
|
Client.BufWriteChar (Char(ZDLE));
|
|
Client.BufWriteChar (Char(ZHEX));
|
|
|
|
ZPutHex (FrameType);
|
|
|
|
CRC := Crc16(FrameType, 0);
|
|
|
|
For Count := 0 to 3 Do Begin
|
|
ZPutHex (TxHdr[Count]);
|
|
CRC := Crc16(TxHdr[Count], CRC);
|
|
End;
|
|
|
|
CRC := Crc16(0, CRC);
|
|
CRC := Crc16(0, CRC);
|
|
|
|
ZPutHex (Lo(SmallInt(CRC SHR 8)));
|
|
ZPutHex (Lo(CRC));
|
|
|
|
Client.BufWriteChar (#13);
|
|
Client.BufWriteChar (#10);
|
|
|
|
If (FrameType <> ZFIN) And (FrameType <> ZACK) Then
|
|
Client.BufWriteChar (Char(XON));
|
|
|
|
Client.BufFlush;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZGetByte : SmallInt;
|
|
Begin
|
|
While Connected Do Begin
|
|
Result := ReadByteTimeOut(RxTimeOut);
|
|
|
|
If Result < 0 Then Begin
|
|
Result := ZTIMEOUT;
|
|
Exit;
|
|
End;
|
|
|
|
Result := Result AND $007F;
|
|
|
|
Case Result of
|
|
XON,
|
|
XOFF : Continue;
|
|
Else
|
|
Exit;
|
|
End;
|
|
End;
|
|
|
|
Result := RCDO;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZDLRead : SmallInt;
|
|
Begin
|
|
Result := ReadByteTimeOut(RxTimeOut);
|
|
|
|
If Result <> CAN Then Exit;
|
|
|
|
Result := ReadByteTimeOut(RxTimeOut);
|
|
|
|
If Result = CAN Then Begin
|
|
Result := ReadByteTimeOut(RxTimeOut);
|
|
If Result = CAN Then Begin
|
|
Result := ReadByteTimeOut(RxTimeOut);
|
|
If Result = CAN Then
|
|
Result := ReadByteTimeOut(RxTimeOut);
|
|
End
|
|
End;
|
|
|
|
Case Result of
|
|
CAN : Result := GOTCAN;
|
|
ZCRCE,
|
|
ZCRCG,
|
|
ZCRCQ,
|
|
ZCRCW : Result := (Result OR 256);
|
|
ZRUB0 : Result := $007F;
|
|
ZRUB1 : Result := $00FF;
|
|
Else
|
|
If Result > 0 Then
|
|
If ((Result AND $60) = $40) Then
|
|
Result := Result XOR $40
|
|
Else
|
|
Result := ZERROR;
|
|
End;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZReceiveBinaryHeader (Var Hdr: ZHdrType) : SmallInt;
|
|
Var
|
|
C : SmallInt;
|
|
N : SmallInt;
|
|
CRC : Word;
|
|
Begin
|
|
C := ZDLRead;
|
|
|
|
If C < 0 Then Begin
|
|
ZReceiveBinaryHeader := C;
|
|
Exit;
|
|
End;
|
|
|
|
RxType := C;
|
|
CRC := Crc16(RxType, 0);
|
|
|
|
For N := 0 To 3 Do Begin
|
|
C := ZDLRead;
|
|
|
|
If Hi(C) <> 0 Then Begin
|
|
ZReceiveBinaryHeader := C;
|
|
Exit;
|
|
End;
|
|
|
|
Hdr[N] := Lo(C);
|
|
CRC := Crc16(Lo(C), CRC);
|
|
End;
|
|
|
|
C := ZDLRead;
|
|
|
|
If Hi(C) <> 0 Then Begin
|
|
ZReceiveBinaryHeader := C;
|
|
Exit;
|
|
End;
|
|
|
|
CRC := Crc16(Lo(C), CRC);
|
|
|
|
C := ZDLRead;
|
|
|
|
If Hi(C) <> 0 Then Begin
|
|
ZReceiveBinaryHeader := C;
|
|
Exit;
|
|
End;
|
|
|
|
CRC := Crc16(Lo(C), CRC);
|
|
|
|
If CRC <> 0 Then Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZReceiveBinaryHeader -> CRC error'); {$ENDIF}
|
|
|
|
ZReceiveBinaryHeader := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
ZReceiveBinaryHeader := RxType;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZReceiveBinaryHeader32 (Var Hdr: ZHdrType) : SmallInt;
|
|
Var
|
|
C : SmallInt;
|
|
Loop : Byte;
|
|
CRC : LongInt;
|
|
Begin
|
|
C := ZDLRead;
|
|
|
|
If C < 0 Then Begin
|
|
ZReceiveBinaryHeader32 := C;
|
|
Exit;
|
|
End;
|
|
|
|
RxType := C;
|
|
CRC := Crc32(RxType, LongInt($FFFFFFFF));
|
|
|
|
For Loop := 0 To 3 Do Begin
|
|
C := ZDLRead;
|
|
|
|
If Hi(C) <> 0 Then Begin
|
|
ZReceiveBinaryHeader32 := C;
|
|
Exit;
|
|
End;
|
|
|
|
Hdr[Loop] := Lo(C);
|
|
CRC := Crc32(Lo(C), CRC);
|
|
End;
|
|
|
|
For Loop := 0 To 3 Do Begin
|
|
C := ZDLRead;
|
|
|
|
If Hi(C) <> 0 Then Begin
|
|
ZReceiveBinaryHeader32 := C;
|
|
Exit;
|
|
End;
|
|
|
|
CRC := Crc32(Lo(C), CRC);
|
|
End;
|
|
|
|
If CRC <> LongInt($DEBB20E3) Then Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZReceieveBinaryHeader32 -> CRC error'); {$ENDIF}
|
|
|
|
ZReceiveBinaryHeader32 := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
ZReceiveBinaryHeader32 := RxType;
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.SendEscaped (B: SmallInt);
|
|
Var
|
|
C1 : Char;
|
|
C2 : Char;
|
|
Begin
|
|
If (EscapeAll) And ((B AND $60) = 0) Then Begin
|
|
Client.BufWriteChar(Char(ZDLE));
|
|
LastSent := B XOR $40;
|
|
End Else If (B and $11) = 0 Then
|
|
LastSent := B
|
|
Else Begin
|
|
C1 := Char(B and $7F);
|
|
C2 := Char(LastSent and $7F);
|
|
|
|
Case B of
|
|
Xon,
|
|
Xoff,
|
|
cDle,
|
|
cXonHi,
|
|
cXoffHi,
|
|
cDleHi,
|
|
ZDle : Begin
|
|
Client.BufWriteChar(Char(ZDLE));
|
|
LastSent := B xor $40;
|
|
End;
|
|
255 : Begin
|
|
Client.BufWriteChar(Char(ZDLE));
|
|
LastSent := ZRUB1;
|
|
End;
|
|
Else
|
|
If ((C1 = #13) and (C2 = #$40)) Then Begin
|
|
Client.BufWriteChar(Char(ZDLE));
|
|
LastSent := B xor $40;
|
|
End Else
|
|
LastSent := B;
|
|
End;
|
|
End;
|
|
|
|
Client.BufWriteChar(Char(LastSent));
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.ZSendBinaryHeader (FrameType : Byte);
|
|
Var
|
|
ulCRC : LongInt;
|
|
CRC : SmallInt;
|
|
Count : SmallInt;
|
|
Begin
|
|
Client.BufWriteChar(Char(ZPAD));
|
|
Client.BufWriteChar(Char(ZDLE));
|
|
|
|
If UseCRC32 Then Begin
|
|
Client.BufWriteChar(Char(ZBIN32));
|
|
|
|
SendEscaped (FrameType);
|
|
|
|
ulCRC := Crc32(FrameType, LongInt($FFFFFFFF));
|
|
|
|
For Count := 0 to 3 Do Begin
|
|
SendEscaped (TxHdr[Count]);
|
|
ulCRC := Crc32 (TxHdr[Count], ulCRC);
|
|
End;
|
|
|
|
ulCRC := Not ulCRC;
|
|
|
|
For Count := 0 to 3 Do Begin
|
|
SendEscaped (Byte(ulCRC));
|
|
ulCRC := ulCRC SHR 8;
|
|
End;
|
|
End Else Begin
|
|
Client.BufWriteChar(Char(ZBIN));
|
|
|
|
SendEscaped (FrameType);
|
|
|
|
CRC := Crc16(FrameType, 0);
|
|
|
|
For Count := 0 to 3 Do Begin
|
|
SendEscaped (TxHdr[Count]);
|
|
CRC := Crc16 (TxHdr[Count], CRC);
|
|
End;
|
|
|
|
CRC := Crc16(0, CRC);
|
|
CRC := Crc16(0, CRC);
|
|
|
|
SendEscaped (Lo(SmallInt(CRC SHR 8)));
|
|
SendEscaped (Lo(CRC));
|
|
End;
|
|
|
|
Client.BufFlush;
|
|
|
|
If FrameType <> ZDATA Then WaitMS(250); { do we need this? }
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZGetHex : SmallInt;
|
|
Var
|
|
C : SmallInt;
|
|
N : SmallInt;
|
|
Begin
|
|
C := ZGetByte;
|
|
|
|
If C < 0 Then Begin
|
|
ZGetHex := C;
|
|
Exit;
|
|
End;
|
|
|
|
N := C - 48;
|
|
|
|
If N > 9 Then
|
|
N := N - 39;
|
|
|
|
If (N AND $FFF0) <> 0 Then Begin
|
|
ZGetHex := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
C := ZGetByte;
|
|
|
|
If C < 0 Then Begin
|
|
ZGetHex := C;
|
|
Exit;
|
|
End;
|
|
|
|
C := C - 48;
|
|
|
|
If C > 9 Then
|
|
C := C - 39;
|
|
|
|
If (C AND $FFF0) <> 0 Then Begin
|
|
ZGetHex := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
C := C + (N SHL 4);
|
|
|
|
ZGetHex := C;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZGetLong (Var Hdr: ZHdrType) : LongInt;
|
|
Begin
|
|
Result := Hdr[ZP3];
|
|
Result := (Result SHL 8) OR Hdr[ZP2];
|
|
Result := (Result SHL 8) OR Hdr[ZP1];
|
|
Result := (Result SHL 8) OR Hdr[ZP0];
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZReceiveHexHeader (Var Hdr : ZHdrType) : SmallInt;
|
|
Var
|
|
N : SmallInt;
|
|
C : SmallInt;
|
|
CRC : Word;
|
|
Begin
|
|
C := ZGetHex;
|
|
|
|
If C < 0 Then Begin
|
|
ZReceiveHexHeader := C;
|
|
Exit;
|
|
End;
|
|
|
|
RxType := C;
|
|
CRC := Crc16(RxType, 0);
|
|
|
|
For N := 0 To 3 Do Begin
|
|
C := ZGetHex;
|
|
|
|
If C < 0 Then Begin
|
|
ZReceiveHexHeader := C;
|
|
Exit;
|
|
End;
|
|
|
|
Hdr[N] := Lo(C);
|
|
CRC := Crc16(Lo(C), CRC);
|
|
End;
|
|
|
|
C := ZGetHex;
|
|
|
|
If C < 0 Then Begin
|
|
ZReceiveHexHeader := C;
|
|
Exit;
|
|
End;
|
|
|
|
CRC := Crc16(Lo(C), CRC);
|
|
|
|
C := ZGetHex;
|
|
|
|
If C < 0 Then Begin
|
|
ZReceiveHexHeader := C;
|
|
Exit;
|
|
End;
|
|
|
|
CRC := Crc16(Lo(C), CRC);
|
|
|
|
If (CRC <> 0) Then Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZReceieveHexHeader -> CRC error'); {$ENDIF}
|
|
ZReceiveHexHeader := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
If ReadByteTimeOut(20) = 13 Then
|
|
C := ReadByteTimeOut(20);
|
|
|
|
ZReceiveHexHeader := RxType;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZGetHeader (Var Hdr: ZHdrType) : SmallInt;
|
|
Label
|
|
Again,
|
|
Again2,
|
|
Splat,
|
|
Finished;
|
|
Var
|
|
C : SmallInt;
|
|
SyncTries : SmallInt;
|
|
CanCount : SmallInt;
|
|
Begin
|
|
SyncTries := 32;
|
|
CanCount := 5;
|
|
RxFrameIdx := 0;
|
|
RxType := 0;
|
|
|
|
Again:
|
|
|
|
C := ZGetByte;
|
|
|
|
Case C of
|
|
ZPAD : Goto Splat;
|
|
RCDO,
|
|
ZTIMEOUT: Goto Finished;
|
|
CAN : Begin
|
|
Dec (CanCount);
|
|
If CanCount <= 0 Then Begin
|
|
C := ZCAN;
|
|
Goto Finished;
|
|
End;
|
|
End;
|
|
Else
|
|
|
|
Again2:
|
|
|
|
Dec (SyncTries);
|
|
|
|
If SyncTries = 0 Then Begin
|
|
ZGetHeader := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
If C <> CAN Then
|
|
CanCount := 5;
|
|
|
|
Goto Again;
|
|
End;
|
|
|
|
CanCount := 5;
|
|
|
|
Splat:
|
|
|
|
C := ZGetByte;
|
|
|
|
Case C of
|
|
ZPAD : Goto Splat;
|
|
RCDO,
|
|
ZTIMEOUT: Goto Finished;
|
|
ZDLE : ;
|
|
Else
|
|
Goto Again2;
|
|
End;
|
|
|
|
C := ZGetByte;
|
|
|
|
Case C of
|
|
RCDO,
|
|
ZTIMEOUT: Goto Finished;
|
|
ZBIN : Begin
|
|
RxFrameIdx := ZBIN;
|
|
C := ZReceiveBinaryHeader(Hdr);
|
|
End;
|
|
ZBIN32 : Begin
|
|
RxFrameIdx := ZBIN32;
|
|
C := ZReceiveBinaryHeader32(Hdr);
|
|
End;
|
|
ZHEX : Begin
|
|
RxFrameIdx := ZHEX;
|
|
C := ZReceiveHexHeader(Hdr);
|
|
End;
|
|
CAN : Begin
|
|
Dec (CanCount);
|
|
|
|
If CanCount <= 0 Then Begin
|
|
C := ZCAN;
|
|
Goto Finished;
|
|
End;
|
|
Goto Again2;
|
|
End;
|
|
Else
|
|
Goto Again2;
|
|
End;
|
|
|
|
RxPos := ZGetLong(Hdr);
|
|
|
|
Finished:
|
|
|
|
If C = GOTCAN Then C := ZCAN;
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZGetHeader -> Result ' + HeaderType(C)); {$ENDIF}
|
|
|
|
Result := C;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZInitReceiver : SmallInt;
|
|
Var
|
|
I : SmallInt;
|
|
Begin
|
|
ZPutLong (0);
|
|
ZSendHexHeader (ZRQINIT);
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZInitReceiver -> begin ZRQINIT want ZRINIT'); {$ENDIF}
|
|
|
|
For I := 0 to 10 Do Begin
|
|
If AbortTransfer Then Break;
|
|
|
|
Case ZGetHeader(RxHdr) of
|
|
ZCHALLENGE: Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Got ZCHALLENGE'); {$ENDIF}
|
|
|
|
ZPutLong (RxPos);
|
|
ZSendHexHeader (ZACK);
|
|
End;
|
|
ZCOMMAND : Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Got ZCOMMAND'); {$ENDIF}
|
|
|
|
ZPutLong (0);
|
|
ZSendHexHeader (ZRQINIT);
|
|
End;
|
|
ZRINIT : Begin
|
|
RxBufLen := (Word(RxHdr[ZP1]) SHL 8) OR RxHdr[ZP0];
|
|
UseCrc32 := (RxHdr[ZF0] AND CANFC32) <> 0;
|
|
EscapeAll := (RxHdr[ZF0] AND ESCALL) = ESCALL;
|
|
ZInitReceiver := ZOK;
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZInitReceiver -> ZRINIT'); {$ENDIF}
|
|
{$IFDEF ZDEBUG} ZLog('ZInitReceiver -> CRC32:' + strI2S(Ord(UseCrc32))); {$ENDIF}
|
|
{$IFDEF ZDEBUG} ZLog('ZInitReceiver -> EscapeAll:' + strI2S(Ord(EscapeAll))); {$ENDIF}
|
|
{$IFDEF ZDEBUG} ZLog('ZInitReceiver -> BlockSize:' + strI2S(RxBufLen)); {$ENDIF}
|
|
|
|
Exit;
|
|
End;
|
|
RCDO,
|
|
ZCAN,
|
|
ZTIMEOUT : Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Got TIMEOUT/CAN'); {$ENDIF}
|
|
|
|
ZInitReceiver := ZERROR;
|
|
Exit;
|
|
End;
|
|
ZRQINIT : {$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Got ZRQINIT response') {$ENDIF};
|
|
Else
|
|
{$IFDEF ZDEBUG} ZLog('ZInitReceiver -> Unknown sending ZNAK'); {$ENDIF}
|
|
ZSendHexHeader (ZNAK);
|
|
End;
|
|
End;
|
|
|
|
Result := ZERROR;
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.ZSendData (BufSize: SmallInt; FrameEnd: Byte);
|
|
Var
|
|
ulCRC : LongInt;
|
|
CRC : SmallInt;
|
|
Count : LongInt;
|
|
Begin
|
|
If UseCRC32 Then Begin
|
|
ulCRC := LongInt($FFFFFFFF);
|
|
|
|
For Count := 0 to BufSize - 1 Do Begin
|
|
SendEscaped (TxBuf[Count]);
|
|
ulCRC := Crc32(TxBuf[Count], ulCRC);
|
|
End;
|
|
|
|
ulCRC := Crc32(FrameEnd, ulCRC);
|
|
ulCRC := Not ulCRC;
|
|
|
|
Client.BufWriteChar(Char(ZDLE));
|
|
Client.BufWriteChar(Char(FrameEnd));
|
|
|
|
For Count := 0 to 3 Do Begin
|
|
SendEscaped (Byte(ulCRC));
|
|
ulCRC := ulCRC SHR 8;
|
|
End;
|
|
|
|
End Else Begin
|
|
CRC := 0;
|
|
|
|
For Count := 0 to BufSize - 1 Do Begin
|
|
SendEscaped (TxBuf[Count]);
|
|
CRC := Crc16(TxBuf[Count], CRC);
|
|
End;
|
|
|
|
CRC := Crc16(FrameEnd, CRC);
|
|
|
|
Client.BufWriteChar(Char(ZDLE));
|
|
Client.BufWriteChar(Char(FrameEnd));
|
|
|
|
CRC := Crc16(0, CRC);
|
|
CRC := Crc16(0, CRC);
|
|
|
|
SendEscaped (Lo(SmallInt(CRC SHR 8)));
|
|
SendEscaped (Lo(CRC));
|
|
End;
|
|
|
|
If FrameEnd = ZCRCW Then Begin
|
|
Client.BufWriteChar(Char(XON));
|
|
// WaitMS(250);
|
|
End;
|
|
|
|
Client.BufFlush;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZSendFile : SmallInt;
|
|
Label
|
|
Start;
|
|
Var
|
|
FTime : LongInt;
|
|
TmpStr : String;
|
|
C : SmallInt;
|
|
Res : LongInt;
|
|
FileDone : Boolean;
|
|
GoodBlks : Word;
|
|
GoodNeeded : Word;
|
|
Begin
|
|
{$IFDEF ZDEBUG} ZLog(''); {$ENDIF}
|
|
{$IFDEF ZDEBUG} ZLog('ZSendFile -> begin'); {$ENDIF}
|
|
{$IFDEF ZDEBUG} ZLog('ZSendFile -> file:' + Queue.QData[Queue.QPos].FileName); {$ENDIF}
|
|
|
|
Result := ZERROR;
|
|
|
|
Assign (WrkFile, Queue.QData[Queue.QPos]^.FilePath + Queue.QData[Queue.QPos]^.FileName);
|
|
|
|
If Not ioReset (WrkFile, 1, fmReadWrite + fmDenyNone) Then Exit;
|
|
|
|
GetFTime (WrkFile, FTime);
|
|
|
|
Status.FileName := Queue.QData[Queue.QPos]^.FileName;
|
|
Status.FilePath := Queue.QData[Queue.QPos]^.FilePath;
|
|
Status.FileSize := Queue.QData[Queue.QPos]^.FileSize;
|
|
Status.Position := 0;
|
|
Status.StartPos := 0;
|
|
Status.StartTime := TimerSeconds;
|
|
|
|
StatusUpdate(False, False);
|
|
|
|
Repeat
|
|
If AbortTransfer Then Begin
|
|
Close (WrkFile);
|
|
Exit;
|
|
End;
|
|
|
|
FillChar (TxHdr, SizeOf(TxHdr), 0);
|
|
FillChar (TxBuf, SizeOf(TxBuf), 0);
|
|
|
|
TxHdr[ZF0] := ZCRESUM;
|
|
|
|
TmpStr := Status.FileName + #0 + strI2S(Status.FileSize);
|
|
|
|
Move (TmpStr[1], TxBuf[0], Length(TmpStr));
|
|
|
|
ZSendBinaryHeader (ZFILE);
|
|
ZSendData (Length(TmpStr), ZCRCW);
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Sending ZFILE want ZRPOS'); {$ENDIF}
|
|
|
|
WaitMS(500); // Delay for older terminal programs apparently
|
|
|
|
Repeat
|
|
C := ZGetHeader(RxHdr);
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Handshake header ' + HeaderType(C)); {$ENDIF}
|
|
|
|
Case C of
|
|
ZRINIT : ;
|
|
RCDO,
|
|
ZCAN,
|
|
ZABORT,
|
|
ZFIN,
|
|
ZTIMEOUT : Begin
|
|
Close (WrkFile);
|
|
|
|
Exit;
|
|
End;
|
|
ZSKIP : Begin
|
|
Close (WrkFile);
|
|
ZSendFile := ZSKIP;
|
|
|
|
Exit;
|
|
End;
|
|
ZCRC : Begin
|
|
ZPutLong(FileCRC32(Status.FilePath + Status.FileName));
|
|
ZSendHexHeader(ZCRC);
|
|
|
|
Continue;
|
|
End;
|
|
ZRPOS : Goto Start;
|
|
End;
|
|
Until (C <> ZRINIT);
|
|
Until False;
|
|
|
|
Start:
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Start transfer at ' + strI2S(RxPos)); {$ENDIF}
|
|
|
|
Seek (WrkFile, RxPos);
|
|
|
|
TxPos := RxPos;
|
|
FileDone := False;
|
|
GoodBlks := 0;
|
|
GoodNeeded := 0;
|
|
RxBufLen := ZBufSize;
|
|
|
|
Status.Position := RxPos;
|
|
Status.BlockSize := RxBufLen;
|
|
|
|
StatusUpdate(False, False);
|
|
|
|
If TxPos < Status.FileSize Then Begin
|
|
ZPutLong (TxPos);
|
|
ZSendBinaryHeader (ZDATA);
|
|
End;
|
|
|
|
StatusTimer := TimerSet(StatusCheck);
|
|
|
|
While Not EndTransfer Do Begin
|
|
If Not FileDone Then Begin
|
|
ioBlockRead (WrkFile, TxBuf, RxBufLen, Res);
|
|
|
|
If Res > 0 Then Begin
|
|
If Res < RxBufLen Then
|
|
ZSendData (Res, ZCRCE)
|
|
Else
|
|
ZSendData (Res, ZCRCG);
|
|
|
|
Inc (TxPos, Res);
|
|
|
|
Status.Position := TxPos;
|
|
Status.BlockSize := Res;
|
|
|
|
If TimerUp(StatusTimer) Then Begin
|
|
If AbortTransfer Then Break;
|
|
StatusUpdate(False, False);
|
|
StatusTimer := TimerSet(StatusCheck);
|
|
End;
|
|
End Else Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Sending ZEOF want ZRINIT'); {$ENDIF}
|
|
|
|
FileDone := True;
|
|
ZPutLong (TxPos);
|
|
ZSendBinaryHeader (ZEOF);
|
|
|
|
StatusUpdate(False, False);
|
|
End;
|
|
End;
|
|
|
|
Inc (GoodBlks);
|
|
|
|
If (RxBufLen < ZBUFSIZE) And (GoodBlks > GoodNeeded) Then Begin
|
|
If ((RxBufLen SHL 1) < ZBUFSIZE) Then
|
|
RxBufLen := RxBufLen SHL 1
|
|
Else
|
|
RxBufLen := ZBUFSIZE;
|
|
|
|
GoodBlks := 0;
|
|
End;
|
|
|
|
While Client.DataWaiting And Not AbortTransfer Do Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Might have packet response, checking'); {$ENDIF}
|
|
|
|
C := ReadByteTimeOut(200);
|
|
|
|
If (C = CAN) or (C = ZPAD) Then Begin
|
|
C := ZGetHeader(RxHdr);
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Got packet response ' + HeaderType(C)); {$ENDIF}
|
|
|
|
Case C of
|
|
ZACK : Continue;
|
|
ZRINIT : Begin
|
|
Close (WrkFile);
|
|
Result := ZOK;
|
|
Exit;
|
|
End;
|
|
ZRPOS : Begin
|
|
TxPos := RxPos;
|
|
FileDone := False;
|
|
|
|
ioSeek (WrkFile, TxPos);
|
|
|
|
Client.PurgeInputData;
|
|
Client.PurgeOutputData;
|
|
|
|
If TxPos < Status.FileSize Then Begin
|
|
ZPutLong (TxPos);
|
|
ZSendBinaryHeader (ZDATA);
|
|
End;
|
|
|
|
If RxPos > 0 Then Begin
|
|
If (RxBufLen SHR 2) > 64 Then
|
|
RxBufLen := RxBufLen SHR 2
|
|
Else
|
|
RxBufLen := 64;
|
|
|
|
GoodBlks := 0;
|
|
|
|
If GoodNeeded SHL 1 > 16 Then
|
|
GoodNeeded := 16
|
|
Else
|
|
GoodNeeded := GoodNeeded SHL 1;
|
|
End;
|
|
|
|
Status.Position := RxPos;
|
|
Status.BlockSize := RxBufLen;
|
|
|
|
StatusUpdate(False, False);
|
|
|
|
Break;
|
|
End;
|
|
ZSKIP : Begin
|
|
Close (WrkFile);
|
|
ZSendFile := ZSKIP;
|
|
Exit;
|
|
End;
|
|
End;
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
Close (WrkFile);
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.ZEndSender;
|
|
Var
|
|
TimeOut : LongInt;
|
|
Begin
|
|
TimeOut := TimerSet(500);
|
|
|
|
While Not AbortTransfer And Not TimerUp(TimeOut) Do Begin
|
|
Client.PurgeInputData;
|
|
|
|
ZPutLong (0);
|
|
ZSendBinaryHeader (ZFIN);
|
|
|
|
If Not Client.DataWaiting Then
|
|
WaitMS(500)
|
|
Else
|
|
Case ZGetHeader(RxHdr) of
|
|
ZFIN: Begin
|
|
Client.BufWriteStr('OO');
|
|
Client.BufFlush;
|
|
Break;
|
|
End;
|
|
ZCAN,
|
|
ZTIMEOUT,
|
|
RCDO: Break;
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.ZAckBiBi;
|
|
Var
|
|
Count : Byte;
|
|
Ch : SmallInt;
|
|
Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZAckBiBi -> begin'); {$ENDIF}
|
|
|
|
ZPutLong (0);
|
|
|
|
// Send ZFIN and wait up to 5 seconds for OO
|
|
|
|
For Count := 1 to 5 Do Begin
|
|
If AbortTransfer Then Break;
|
|
|
|
ZSendHexHeader (ZFIN);
|
|
|
|
Ch := ReadByteTimeOut(100);
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZAckBiBi -> ZFIN response is ' + HeaderType(Ch)); {$ENDIF}
|
|
|
|
Case Ch of
|
|
Ord('O') : Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZAckBiBi -> Got ending O'); {$ENDIF}
|
|
ReadByteTimeOut(1);
|
|
Break;
|
|
End;
|
|
ZTIMEOUT,
|
|
RCDO : Break;
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZInitSender : SmallInt;
|
|
Label
|
|
Again;
|
|
Var
|
|
Tmp : SmallInt;
|
|
N : SmallInt;
|
|
Errors : SmallInt;
|
|
Begin
|
|
UseCRC32 := True;
|
|
Errors := 0;
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZInitSender -> begin'); {$ENDIF}
|
|
|
|
For N := 1 to 10 Do Begin
|
|
If AbortTransfer Then Break;
|
|
|
|
FillChar (TxHdr, SizeOf(TxHdr), 0); // zero out all flags
|
|
|
|
TxHdr[ZF0] := CANFDX OR CANOVIO OR CANFC32 OR CANBRK;
|
|
|
|
If EscapeAll Then
|
|
TxHdr[ZF0] := TxHdr[ZF0] or ESCALL;
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZInitSender -> Sending ZRINIT'); {$ENDIF}
|
|
|
|
ZSendHexHeader (ZRINIT);
|
|
|
|
Again:
|
|
|
|
Tmp := ZGetHeader(RxHdr);
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZInitSender -> Got response ' + HeaderType(Tmp)); {$ENDIF}
|
|
|
|
Case Tmp of
|
|
ZRQINIT : Continue;
|
|
ZEOF : Continue;
|
|
ZTIMEOUT: Continue;
|
|
ZFILE : Begin
|
|
If ZReceiveData(RxBuf, ZBUFSIZE) = GOTCRCW Then Begin
|
|
ZInitSender := ZFILE;
|
|
Exit;
|
|
End;
|
|
|
|
ZSendHexHeader (ZNAK);
|
|
Goto Again;
|
|
End;
|
|
ZSINIT : Begin
|
|
If ZReceiveData (RxBuf, ZATTNLEN) = GOTCRCW Then Begin
|
|
Attn := '';
|
|
Tmp := 0;
|
|
While RxBuf[Tmp] <> 0 Do Begin
|
|
Attn := Attn + Chr(RxBuf[Tmp]);
|
|
Inc (Tmp);
|
|
End;
|
|
ZPutLong (1);
|
|
ZSendHexHeader (ZACK);
|
|
End Else
|
|
ZSendHexHeader (ZNAK);
|
|
|
|
Goto Again;
|
|
End;
|
|
ZFREECNT: Begin
|
|
ZPutLong (LongInt($FFFFFFFF));
|
|
ZSendHexHeader (ZACK);
|
|
|
|
Goto Again;
|
|
End;
|
|
ZCOMMAND: Begin
|
|
If ZReceiveData (RxBuf, ZBUFSIZE) = GOTCRCW Then Begin
|
|
ZPutLong (0);
|
|
Repeat
|
|
ZSendHexHeader (ZCOMPL);
|
|
Inc (Errors);
|
|
Until (Errors >= 10) or (ZGetHeader(RxHdr) = ZFIN);
|
|
ZAckBiBi;
|
|
ZInitSender := ZCOMPL;
|
|
Exit;
|
|
End Else
|
|
ZSendHexHeader (ZNAK);
|
|
|
|
Goto Again;
|
|
End;
|
|
ZCOMPL : Continue;
|
|
ZFIN : Begin
|
|
ZAckBiBi;
|
|
ZInitSender := ZCOMPL;
|
|
Exit;
|
|
End;
|
|
RCDO,
|
|
ZCAN : Begin
|
|
ZInitSender := ZERROR;
|
|
Exit;
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
ZInitSender := ZOK;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZReceiveData (Var Buf: ZBufType; Len: SmallInt) : SmallInt;
|
|
Label
|
|
ErrorCRC16,
|
|
ErrorCRC32;
|
|
Var
|
|
C, D : SmallInt;
|
|
CRC : SmallInt;
|
|
ulCRC : LongInt;
|
|
Count : SmallInt;
|
|
Begin
|
|
RxCount := 0;
|
|
|
|
If RxFrameIdx = ZBIN32 Then Begin
|
|
ulCRC := LongInt($FFFFFFFF);
|
|
|
|
While (Len >= 0) Do Begin
|
|
C := ZDLRead;
|
|
|
|
If Hi(C) <> 0 Then Begin
|
|
|
|
ErrorCRC32:
|
|
|
|
Case C of
|
|
GOTCRCE,
|
|
GOTCRCG,
|
|
GOTCRCQ,
|
|
GOTCRCW : Begin
|
|
D := C;
|
|
ulCRC := Crc32(Lo(C), ulCRC);
|
|
|
|
For Count := 1 to 4 Do Begin
|
|
C := ZDLRead;
|
|
|
|
If Hi(C) <> 0 Then Goto ErrorCRC32;
|
|
|
|
ulCRC := Crc32(Lo(C), ulCRC);
|
|
End;
|
|
|
|
If (ulCRC <> LongInt($DEBB20E3)) Then Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZReceiveData -> CRC32 error'); {$ENDIF}
|
|
Result := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
Result := D;
|
|
|
|
Exit;
|
|
End;
|
|
GOTCAN : Begin
|
|
ZReceiveData := ZCAN;
|
|
Exit;
|
|
End;
|
|
Else
|
|
ZReceiveData := C;
|
|
Exit;
|
|
End;
|
|
End;
|
|
|
|
Buf[RxCount] := Lo(C);
|
|
|
|
Dec (Len);
|
|
Inc (RxCount);
|
|
|
|
ulCRC := Crc32(Lo(C), ulCRC);
|
|
End;
|
|
End Else Begin
|
|
CRC := 0;
|
|
|
|
While Len >= 0 Do Begin
|
|
C := ZDLRead;
|
|
|
|
If Hi(C) <> 0 Then Begin
|
|
|
|
ErrorCRC16:
|
|
|
|
Case C of
|
|
GOTCRCE,
|
|
GOTCRCG,
|
|
GOTCRCQ,
|
|
GOTCRCW : Begin
|
|
D := C;
|
|
|
|
For Count := 1 to 2 Do Begin
|
|
CRC := Crc16(Lo(C), CRC);
|
|
|
|
C := ZDLRead;
|
|
|
|
If Hi(C) <> 0 Then Goto ErrorCRC16;
|
|
End;
|
|
|
|
CRC := Crc16(Lo(C), CRC);
|
|
|
|
If CRC <> 0 Then Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZReceiveData -> CRC16 error'); {$ENDIF}
|
|
ZReceiveData := ZERROR
|
|
End Else
|
|
ZReceiveData := D;
|
|
|
|
Exit;
|
|
End;
|
|
GOTCAN : Begin
|
|
ZReceiveData := ZCAN;
|
|
Exit;
|
|
End;
|
|
Else
|
|
ZReceiveData := C;
|
|
Exit;
|
|
End;
|
|
|
|
Buf[RxCount] := Lo(C);
|
|
|
|
Inc(RxCount);
|
|
Dec(Len);
|
|
|
|
CRC := Crc16(Lo(C), CRC);
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZReceiveData -> ZERROR (frameidx=' + strI2S(RxFrameIdx) + ')'); {$ENDIF}
|
|
|
|
ZReceiveData := ZERROR;
|
|
End;
|
|
|
|
Function TProtocolZmodem.ZReceiveFile : SmallInt;
|
|
Label
|
|
NextHeader,
|
|
MoreData;
|
|
Var
|
|
Tmp : SmallInt;
|
|
FName : String;
|
|
FSize : LongInt;
|
|
RetryCount : SmallInt;
|
|
C : SmallInt;
|
|
Begin
|
|
{$IFDEF ZDEBUG} ZLog(''); {$ENDIF}
|
|
{$IFDEF ZDEBUG} ZLog('ZRecvFile -> begin'); {$ENDIF}
|
|
|
|
FName := '';
|
|
FSize := 0;
|
|
RxBytes := 0;
|
|
|
|
Tmp := 0;
|
|
While RxBuf[Tmp] <> 0 Do Begin
|
|
FName := FName + Chr(RxBuf[Tmp]);
|
|
Inc (Tmp);
|
|
End;
|
|
|
|
// Strip path if exists, and leading/trailing spaces
|
|
FName := JustFile(strStripB(FName, ' '));
|
|
|
|
Inc (Tmp);
|
|
While (RxBuf[Tmp] <> $20) and (RxBuf[Tmp] <> 0) Do Begin
|
|
FSize := (FSize * 10) + RxBuf[Tmp] - $30;
|
|
Inc (Tmp);
|
|
End;
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZRecvFile -> File:' + FName); {$ENDIF}
|
|
{$IFDEF ZDEBUG} ZLog('ZRecvFile -> Size:' + strI2S(FSize)); {$ENDIF}
|
|
|
|
Client.PurgeInputData;
|
|
|
|
Queue.Add(ReceivePath, FName);
|
|
|
|
Queue.QData[Queue.QSize]^.FileSize := FSize;
|
|
Queue.QData[Queue.QSize]^.Status := QueueIntransit;
|
|
|
|
Assign (WrkFile, ReceivePath + FName);
|
|
|
|
{$I-} Reset (WrkFile, 1); {$I+}
|
|
|
|
If IoResult = 0 Then Begin
|
|
If FSize = FileSize(WrkFile) Then Begin
|
|
// Same size file, SKIP it
|
|
Close (WrkFile);
|
|
|
|
Queue.QData[Queue.QSize]^.Status := QueueSkipped;
|
|
|
|
ZSendHexHeader (ZSKIP);
|
|
|
|
ZReceiveFile := ZEOF;
|
|
|
|
Exit;
|
|
End Else
|
|
If FileSize(WrkFile) < FSize Then Begin
|
|
// Resume transfer
|
|
RxBytes := FileSize(WrkFile);
|
|
|
|
Seek (WrkFile, RxBytes);
|
|
End Else Begin
|
|
// If adding rename/overwrite support do it either
|
|
// but for now we just ZSKIP
|
|
|
|
Close (WrkFile);
|
|
|
|
Queue.QData[Queue.QSize]^.Status := QueueSkipped;
|
|
|
|
ZSendHexHeader (ZSKIP);
|
|
|
|
ZReceiveFile := ZEOF;
|
|
|
|
Exit;
|
|
End;
|
|
End Else Begin
|
|
{$I-} ReWrite (WrkFile, 1); {$I+}
|
|
|
|
If IoResult <> 0 Then Begin
|
|
ZSendHexHeader (ZSKIP);
|
|
ZReceiveFile := ZEOF;
|
|
|
|
Exit;
|
|
End;
|
|
End;
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZRecvFile -> Begin data'); {$ENDIF}
|
|
|
|
Status.FilePath := ReceivePath;
|
|
Status.FileName := FName;
|
|
Status.FileSize := FSize;
|
|
Status.BlockSize := 0;
|
|
Status.Position := RxBytes;
|
|
Status.StartTime := TimerSeconds;
|
|
|
|
StatusUpdate(False, False);
|
|
|
|
RetryCount := 25;
|
|
|
|
Queue.QData[Queue.QSize]^.Status := QueueFailed;
|
|
|
|
StatusTimer := TimerSet(StatusCheck);
|
|
|
|
While Not EndTransfer Do Begin
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZRecvFile -> Sending ZRPOS ' + strI2S(RxBytes)); {$ENDIF}
|
|
|
|
ZPutLong (RxBytes);
|
|
ZSendBinaryHeader (ZRPOS);
|
|
|
|
NextHeader:
|
|
|
|
C := ZGetHeader(RxHdr);
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZRecvFile -> NextHeader -> Got ' + HeaderType(C)); {$ENDIF}
|
|
|
|
Case C of
|
|
ZNAK,
|
|
ZTIMEOUT: Begin
|
|
Dec (RetryCount);
|
|
|
|
If RetryCount < 0 Then Begin
|
|
Close (WrkFile);
|
|
ZReceiveFile := ZERROR;
|
|
Exit;
|
|
End;
|
|
End;
|
|
ZFILE : Begin
|
|
ZReceiveData (RxBuf, ZBUFSIZE);
|
|
Continue;
|
|
End;
|
|
ZEOF : Begin
|
|
If ZGetLong(RxHdr) <> RxBytes Then Continue;
|
|
|
|
Status.Position := RxBytes;
|
|
Status.BlockSize := RxCount;
|
|
|
|
StatusUpdate(False, False);
|
|
|
|
Close (WrkFile);
|
|
|
|
Queue.QData[Queue.QSize]^.Status := QueueSuccess;
|
|
|
|
ZReceiveFile := C;
|
|
|
|
Exit;
|
|
End;
|
|
ZERROR : Begin
|
|
Dec (RetryCount);
|
|
|
|
If RetryCount < 0 Then Begin
|
|
Close (WrkFile);
|
|
ZReceiveFile := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
Client.BufWriteStr(Attn);
|
|
Client.BufFlush;
|
|
|
|
Continue;
|
|
End;
|
|
ZDATA : Begin
|
|
If ZGetLong(RxHdr) <> RxBytes Then Begin
|
|
{$IFDEF ZDEBUG} ZLog('ZRecvFile -> NextHeader -> ZDATA -> Size not ' + strI2S(RxBytes)); {$ENDIF}
|
|
|
|
Dec(RetryCount);
|
|
|
|
If RetryCount < 0 Then Begin
|
|
Close (WrkFile);
|
|
ZReceiveFile := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
Client.BufWriteStr(Attn);
|
|
Client.BufFlush;
|
|
|
|
Continue;
|
|
End;
|
|
|
|
MoreData:
|
|
|
|
If TimerUp(StatusTimer) Then Begin
|
|
If AbortTransfer Then Break;
|
|
|
|
StatusUpdate(False, False);
|
|
|
|
StatusTimer := TimerSet(StatusCheck);
|
|
End;
|
|
|
|
C := ZReceiveData(RxBuf, ZBUFSIZE);
|
|
|
|
{$IFDEF ZDEBUG} ZLog('ZRecvFile -> MoreData -> Got ' + HeaderType(C)); {$ENDIF}
|
|
|
|
Case C of { we can combine zreceivedata and case here }
|
|
ZCAN : Begin
|
|
Close (WrkFile);
|
|
ZReceiveFile := ZERROR;
|
|
Exit;
|
|
End;
|
|
ZERROR : Begin
|
|
Dec(RetryCount);
|
|
|
|
If RetryCount < 0 Then Begin
|
|
Close (WrkFile);
|
|
ZReceiveFile := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
Client.BufWriteStr(Attn);
|
|
Client.BufFlush;
|
|
End;
|
|
ZTIMEOUT: Begin
|
|
Dec(RetryCount);
|
|
|
|
If RetryCount < 0 Then Begin
|
|
Close (WrkFile);
|
|
ZReceiveFile := ZERROR;
|
|
Exit;
|
|
End;
|
|
|
|
Continue;
|
|
End;
|
|
GOTCRCW : Begin
|
|
RetryCount := 25;
|
|
|
|
BlockWrite (WrkFile, RxBuf, RxCount);
|
|
|
|
RxBytes := RxBytes + RxCount;
|
|
|
|
ZPutLong (RxBytes);
|
|
ZSendBinaryHeader (ZACK);
|
|
|
|
Status.Position := RxBytes;
|
|
Status.BlockSize := RxCount;
|
|
|
|
Goto NextHeader;
|
|
End;
|
|
GOTCRCQ : Begin
|
|
RetryCount := 25;
|
|
|
|
BlockWrite (WrkFile, RxBuf, RxCount);
|
|
|
|
Rxbytes := RxBytes + RxCount;
|
|
|
|
ZPutLong (RxBytes);
|
|
|
|
ZSendBinaryHeader (ZACK);
|
|
|
|
Status.Position := RxBytes;
|
|
Status.BlockSize := RxCount;
|
|
|
|
Goto MoreData;
|
|
End;
|
|
GOTCRCG : Begin
|
|
RetryCount := 25;
|
|
|
|
BlockWrite (WrkFile, RxBuf, RxCount);
|
|
|
|
Rxbytes := RxBytes + RxCount;
|
|
|
|
Status.Position := RxBytes;
|
|
Status.BlockSize := RxCount;
|
|
|
|
Goto MoreData;
|
|
End;
|
|
GOTCRCE : Begin
|
|
RetryCount := 25;
|
|
|
|
BlockWrite (WrkFile, RxBuf, Rxcount);
|
|
|
|
Rxbytes := RxBytes + Rxcount;
|
|
|
|
Status.Position := RxBytes;
|
|
Status.BlockSize := RxCount;
|
|
|
|
Goto NextHeader;
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
End;
|
|
End;
|
|
|
|
Close (WrkFile);
|
|
|
|
ZReceiveFile := ZERROR;
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.DoAbortSequence;
|
|
Begin
|
|
If Not Connected Then Exit;
|
|
|
|
Client.PurgeInputData;
|
|
Client.PurgeOutputData;
|
|
Client.BufWriteStr(Attn);
|
|
Client.BufWriteStr(CancelStr);
|
|
Client.BufFlush;
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.QueueReceive;
|
|
Begin
|
|
Status.Sender := False;
|
|
|
|
StatusUpdate(True, False);
|
|
|
|
RxBufLen := ZBufSize;
|
|
|
|
While Not AbortTransfer Do Begin
|
|
If ZInitSender = ZFILE Then Begin
|
|
If ZReceiveFile <> ZEOF Then Break;
|
|
End Else
|
|
Break;
|
|
End;
|
|
|
|
If AbortTransfer Then DoAbortSequence;
|
|
|
|
StatusUpdate(False, True);
|
|
End;
|
|
|
|
Procedure TProtocolZmodem.QueueSend;
|
|
Begin
|
|
Status.Sender := True;
|
|
|
|
StatusUpdate (True, False);
|
|
|
|
Queue.QPos := 0;
|
|
|
|
While Queue.Next And Not AbortTransfer Do Begin
|
|
If Queue.QPos = 1 Then
|
|
If ZInitReceiver <> ZOK Then Break;
|
|
|
|
Case ZSendFile of
|
|
ZOK : Queue.QData[Queue.QPos]^.Status := QueueSuccess;
|
|
ZSKIP : Queue.QData[Queue.QPos]^.Status := QueueSkipped;
|
|
ZERROR : Queue.QData[Queue.QPos]^.Status := QueueFailed;
|
|
End;
|
|
End;
|
|
|
|
If AbortTransfer Then
|
|
DoAbortSequence
|
|
Else
|
|
ZEndSender;
|
|
|
|
StatusUpdate(False, True);
|
|
End;
|
|
|
|
End. |