home *** CD-ROM | disk | FTP | other *** search
/ PC Underground / UNDERGROUND.ISO / ports / serial.pas < prev   
Pascal/Delphi Source File  |  1995-07-28  |  4KB  |  123 lines
  1. Uses Crt,Dos;
  2.  
  3. Const
  4.   RxR=0;                        {Receive Data, for read accesses}
  5.   TxR=0;                        {Transmit Data, for write accesses}
  6.   IER=1;                        {Interrupt Enable}
  7.   IIR=2;                        {Interrupt Identification}
  8.   LCR=3;                        {Line Control}
  9.   MCR=4;                        {Modem Control}
  10.   LSR=5;                        {Line Status}
  11.   MSR=6;                        {Modem Status}
  12.   DLL=0;                        {Divisor Latch High}
  13.   DLH=1;                        {Divisor Latch Low}
  14.  
  15.   N=0;                          {no parity}
  16.   O=8;                          {odd parity}
  17.   E=24;                         {even parity}
  18.  
  19.   IRQ_Tab:Array[1..4] of Word   {Interrupt numbers of the ports}
  20.     =(4,3,4,3);
  21.   Base_Tab:Array[1..4] of Word  {Port addresses of the ports}
  22.     =($3f8,$2f8,$3e8,$2e8);
  23.  
  24. Var OldInt:Pointer;             {original interrupt vector}
  25.     Key:Char;                   {pressed key}
  26.     IRQ,                        {IRQ number of current port}
  27.     Base:Word;                  {port address of current port}
  28.     finished:Boolean;             {flag for program end}
  29.  
  30. Procedure Handler;interrupt;
  31. {Interrupt handler, receives characters from serial port}
  32. Begin
  33.   Write(Chr(Port[Base+RxR]));   {take characters from port and output}
  34.   Port[$20]:=$20;               {send EOI}
  35. End;
  36.  
  37. Procedure Open_Port(No:Word);
  38. {prepares COM port for input/output}
  39. Begin
  40.   IRQ:=IRQ_Tab[No];             {get IRQ number}
  41.   Base:=Base_Tab[No];           {get base address}
  42.   GetIntVec(IRQ+8,OldInt);      {bend/deflect pointer}
  43.   SetIntVec(IRQ+8,@Handler);
  44.   Port[$21]:=Port[$21] and      {allow IRQ}
  45.     not (1 shl IRQ);
  46.   Port[Base+MCR]:=11;           {Auxiliary Output, set RTS and DTR}
  47.   Port[Base+IER]:=1;            {Interrupt Enable for Receive}
  48. End;
  49.  
  50. Procedure Close_Port;
  51. {resets COM interrupts}
  52. Begin
  53.   SetIntVec(IRQ+8,OldInt);      {restore IRQ vector}
  54.   Port[Base+MCR]:=0;            {reset signals}
  55.   Port[Base+IER]:=0;            {disable interrupts}
  56.   Port[$21]:=                   {reset Interrupt Controller}
  57.     Port[$21] or (1 shl IRQ);
  58. End;
  59.  
  60. Procedure Set_Speed(bps:LongInt);
  61. {sets port speed}
  62. Var Divisor:Word;
  63. Begin
  64.   Port[Base+LCR]:=Port[Base+LCR]{enable DLAB}
  65.     or 128;
  66.   Divisor:=115200 div bps;
  67.   Port[Base+DLL]:=Lo(Divisor);  {write values in Divisor Latch}
  68.   Port[BAse+DLH]:=Hi(Divisor);
  69.   Port[Base+LCR]:=Port[Base+LCR]{disable DLAB}
  70.     and not 128;
  71. End;
  72.  
  73. Procedure Set_Param(Data,Par,Stop:Word);
  74. {sets parameters for data bits, parity and stop bits}
  75. Begin
  76.   Port[Base+LCR]:=
  77.     (Data-5)                    {set bits 0-1 to data bit}
  78.     + Par                       {add parity}
  79.     + (Stop-1) shl 2;           {set stop bits in Bit 2 of LCR}
  80. End;
  81.  
  82. Procedure Error;
  83. {called during time out in the Send procedure}
  84. Begin
  85.   WriteLn;
  86.   WriteLn('Send time out');     {message}
  87.   Close_Port;                   {close port}
  88.   Halt(1);                      {and abort}
  89. End;
  90.  
  91. Procedure Transmit(c:Char);
  92. {sends characters via serial port}
  93. Var Time_Out:Integer;           {counter for time out}
  94. Begin
  95.   Time_Out:=-1;
  96.   While Port[Base+MSR] and 16 = 0 Do Begin
  97.     Dec(Time_Out);              {wait for CTS}
  98.     If Time_Out=0 Then Error;
  99.   End;
  100.   Time_Out:=-1;
  101.   While Port[Base+LSR] and 32 = 0 Do Begin
  102.     Dec(Time_Out);              {wait for empty transmitter register}
  103.     If Time_Out=0 Then Error;
  104.   End;
  105.   Port[Base+TxR]:=Ord(c);       {send characters}
  106. End;
  107.  
  108. Begin
  109.   Open_Port(2);                 {open COM}
  110.   Set_Speed(19200);             {speed 19200 bps}
  111.   Set_Param(8,N,1);             {set parameters}
  112.   WriteLn;
  113.   WriteLn('terminal in function (Alt-X to exit):');
  114.   Repeat
  115.     Key:=ReadKey;               {read key}
  116.     If Key <> #0 Then           {send normal keys to COM port}
  117.       Transmit(Key)
  118.     Else                        {exit on Alt-X}
  119.       If ReadKey=#45 Then finished:=true;
  120.   Until finished;
  121.   Close_Port;                   {disable interrupts}
  122. End.
  123.