home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0014_Send Hayes commands..pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  8.1 KB  |  352 lines

  1. {Here's a unit for sending and receiving async commands }
  2.  
  3. { ======================= SERIAL COMMUNICATIONS ============================ }
  4.  
  5. UNIT      Async;
  6.  
  7. {$D-,V-,B-,S-,R-}
  8.  
  9. INTERFACE
  10.  
  11. USES      Dos, Crt;
  12.  
  13. TYPE
  14.  
  15.   BAUD              = (B110,B150,B300,B600,B1200,B2400,B4800,B9600);
  16.   PARITY            = (PNONE, PODD, PNOTHING, PEVEN);
  17.  
  18. VAR
  19.   AsyncInstalled    : BOOLEAN;
  20.   AsyncActive       : BOOLEAN;
  21.  
  22.  
  23. PROCEDURE InitAsync(Com       :BYTE;
  24.                     Speed     :BAUD;
  25.                     Par       :PARITY;
  26.                     Stop      :BYTE;
  27.                     Dbits     :BYTE);
  28. PROCEDURE TermAsync;
  29. FUNCTION  CheckAsync          :WORD;
  30. PROCEDURE HangUp;
  31. PROCEDURE Send(Buffer         :STRING);
  32. PROCEDURE Receive(VAR Buffer  :STRING);
  33.  
  34. IMPLEMENTATION
  35.  
  36. CONST
  37.  
  38.   THR               = 0;
  39.   RBR               = 0;
  40.   IER               = 1;
  41.   IIR               = 2;
  42.   LCR               = 3;
  43.   MCR               = 4;
  44.   LSR               = 5;
  45.   MSR               = 6;
  46.   BUFFSIZE          = 255;
  47.   TIMOUT            = 60000;
  48.   EOI               : BYTE = $20;
  49.   IRQ4low           : BYTE = $EF;
  50.   IRQ4high          : BYTE = $10;
  51.   IRQ3low           : BYTE = $F7;
  52.   IRQ3high          : BYTE = $08;
  53.   ErrorMask         : BYTE = $0E;
  54.   DSRready          : BYTE = $20;
  55.   OUT2              : BYTE = $08;
  56.   DTR               : BYTE = $01;
  57.   RTS               : BYTE = $02;
  58.  
  59. VAR
  60.  
  61.   Regs              : REGISTERS;
  62.   OldVector         : POINTER;
  63.   AsyncStatus       : WORD;
  64.   IntType           : BYTE;
  65.   AsyncDisable      : BYTE;
  66.   AsyncEnable       : BYTE;
  67.   AsyncBuff         : ARRAY [0..BUFFSIZE] OF BYTE;
  68.   Front             : INTEGER;
  69.   Rear              : INTEGER;
  70.   ComPort           : BYTE;
  71.   ComBase           : WORD;
  72.  
  73. {//////////////////////////////////////////////////////////////////////////}
  74.  
  75. PROCEDURE ZeroDlab;
  76.  
  77. { -- zero divisor latch access bit allowing access to THR, RBR and IER }
  78.  
  79. BEGIN
  80.           PORT[ComBase+LCR]:= PORT[ComBase+LCR] AND $7F;
  81. END;
  82.  
  83. {//////////////////////////////////////////////////////////////////////////}
  84.  
  85. PROCEDURE SetDTR;
  86.  
  87. { -- enable interrupts and set DTR }
  88.  
  89. BEGIN
  90.   PORT[ComBase+MCR]:= OUT2 + DTR + RTS;
  91.   DELAY(1000)
  92. END;
  93.  
  94. {//////////////////////////////////////////////////////////////////////////}
  95.  
  96. PROCEDURE ReadPorts;
  97.  
  98. { -- read UART values }
  99.  
  100. VAR
  101.   Temp              : BYTE;
  102.  
  103. BEGIN
  104.   Temp:= PORT[ComBase];
  105.   Temp:= PORT[ComBase+IIR];
  106.   Temp:= PORT[ComBase+LSR];
  107.   Temp:= PORT[ComBase+MSR];
  108. END;
  109.  
  110. {//////////////////////////////////////////////////////////////////////////}
  111.  
  112. PROCEDURE HangUp;
  113.  
  114. { -- hang up phone }
  115.  
  116. BEGIN
  117.   ReadPorts;
  118.   PORT[ComBase+MCR]:= 0;
  119.   DELAY(1000);
  120. END;
  121.  
  122. {//////////////////////////////////////////////////////////////////////////}
  123.  
  124. FUNCTION CheckAsync;
  125.  
  126. { -- return status MB = Line Status, LB = Modem Status }
  127.  
  128. VAR
  129.   LSReg             : WORD;
  130.  
  131. BEGIN
  132.   LSReg:= PORT[ComBase+LSR];
  133.   CheckAsync:= (LSReg SHL 8) OR PORT[ComBase+MSR];
  134. END;
  135.  
  136. {//////////////////////////////////////////////////////////////////////////}
  137.  
  138. {$F+}
  139.  
  140. PROCEDURE AsyncISR;
  141.  
  142. INTERRUPT;
  143.  
  144. { -- serial port interrupt routine }
  145.  
  146. BEGIN
  147.   PORT[$21]:= PORT[$21] AND AsyncDisable;
  148.   INLINE($FB);        { enable interrupts }
  149.   IntType:= PORT[ComBase+IIR] AND 6;
  150.   IF IntType = 4 THEN
  151.   BEGIN
  152.     ZeroDlab;
  153.     AsyncBuff[Rear]:= PORT[ComBase+RBR];
  154.     Rear:= SUCC(Rear) MOD BUFFSIZE
  155.   END;
  156.   AsyncStatus:= (PORT[ComBase+LSR] SHL 8) + PORT[ComBase+MSR];
  157.   INLINE($FA);        { disable interrupts }
  158.   PORT[$20]:= EOI;
  159.   PORT[$21]:= PORT[$21] AND AsyncEnable
  160. END;
  161.  
  162. {$F-}
  163.  
  164. {//////////////////////////////////////////////////////////////////////////}
  165.  
  166. PROCEDURE InstallAsync;
  167.  
  168. { -- replaces interrupt vector by user routine }
  169.  
  170. BEGIN
  171.   IF NOT(AsyncInstalled) THEN
  172.   BEGIN
  173.     GetIntVec($0C-ComPort,OldVector);
  174.     SetIntVec($0C-ComPort,@AsyncISR);
  175.     AsyncInstalled:=TRUE;
  176.   END;
  177. END;
  178.  
  179. {//////////////////////////////////////////////////////////////////////////}
  180.  
  181. PROCEDURE DeinstallAsync;
  182.  
  183. { -- restores interrupt vector }
  184.  
  185. BEGIN
  186.   IF AsyncInstalled THEN
  187.   BEGIN
  188.     SetIntVec($0C-ComPort,OldVector);
  189.     AsyncInstalled:=FALSE;
  190.   END;
  191. END;
  192.  
  193. {//////////////////////////////////////////////////////////////////////////}
  194.  
  195. PROCEDURE InitAsync(Com       : BYTE;
  196.                     Speed     : BAUD;
  197.                     Par       : PARITY;
  198.                     Stop      : BYTE;
  199.                     Dbits     : BYTE);
  200.  
  201. { -- initialize serial port communications }
  202.  
  203. BEGIN
  204.   WITH Regs DO
  205.   BEGIN
  206.     IF NOT(AsyncActive) THEN
  207.     BEGIN
  208.       ComPort       := Com-1;
  209.       MEMW[0:$400]  := $3F8;             { to prevent a BIOS bug }
  210.       MEMW[0:$402]  := $2F8;             { to prevent a BIOS bug }
  211.       IF ComPort    = 0 THEN
  212.       BEGIN
  213.         ComBase     := $3F8;
  214.         AsyncEnable := IRQ4low;
  215.         AsyncDisable:= IRQ4high;
  216.       END
  217.       ELSE
  218.       BEGIN
  219.         ComBase     := $2F8;
  220.         AsyncEnable := IRQ3low;
  221.         AsyncDisable:= IRQ3high
  222.       END;
  223.       Front         := 0;
  224.       Rear          := 0;
  225.       AsyncStatus   := 0;
  226.       InstallAsync;
  227.       DX            :=ComPort;
  228.       AX            :=ORD(Speed)*32 + ORD(Par)*8 + (Stop-1)*4 + Dbits-5;
  229.       INTR($14,Regs);
  230.       ReadPorts;
  231.       ZeroDlab;
  232.       PORT[ComBase+IER]:= $05;
  233.       INLINE($FA);                                { disable interrupts }
  234.       PORT[$21]     :=PORT[$21] AND AsyncEnable;
  235.       INLINE($FB);                                { enable interrupts }
  236.       SetDTR;
  237.       AsyncActive   := TRUE;
  238.     END
  239.     ELSE
  240.     BEGIN
  241.       HangUp;
  242.       SetDTR;
  243.     END;
  244.   END;
  245. END;
  246.  
  247. {//////////////////////////////////////////////////////////////////////////}
  248.  
  249. PROCEDURE Receive;
  250.  
  251. { -- get characters from circular buffer }
  252.  
  253. VAR
  254.   Ch                : CHAR;
  255.   NbrChrs           : INTEGER;
  256.   Count             : LONGINT;
  257.  
  258. BEGIN
  259.   Buffer  := '';
  260.   Count   := TIMOUT;
  261.   NbrChrs := 0;
  262.   WHILE Count>0 DO
  263.   BEGIN
  264.     DEC(Count);
  265.     IF Front <> Rear THEN
  266.     BEGIN
  267.       REPEAT
  268.         Ch          := CHAR(AsyncBuff[Front]);
  269.         Front       := SUCC(Front) MOD BUFFSIZE;
  270.         IF Ch IN [#0..#31] THEN Ch:= #32;
  271.         Buffer      := Buffer + Ch;
  272.         INC(NbrChrs);
  273.       UNTIL (Front = Rear) OR (NbrChrs = BUFFSIZE);
  274.       Count:= TIMOUT;
  275.     END;
  276.   END;
  277. END;
  278.  
  279. {//////////////////////////////////////////////////////////////////////////}
  280.  
  281. PROCEDURE Send;
  282.  
  283. VAR
  284.   Ptr               : INTEGER;
  285.   TH                : BYTE;
  286.   CH                : CHAR;
  287.  
  288. BEGIN
  289.   IF LENGTH(Buffer)>0 THEN
  290.   BEGIN
  291.     SetDTR;
  292.     FOR Ptr:=1 TO LENGTH(Buffer) DO
  293.     BEGIN
  294.       REPEAT
  295.         TH:= PORT[ComBase+LSR] AND DSRready
  296.       UNTIL TH<>0;
  297.       CH:= Buffer[Ptr];
  298.       IF (CH = '%') THEN
  299.       BEGIN
  300.         DELAY(1000);
  301.         EXIT;
  302.       END;
  303.       IF (CH = '|') THEN CH:= #13;
  304.       IF (CH = '~') THEN
  305.         DELAY(2000)
  306.       ELSE
  307.         PORT[ComBase+THR]:= BYTE(CH);
  308.     END;
  309.     DELAY(1000);
  310.   END;
  311. END;
  312.  
  313. {//////////////////////////////////////////////////////////////////////////}
  314.  
  315. PROCEDURE TermAsync;
  316.  
  317. { -- terminate communications }
  318.  
  319. BEGIN
  320.   IF AsyncActive THEN
  321.   BEGIN
  322.     HangUp;
  323.     INLINE($FA);                        { disable interrupts }
  324.     PORT[$21]       := PORT[$21] OR (IRQ4high + IRQ3high);
  325.     INLINE($FB);                        { enable interrupts }
  326.     ZeroDlab;
  327.     PORT[ComBase+IER]:= 0;
  328.     DELAY(1000);
  329.     DeinstallAsync;
  330.     AsyncActive     := FALSE;
  331.   END;
  332. END;
  333.  
  334. {//////////////////////////////////////////////////////////////////////////}
  335.  
  336. BEGIN
  337.   AsyncInstalled    := FALSE;
  338.   AsyncActive       := FALSE;
  339. END.
  340.  
  341. It's a old unit from tp4 but it works well for me. I think it will not
  342. support the fifo buffers and the specials of the 16550 uart because
  343. they wern't available at that time but maybe somebody can modify it
  344.  
  345. Greetings from:
  346.                      Niko van Hagen
  347.                      Monday, 25 March 1996, 10:19.
  348.                      The Haghe, Holland
  349.                      Fido       : 2:281/909.11
  350.                      Internet   : nvhagen@worldonline.nl
  351.                      PGP KEYID  : 6CF49689
  352.