home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PCL4P31.ZIP / MODEM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-11  |  3.8 KB  |  141 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*          MODEM.PAS       Jan 92           *)
  4. (*                                           *)
  5. (*  MODEM sets and clears DTR and RTS and    *)
  6. (*  reads DSR, CTS, RI, and DCD              *)
  7. (*                                           *)
  8. (*  This program is donated to the Public    *)
  9. (*  Domain by MarshallSoft Computing, Inc.   *)
  10. (*  It is provided as an example of the use  *)
  11. (*  of the Personal Communications Library.  *)
  12. (*                                           *)
  13. (*********************************************)
  14.  
  15.  
  16. program Modem;
  17. uses crt, PCL4P;
  18.  
  19. Var
  20.   Buffer : array[0..7] of Byte;
  21.   Port : Integer;
  22.  
  23. Procedure MyHalt( Code : Integer);
  24. var
  25.   RetCode : Integer;
  26. begin
  27.   if Code < 0 then RetCode := SioError(Code);
  28.   RetCode := SioDone(Port);
  29.   writeln('*** HALTING ***');
  30.   Halt;
  31. end;
  32.  
  33.  
  34.  
  35. Procedure Display;
  36. Var
  37.  i : Integer;
  38. Begin
  39.  GotoXY(1,1);
  40.  WriteLn('     MODEM CONTROL'); Writeln;
  41.  Write('Data Terminal Ready (DTR): ');
  42.  if SioDTR(Port,READ) > 0 then WriteLn('ON ') else WriteLn('OFF');
  43.  Write('Request to Send     (RTS): ');
  44.  if SioRTS(Port,READ) > 0 then WriteLn('ON ') else WriteLn('OFF');
  45.  WriteLn; WriteLn('     MODEM STATUS'); WriteLn;
  46.  Write('Data Set Ready      (DSR): ');
  47.  if SioDSR(Port) > 0 then WriteLn('ON ') else WriteLn('OFF');
  48.  Write('Clear To Send       (CTS): ');
  49.  if SioCTS(Port) > 0 then WriteLn('ON ') else WriteLn('OFF');
  50.  Write('Data Carrier Detect (DCD): ');
  51.  if SioDCD(Port) > 0 then WriteLn('ON ') else WriteLn('OFF');
  52.  Write('Ring Indicator       (RI): ');
  53.  if SioRI(Port) > 0 then WriteLn('ON ') else WriteLn('OFF')
  54. end;
  55.  
  56.  
  57. (* main program *)
  58.  
  59. Var
  60.  Row : Integer;
  61.  Col : Integer;
  62.  xRow : Integer;
  63.  RetCode : Integer;
  64.  I : Integer;
  65.  C : Char;
  66. Begin
  67.  (* fetch port from command line *)
  68.  if ParamCount <> 1 then
  69.    begin
  70.      writeln('USAGE: "MODEM <port>" ');
  71.      halt;
  72.    end;
  73.  Val( ParamStr(1), Port, RetCode);
  74.  if RetCode <> 0 then
  75.    begin
  76.      writeln('Port must be 1 to 4');
  77.      Halt;
  78.    end;
  79.  (* COM1 = 0, .., COM4 = 3 *)
  80.  Port := Port - 1;
  81.  (* must call SioRxBuf before SioReset *)
  82.  RetCode := SioRxBuf(Port,Ofs(Buffer),Seg(Buffer),Size8);
  83.  if RetCode < 0 then MyHalt(RetCode);
  84.  (* reset port *)
  85.  RetCode := SioReset(Port,NORESET);
  86.  if RetCode < 0 then MyHalt(RetCode);
  87.  TextMode(BW80);
  88.  ClrScr;
  89.  xRow := WhereY;
  90.  Display;
  91.  WriteLn;
  92.  WriteLn('1) Set DTR    3) Clear DTR    5) Redisplay');
  93.  WriteLn('2) Set RTS    4) Clear RTS    0) QUIT');
  94.  WriteLn;
  95.  Row := WhereY;
  96.  while TRUE do
  97.    begin
  98.      (* clear keyboard *)
  99.      while KeyPressed do C := ReadKey;
  100.      (* get users' response *)
  101.      GotoXY(1,Row);
  102.      WriteLn('Select 0 to 5:   ');
  103.      GotoXY(15,Row);
  104.      C := ReadKey; Write(C);
  105.      if (C<'0') or (C>'5') then
  106.        begin
  107.          GotoXY(1,Row+1);
  108.          Write('Must select 0 to 5. Type ENTER to continue');
  109.          C := ReadKey;
  110.          GotoXY(1,Row+1);
  111.          for I := 0 to 41 do Write(' ');
  112.        end
  113.      else
  114.        begin
  115.          C := UpCase(C);
  116.          case C of
  117.            '0':  (* QUIT *)
  118.               begin
  119.                 RetCode := SioDone(Port);
  120.                 Halt
  121.               end;
  122.            '1':  (* Set DTR *)
  123.               RetCode := SioDTR(Port,SETON);
  124.            '2':  (* Set RTS *)
  125.               RetCode := SioRTS(Port,SETON);
  126.            '3':  (* Clear DTR *)
  127.               RetCode := SioDTR(Port,CLEAR);
  128.            '4':  (* Clear RTS *)
  129.               RetCode := SioRTS(Port,CLEAR);
  130.            '5':  (* redisplay *)
  131.          else
  132.            begin
  133.              Write('Bad response');
  134.            end;
  135.          end; (* case *)
  136.         GotoXY(xRow,1);
  137.         Display;
  138.      end (* else *)
  139.    end (* while *)
  140. end.
  141.