'===========================================================================
' Subject: COM SUPPORT                        Date: 03-03-96 (07:25)       
'  Author: Michael Parker                     Code: QB, QBasic, PDS        
'  Origin: comp.lang.basic.misc             Packet: MODEM.ABC
'===========================================================================
'>   Help on how to access COM's 1 through 4 or 8. Please help.

'Here's a _very_ nice routine to open com1-com4 (up to 115k baud, too).
'These routines were written by Michael Parker.  Hope they help.
'Originally posted by Jonathan Leger <leger@pc2.pc.maricopa.edu>

'--- START HERE ---

' Quick Basic Routine OpenCom
' This routine will accept the entire OPEN command parameters
' that is in QB 4.5 , the only exception is the baud rate and
' COM port.  Baud rate is optional, if specified, this module
' will set the specifed rate up to 115,200.  If the baud rate
' is specifed at 0, the specifed port will be polled  for the
' current baud rate and the baud rate will be set at the rate
' that is present, if any.  NOTE:  the baud rate parameter on
' the command line IS  NOT optional,  if you want this module
' to set the baud rate,  put an extra comma  into the command
' line to replace the baud rate.  The COM Port will accept up
' to COM 4 now.

' OPENCOM "COMX:{option list1 [baudrate,parity,databit]},{option list2}
' AS FileNum"
' examples:
' OPENCOM "COM1:38400 as 1"
' OPENCOM "COM4:,op500 as 1"
' OPENCOM "COM2:2400,n,8,1,op500 as 4"
' OPENCOM "COM3:,,, OP500 as 2"

DECLARE SUB OPENCOM (InString$)
CALL OPENCOM(InString$)
END

SUB OPENCOM (Sting$)
Sting$ = LTRIM$(RTRIM$(Sting$))
Port$ = UCASE$(LEFT$(Sting$, 5))
Sting$ = RIGHT$(Sting$, LEN(Sting$) - 5)
FOR x = 1 TO LEN(Sting$)
     H$ = MID$(Sting$, x, 1)
     IF UCASE$(H$) = "A" THEN
          H$ = H$ + MID$(Sting$, x + 1, 1)
          IF UCASE$(H$) = "AS" THEN
                FileNum = VAL(MID$(Sting$, x + 2, LEN(Sting$)))
                EXIT FOR
          END IF
     END IF
     InputString$ = InputString$ + H$
NEXT x
FOR x = 1 TO LEN(InputString$)
     IF MID$(InputString$, x, 1) <> "," THEN
          BaudRate$ = BaudRate$ + MID$(InputString$, x, 1)
     ELSE
          InputString$ = MID$(InputString$, x + 1, LEN(InputString$))
          EXIT FOR
     END IF
NEXT x
IF LTRIM$(BaudRate$) = "" THEN
     BaudRate& = 0
END IF
SELECT CASE Port$
     CASE "COM1:"
          BaseAddr% = &H3F8
          Port1$ = "COM1:"
     CASE "COM2:"
          BaseAddr% = &H2F8
          Port1$ = "COM2:"
     CASE "COM3:"
          BaseAddr% = &H2F8
          Port1$ = "COM1:"
     CASE "COM4:"
          BaseAddr% = &H3F8
          Port1$ = "COM2:"
     CASE ELSE
          PRINT "Illegal COM Port"
END SELECT

IF BaudRate$ = "" THEN
     OUT BaseAddr% + 3, INP(BaseAddr% + 3) OR &H80
     LSB% = INP(BaseAddr%)
     MSB% = INP(BaseAddr% + 1)
     OUT BaseAddr% + 3, INP(BaseAddr% + 3) AND &H7F
     Divisor& = MSB% * &H100 + LSB%
     IF Divisor& = 0 THEN
          BaudRate& = 0
     ELSE
          BaudRate& = 115200 / Divisor&
     END IF
ELSE
     BaudRate& = VAL(BaudRate$)
END IF
IF LEFT$(InputString$, 1) <> "," THEN
     InputString$ = "," + InputString$
END IF
OPEN Port1$ + "300" + InputString$ FOR RANDOM AS FileNum
IF Port$ = "COM3:" THEN
     POKE &H400, &HE8
ELSEIF Port$ = "COM4:" THEN
     POKE &H402, &HE8
END IF
IF BaudRate& <> 0 THEN
     Divisors# = 115200 / BaudRate&
END IF
LCR = BaseAddr% + 3
Temp = INP(LCR)
OUT LCR, Temp OR 128
OUT BaseAddr% + 1, INT(Divisors# / 256)
OUT BaseAddr%, Divisors#
OUT LCR, Temp AND 127

END SUB