home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PCL4P30.ZIP / LOOPBACK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-18  |  1.9 KB  |  62 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*     LOOPBACK.PAS      Jan 92              *)
  4. (*                                           *)
  5. (*  Performs UART loopback test.             *)
  6. (*                                           *)
  7. (*  This program is donated to the Public    *)
  8. (*  Domain by MarshallSoft Computing, Inc.   *)
  9. (*  It is provided as an example of the use  *)
  10. (*  of the Personal Communications Library.  *)
  11. (*                                           *)
  12. (*********************************************)
  13.  
  14. program LoopBack;
  15. uses PCL4P;
  16.  
  17. const
  18.    BaudCode = Baud300;
  19. var
  20.    Buffer  : array[0..7] of Char;
  21.    RetCode : Integer;
  22.    Port  : Integer;
  23.    Error : Integer;
  24. begin   (* main program *)
  25.    (* fetch PORT # from command line *)
  26.    if ParamCount <> 1 then
  27.       begin
  28.          writeln('USAGE: "LOOPBACK <port>" where port = 1,2,3, or 4');
  29.          halt;
  30.       end;
  31.    Val( ParamStr(1),Port, RetCode );
  32.    if RetCode <> 0 then
  33.       begin
  34.          writeln('Port must be 1 to 4');
  35.          Halt;
  36.       end;
  37.    (* COM1 = 0, COM2 = 1, COM3 = 2, COM4 = 3 *)
  38.    Port := Port - 1;
  39.    if (Port<COM1) or (Port>COM4) then
  40.       begin
  41.          writeln('Port must be 1 to 4');
  42.          Halt
  43.       end;
  44.    (* reset port *)
  45.    RetCode := SioRxBuf(Port, Ofs(Buffer), Seg(Buffer), Size8);
  46.    RetCode := SioReset(Port,BaudCode);
  47.    if RetCode <> 0 then
  48.       begin
  49.          writeln('Cannot reset COM',Port+1,', error = ',RetCode);
  50.          Error := RetCode;
  51.          RetCode := SioError(Error);
  52.          RetCode := SioDone(Port);
  53.          Halt
  54.       end;
  55.    (* Perform UART loopback test *)
  56.    RetCode := SioLoopBack(Port);
  57.    Error := RetCode;
  58.    if RetCode = 0 then writeln('LOOPBACK: Testing COM',1+Port,' -- OK')
  59.    else  RetCode := SioError(Error);
  60.    RetCode := SioDone(Port);
  61. end.
  62.