home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / communic / comlib.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-03-12  |  6.4 KB  |  227 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.   procedure __OutPort2(C: Byte);
  128.   { Called by Write to Aux or Usr when assigned to COM2 }
  129.  
  130.     begin
  131.       while (SerialStatuS(2) and $30)=0 do ;
  132.       __Int14(2,1,C);
  133.       OutError[2]:=OutError[2] Or (__Regs.AH and $8E);
  134.     end;
  135.  
  136.  
  137.   Function __InPort1: Char;
  138.   { Called by Read from Aux or Usr when assigned to COM1 }
  139.  
  140.     begin
  141.       __Int14(1,2,0);
  142.       __InPort1:=Chr(__Regs.AL);
  143.       InError[1]:=InError[1] Or (__Regs.AH and $8E);
  144.     end;
  145.  
  146.  
  147.   Function __InPort2: Char;
  148.   { Called by Read from Aux or Usr when assigned to COM2 }
  149.  
  150.     begin
  151.       __Int14(2,2,0);
  152.       __InPort2:=Chr(__Regs.AL);
  153.       InError[2]:=InError[2] Or (__Regs.AH and $8E);
  154.     end;
  155.  
  156.  
  157.   procedure __AssignPort(PortNumber: Integer; var InPtr,OutPtr: Integer);
  158.   { Assign either Aux or Usr to either COM1 or COM2 }
  159.  
  160.     begin
  161.       if PortNumber=2 then
  162.        begin
  163.         OutPtr:=Ofs(__OutPort2);
  164.         InPtr:=Ofs(__InPort2);
  165.        end
  166.       else { Default to port 1 }
  167.        begin
  168.         OutPtr:=Ofs(__OutPort1);
  169.         InPtr:=Ofs(__InPort1);
  170.        end;
  171.       InError[PortNumber]:=0;
  172.       OutError[PortNumber]:=0;
  173.     end;
  174.  
  175.  
  176.   procedure AssignAux(PortNumber: Integer);
  177.   { Assign Aux to either COM1 or COM2 }
  178.  
  179.     begin
  180.       __AssignPort(PortNumber,AuxInPtr,AuxOutPtr);
  181.     end;
  182.  
  183.  
  184.   procedure AssignUsr(PortNumber: Integer);
  185.   { Assign Usr to either COM1 or COM2 }
  186.  
  187.  
  188.     begin
  189.       __AssignPort(PortNumber,UsrInPtr,UsrOutPtr);
  190.     end;
  191.  
  192.  
  193.   Function Binary(V: Integer): String19;
  194.  
  195.     var
  196.       I: Integer;
  197.       B: Array [0..3] of String[4];
  198.  
  199.     begin
  200.       For I:=0 To 15 do
  201.         if (V and (1 Shl (15-I)))<>0 then B[I Div 4][(I Mod 4)+1]:='1'
  202.         else B[I Div 4][(I Mod 4)+1]:='0';
  203.       For I:=0 To 3 do B[I][0]:=Chr(4);
  204.       Binary:=B[0]+' '+B[1]+' '+B[2]+' '+B[3];
  205.     end;
  206.  
  207.  
  208.   begin
  209.     Write('Enter port number:                    ');
  210.     ReadLn(Port);
  211.     AssignUsr(Port);
  212.     Write('Enter baud rate:                      ');
  213.     ReadLn(Baud);
  214.     Write('Enter stop bits:                      ');
  215.     ReadLn(StopBits);
  216.     Write('Enter data bits:                      ');
  217.     ReadLn(DataBits);
  218.     Write('Enter parity (0=none, 1=even, 2=odd): ');
  219.     ReadLn(Par);
  220.     Write('Enter message to print:               ');
  221.     ReadLn(Message);
  222.     SetSerial(1,Baud,StopBits,DataBits,__ParityType(Par));
  223.     WriteLn(Usr,Message);
  224.     WriteLn('OutError[',Port,']: ',Binary(OutError[Port]));
  225.     WriteLn('SerialStatus(',Port,'): ',Binary(SerialStatus(Port)));
  226.   end.
  227.