Area: Quik_Bas
Msg: #367
Date: 06-14-93 16:18 (Public)
From: J. Thomas Hunter
To: All
Subject: QB Fossil support
Okay, boyz and girls...
Thought I might contribute this little snippet of code...
it's a fossil interface for X00, allowing QB to import and
export data through the fossil driver... ideal for DarkStar
InterWare or other DoorWare development projects.
The program itself is a simple terminal - objective of
which was to verify proper fossil communications. The ONLY
thing preventing this from operating properly with BNU is
the fossil initialization routine, which can be easily
modified to reflect...
As you might surmise, the sub INPORT imports characters
from the port courtesy the fossil. EXPORT complements same.
It's not the cleanest stuff in the world, but should prove
sufficient to get those of you started who're suddenly on
the big DOORWARE rampage (G).
It's been posted as a single msg in the interest of keeping
it intact. Will post in two parts later if network
truncation necessitates.
Regards,
J.Hunter
DEFINT A-Z
TYPE regtypex
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
ds AS INTEGER
es AS INTEGER
END TYPE
CALL closeport(0)
portnum = 0
CALL portinit(9600, "n", 8, 1, portnum)
IF ah = 1 THEN
COLOR 15, 1:CLS
END IF
scanport:
CALL inport(inbound$, 0)
IF LEN(inbound$) > 0 THEN
PRINT inbound$;
inbound$ = ""
END IF
a$ = INKEY$
IF LEN(a$) > 0 THEN
CALL export(a$, 0)
END IF
GOTO scanport
FUNCTION BinStr2Bin% (B$) STATIC
bin% = 0
t$ = RIGHT$(STRING$(16, "0") + B$, 16)
IF LEFT$(t$, 1) = "1" THEN
bin% = &H8000
END IF
mask% = &H4000
FOR I% = 2 TO 16
IF MID$(t$, I%, 1) = "1" THEN
bin% = bin% OR mask%
END IF
mask% = mask% \ 2
NEXT I%
BinStr2Bin% = bin%
END FUNCTION
SUB closeport (portnum)
DIM inreg AS regtypex, outreg AS regtypex
inreg.ax = &H5
inreg.bx = 0
inreg.cx = 0
inreg.dx = portnum
CALL INTerruptx(&H14, inreg, outreg)
END SUB
SUB commhandler (ax%, bx%, cx%, dx%) STATIC
DIM inreg AS regtypex, outreg AS regtypex
inreg.ax = ax%
inreg.bx = bx%
inreg.cx = cx%
inreg.dx = dx%
CALL INTerruptx(&H14, inreg, outreg)
ax% = outreg.ax
bx% = outreg.bx
cx% = outreg.cx
dx% = outreg.dx
END SUB
SUB export (outem$, portnum) STATIC
DIM inreg AS regtypex, outreg AS regtypex
DIM outbound AS STRING * 10
outbound = outem$
inreg.ax = &H1900
inreg.bx = 0
inreg.cx = &H1
inreg.dx = portnum
inreg.bp = 0
inreg.si = 0
inreg.di = VARPTR(outbound)
inreg.flags = 0
inreg.ds = 0
inreg.es = VARSEG(outbound)
CALL INTerruptx(&H14, inreg, outreg)
outem$=left$(outbound,outreg.ax)
END SUB
SUB inport (inbound$, portnum) STATIC
DIM inreg AS regtypex, outreg AS regtypex
DIM incoming AS STRING * 4096
inreg.ax = &H1800
inreg.bx = 0
inreg.cx = &HFFFF
inreg.dx = portnum
inreg.bp = 0
inreg.si = 0
inreg.di = VARPTR(incoming)
inreg.flags = 0
inreg.ds = 0
inreg.es = VARSEG(incoming)
CALL INTerruptx(&H14, inreg, outreg)
inbound$ = LEFT$(incoming, outreg.ax)
END SUB
SUB portinit (baud%, parity$, databits%, stopbits%, portnum) STATIC
step1:
IF baud% = 1200 THEN ah$ = "100": GOTO step2
IF baud% = 2400 THEN ah$ = "101": GOTO step2
IF baud% = 9600 THEN ah$ = "111": GOTO step2
IF baud% = 19200 THEN ah$ = "000": GOTO step2
step2:
IF parity$ = "N" OR parity$ = "n" THEN ah$ = ah$ + "00": GOTO step3
IF parity$ = "E" OR parity$ = "e" THEN ah$ = ah$ + "11": GOTO step3
IF parity$ = "O" OR parity$ = "o" THEN ah$ = ah$ + "01": GOTO step3
step3:
IF stopbits% = 1 THEN ah$ = ah$ + "0": GOTO step4
IF stopbits% = 2 THEN ah$ = ah$ + "1": GOTO step4
step4:
IF databits% = 5 THEN ah$ = ah$ + "00": GOTO doneah
IF databits% = 6 THEN ah$ = ah$ + "01": GOTO doneah
IF databits% = 7 THEN ah$ = ah$ + "10": GOTO doneah
IF databits% = 8 THEN ah$ = ah$ + "11": GOTO doneah
doneah:
ax = BinStr2Bin%(ah$)
bx = 0
cx = 0
dx = portnum
CALL commhandler(ax, bx, cx, dx)
ax = &H400
bx = 0
cx = 0
dx = portnum
CALL commhandler(ax, bx, cx, dx)
IF HEX$(ax) = "1954" THEN success=1 else success=0
ax = &HF02
bx = 0
cx = 0
dx = portnum
CALL commhandler(ax, bx, cx, dx)
portnum = success
END SUB
If you have questions or comments, you know where to find me...
It's a quick-n-dirty, but it should shed some insight...
Regards,
J.Hunter
--- GEcho 1.00/beta
* Origin: DarkStar - QB45 Comes ALIVE! - (501) 631-5976 (1:3823/10)
$$
