home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / Samples / V24.ARJ / V24.PAS
Encoding:
Pascal/Delphi Source File  |  1987-06-25  |  3.5 KB  |  119 lines
  1.  
  2. (*
  3.     V24.PAS
  4.  
  5.     Dies ist eine Routine, mit der die V24-Schnittstellenparameter
  6.     durch ein Turbopascal Programm eingestellt werden koennen.
  7.     Dabei kann jede beliebige Baudrate eingestellt werden.
  8.     Das File V24.PAS sollte einfach in das Hauptprogramm INCLUDEd werden.
  9.  
  10.     Baudraten: 10 - 19200 Baud
  11.     Paritaet:  pSpace, pOdd, pMark, pEven, pNone
  12.     Datenbits: d5, d6, d7, d8
  13.     Stopbits:  s1, s2
  14.  
  15.     Der Aufruf        setV24(1200,pNone,d8,s2)
  16.  
  17.     setzt die V24-Schnittstelle z.B. auf 1200 Baud, keine Paritaet,
  18.     8 Datenbits und 2 Stopbits.
  19.  
  20.     .... angepasst im Maerz 1987 von R. Schmidt
  21. *)
  22.  
  23. TYPE    tComPort = (Com1, Com2);
  24.         tParity = (pSpace, pOdd, pMark, pEven, pNone);
  25.         tDatabits = (d5, d6, d7, d8);
  26.         tStopbits = (s1, s2);
  27.  
  28. (* Define address adders for the various Async card registers. *)
  29.  
  30. CONST   RBR = $00;     (*  xF8   Receive Buffer Register              *)
  31.         THR = $00;     (*  xF8   Transmitter Holding Register         *)
  32.         IER = $01;     (*  xF9   Interrupt Enable Register            *)
  33.         IIR = $02;     (*  xFA   Interrupt Identification  Register   *)
  34.         LCR = $03;     (*  xFB   Line Control Register                *)
  35.         MCR = $04;     (*  xFC   Modem Control Register               *)
  36.         LSR = $05;     (*  xFD   Line Status Register                 *)
  37.         MSR = $06;     (*  xFE   Modem Status Register                *)
  38.         DLL = $00;     (*  xF8   Divisor Latch Least  Significant     *)
  39.         DLM = $01;     (*  xF9   Divisor Latch Most   Significant     *)
  40.  
  41. (*   Asynch base port addresses are in the ROM BIOS data area  *)
  42.  
  43. VAR     ComBaseAddr : ARRAY[Com1..Com2] OF Integer ABSOLUTE $0040 : $0000;
  44.  
  45.  
  46. PROCEDURE setV24(Baud : integer;
  47.                  Parity : tParity;
  48.                  Databits : tDatabits;
  49.                  Stopbits : tStopbits);
  50.  
  51. CONST  paritycode : ARRAY[pSpace..pNone] OF Byte =
  52.                  ($38, $08, $28, $18, $00);
  53.        databitscode : ARRAY[d5..d8] OF Byte = ($00, $01, $02, $03);
  54.        stopbitscode : ARRAY[s1..s2] OF Byte = ($00, $04);
  55.  
  56. VAR    LCRreg     : Byte;
  57.        ComBase    : integer;
  58.        ComPort    : tComPort;
  59.        BaudFaktor : integer;
  60.  
  61. BEGIN
  62.   BaudFaktor := round(115200.0/Baud);
  63.   ComPort := com1;
  64.   ComBase := ComBaseAddr[ComPort];
  65.   LCRreg := $80;     (*  Set Divisor Latch Access Bit in LCR   *)
  66.   LCRreg := LCRreg OR paritycode[Parity];  (*  Setup Parity  *)
  67.   LCRreg := LCRreg OR databitscode[Databits]; (*  Setup # data bits *)
  68.   LCRreg := LCRreg OR stopbitscode[Stopbits]; (*  Setup # stop bits *)
  69.   Port[LCR+ComBase] := LCRreg; (* Set Parity, Data and Stop Bits and set DLAB *)
  70.   Port[DLM+ComBase] := Hi(BaudFaktor);     (* Set Baud rate  *)
  71.   Port[DLL+ComBase] := Lo(BaudFaktor);     (* Set Baud rate  *)
  72.   Port[LCR+ComBase] := LCRreg AND $7F;     (*  Reset DLAB    *)
  73. END;
  74.  
  75.  
  76. function zeichen:boolean;
  77. var
  78.   Register      :  regs;
  79.  
  80. begin
  81.   with Register do
  82.   begin
  83.     AX := $0200;
  84.     intr($60,Register);
  85.     Zeichen := (lo(AX) = 1);
  86.   end;
  87. end;
  88.  
  89.  
  90. procedure readaux(var ch : char);
  91. var
  92.   Register  : regs;
  93. Begin
  94.   if not Zeichen then repeat until Zeichen;
  95.   with Register do
  96.   Begin
  97.     AX := 0;
  98.     intr($60,Register);
  99.     ch := char(lo(AX));
  100.   End;
  101. End;
  102.  
  103.  
  104. procedure writeaux(Zeile : str80);
  105. var
  106.   Register  : regs;
  107.   i         : integer;
  108. Begin
  109.   with Register do
  110.   Begin
  111.     for i := 1 to length(Zeile) do
  112.     Begin
  113.       AX := 256 + ord(Zeile[i]);
  114.       intr($60,Register);
  115.     End;
  116.   End;
  117. End;
  118.  
  119.