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

Blah

This commit is contained in:
mysticbbs 2012-08-12 05:26:22 -04:00
parent 5fb3eb7bbd
commit 3b276e968e
2 changed files with 125 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
mdl/m_ops.pas
View File

@ -28,8 +28,8 @@
------------------------------------------------------------------------- -------------------------------------------------------------------------
} }
{.$DEFINE DEBUG} {$DEFINE DEBUG}
{$DEFINE RELEASE} {.$DEFINE RELEASE}
{.$DEFINE LOGGING} {.$DEFINE LOGGING}
{ ------------------------------------------------------------------------- } { ------------------------------------------------------------------------- }
@ -63,7 +63,6 @@
{$BOOLEVAL OFF} {$BOOLEVAL OFF}
{$IMPLICITEXCEPTIONS OFF} {$IMPLICITEXCEPTIONS OFF}
{$OBJECTCHECKS OFF} {$OBJECTCHECKS OFF}
{$MODESWITCH NESTEDPROCVARS}
{$IFDEF CPUX86_64 {$IFDEF CPUX86_64
{$FPUTYPE SSE64} {$FPUTYPE SSE64}

174
mdl/m_protocol_zmodem.pas
View File

@ -2,10 +2,12 @@ Unit m_Protocol_Zmodem;
{$I M_OPS.PAS} {$I M_OPS.PAS}
{.$DEFINE ZDEBUG} {$DEFINE ZDEBUG}
Interface Interface
// Ported from ZMODEM.C
Uses Uses
DOS, DOS,
m_CRC, m_CRC,
@ -95,7 +97,7 @@ Const
XOFF = 19; XOFF = 19;
CAN = 24; CAN = 24;
ZCAN = 16; ZCAN = 16;
CDLE = 16; DLE = 16;
ZBIN = 65; ZBIN = 65;
GOTCAN = 272; GOTCAN = 272;
ZCRCE = 104; ZCRCE = 104;
@ -132,9 +134,9 @@ Const
ZSINIT = 2; ZSINIT = 2;
ZFREECNT = 17; ZFREECNT = 17;
ZCOMPL = 15; ZCOMPL = 15;
cDleHi = cDle + $80; DleHi = Dle OR $80;
cXonHi = Xon + $80; XonHi = Xon OR $80;
cXoffHi = Xoff + $80; XoffHi = Xoff OR $80;
CancelStr : String = #24#24#24#24#24#24#24#24#8#8#8#8#8#8#8#8; CancelStr : String = #24#24#24#24#24#24#24#24#8#8#8#8#8#8#8#8;
@ -165,6 +167,7 @@ Begin
GOTCRCG : Result := 'GOTCRCG'; GOTCRCG : Result := 'GOTCRCG';
GOTCRCQ : Result := 'GOTCRCQ'; GOTCRCQ : Result := 'GOTCRCQ';
GOTCRCW : Result := 'GOTCRCW'; GOTCRCW : Result := 'GOTCRCW';
ZCRC : Result := 'ZCRC';
Else Else
Result := 'UNKNOWN:' + strI2S(Ord(B)); Result := 'UNKNOWN:' + strI2S(Ord(B));
End; End;
@ -279,7 +282,42 @@ Function TProtocolZmodem.ZDLRead : SmallInt;
Begin Begin
Result := ReadByteTimeOut(RxTimeOut); Result := ReadByteTimeOut(RxTimeOut);
If Result <> CAN Then Exit; If Result <> ZDLE 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.ZDLRead : SmallInt;
Begin
Result := ReadByteTimeOut(RxTimeOut);
If Result <> ZDLE Then Exit;
Result := ReadByteTimeOut(RxTimeOut); Result := ReadByteTimeOut(RxTimeOut);
@ -308,6 +346,7 @@ Begin
Result := ZERROR; Result := ZERROR;
End; End;
End; End;
*)
Function TProtocolZmodem.ZReceiveBinaryHeader (Var Hdr: ZHdrType) : SmallInt; Function TProtocolZmodem.ZReceiveBinaryHeader (Var Hdr: ZHdrType) : SmallInt;
Var Var
@ -415,41 +454,35 @@ Begin
End; End;
Procedure TProtocolZmodem.SendEscaped (B: SmallInt); Procedure TProtocolZmodem.SendEscaped (B: SmallInt);
Var
C1 : Char;
C2 : Char;
Begin Begin
If (EscapeAll) And ((B AND $60) = 0) Then Begin Case B of
Client.BufWriteChar(Char(ZDLE)); DLE,
LastSent := B XOR $40; DLEHI,
End Else If (B and $11) = 0 Then XON,
LastSent := B XONHI,
Else Begin XOFF,
C1 := Char(B and $7F); XOFFHI,
C2 := Char(LastSent and $7F); ZDLE : Begin
Client.BufWriteChar(Char(ZDLE));
LastSent := B XOR $40;
End;
13,
13 OR $80 : If {EscapeAll And} (LastSent AND $7F = Ord('@')) Then Begin
Client.BufWriteChar(Char(ZDLE));
LastSent := B XOR $40;
End Else
LastSent := B;
255 : Begin
Client.BufWriteChar(Char(ZDLE));
LastSent := ZRUB1;
End;
Case B of Else
Xon, If {(EscapeAll) and} ((B AND $60) = 0) Then Begin
Xoff, Client.BufWriteChar(Char(ZDLE));
cDle, LastSent := B XOR $40;
cXonHi, End Else
cXoffHi, LastSent := B;
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; End;
Client.BufWriteChar(Char(LastSent)); Client.BufWriteChar(Char(LastSent));
@ -907,11 +940,28 @@ Begin
Exit; Exit;
End; End;
ZCRC : Begin ZCRC : Begin
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Sending File CRC response'); {$ENDIF}
ZPutLong(FileCRC32(Status.FilePath + Status.FileName)); ZPutLong(FileCRC32(Status.FilePath + Status.FileName));
ZSendHexHeader(ZCRC); ZSendHexHeader(ZCRC);
Continue; RxPos := 0;
// SYNCTERM expects ZDATA after a ZCRC i am not sure
// this is correct because how do we know the ZPOS from
// receiver if it works this way? zmodem doc isnt very
// clear on this. Lets try it...
Goto Start; //Continue;
End; End;
(* is SYNCTERM really asking for the FREENCNT here????? WTF
ZFREECNT: Begin
ZPutLong (LongInt($FFFFFFFF));
ZSendHexHeader (ZACK);
Continue;
End;
*)
ZRPOS : Goto Start; ZRPOS : Goto Start;
End; End;
Until (C <> ZRINIT); Until (C <> ZRINIT);
@ -961,6 +1011,8 @@ Start:
StatusUpdate(False, False); StatusUpdate(False, False);
StatusTimer := TimerSet(StatusCheck); StatusTimer := TimerSet(StatusCheck);
End; End;
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Sent ZDATA block position now: ' + strI2S(TxPos)); {$ENDIF}
End Else Begin End Else Begin
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Sending ZEOF want ZRINIT'); {$ENDIF} {$IFDEF ZDEBUG} ZLog('ZSendFile -> Sending ZEOF want ZRINIT'); {$ENDIF}
@ -1006,6 +1058,8 @@ Start:
ioSeek (WrkFile, TxPos); ioSeek (WrkFile, TxPos);
{$IFDEF ZDEBUG} ZLog('ZSendFile -> Got ZRPOS Sending ZDATA position: ' + strI2S(TxPos)); {$ENDIF}
Client.PurgeInputData; Client.PurgeInputData;
Client.PurgeOutputData; Client.PurgeOutputData;
@ -1041,7 +1095,7 @@ Start:
Exit; Exit;
End; End;
End; End;
End; End {$IFDEF ZDEBUG}Else ZLog('ZSendFile -> Nonsense response: ' + HeaderType(C)) {$ENDIF};
End; End;
End; End;
@ -1158,15 +1212,26 @@ Again:
If ZReceiveData (RxBuf, ZATTNLEN) = GOTCRCW Then Begin If ZReceiveData (RxBuf, ZATTNLEN) = GOTCRCW Then Begin
Attn := ''; Attn := '';
Tmp := 0; Tmp := 0;
While RxBuf[Tmp] <> 0 Do Begin While RxBuf[Tmp] <> 0 Do Begin
Attn := Attn + Chr(RxBuf[Tmp]); Attn := Attn + Chr(RxBuf[Tmp]);
Inc (Tmp); Inc (Tmp);
End; End;
ZPutLong (1); ZPutLong (1);
ZSendHexHeader (ZACK); ZSendHexHeader (ZACK);
End Else End Else
ZSendHexHeader (ZNAK); ZSendHexHeader (ZNAK);
(*
RxBufLen := (Word(RxHdr[ZP1]) SHL 8) OR RxHdr[ZP0];
UseCrc32 := (RxHdr[ZF0] AND CANFC32) <> 0;
EscapeAll := (RxHdr[ZF0] AND ESCALL) = ESCALL;
{$IFDEF ZDEBUG} ZLog('ZInitSender -> ZSINIT'); {$ENDIF}
{$IFDEF ZDEBUG} ZLog('ZInitSender -> CRC32:' + strI2S(Ord(UseCrc32))); {$ENDIF}
{$IFDEF ZDEBUG} ZLog('ZInitSender -> EscapeAll:' + strI2S(Ord(EscapeAll))); {$ENDIF}
{$IFDEF ZDEBUG} ZLog('ZInitSender -> BlockSize:' + strI2S(RxBufLen)); {$ENDIF}
*)
Goto Again; Goto Again;
End; End;
ZFREECNT: Begin ZFREECNT: Begin
@ -1178,10 +1243,12 @@ Again:
ZCOMMAND: Begin ZCOMMAND: Begin
If ZReceiveData (RxBuf, ZBUFSIZE) = GOTCRCW Then Begin If ZReceiveData (RxBuf, ZBUFSIZE) = GOTCRCW Then Begin
ZPutLong (0); ZPutLong (0);
Repeat Repeat
ZSendHexHeader (ZCOMPL); ZSendHexHeader (ZCOMPL);
Inc (Errors); Inc (Errors);
Until (Errors >= 10) or (ZGetHeader(RxHdr) = ZFIN); Until (Errors >= 10) or (ZGetHeader(RxHdr) = ZFIN);
ZAckBiBi; ZAckBiBi;
ZInitSender := ZCOMPL; ZInitSender := ZCOMPL;
Exit; Exit;
@ -1212,13 +1279,15 @@ Label
ErrorCRC16, ErrorCRC16,
ErrorCRC32; ErrorCRC32;
Var Var
C, D : SmallInt; C, D : SmallInt;
CRC : SmallInt; CRC : SmallInt;
ulCRC : LongInt; ulCRC : LongInt;
Count : SmallInt; Count : SmallInt;
Begin Begin
RxCount := 0; RxCount := 0;
{$IFDEF ZDEBUG} ZLog('ZReceiveData -> begin'); {$ENDIF}
If RxFrameIdx = ZBIN32 Then Begin If RxFrameIdx = ZBIN32 Then Begin
ulCRC := LongInt($FFFFFFFF); ulCRC := LongInt($FFFFFFFF);
@ -1251,6 +1320,8 @@ ErrorCRC32:
Exit; Exit;
End; End;
{$IFDEF ZDEBUG} ZLog('ZReceiveData -> Successful packet ' + HeaderType(D) + ' size ' + strI2S(RxCount)); {$ENDIF}
Result := D; Result := D;
Exit; Exit;
@ -1260,6 +1331,8 @@ ErrorCRC32:
Exit; Exit;
End; End;
Else Else
{$IFDEF ZDEBUG} ZLog('ZReceiveData -> Got bad frame type? ' + HeaderType(C)); {$ENDIF}
ZReceiveData := C; ZReceiveData := C;
Exit; Exit;
End; End;
@ -1326,7 +1399,7 @@ ErrorCRC16:
End; End;
End; End;
{$IFDEF ZDEBUG} ZLog('ZReceiveData -> ZERROR (frameidx=' + strI2S(RxFrameIdx) + ')'); {$ENDIF} {$IFDEF ZDEBUG} ZLog('ZReceiveData -> Long packet (frameidx=' + strI2S(RxFrameIdx) + '; rxcount=' + strI2S(RxCount) + ')'); {$ENDIF}
ZReceiveData := ZERROR; ZReceiveData := ZERROR;
End; End;
@ -1526,7 +1599,7 @@ MoreData:
C := ZReceiveData(RxBuf, ZBUFSIZE); C := ZReceiveData(RxBuf, ZBUFSIZE);
{$IFDEF ZDEBUG} ZLog('ZRecvFile -> MoreData -> Got ' + HeaderType(C)); {$ENDIF} {$IFDEF ZDEBUG} ZLog('ZRecvFile -> MoreData -> Got ' + HeaderType(C) + ' want data packet'); {$ENDIF}
Case C of { we can combine zreceivedata and case here } Case C of { we can combine zreceivedata and case here }
ZCAN : Begin ZCAN : Begin
@ -1577,10 +1650,9 @@ MoreData:
BlockWrite (WrkFile, RxBuf, RxCount); BlockWrite (WrkFile, RxBuf, RxCount);
Rxbytes := RxBytes + RxCount; RxBytes := RxBytes + RxCount;
ZPutLong (RxBytes); ZPutLong (RxBytes);
ZSendBinaryHeader (ZACK); ZSendBinaryHeader (ZACK);
Status.Position := RxBytes; Status.Position := RxBytes;
@ -1603,9 +1675,9 @@ MoreData:
GOTCRCE : Begin GOTCRCE : Begin
RetryCount := 25; RetryCount := 25;
BlockWrite (WrkFile, RxBuf, Rxcount); BlockWrite (WrkFile, RxBuf, RxCount);
Rxbytes := RxBytes + Rxcount; RxBytes := RxBytes + RxCount;
Status.Position := RxBytes; Status.Position := RxBytes;
Status.BlockSize := RxCount; Status.BlockSize := RxCount;