{$I COMPDIR.PAS}
UNIT UYmodem ;
INTERFACE
{$UNDEF VERBOSE}
{$DEFINE ERRORS}
CONST OneK = 1024 ; { For one kilobyte packet }
TYPE YM_Buffer = ARRAY[0..OneK-1] OF BYTE ; { To receive/send packets }
VAR YM_Error : STRING ;
YM_ErrorNb : WORD ;
FUNCTION YM_ReceiveFile ( NbPort : BYTE ; DoReplace : BOOLEAN ) : BOOLEAN ;
FUNCTION YM_SendFile ( NbPort:BYTE;
NameFile:STRING;
NameRecept:STRING ) : BOOLEAN ;
PROCEDURE YM_CloseBatchSession ( NbPort : BYTE );
IMPLEMENTATION
USES UEZComm , UCRC ;
CONST SOH = 1 ; { 128 bytes packet }
STX = 2 ; { 1024 bytes packet }
EOT = 4 ; { End of transmission }
ACK = 6 ; { Acknowledge }
NAK = 21 ; { Not-Acknowledge }
CONST _20_ticks = 20 ;
_100_ticks = 100 ;
FUNCTION YM_ReceivePacket ( NbPort : BYTE ;
Max_Retries : BYTE ;
VAR Size : WORD ;
VAR NumPacket : BYTE ;
VAR Packet : YM_Buffer ;
DoCRC : BOOLEAN;
WaitsForEOT : BOOLEAN ) : BOOLEAN ;
{ The only case where YM_ReceivePacket = FALSE and YM_ErrorNb = 0
is when: WaitsForEOT = TRUE
AND effectively the first character received is EOT
}
VAR Retry : BYTE ;
Ch : BYTE ;
i : INTEGER ;
CRC_Cal : WORD ;
CRC_Rec : WORD ;
Checksum_Cal : BYTE ;
Checksum_Rec : BYTE ;
LABEL Bad_Packet ;
BEGIN
YM_ErrorNb := 0 ;
Retry := 0 ;
WHILE ( Retry <> Max_Retries ) DO
BEGIN
IF NOT ( PortReadTicks ( NbPort , _100_ticks , Ch ) ) THEN
BEGIN
YM_ErrorNb := 10 ;
YM_Error := 'Time out' ;
{$IFDEF ERRORS}
WriteLn( 'Receiving Packet: Error; TimeOut first byte.');
{$ENDIF}
Inc ( Retry ) ;
Continue ;
END;
IF WaitsForEOT AND (Ch=EOT) THEN
BEGIN YM_ErrorNb := 0 ; { No error !! }
YM_ReceivePacket := FALSE ;
Exit ;
END;
CASE Ch OF
STX : Size := 1024 ;
SOH : Size := 128 ;
ELSE
BEGIN YM_ErrorNb := 11 ;
YM_Error := 'Bad synchro character' ; GOTO Bad_Packet ;
END;
END;
{$IFDEF VERBOSE}
WriteLn('Receiving Packet; first byte OK: ', Ch:3 );
{$ENDIF}
IF NOT ( PortReadTicks ( NbPort , _20_ticks , Ch ) ) THEN
BEGIN YM_ErrorNb := 12 ;
YM_Error := 'Time out' ; GOTO Bad_Packet ;
END;
IF ( Ch <> NumPacket ) THEN
IF (NumPacket > 0) AND (Ch = NumPacket-1) THEN
BEGIN { Maybe the ACK was not correctly transmitted, so
the sender sends this packet another time }
{ For synchro with the main handler, we set NumPacket=Ch }
NumPacket := Ch ;
END
ELSE
BEGIN YM_ErrorNb := 13 ;
YM_Error := 'Bad packet number' ; GOTO Bad_Packet ;
END;
{$IFDEF VERBOSE}
WriteLn('Receiving Packet; Packet num OK: ', NumPacket:3 );
{$ENDIF}
IF NOT ( PortReadTicks ( NbPort , _20_ticks , Ch ) ) THEN
BEGIN YM_ErrorNb := 14 ;
YM_Error := 'Time out' ; GOTO Bad_Packet ;
END;
IF ( Ch <> $FF - NumPacket ) THEN
BEGIN YM_ErrorNb := 15 ;
YM_Error := 'Bad 1-complement packet number' ; GOTO Bad_Packet ;
END;
{$IFDEF VERBOSE}
WriteLn('Receiving Packet; 1-complement Packet num OK: ', Ch:3 );
{$ENDIF}
CRC_Cal := 0 ;
Checksum_Cal := 0 ;
FOR i := 0 TO Size - 1 DO
BEGIN
IF NOT ( PortReadTicks (NbPort,_20_ticks,Packet[i]) ) THEN
BEGIN YM_ErrorNb := 16 ;
YM_Error := 'Time out' ; GOTO Bad_Packet ;
END;
{$IFDEF VERBOSE}
IF (i MOD 64) = 0 THEN Write('.');
{$ENDIF}
CRC_Cal := UpdCRCfast ( Packet[ i ] , CRC_Cal );
Inc(Checksum_Cal,Packet[i]);
END;
{$IFDEF VERBOSE}
WriteLn ;
WriteLn( 'Receiving Packet; all data bytes are here.');
{$ENDIF}
IF NOT ( PortReadTicks ( NbPort , _20_ticks , Ch ) ) THEN
BEGIN YM_ErrorNb := 17 ;
YM_Error := 'Time out' ; GOTO Bad_Packet ;
END;
IF DoCrc THEN
BEGIN
{ Checks with the CRC }
CRC_Rec := Ch SHL 8 ;
IF NOT ( PortReadTicks ( NbPort , _20_ticks , Ch ) ) THEN
BEGIN YM_ErrorNb := 18 ;
YM_Error := 'Time out' ; GOTO Bad_Packet ;
END;
CRC_Rec := CRC_Rec OR Ch ;
{$IFDEF VERBOSE}
WriteLn( 'Receiving Packet; CRC reception OK.');
{$ENDIF}
IF ( CRC_Cal <> CRC_Rec ) THEN
BEGIN YM_ErrorNb := 19 ;
{$IFDEF VERBOSE}
WriteLn( 'My CRC : ' , CRC_Cal:5 );
WriteLn( 'Sender''s CRC : ' , CRC_Rec:5 );
{$ENDIF}
YM_Error := 'Bad CRC' ; GOTO Bad_Packet ;
END;
END
ELSE
BEGIN
{ Checks with the checksum }
{$IFDEF VERBOSE}
WriteLn( 'Receiving Packet; checksum reception OK.');
{$ENDIF}
Checksum_Rec := Ch ;
IF ( Checksum_Cal <> Checksum_Rec ) THEN
BEGIN YM_ErrorNb := 20 ;
YM_Error := 'Bad checksum' ; GOTO Bad_Packet ;
END;
END;
{$IFDEF VERBOSE}
WriteLn( 'Receiving Packet; sending ACK.');
{$ENDIF}
PortWrite ( NbPort , ACK ) ;
YM_ReceivePacket := TRUE ;
Exit ;
Bad_Packet :
{ Waits for the line to clear }
{$IFDEF ERRORS}
WriteLn( 'Receiving Packet; error:clearing line.');
{$ENDIF}
PortClearLineTicks ( NbPort, _20_ticks );
{ Now write NAK }
PortWrite ( NbPort , NAK ) ;
{$IFDEF ERRORS}
WriteLn ( 'Error: ' , YM_Error:3 );
{$ENDIF}
Inc ( Retry ) ;
{$IFDEF ERRORS}
WriteLn ('Retry Nø ' , Retry:2 );
{$ENDIF}
END;
YM_ReceivePacket := FALSE ;
END;
FUNCTION YM_ReceiveFile ( NbPort : BYTE ; DoReplace : BOOLEAN ) : BOOLEAN ;
CONST DecimalDigits : STRING = '0123456789' ;
VAR PacketSize : WORD ;
PacketBuff : YM_Buffer ;
Retry : BYTE ;
LastPacket : BYTE ;
ExpectedPacket : BYTE ;
Index : WORD ;
NameFile : STRING ;
SizeFile : LONGINT ;
tmp : WORD ;
ResFile : FILE ;
ReceivedBytes : LONGINT ;
ToWrite : WORD ;
DoCRC : BOOLEAN ;
FUNCTION FileExists(FileName: String): BOOLEAN;
VAR F: FILE;
BEGIN
{$I-}
Assign(F, FileName);
FileMode := 0; { Set file access to read only }
Reset(F);
Close(F);
{$I+}
FileExists := (IOResult = 0) and (FileName <> '');
END; { FileExists }
PROCEDURE GetNewName ;
VAR Nam , Ext : STRING ;
Ind : BYTE ;
Finished : BOOLEAN ;
Count : LONGINT ;
NbStr : STRING ;
TmpName : STRING ;
BEGIN Ind := 1 ;
WHILE ( Ind <= Length(NameFile) ) AND ( NameFile[Ind]<>'.' )
DO Inc(Ind);
Nam := Copy(NameFile,1,Ind-1);
Ext := Copy(NameFile,Ind,Length(NameFile)-Ind+1);
Count := 0 ;
Finished := FALSE ;
WHILE Not(Finished) DO
BEGIN Str( Count , NbStr );
TmpName := Nam ;
WHILE Length(TmpName) < 8 DO TmpName := TmpName + '0' ;
FOR Ind := 1 TO Length(NbStr) DO
TmpName[8-Length(NbStr)+ Ind] := NbStr[Ind] ;
{ Checks if the file exists ... }
TmpName := TmpName + Ext ;
Finished := NOT FileExists( TmpName);
Inc(Count);
END;
NameFile := TmpName ;
WriteLn (' Changing to /' , NameFile , '/.' );
END;
LABEL Handshake_OK ;
BEGIN
YM_ErrorNb := 0 ; { No error at the beginning }
ExpectedPacket := 0 ; { We expect the first packet }
{ Try 5 times with the CRC('C') handshake }
DoCRC := TRUE ;
Retry := 0 ;
WHILE ( Retry < 5 ) DO
BEGIN
{$IFDEF VERBOSE}
WriteLn('Rec File: Sending C; Retry Nø' , Retry );
{$ENDIF}
PortWrite ( NbPort , Ord('C') ) ;
IF YM_ReceivePacket( NbPort,1,
PacketSize,ExpectedPacket,
PacketBuff,DoCRC,FALSE)
THEN Goto Handshake_OK ;
Inc ( Retry ) ;
END;
{ Now we try with the checksum handshake (NAK) 5 times }
DoCRC := FALSE ;
Retry := 0 ;
WHILE ( Retry < 5 ) DO
BEGIN
{$IFDEF VERBOSE}
WriteLn('Rec File: Sending NAK; Retry Nø' , Retry );
{$ENDIF}
PortWrite ( NbPort , NAK ) ;
IF YM_ReceivePacket( NbPort,1,
PacketSize,ExpectedPacket,
PacketBuff,DoCRC,FALSE)
THEN Goto Handshake_OK ;
Inc ( Retry ) ;
END;
{ We abort the reception of the file ... }
YM_ErrorNb := 1 ;
YM_ReceiveFile := FALSE ; Exit ;
Handshake_OK:
{$IFDEF VERBOSE}
WriteLn('Rec File: Sender answered');
{$ENDIF}
{ We try to get sensible information from the first packet }
{ First, get the name }
NameFile := '' ;
Index := 0 ;
WHILE (Index < PacketSize) AND (PacketBuff[Index] <> 0) DO
BEGIN NameFile:=NameFile+Chr(PacketBuff[Index]); Inc(Index);
END;
IF Index = 0 THEN
BEGIN { Null name : that is the normal end of the batch session }
{ That is not an error !! }
WriteLn('End of batch session');
YM_ReceiveFile := FALSE ; Exit ;
END;
IF Index = PacketSize THEN
BEGIN { We could not find the end of the name ...}
YM_ErrorNb := 2 ;
YM_ReceiveFile := FALSE ; Exit ;
END;
{ Now, get the size (in bytes) }
Inc(Index); { To skip the null char }
SizeFile := 0 ;
WHILE (Index < PacketSize) AND NOT(PacketBuff[Index] IN [Ord(' '),0])
DO BEGIN SizeFile := SizeFile * 10 ;
tmp := Pos( Chr(PacketBuff[Index]) , DecimalDigits );
IF tmp = 0 THEN
BEGIN YM_ErrorNb := 3 ;
YM_ReceiveFile := FALSE ; Exit ;
END;
Inc(SizeFile, tmp-1 );
Inc(Index);
END;
{ We don't use the other fields in the packet 0 (date,attribs,mode) }
{ Now we open the file }
WriteLn('Receiving /' , NameFile , '/ ( ' , SizeFile ,' bytes).');
IF FileExists ( NameFile ) AND NOT DoReplace THEN
BEGIN WriteLn ('/', NameFile ,'/ already exists !!' );
GetNewName ;
END;
Assign( ResFile , NameFile );
Rewrite ( ResFile , 1 ) ;
IF IOResult <> 0 THEN
BEGIN WriteLn ('Unable to create /' , NameFile ,'/.' );
YM_ReceiveFile := FALSE ; Exit ;
END;
{ And signal the sender we're ready }
IF DoCRC THEN PortWrite( NbPort, Ord('C') )
ELSE PortWrite( NbPort, NAK );
ReceivedBytes := 0 ;
WHILE ReceivedBytes < SizeFile DO
BEGIN
LastPacket := ExpectedPacket ;
Inc(ExpectedPacket);
IF NOT YM_ReceivePacket( NbPort,10,
PacketSize,ExpectedPacket,
PacketBuff,DoCRC,FALSE)
THEN
BEGIN
Close ( ResFile ) ;
YM_ReceiveFile := FALSE ; Exit ;
END;
IF ExpectedPacket = LastPacket +1 THEN
BEGIN
IF ( ReceivedBytes+PacketSize > SizeFile )
THEN ToWrite := SizeFile - ReceivedBytes
ELSE ToWrite := PacketSize ;
BlockWrite ( ResFile , PacketBuff , ToWrite , tmp ) ;
IF IOResult <> 0 THEN
BEGIN WriteLn ('Unable to write block !' );
Close ( ResFile ) ;
YM_ReceiveFile := FALSE ; Exit ;
END;
Inc ( ReceivedBytes , ToWrite ) ;
WriteLn( ReceivedBytes ,' bytes have been successfully received.( '
, (100* ReceivedBytes) / SizeFile :4:1 , '% )' );
END
ELSE ;
{ The sender should have resent a packet we already received without
any error ( for example, the ACK was garbaged ), so do nothing }
END;
Close(ResFile);
{ If the last ACK sent to the sender was not correctly transmitted,
then the sender resends the last packet. Here we can either get
the EOT, or get the last packet. }
Retry := 0 ;
REPEAT
WHILE YM_ReceivePacket( NbPort,1,
PacketSize,ExpectedPacket,
PacketBuff,DoCRC,TRUE)
DO ;
Inc(Retry);
IF Retry > 9 THEN
BEGIN
YM_ErrorNb := 4 ;
YM_ReceiveFile := FALSE ; Exit ;
END;
UNTIL YM_ErrorNb=0;
PortWrite(NbPort,ACK);
YM_ReceiveFile := TRUE ;
END;
{-----------------------------------------------------------------}
FUNCTION YM_SendPacket ( NbPort : BYTE ;
Size : INTEGER ;
NumPacket : BYTE ;
Packet : YM_Buffer ;
DoCRC : BOOLEAN ) : BOOLEAN ;
VAR Retry : BYTE ;
Index : WORD ;
CRC_Cal : WORD ;
Checksum_Cal : BYTE ;
Answer : BYTE ;
BEGIN
Retry := 0 ;
WHILE ( Retry < 10 ) DO
BEGIN
CASE Size OF
128 : PortWrite ( NbPort , SOH ) ;
1024 : PortWrite ( NbPort , STX ) ;
ELSE
BEGIN WriteLn('Internal Error' );
Halt(1);
END;
END;
{$IFDEF VERBOSE}
WriteLn( 'Sending Packet:', NumPacket);
{$ENDIF}
PortWrite ( NbPort , NumPacket ) ;
PortWrite ( NbPort , $FF - NumPacket ) ;
{$IFDEF VERBOSE}
WriteLn( 'Sending Packet: Sending data');
{$ENDIF}
CRC_Cal := 0 ;
Checksum_Cal := 0 ;
FOR Index := 0 TO Pred(Size) DO
BEGIN
PortWrite ( NbPort , Packet[Index] ) ;
{$IFDEF VERBOSE}
IF (Index MOD 64) = 0 THEN Write('.');
{$ENDIF}
CRC_Cal := UpdCRCfast ( Packet[ Index ] , CRC_Cal );
Inc( Checksum_Cal, Packet[Index] );
END;
{$IFDEF VERBOSE}
WriteLn;
{$ENDIF}
IF DoCRC THEN
BEGIN {$IFDEF VERBOSE}
WriteLn('Sending Packet: Sending CRC');
{$ENDIF}
PortWrite ( NbPort , CRC_Cal SHR 8 ) ;
PortWrite ( NbPort , CRC_Cal AND $FF ) ;
END
ELSE
BEGIN {$IFDEF VERBOSE}
WriteLn('Sending Packet: Sending checksum');
{$ENDIF}
PortWrite ( NbPort , Checksum_Cal ) ;
END;
IF PortReadTicks ( NbPort , _100_ticks , Answer ) THEN
CASE Answer OF
ACK : BEGIN {$IFDEF VERBOSE}
WriteLn('Sending Packet: Receiver acknowledged');
{$ENDIF}
YM_SendPacket := TRUE ; Exit ;
END;
NAK : BEGIN {$IFDEF VERBOSE}
WriteLn('Sending Packet: !! Receiver sent NAK !!');
{$ENDIF}
END;
{$IFDEF VERBOSE}
ELSE WriteLn('Sending Packet: !! Receiver sent :',Answer,' !!');
{$ENDIF}
END;
{$IFDEF ERRORS}
WriteLn('Sending Packet: Error , retry' , Retry);
{$ENDIF}
Inc ( Retry ) ;
END;
YM_SendPacket := FALSE ;
END;
FUNCTION YM_SendFile ( NbPort : BYTE ;NameFile:STRING ; NameRecept:STRING)
: BOOLEAN ;
VAR Retry : WORD ;
Connect : BYTE ;
DoCRC : BOOLEAN ;
PacketBuff : YM_Buffer ;
PacketSize : WORD ;
Index : WORD ;
SrcFile : FILE ;
SizeFile : LONGINT ;
TmpString : STRING ;
CurrPacket : BYTE ;
BytesRead : WORD ;
BytesSent : LONGINT ;
BEGIN CurrPacket := 0 ;
Retry := 0 ;
{ We try to get a character, with 10 retries }
{$IFDEF VERBOSE}
WriteLn('Sending File: trying to connect' );
{$ENDIF}
WHILE NOT PortReadTicks ( NbPort , _100_ticks , Connect ) DO
BEGIN Inc(Retry);
IF Retry > 9 THEN
BEGIN {$IFDEF ERRORS}
WriteLn('Sending File: Error no answer' );
{$ENDIF}
YM_SendFile := FALSE ; Exit ;
END;
END;
{$IFDEF VERBOSE}
WriteLn('#1:Receiver answered with ' , Connect );
{$ENDIF}
CASE Connect OF
Ord('C') : DoCRC := TRUE ;
NAK : DoCRC := FALSE ;
ELSE
BEGIN { Bad connect character : 'C' or NAK expected }
{$IFDEF ERRORS}
WriteLn('Sending File: Error ; ''C'' or NAK expected' );
{$ENDIF}
YM_SendFile := FALSE ; Exit ;
END;
END;
IF Length(NameRecept) = 0
THEN WriteLn ('End of batch session.' )
ELSE WriteLn ('Sending file ' , NameFile , ' as ' , NameRecept ,'.');
IF DoCRC THEN WriteLn( 'Using 16 bit CRC to detect errors')
ELSE WriteLn( 'Using checksum to detect errors');
{ We now prepare the first packet }
{ First clear the packet }
FillChar ( PacketBuff , 128 , 0 );
{ We check if that is the end of the batch session }
IF Length(NameRecept) > 0 THEN
BEGIN
{ Now write the name }
Move ( NameRecept[1] , PacketBuff[0] ,Length(NameRecept) );
Index := Length(NameRecept)+1 ;
{ Now write the size ... }
Assign( SrcFile, NameFile );
Reset(SrcFile,1);
IF IOResult <> 0 THEN
BEGIN WriteLn ('Unable to open /' , NameFile ,'/.' );
YM_SendFile := FALSE ; Exit ;
END;
SizeFile := FileSize(SrcFile);
Str( SizeFile , TmpString );
Move ( TmpString[1] , PacketBuff[Index] , Length(TmpString) );
END;
{ The first packet is ready }
{$IFDEF VERBOSE}
WriteLn('Sending File: Sending packet #0' );
{$ENDIF}
IF NOT YM_SendPacket ( NbPort ,
128 , { Use a small packet }
CurrPacket ,
PacketBuff ,
DoCRC )
THEN
BEGIN YM_SendFile := FALSE ; Exit ;
END;
IF Length(NameRecept) = 0 THEN
BEGIN { End of batch session }
YM_SendFile := TRUE ; Exit ;
END;
{ Here we wait for a character, either 'C' or ACK , 10 retries }
{$IFDEF VERBOSE}
WriteLn('Sending File: Waiting for receiver' );
{$ENDIF}
Retry := 0 ;
WHILE NOT PortReadTicks ( NbPort , _100_ticks , Connect ) DO
BEGIN Inc(Retry);
IF Retry > 9 THEN
BEGIN {$IFDEF ERRORS}
WriteLn('Sending File: Error; No answer' );
{$ENDIF}
YM_SendFile := FALSE ; Exit ;
END;
END;
{$IFDEF VERBOSE}
WriteLn('#2:Receiver answered with ' , Connect );
{$ENDIF}
CASE Connect OF
Ord('C') : ; { OK }
NAK : ; { OK }
ELSE
BEGIN { Bad connect character : 'C' or NAK expected }
{$IFDEF ERRORS}
WriteLn('Sending File: Error; ''C'' or NAK expected' );
{$ENDIF}
YM_SendFile := FALSE ; Exit ;
END;
END;
{ So here we will send the file itself }
BytesSent := 0 ;
REPEAT
FillChar ( PacketBuff , 1024 , 0 );
BlockRead ( SrcFile , PacketBuff , 1024 , BytesRead ) ;
IF IOResult <> 0 THEN
BEGIN WriteLn ('Unable to read a block from /' , NameFile ,'/.' );
YM_SendFile := FALSE ; Exit ;
END;
IF BytesRead > 0 THEN
BEGIN
Inc(CurrPacket);
IF NOT YM_SendPacket ( NbPort ,
1024 , { Use a big packet }
CurrPacket ,
PacketBuff ,
DoCRC )
THEN
BEGIN YM_SendFile := FALSE ; Exit ;
END;
Inc(BytesSent, BytesRead );
WriteLn( BytesSent ,' bytes have been successfully sent.( ',
(100.0*BytesSent)/SizeFile :4:1 , ' %)' );
END;
UNTIL BytesRead <> 1024 ;
Close(SrcFile);
{ And now, send EOT and wait for ACK }
Retry := 0 ;
WHILE Retry < 9 DO
BEGIN
PortWrite ( NbPort , EOT );
IF PortReadTicks ( NbPort , _100_ticks , Connect ) AND (Connect=ACK)
THEN BEGIN {$IFDEF VERBOSE}
WriteLn('Sending File: Receiver aknowledged EOT.' );
{$ENDIF}
YM_SendFile := TRUE ; Exit ;
END;
Inc(Retry);
{$IFDEF ERRORS}
WriteLn('Sending File: Sending EOT , retry # ' , retry );
{$ENDIF}
END;
YM_SendFile := FALSE ;
END;
PROCEDURE YM_CloseBatchSession ( NbPort : BYTE );
BEGIN YM_SendFile ( NbPort , '', '' );
END;
END.
