QB Fossil support

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

'                      Code begins
'--------------------------------------------------------------
'                 Tear along perforation

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
' 浜様様様様様様様様様様様様様様様様様様様様様様様様
'  Sub Collection : FOSSIL01                       
' 把陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳陳
'  Projammer      : J.Hunter                       
'  Purpose        : Interface to X00 fossil driver 
'                   for concurrent multiport comm- 
'                   unications under Alarm Central 
'                   application (4 ports at once)  
'                                                  
'  CopyRight (C) 1992,93 - J. Thomas Hunter        
'                          Paragon Labs            
'                                                  
' 藩様様様様様様様様様様様様様様様様様様様様様様様様
CALL closeport(0)
        portnum = 0  ' *** port number to initialize ***
        CALL portinit(9600, "n", 8, 1, portnum) '*** initialize the port ***
        IF ah = 1 THEN
                COLOR 15, 1:CLS
        END IF
scanport:
        CALL inport(inbound$, 0)         '***** first, check port *****
        IF LEN(inbound$) > 0 THEN        '*                           *
                PRINT inbound$;          '*** disp any inbound data ***
                inbound$ = ""            '*                           *
        END IF                           '*                           *
        a$ = INKEY$                      '******* scan keyboard *******
        IF LEN(a$) > 0 THEN              '*                           *
                CALL export(a$, 0)       '***** export keyed data *****
        END IF                           '*                           *
        GOTO scanport                    '********** loop her! ********

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%                    ' machine code latch to register AX
    inreg.bx = bx%                    ' machine code latch to register BX
    inreg.cx = cx%                    ' machine code latch to register CX
    inreg.dx = dx%                    ' machine code latch to register 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:                         ' (Initialization for X00 ONLY - JH)
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

'                        Code Ends
'------------------------------------------------------------
'                    Tear along perforation

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)

$$
Outer Court
Echo Basic Postings

Books at Amazon:

Back to BASIC: The History, Corruption, and Future of the Language

Hackers: Heroes of the Computer Revolution (including Tiny BASIC)

Go to: The Story of the Math Majors, Bridge Players, Engineers, Chess Wizards, Scientists and Iconoclasts who were the Hero Programmers of the Software Revolution

The Advent of the Algorithm: The Idea that Rules the World

Moths in the Machine: The Power and Perils of Programming

Mastering Visual Basic .NET