home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PCL4P30.ZIP / MODEM_IO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-18  |  3.0 KB  |  119 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*  Talks to your modem. Called by TERM.PAS  *)
  4. (*                                           *)
  5. (*  This program is donated to the Public    *)
  6. (*  Domain by MarshallSoft Computing, Inc.   *)
  7. (*  It is provided as an example of the use  *)
  8. (*  of the Personal Communications Library.  *)
  9. (*                                           *)
  10. (*********************************************)
  11.  
  12. unit Modem_IO;
  13.  
  14. interface
  15.  
  16. type
  17.   String80 = String[80];
  18.  
  19.  
  20. procedure SendTo( Port:Integer; ThisString:String80);
  21. function  WaitFor( Port:Integer; ThisString:String80):Boolean;
  22.  
  23. implementation
  24.  
  25. uses PCL4P;
  26.  
  27. procedure SendTo( Port: Integer; ThisString:String80);
  28. const
  29.    CR = 13;
  30. var
  31.    rc : Integer;
  32.    i  : Integer;
  33.    c  : Char;
  34. begin
  35.    rc := SioRxFlush(Port);
  36.    rc := SioDelay(4);
  37.    for i := 1 to Length(ThisString) do
  38.       begin
  39.          c := UpCase(ThisString[i]);
  40.          case c of
  41.             '!' : c := chr(CR);
  42.             '~' : begin
  43.                      (* delay 1/2 second *)
  44.                      rc := SioDelay(9);
  45.                      c := ' '
  46.                   end;
  47.              ' ': rc := SioDelay(4);
  48.          end;
  49.          (* transmit as 7 bit char *)
  50.          rc := SioPutc(Port, chr(ord(c) and $7f));
  51.          (* wait 1/18th of a second *)
  52.          rc := SioDelay(1);
  53.          (* wait 1 second for echo *)
  54.          rc := SioGetc(Port,18);
  55.          if rc > 0 then Write(chr(rc));
  56.       end (* for *)
  57. end; (* SendTo *)
  58.  
  59. Function WaitFor(Port:Integer; ThisString:String80): Boolean;
  60. label WaitForExit;
  61. const
  62.   CR = 13;
  63.   LF = 10;
  64.  
  65. var
  66.   code : Integer;
  67.   c : Char;
  68.   i : Integer;
  69.   rc: Integer;
  70.  
  71. procedure Flush;
  72. label FlushExit;
  73. var code : integer;
  74. begin
  75.   while TRUE do
  76.     begin
  77.        (* get next incoming character *)
  78.        code := SioGetc(Port,38);
  79.        if code = -1 then exit;
  80.        (* skip CR & LF *)
  81.        if (code <> CR) and (code <> LF) then
  82.          begin
  83.            (*writeln('Pushing ',chr(code),' [',code,']');*)
  84.            rc := SioUnGetc(Port, code );
  85.            goto FlushExit;
  86.          end;
  87.     end; (* while *)
  88. FlushExit: end; (* Flush *)
  89.  
  90. begin (* WaitFor *)
  91.   Write( chr(LF) );
  92.   Flush;
  93.   for i:= 1 to Length(ThisString) do
  94.     begin
  95.        (* c is expected character *)
  96.        c := UpCase( ThisString[i] );
  97.        (* wait 1 second for next character *)
  98.        code := SioGetc(Port,18);
  99.        if code = -1 then
  100.           begin
  101.              WaitFor := FALSE;
  102.              goto WaitForExit;
  103.           end;
  104.        (* echo character from modem *)
  105.        Write(chr(code));
  106.        if chr(code) <> c then
  107.           begin
  108.              writeln('Expecting ',c,' not ',chr(code),'[',code,']');
  109.              WaitFor := FALSE;
  110.              goto WaitForExit;
  111.           end;
  112.     end; (* for *)
  113.   (* a last character ? *)
  114.   rc := SioGetc(Port,18);
  115.   if rc > 0 then Write(chr(rc));
  116.   WaitFor := TRUE;
  117. WaitForExit: end; (* WaitFor *)
  118.  
  119. end.