home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
BEEHIVE
/
COMMS
/
PMODEM.ARC
/
HOST.INC
< prev
next >
Wrap
Text File
|
1991-08-11
|
4KB
|
151 lines
{********** host.inc **********}
{ host modem routines}
procedure get(var In_Char: char);
{modem_in with echo to terminal}
begin
in_char := modem_in;
write(in_char);
end; {get}
procedure get_line(var line: data2);
{modem_in a line with echo to terminal}
var
In_char: char;
begin
repeat
get(in_char);
line:= line + in_char;
until in_char= LF;
end; {get_line}
procedure send_chr(OutChar: char);
{modem_out with echoe to terminal}
begin
modem_out(outChar);
write(outChar);
end; {send_chr}
procedure send(line: data2);
{modem_out line no cr/ with echoe to terminal}
var
local: byte;
begin
for local:= 1 to length(line) do
modem_out(line[local]);
write(line);
end; {send}
procedure send_line(Line: data2);
begin
modem_out_line(line);
writeln(line);
end; {send_line}
procedure go_answer;
label quit_answer;
var
local: char;
begin
if eraseOK then clrScr;
modem_out_line('ATS0=3'); {enable auto answer 4 rings}
writeln('HOST mode (awaiting phone call)');
writeln('(^T test / ^X to quit)');
repeat
sinp(local);
if local in [ ^X, ^T ] then goto quit_answer;
until carrier; {want terminal mode if answer}
QUIT_ANSWER:
X:= local;
modem_out_line('ATS0=0');
end; {go_answer}
procedure remote_menu;
label startloop, quitloop;
var
local: data2;
begin
startloop:
send_line(' ');
send_line('Remote Menue');
send_line('============');
send_line(' ');
send_line('(C)hat with operator');
send_line('(E)nter a message');
send_line('(R)ead message(s)');
send_line('(G)oodbye');
write(CRLF+ 'Enter SELECTION: ');
if carrier then get_line(local) else readln(local); {local := modem_in;}
send_line(' ');
if length(local)= 0 then local:= '?';
case upCase(local[1]) of
'C': begin
send_line('CHAT mode / ^E for menu');
duplex:= false;
terminal_mode;
duplex:= true;
end;
{ 'G': local:= '0'; } {goto quitloop}
end;
if local in ['G', 'g'] then else goto startloop; {loop back}
quitloop:
end; {remote_menue}
procedure host;
label rehost, access, endhost, quit;
var
Password,Sysop,Host_Answer: boolean;
local: data2;
temp1: data;
local1: byte;
local2: char;
begin
Password:= false; OK:= false; Sysop:= false;
writeln('HOST mode');
writeln;
{setup_Host;}
host_mode:= true;
write('Use password (Y/[N])? ');
readln(local);
if length(local)= 0 then local:= 'N';
if upCase(local)= 'N' then OK:= true;
REHOST:
password:= OK; local1:= 0;
repeat
go_answer;
if X= ^X then goto endhost;
if X= ^T then goto access; {test}
until carrier;
ACCESS:
if not carrier then writeln('==> test mode');
{now connected}
send_line(CRLF);
send_line('>> Phil''s Remote Computer System <<');
send_line(CRLF);
send_line('Welcome!');
if not Password then begin
repeat
send('Enter PASSWORD: ');
if carrier then get_line(local) else Readln(local);
temp1:= local;
upper(temp1);
if temp1= 'FOOBAR' then Password:= true;
if temp1= 'BYE' then goto quit;
if not Password then begin
send_line(CRLF+'++ Password Fail ++'+CRLF);
local1:= local1+ 1;
end;
if password then local1:= 3;
until local1= 3;
end;
if Password then remote_menu
else send_line('==> Access fails -- disconnecting --');
quit:
send_line('Goodbye, thanks for calling . . .');
if carrier then go_onHook
else delay(2000);
goto rehost;
endhost:
end; {host}