home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / edit / viewer / comtst.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-08  |  3.0 KB  |  129 lines
  1. { * * * * comtst.pas * * * * }
  2.  
  3. {$X+}  { enable c-like extensions }
  4.  
  5. program comtst;
  6.  
  7.    uses
  8.       strings,
  9.       wincrt,
  10.       wintypes, winprocs;
  11.  
  12.    var
  13.       dev_ctl : tdcb;
  14.  
  15. function comopen( var dev_ctl : tdcb; mode : pchar) : boolean;
  16.    { ***
  17.    --- SET UP SERIAL PORT DEVICE CONTROL ---
  18.    *** }
  19.  
  20.    var
  21.       com_name : array[ 0..7 ] of char;
  22.       com_hdl  : integer;
  23.  
  24. begin
  25.    comopen := false;
  26.    strmove( com_name, mode, 4);  { 'comx' }
  27.    com_name[ 4 ] := #0;
  28.    com_hdl := opencomm( com_name, 4000, 4000);
  29.    if ( com_hdl >= 0) then
  30.    begin
  31.       if ( buildcommdcb( mode, dev_ctl) >= 0) then
  32.       begin
  33.          dev_ctl.id := com_hdl;
  34.          if ( setcommstate( dev_ctl) >= 0) then
  35.          begin
  36.             comopen := true;
  37.          end;  { initialized port? }
  38.       end;  { set up port parameters? }
  39.    end;  { opened port? }
  40. end;
  41. { comopen() _______________________________________________________ }
  42.  
  43. procedure comclose( var dev_ctl : tdcb);
  44.    { ***
  45.    --- SHUT DOWN SERIAL PORT DEVICE ---
  46.    *** }
  47. begin
  48.    closecomm( dev_ctl.id);
  49. end;
  50. { comclose() ______________________________________________________ }
  51.  
  52. function computs( var dev_ctl : tdcb; var msg : string) : boolean;
  53.    { ***
  54.    --- OUTPUT A MESSAGE TO THE SERIAL PORT ---
  55.    *** }
  56.  
  57.    var
  58.       err : integer;
  59.  
  60. begin
  61.    err :=  writecomm( dev_ctl.id, @msg[ 1 ], integer( msg[ 0 ]) );
  62.    computs := ( err >= 0);  { negative value indicates error }
  63. end;
  64. { computs() _______________________________________________________ }
  65.  
  66. procedure echo( var dev_ctl : tdcb);
  67.    { ***
  68.    --- ECHO BACK INPUT FROM SERIAL PORT ---
  69.    *** }
  70.  
  71.    const
  72.       sign_on      : string =
  73.             'Welcome to the bogus windows system' + #13;
  74.       instructions : string =
  75.             'Press Q or Esc to quit...' + #13;
  76.  
  77.    var
  78.       c   : char;
  79.       cnt : integer;
  80.  
  81. begin
  82.    computs( dev_ctl, sign_on);
  83.    computs( dev_ctl, instructions);
  84.  
  85. { $ IFDEF DEADCODE }
  86.    c := #0;
  87.    while ( not ( c in [ 'Q', 'q', #27 ]) ) do
  88.  
  89.    begin
  90.       yield;
  91.       cnt := readcomm( dev_ctl.id, @c, 1);
  92.       { cnt := 1; }
  93.       { c := readkey; }
  94.       if ( cnt > 0) then
  95.       begin
  96.          write( c);
  97.          yield;
  98.          writecomm( dev_ctl.id, @c, 1);
  99.       end  { character received? }
  100.       else if ( cnt < 0) then
  101.       begin
  102.          writeln;
  103.          writeln( 'readcomm error code:  ', cnt);
  104.       end;  { error code? }
  105.    end;  { read & echo until user quits }
  106. { $ ENDIF }
  107.  
  108. end;
  109. { echo() __________________________________________________________ }
  110.  
  111. begin
  112.    writeln( 'Attempting to open communications...');
  113.    if ( not comopen( dev_ctl, 'COM1:9600,N,8,1') ) then
  114.    begin
  115.       writeln( 'Failed opening communications');
  116.       halt;
  117.    end;  { opened com port? }
  118.  
  119.    writeln( 'Attempting to transmit/receive...');
  120.    echo( dev_ctl);
  121.  
  122.    writeln( 'Closing communications');
  123.    comclose( dev_ctl);
  124. end.
  125. { "main" __________________________________________________________ }
  126.  
  127.  
  128. { ***************** EOF: COMTST.PAS ********************** }
  129.