home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / turbopas / pmodem.ark / HOST.INC < prev    next >
Encoding:
Text File  |  1987-02-22  |  3.6 KB  |  151 lines
  1. {********** host.inc **********}
  2.       { host modem routines}
  3.  
  4. procedure get(var In_Char: char);
  5. {modem_in with echo to terminal}
  6. begin
  7.   in_char := modem_in;
  8.   write(in_char);
  9. end;  {get}
  10.  
  11. procedure get_line(var line: data2);
  12. {modem_in a line with echo to terminal}
  13. var
  14.   In_char: char;
  15. begin
  16.   repeat
  17.     get(in_char);
  18.     line:= line + in_char;
  19.   until in_char= LF;
  20. end; {get_line}
  21.  
  22. procedure send_chr(OutChar: char);
  23. {modem_out with echoe to terminal}
  24. begin
  25.   modem_out(outChar);
  26.   write(outChar);
  27. end;   {send_chr}
  28.  
  29. procedure send(line: data2);
  30. {modem_out line no cr/ with echoe to terminal}
  31. var
  32.   local: byte;
  33. begin
  34.   for local:= 1 to length(line) do
  35.     modem_out(line[local]);
  36.   write(line);
  37. end;   {send}
  38.  
  39. procedure send_line(Line: data2);
  40. begin
  41.   modem_out_line(line);
  42.   writeln(line);
  43. end;   {send_line}
  44.  
  45. procedure go_answer;
  46. label quit_answer;
  47. var
  48.   local: char;
  49. begin
  50.   if eraseOK then clrScr;
  51.   modem_out_line('ATS0=3'); {enable auto answer 4 rings}
  52.   writeln('HOST mode (awaiting phone call)');
  53.   writeln('(^T test / ^X to quit)');
  54.   repeat
  55.   sinp(local);
  56.   if local in [ ^X, ^T ] then goto quit_answer;
  57.   until carrier;  {want terminal mode if answer}
  58. QUIT_ANSWER:
  59.   X:= local;
  60.   modem_out_line('ATS0=0');
  61. end; {go_answer}
  62.  
  63. procedure remote_menu;
  64. label startloop, quitloop;
  65. var
  66.   local: data2;
  67. begin
  68. startloop:
  69.    send_line(' ');
  70.    send_line('Remote Menue');
  71.      send_line('============');
  72.      send_line(' ');
  73.      send_line('(C)hat with operator');
  74.      send_line('(E)nter a message');
  75.      send_line('(R)ead message(s)');
  76.      send_line('(G)oodbye');
  77.      write(CRLF+ 'Enter SELECTION: ');
  78.    if carrier then get_line(local) else readln(local);  {local := modem_in;}
  79.    send_line(' ');
  80.    if length(local)= 0 then local:= '?';
  81.    case upCase(local[1]) of
  82.      'C': begin
  83.             send_line('CHAT mode / ^E for menu');
  84.             duplex:= false;
  85.             terminal_mode;
  86.             duplex:= true;
  87.           end;
  88.    {  'G': local:= '0'; } {goto quitloop}
  89.    end;
  90.    if local in ['G', 'g'] then else goto startloop; {loop back}
  91. quitloop:
  92. end;  {remote_menue}
  93.  
  94. procedure host;
  95. label rehost, access, endhost, quit;
  96. var
  97.   Password,Sysop,Host_Answer: boolean;
  98.   local:  data2;
  99.   temp1:  data;
  100.   local1: byte;
  101.   local2: char;
  102. begin
  103.   Password:= false; OK:= false; Sysop:= false;
  104.   writeln('HOST mode');
  105.   writeln;
  106.   {setup_Host;}
  107.   host_mode:= true;
  108.   write('Use password (Y/[N])? ');
  109.   readln(local);
  110.   if length(local)= 0 then local:= 'N';
  111.   if upCase(local)= 'N' then OK:= true;
  112. REHOST:
  113.   password:= OK;  local1:= 0;
  114.   repeat
  115.     go_answer;
  116.     if X= ^X then goto endhost;
  117.     if X= ^T then goto access;  {test}
  118.   until carrier;
  119. ACCESS:
  120.   if not carrier then writeln('==> test mode');
  121.   {now connected}
  122.   send_line(CRLF);
  123.   send_line('>> Phil''s Remote Computer System <<');
  124.   send_line(CRLF);
  125.   send_line('Welcome!');
  126.  if not Password then begin
  127.   repeat
  128.     send('Enter PASSWORD: ');
  129.     if carrier then get_line(local) else Readln(local);
  130.     temp1:= local;
  131.     upper(temp1);
  132.     if temp1= 'FOOBAR' then Password:= true;
  133.     if temp1= 'BYE' then goto quit;
  134.     if not Password then begin
  135.       send_line(CRLF+'++ Password Fail ++'+CRLF);
  136.       local1:= local1+ 1;
  137.     end;
  138.     if password then local1:= 3;
  139.   until local1= 3;
  140.  end;
  141.   if Password then remote_menu
  142.   else send_line('==> Access fails -- disconnecting --');
  143. quit:
  144.   send_line('Goodbye, thanks for calling . . .');
  145.   if carrier then go_onHook
  146.     else delay(2000);
  147.   goto rehost;
  148. endhost:
  149. end; {host}
  150.  
  151.