Program Modem7;
{
Written: 05-19-90
Revised: 12-27-92
Copyright (c)1990,1992, Eric J. Givler, All Rights Reserved.
}
USES Ansi_Drv,
Dos,
Crt,
CRCS, { CRCS is a host of crc calculation routines }
FOS, { Fossil Communications primitives }
protocol; { Protocol Unit }
CONST
COMport = 1;
NUL = #$00; { a # means character instead of byte, ie #$01 }
SOH = #$01;
STX = #$02;
EOT = #$04;
ACK = #$06;
NAK = #$15;
XON = #$11;
XOFF = #$13;
CPMEOF = #$1A;
CAN = #$18;
C = #$43;
TAB = #$09;
LF = #$0A; {character}
CR = #$0D; {character}
SPACE = #$20;
DELete = #$7F;
lastbyte = 127;
errormax = 5;
retrymax = 5;
TYPE maxstr = string;
hexstr = string[4];
blocktype = array[0..127] of byte;
VAR Screen : Text;
WorkFile: file;
option,
hangup,
return,
mode : char;
baudrate : longint;
sector : blocktype; { array[0..lastbyte] of byte; }
rcvbuf : blocktype; { array[0..127] of byte; }
inptr,
outptr: integer;
dt : DateTime;
{ regs :registers;
portnum : word; }
(*
================================================================
FUNCTIONS and PROCEDURES follow.
================================================================
PROCEDURE GetOption - draws menu and gets user terminal option.
PROCEDURE ReceiveFile - Receive a File (main)
PROCEDURE ReceiveIt - Receive a File - Xmodem/Checksum
PROCEDURE SendFile - Send a File - MAIN menu system.
PROCEDURE SendAscii - Send a File - Ascii with XON/XOFF
PROCEDURE SendCRC - Send a File - Xmodem/CRC
PROCEDURE SendMEGALink - Send a File - MEGALINK
PROCEDURE Terminal - SIMPLE terminal.
*)
PROCEDURE SendFile;
VAR j,
blocknum,
counter,
result,
checksum : integer;
filename : string;
c : char;
success : boolean;
(* {$I ASCIIS } { Ascii Send - SendAscii } *)
(* {$I MEGALS } { MegaLink Send - SendMEGALink } *)
(* {$I YMGS } { Ymodem-G Send - SendYmodem_G } *)
BEGIN
Write('Filename.Ext ? ');
ReadLn(filename);
IF Length(filename) > 0 THEN
begin
Write('X)modem/chksum,Xmodem(C)rc,(1)KXmdm,(Y)modem: ');
readln(c); { repeat until keypressed; }
c := upcase(c);
case c of
{'A' : SendAscii;}
'X' : success := Upload( filename, XmodemChkSum );
'C' : success := Upload( filename, XmodemCRC );
'1' : success := Upload( filename, Xmodem1K );
'Y' : success := Upload( filename, Ymodem );
else
writeln('Invalid protocol [',c,'] selected.');
end;
end;
end;
PROCEDURE ReceiveFile;
VAR j,
firstchar,
sectornum,
sectorcurrent,
sectorcomp,
errors,
checksum : integer;
errorflag : boolean;
filename : string[20];
c : char;
(* {$I ASCIIR } { Receive Ascii module } *)
(*
PROCEDURE ReceiveIt;
VAR j : integer;
BEGIN
sectornum := 0;
errors := 0;
Send(NAK);
Send(NAK); { send ready characters }
REPEAT
errorflag := false;
REPEAT
firstchar := readline(20);
UNTIL ((firstchar IN [Ord(SOH),Ord(EOT)]) OR (firstchar = timeout));
IF firstchar = timeout THEN Writeln(cr,lf,'Error - No starting SOH');
IF firstchar = Ord(SOH) THEN BEGIN
sectorcurrent := Readline(1); {real sector number}
sectorcomp := Readline(1); {+ inverse of above}
IF (sectorcurrent+sectorcomp) = 255 THEN BEGIN {< becomes this #}
IF (sectorcurrent=sectornum+1) THEN BEGIN
checksum := 0;
FOR j := 0 TO lastbyte DO BEGIN
sector[j] := Readline(1);
checksum := (checksum+sector[j]) AND $00FF
END;
IF checksum = Readline(1) THEN BEGIN
Blockwrite(WorkFile,sector,1);
errors := 0;
sectornum := sectorcurrent;
Write(cr,'Received sector ',sectorcurrent);
Send(ACK)
END ELSE BEGIN
Writeln(cr,lf,'Checksum error');
errorflag := true
END
END ELSE IF (sectorcurrent=sectornum) THEN BEGIN
REPEAT
UNTIL Readline(1) = timeout;
Writeln(cr,lf,'Received duplicate sector ', sectorcurrent);
Send(ack)
END ELSE BEGIN
Writeln(cr,lf,'Synchronization error');
errorflag := true
END
END else BEGIN
Writeln(cr,lf,'Sector number error');
errorflag := true
END
END;
IF errorflag THEN BEGIN
inc(errors);
REPEAT
UNTIL Readline(1) = timeout;
Send(nak)
END;
UNTIL ((firstchar = Ord(EOT)) OR (firstchar = timeout)) OR
(errors = errormax) OR (NOT Carrier);
IF (firstchar = Ord(EOT)) AND (errors < errormax) THEN BEGIN
Send(ack);
Writeln(cr,lf,'Transfer complete')
END
ELSE Writeln(cr,lf,'Aborting');
END;
*)
BEGIN
Write('Filename.Ext? ');
Readln(filename);
IF length(filename) > 0 then begin
Write('Protocol: a)scii, x)modem: ');
repeat until keypressed;
c := upcase(readkey);
CASE c of
'a' : {}
(* 'A' : RecvAscii(filename); *)
{ 'X' : begin
Assign(WorkFile,filename);
Rewrite(WorkFile);
ReceiveIt;
Close(WorkFile);
end;}
else
writeln(c,' is not a valid protocol.');
end;
END;
END;
PROCEDURE PortChange;
var port : integer;
begin
Write('Enter port #: ');
ReadLn(port);
CloseFossil;
PortNum := Port;
IF NOT OpenFossil THEN Exit;
end;
PROCEDURE terminal;
VAR C : char;
BEGIN
writeln('Use ctrl-E to exit terminal mode.');
repeat
IF SerialChar THEN
begin
c := Receive;
{Ansi_Write( c );}
Write(Screen, c);
end;
IF keypressed THEN
BEGIN
c := readkey;
send(c);
END;
until (c = ^E);
END;
procedure BaudChange;
begin
write(Screen,'Enter Baud: ');
Readln(baudrate);
SetBaudRate(baudrate);
end;
PROCEDURE GetOption;
BEGIN
Writeln('Options:');
Writeln;
Writeln(' B - BaudRate');
Writeln(' H - hang up the phone');
WriteLn(' P - Com Port');
Writeln(' R - receive a file');
Writeln(' S - send a file');
Writeln;
Writeln(' T - terminal mode');
Writeln(' X - exit to system');
Writeln;
Write('which ? ');
REPEAT
option := Upcase(readkey);
UNTIL option IN ['B','H','P','R','S','T','X'];
Writeln(option);
END;
BEGIN { Modem7 }
PortNum := 1;
If not OpenFossil then
begin
writeln('Fossil not installed or problem initializing.');
Halt;
end;
Assign(Screen,'');
Rewrite(Screen);
baudrate := 19200;
SetBaudRate(baudrate);
return := 'N';
REPEAT
GetOption;
CASE option OF
'B': BaudChange;
'H': HangUpPhone;
'P': PortChange;
'R': ReceiveFile;
'S': SendFile;
'T': Terminal;
'X': return := 'Y';
END;
UNTIL return = 'Y';
CloseFossil;
Close(Screen);
END.
