home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / communic / comset.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-06-10  |  5.3 KB  |  213 lines
  1. {$U+}
  2.  
  3.   var
  4.     Port,Baud,StopBits,DataBits,Par: Integer;
  5.     Message: String[80];
  6.  
  7.   type
  8.     String19=String[19];
  9.  
  10. { A set of routines to enable COM1 and COM2 to be accessed from Turbo Pascal.
  11.   The following procedures are meant to be called by your programs:
  12.  
  13.   AssignAux(PortNumber in [1,2]) assigns Aux to COM1 or COM2
  14.   AssignUsr(PortNumber in [1,2]) assigns Usr to COM1 or COM2
  15.   SetSerial(PortNumber in [1,2],
  16.             BaudRate in [110,150,300,600,1200,2400,4800,9600],
  17.             StopBits in [1,2],
  18.             DataBits in [7,8],
  19.             Parity in [None,Even,Odd]) sets the baud rate, stop bits, data
  20.                                bits, and parity of one of the serial ports.
  21.  
  22.   The arrays InError and OutError may be examined to detect errors.  The bits
  23.   are as follows:
  24.      Bit 7 (128)        Time out (no device connected)
  25.      Bit 3 (8)          Framing error
  26.      Bit 2 (4)          Parity error
  27.      Bit 1 (2)          Overrun error
  28.  
  29.   Function SerialStatus(PortNumber in [1,2]) returns a more complete status:
  30.      Bit 15 (negative)  Time out (no device connected)
  31.      Bit 14 (16384)     Transmission shift register empty
  32.      Bit 13 (8192)      Transmission holding register empty
  33.      Bit 12 (4096)      Break detect
  34.      Bit 11 (2048)      Framing error
  35.      Bit 10 (1024)      Parity error
  36.      Bit 9  (512)       Overrun error
  37.      Bit 8  (256)       Data ready
  38.      Bit 7  (128)       Received line signal detect
  39.      Bit 6  (64)        Ring indicator
  40.      Bit 5  (32)        Data set ready
  41.      Bit 4  (16)        Clear to send
  42.      Bit 3  (8)         Delta receive line signal detect
  43.      Bit 2  (4)         Trailing edge ring detector
  44.      Bit 1  (2)         Delta data set ready
  45.      Bit 0  (1)         Delta clear to send
  46.  
  47.   Identifiers starting with "__" are not meant to be used by the user program.
  48. }
  49.  
  50.   Type
  51.     __RegisterSet=Record case Integer of
  52.                   1: (AX,BX,CX,DX,BP,DI,SE,DS,ES,Flags: Integer);
  53.                   2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  54.                 end;
  55.     __ParityType=(None,Even,Odd);
  56.  
  57.   var
  58.     __Regs: __RegisterSet;
  59.     InError,OutError: Array [1..2] of Byte;
  60.  
  61.   procedure __Int14(PortNumber,Command,Parameter: Integer);
  62.   { do a BIOS COM driver interrupt }
  63.  
  64.     begin
  65.       with __Regs do
  66.        begin
  67.         DX:=PortNumber-1;
  68.         AH:=Command;
  69.         AL:=Parameter;
  70.         Flags:=0;
  71.         Intr($14,__Regs);
  72.        end;
  73.     end;
  74.  
  75.  
  76.   procedure SetSerial(PortNumber,BaudRate,StopBits,DataBits: Integer;
  77.                       Parity: __ParityType);
  78.   { Set serial parameters on a COM port }
  79.  
  80.     var
  81.       Parameter: Integer;
  82.  
  83.     begin
  84.       case BaudRate of
  85.         110: BaudRate:=0;
  86.         150: BaudRate:=1;
  87.         300: BaudRate:=2;
  88.         600: BaudRate:=3;
  89.         1200: BaudRate:=4;
  90.         2400: BaudRate:=5;
  91.         4800: BaudRate:=6;
  92.         else BaudRate:=7; { Default to 9600 baud }
  93.        end;
  94.       if StopBits=2 then StopBits:=1
  95.       else StopBits:=0; { Default to 1 stop bit }
  96.       if DataBits=7 then DataBits:=2
  97.       else DataBits:=3; { Default to 8 data bits }
  98.       Parameter:=(BaudRate Shl 5)+(StopBits Shl 2)+DataBits;
  99.       case Parity of
  100.         Odd: Parameter:=Parameter+8;
  101.         Even: Parameter:=Parameter+24;
  102.         else; { Default to no parity }
  103.        end;
  104.       __Int14(PortNumber,0,Parameter);
  105.     end;
  106.  
  107.  
  108.   Function SerialStatus(PortNumber: Integer): Integer;
  109.   { Return the status of a COM port }
  110.  
  111.     begin
  112.       __Int14(PortNumber,3,0);
  113.       SerialStatus:=__Regs.AX;
  114.     end;
  115.  
  116.  
  117.   procedure __OutPort1(C: Byte);
  118.   { Called by Write to Aux or Usr when assigned to COM1 }
  119.  
  120.     begin
  121.       while (SerialStatus(1) and $30)=0 do ;
  122.       __Int14(1,1,C);
  123.       OutError[1]:=OutError[1] Or (__Regs.AH and $8E);
  124.     end;
  125.  
  126.  
  127.  
  128.  
  129.   Function __InPort1: Char;
  130.   { Called by Read from Aux or Usr when assigned to COM1 }
  131.  
  132.     begin
  133.       __Int14(1,2,0);
  134.       __InPort1:=Chr(__Regs.AL);
  135.       InError[1]:=InError[1] Or (__Regs.AH and $8E);
  136.     end;
  137.  
  138.  
  139.  
  140.  
  141.  
  142.   procedure __AssignPort(PortNumber: Integer; var InPtr,OutPtr: Integer);
  143.   { Assign either Aux or Usr to either COM1 or COM2 }
  144.  
  145.     begin
  146.         OutPtr:=Ofs(__OutPort1);
  147.         InPtr:=Ofs(__InPort1);
  148.         InError[1]:=0;
  149.         OutError[1]:=0;
  150.     end;
  151.  
  152.  
  153.   procedure AssignAux(PortNumber: Integer);
  154.   { Assign Aux to either COM1 or COM2 }
  155.  
  156.     begin
  157.       __AssignPort(PortNumber,AuxInPtr,AuxOutPtr);
  158.     end;
  159.  
  160.  
  161.  
  162.  
  163.   Function Binary(V: Integer): String19;
  164.  
  165.     var
  166.       I: Integer;
  167.       B: Array [0..3] of String[4];
  168.  
  169.     begin
  170.       For I:=0 To 15 do
  171.         if (V and (1 Shl (15-I)))<>0 then B[I Div 4][(I Mod 4)+1]:='1'
  172.         else B[I Div 4][(I Mod 4)+1]:='0';
  173.       For I:=0 To 3 do B[I][0]:=Chr(4);
  174.       Binary:=B[0]+' '+B[1]+' '+B[2]+' '+B[3];
  175.     end;
  176.  
  177. procedure comset;
  178.  
  179.  
  180.   begin
  181.     port :=1;
  182.  
  183.     assignAUX(Port);
  184.     baud :=1200;
  185.  
  186.     stopbits :=1;
  187.  
  188.     databits :=8;
  189.  
  190.     par :=0;
  191.     message :='ATZ';
  192.  
  193.     SetSerial(1,Baud,StopBits,DataBits,__ParityType(Par));
  194.     WriteLn(AUX,Message);
  195.  
  196.   end;
  197. var
  198.   c : char;
  199. begin
  200.  
  201.      comset;
  202.  
  203.      repeat
  204.  
  205.      if keypressed then begin {$I-}
  206.      read(kbd,c);
  207.      write(c);
  208.  
  209.      end;
  210.  
  211.      until (c = ^E);
  212.  
  213. end.