===========================================================================
 BBS: The Abacus * HST/DS * Potterville, MI
Date: 06-04-93 (19:42)             Number: 29
From: JOHN GALLAS                  Refer#: NONE
  To: ROBERT FORTUNE                Recvd: NO  
Subj: QB COM code                    Conf: (35) Quick Basi
---------------------------------------------------------------------------
Ok, heres the communications routines.  Turn your capture on ... NOW!


'-->SNIP<-->SNIP<-->SNIP<-->SNIP<-->SNIP<-->SNIP<-->SNIP<-->SNIP<--

' This sub is for fixing that stupid DTR bug that QB has.  After you
' CLOSE the COM port, simply call SetDTR with a true value (anything
' other than 0) and the DTR won't go down.
SUB SetDTR (Setting%) ' For COM1 the address is &H3F8, for COM2 its
                      ' &H2F8

PortAddress = &H3F8

IF Setting% THEN
  OUT PortAddress + 4, INP(PortAddress + 4) OR 1
ELSE
  OUT PortAddress + 4, INP(PortAddress + 4) AND &HFE
END IF

END SUB

'Heres the function that bumps up the baud rate.
DECLARE SUB BaudRate (Func, Port, baud&, err.code)

'example use:

OPEN "COM1:2400,N,8,1" FOR RANDOM AS #1

'now bump it up to 115,200 bps

BaudRate 1, 1, 115200, err.code

IF err.code = 0 THEN PRINT "Success!"

END

SUB BaudRate (Func, Port, baud&, err.code) STATIC

'INPUT: FUNC=0  -  return the current baud rate in baud&
'       FUNC=1  -  set the baud rate from baud&
'See the Serial/Parallel Adapter Tech.Ref. for details

err.code = 0

IF (Port <> 1 AND Port <> 2) THEN err.code = -1: GOTO finito
IF Func = 1 AND baud& < 100 THEN err.code = -2: GOTO finito

ADDR = &H4F8 - (&H100 * Port)            ' base address of port reg's
ADDR.LCR = ADDR + 3                      ' Line Control Register
ADDR.DL.LSB = ADDR + 0: ADDR.DL.MSB = ADDR + 1' Divisor Latch LSB & MSB
VAL.LCR = INP(ADDR.LCR)                  ' get old LCR value
OUT ADDR.LCR, VAL.LCR AND &H7F           ' Disable DLAB to get to inters
VAL.INT = INP(ADDR.DL.MSB)               ' Get the int enable statuses
OUT ADDR.DL.MSB, 0                        ' Disable all modem intertupts
OUT ADDR.LCR, VAL.LCR OR &H80            ' Enable DLAB to gain access
IF Func = 0 THEN GOTO getbaud             ' if get then go
DIVISOR = (1843200! / baud&) / 16'see page 17 of the SERIAL/PARALLEL ADAPTER (
MSB = DIVISOR \ 2 ^ 8: LSB = DIVISOR MOD 2 ^ 8
OUT ADDR.DL.MSB, MSB
OUT ADDR.DL.LSB, LSB' put out the new baud rate
GOTO finito

getbaud:
'get the current baud rate
MSB = INP(ADDR.DL.MSB)
LSB = INP(ADDR.DL.LSB)'get old baud rate
DIVISOR = MSB * 2 ^ 8 + LSB
baud& = (1843200! / DIVISOR) / 16

finito:
IF err.code = 0 THEN
        OUT ADDR.LCR, VAL.LCR AND &H7F    ' Disable DLAB to get to inters
        OUT ADDR.DL.MSB, VAL.INT          ' Replace orig. inter. values
        OUT ADDR.LCR, VAL.LCR             ' Replace orig. LCR values
END IF

END SUB

'This is for checking if the carrier is high (tells if you're connected
'or not)
FUNCTION Carrier  'returns false if no carrier

BaseAddress = &H3F8  '&H2F8 for com 2

DEF SEG = &H40
Carrier = ((INP(BaseAddress + 6) AND 128) >= &H80)
DEF SEG

END FUNCTION

'And finally here's some com3/com4 startup code.  I haven't tested this
'yet, but it should work.
'Dick Dennison 10/92  1:272/34

'Save vectors at bios Addresses for Com1-Com2
DEF SEG = 0
  OldPort1H = PEEK(&H400)
  OldPort1L = PEEK(&H401)
  OldPort2H = PEEK(&H402)
  OldPort2L = PEEK(&H403)

'Initialize the com1/com2 address space
 POKE &H400, &HF8
 POKE &H401, 3
 POKE &H402, &HF8
 POKE &H403, 2

'Obviously, change the baud rate to whatever
'you want up to 19200.

SELECT CASE port%
     CASE 1
        Start$ = "COM1:2400,N,8,1,DS0"
     CASE 2
        Start$ = "COM2:2400,N,8,1,DS0"
     CASE 3
        POKE &H400, &HE8   'For com1 to com3
        Start$ = "COM1:2400,N,8,1,DS0"
     CASE 4
        POKE &H402, &HE8   'For com2 to com4
        Start$ = "COM2:2400,N,8,1,DS0"
END SELECT
DEF SEG
OPEN Start$ FOR RANDOM AS 1

'Do your terminal program here

CLOSE 1

'Restore the comm address vectors
DEF SEG = 0
   POKE &H400, OldPort1H
   POKE &H401, OldPort1L
   POKE &H402, OldPort2H
   POKE &H403, OldPort2L
DEF SEG
END
'-----------------------{ Thats all folks! }----------------------

 * OLX 2.1 TD * Coming Soon!!  Mouse Support for Edlin!!

--- Maximus 2.01wb
 * Origin: Command Line BBS =Mpls. MN= V.32bis [612-788-6685] (1:282/2007)
SEEN-BY: 1/211 11/2 4 13/13 101/1 108/89 109/25 110/69 114/5 123/19 124/1
SEEN-BY: 153/752 154/40 77 157/110 159/100 125 430 575 950 203/23 209/209
SEEN-BY: 261/1023 280/1 390/1 396/1 15 397/2 2230/100 2440/5 3603/20