home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
PROGRAM
/
PCL4P30.ZIP
/
TERM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-01-27
|
8KB
|
265 lines
(*********************************************)
(* *)
(* TERM.PAS Jan 1992 *)
(* *)
(* TERM is a simple terminal emulator which *)
(* features XMODEM and YMODEM file transfer *)
(* *)
(* This program is donated to the Public *)
(* Domain by MarshallSoft Computing, Inc. *)
(* It is provided as an example of the use *)
(* of the Personal Communications Library. *)
(* *)
(*********************************************)
{ $DEFINE HAYES}
program term;
uses term_io, modem_io, xymodem, xypacket, crc, crt, PCL4P;
Var
ResetFlag : Boolean;
Port : Integer;
SioBuffer : array[0..2047] of Byte;
function MatchBaud(BaudRate : LongInt) : Integer;
Label 999;
const
BaudRateArray : array[1..10] of LongInt =
(300,600,1200,2400,4800,9600,19200,38400,57600,115200);
var
i : Integer;
begin
for i := 1 to 10 do if BaudRateArray[i] = BaudRate then
begin
MatchBaud := i - 1;
goto 999
end;
(* no match *)
MatchBaud := -1;
999: end;
procedure MyHalt( Code : Integer );
var
RetCode : Integer;
begin
if Code < 0 then SayError( Code,'Halting' );
if ResetFlag then RetCode := SioDone(Port);
writeln('*** HALTING ***');
Halt;
end;
(* main program *)
label 500;
const
WrongBaud1 = 'Cannot recognize baud rate';
WrongBaud2 = 'Must be 300,600,1200,2400,4800,9600,19200,38400,57600, or 155200';
var
Filename : String20;
c : Char;
BaudRate : LongInt;
BaudCode : Integer;
Protocol : Char;
Buffer : BufferType;
RetCode : Integer;
Byte : Char;
i : Integer;
MenuMsg : String40;
StatusMsg : String40;
ResultMsg : String20;
GetNameMsg: String40;
OneKflag : Boolean;
CRCflag : Boolean;
BatchFlag: Boolean;
Flag : Boolean;
begin (* main program *)
InitCRC;
TextMode(BW80);
ClrScr;
Window(1,1,80,24);
ResetFlag := FALSE;
Protocol := 'X';
OneKflag := FALSE;
CRCflag := TRUE;
BatchFlag := FALSE;
MenuMsg := 'Q)uit P)rotocol S)end R)eceive: ';
GetNameMsg := 'Enter filename: ';
StatusMsg := 'COM? X "ESC for menu"';
(* fetch PORT # from command line *)
if ParamCount <> 2 then
begin
writeln('USAGE: "TERM <port> <buadrate>" ');
halt;
end;
Val( ParamStr(1),Port, RetCode );
if RetCode <> 0 then
begin
writeln('Port must be 1 to 4');
Halt;
end;
(* COM1 = 0, COM2 = 1, COM3 = 2, COM4 = 3 *)
Port := Port - 1;
Val( ParamStr(2),BaudRate, RetCode );
if RetCode <> 0 then
begin
writeln(WrongBaud1);
writeln(WrongBaud2);
Halt;
end;
BaudCode := MatchBaud(BaudRate);
if BaudCode < 0 then
begin
writeln(WrongBaud1);
writeln(WrongBaud2);
halt;
end;
(* patch up status message *)
StatusMsg[4] := chr($31+Port);
Insert(ParamStr(2),StatusMsg,8);
WriteMsg(StatusMsg,40);
if (Port<COM1) or (Port>COM4) then
begin
writeln('Port must be 1 to 4');
Halt
end;
(* setup 1K receive buffer *)
RetCode := SioRxBuf(Port, Ofs(SioBuffer), Seg(SioBuffer), Size2048);
if RetCode < 0 then MyHalt( RetCode );
(* reset port *)
RetCode := SioReset(Port,BaudCode);
(* if error then try one more time *)
if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
(* Was port reset ? *)
if RetCode <> 0 then
begin
writeln('Cannot reset COM',Port+1);
MyHalt( RetCode );
end;
(* Port successfully reset *)
ResetFlag := TRUE;
ClrScr;
(* specify parity, # stop bits, and word length for port *)
RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
if RetCode < 0 then MyHalt( RetCode );
RetCode := SioRxFlush(Port);
if RetCode < 0 then MyHalt( RetCode );
(* send initialization string to modem *)
{$IFDEF HAYES}
RetCode := SioDTR(Port,SETON);
RetCode := SioRTS(Port,SETON);
SendTo(Port,'!AT E1 S7=60 S11=60 V1 X1 Q0 S0=1!');
if not WaitFor(Port,'OK') then
begin
writeln('Expected OK not received');
MyHalt(0);
end;
writeln;
writeln('MODEM ready');
{$ENDIF}
(* begin terminal loop *)
WriteMsg(StatusMsg,40);
LowVideo;
while TRUE do
begin (* while TRUE *)
(* did user press Ctrl-BREAK ? *)
if SioBrkKey then
begin
writeln('User typed Ctl-BREAK');
RetCode := SioDone(Port);
Halt;
end;
(* anything incoming over serial port ? *)
RetCode := SioGetc(Port,0);
if RetCode < -1 then MyHalt( RetCode );
if RetCode > -1 then write(chr(RetCode));
(* has user pressed keyboard ? *)
if KeyPressed then
begin (* keypressed *)
(* read keyboard *)
Byte := ReadKey;
(* quit if user types ESC *)
if Byte = chr($1b) then
begin (* ESC *)
WriteMsg(MenuMsg,1);
ReadMsg(ResultMsg,32,1);
c := UpCase(ResultMsg[1]);
case c of
'Q': (* QUIT *)
begin
WriteLn;
WriteLn('TERMINATING: User pressed <ESC>');
RetCode := SioDone(Port);
Halt;
end;
'P': (* PROTOCOL *)
begin
WriteMsg(' Choose X)modem or Y)modem: ',1);
ReadMsg(ResultMsg,32,1);
c := UpCase(ResultMsg[1]);
case c of
'X': (* XMODEM *)
begin
Protocol := 'X';
OneKflag := FALSE;
CRCflag := TRUE;
BatchFlag := FALSE;
WriteMsg('Protocol = XMODEM',1);
end;
'Y': (* YMODEM *)
begin
Protocol := 'Y';
OneKflag := TRUE;
CRCflag := TRUE;
BatchFlag := TRUE;
WriteMsg('Protocol = YMODEM',1);
end;
end; (* case *)
StatusMsg[6] := Protocol;
WriteMsg(StatusMsg,40)
end;
'S': (* Send *)
begin
WriteMsg(GetNameMsg,1);
ReadMsg(Filename,16,20);
if Length(FileName) = 0 then goto 500;
Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
if BatchFlag then
begin
(* send empty filename *)
Filename := '';
RetCode := SioDelay(5);
Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
end
end; (* Send *)
'R': (* Receive *)
begin
if BatchFlag then
repeat
WriteMsg('Ready for next file',1);
Filename := '';
Flag := RxyModem(Port,Filename,Buffer,CRCflag,BatchFlag);
until KeyPressed or (Length(Filename) = 0)
else
begin (* not BatchFlag *)
WriteMsg(GetNameMsg,1);
ReadMsg(Filename,16,20);
If Length(Filename) = 0 then exit;
Flag := RxyModem(Port,Filename,Buffer,CRCflag,BatchFlag);
end
end (* Receive *)
else WriteMsg('Bad response',1);
end; (* case *)
500:
end; (* ESC *)
(* send out over serial line *)
RetCode := SioPutc(Port, Byte );
if RetCode < 0 then MyHalt( RetCode );
end (* keypressed *)
end (* while TRUE *)
end.