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 / BBS / C128PICS.ARC / C1670.MDM < prev    next >
Text File  |  1991-08-11  |  4KB  |  134 lines

  1. { ROSMDM.INC - Remote Operating System Modem Dependent Routines }
  2.  
  3. { File        C1670.mdm
  4. Discription   This is the modem routines for the Commodore 1670 (Hayes
  5.               Compatable) modem.
  6. date          7/7/89
  7. Author        Peter B. Carter
  8. }
  9. const
  10.  
  11. { Modem result codes }
  12.  
  13.   OKAY        = 'OKAY';                    { Command executed with no errors }
  14.   CONNECT300  = 'CONNECT';                 { Carrier detect at 300 bps }
  15.   RING        = 'RING';                    { Ring signal detected }
  16.   NOCARRIER   = 'NO CARRIER';              { Carrier lost or never heard }
  17.   ERROR       = 'ERROR';                   { Error in command execution }
  18.   CONNECT1200 = 'CONNECT 1200';            { Carrier detect at 1200 bps }
  19.  
  20. function mdresult: StrStd;
  21. { Get result code from modem }
  22.   var
  23.     count,num: integer;
  24.     ch: char;
  25.     result: StrStd;
  26.   begin
  27.     result := '';
  28.     repeat
  29.       num:=0;
  30.       repeat
  31.             num:=num+1;
  32.             if num=3000 then
  33.             begin
  34.                  if result='' then
  35.                     mdresult := ERROR
  36.                  else
  37.                     mdresult := result;
  38.                  exit;
  39.             end;
  40.       until ch_inprdy;
  41.       ch := chr(ch_inp);
  42.       if (ch <> CR) and (ch <> chr(10)) then result := result + ch;
  43.     until (ch = CR) and (result <> '');
  44.     mdresult := result;
  45.   end;
  46.  
  47. procedure mdsend(st: StrStd);
  48. { Send a command string to the modem and continue sending until the modem
  49.   echoes exactly what was sent. }
  50.   var
  51.     bt,p: byte;
  52.     count : integer;
  53.   begin
  54.        repeat
  55.              ch_purge;
  56.              OK:=true;
  57.              for p:=1 to length(st) do
  58.              begin
  59.                   ch_out(ord(st[p]));
  60.                   count:=500;
  61.                   repeat
  62.                         count:=pred(count);
  63.                   until (count = 0) or ch_inprdy;
  64.                   if count=0 then OK:=false
  65.                      else
  66.                      begin
  67.                           bt:=ch_inp;
  68.                           if chr(bt)=st[p] then OK:=true
  69.                              else OK:=false;
  70.                      end;
  71.                   if not OK then p:=length(st);
  72.              end;
  73.        until OK;
  74.   end;
  75.  
  76. procedure mdhangup;
  77. { Hangup modem }
  78.   begin
  79.       { Break before disconnect not implemented }
  80.       ch_off;                               { Hangup NOW! }
  81.       while ch_carck do inline(0);
  82.       ch_on;
  83.       ch_purge;
  84.   end;
  85.  
  86. procedure mdbusy;
  87. { Take modem off hook to present a busy signal to incoming callers }
  88.   begin
  89.              mdsend('AT H1' + CR);                  { Take modem off hook }
  90.   end;
  91.  
  92. function mdring: boolean;
  93. { Determine if the phone is ringing }
  94.   begin
  95.     if ch_inprdy
  96.       then mdring := (RING = mdresult)
  97.       else mdring := FALSE;
  98.   end;
  99.  
  100. procedure mdans;
  101. { Detect and set system to rate at which modem answered phone }
  102.   var
  103.     bt: byte;
  104.     result: StrStd;
  105.   begin
  106.     mdsend('AT A' + CR);
  107.     delay(2000);
  108.     result := mdresult;
  109.     if result = CONNECT300
  110.       then ch_set(300)
  111.     else if result = CONNECT1200
  112.       then ch_set(1200)
  113.     else if ch_carck then
  114.     begin
  115.          bt:=inbc($dd01) and 32;
  116.          if bt=32 then ch_set(300) else ch_set(1200)
  117.     end else mdhangup;
  118.   end;
  119.  
  120. procedure mdinit;
  121. { Ensure the modem is hung up, initialized, and ready to wait for a ring. }
  122.   var
  123.     bt: byte;
  124.   begin
  125.     ch_init;                                { Initialize the remote channel }
  126.     ch_on;
  127.     ch_set(1200);                           { Set the channel speed }
  128.     mdsend('ATZ' + CR);                     { Get the modem's attention }
  129.     delay(500);
  130.     ch_purge;
  131.     mdsend('AT X1 H0 M0 S2=3' + CR);
  132.     ch_purge;
  133.   end;
  134.