'===========================================================================
' Subject: QB API TEST PROGRAM                Date: 12-23-97 (14:55)       
'  Author: Rick Elbers                        Code: QBasic                 
'  Origin: authentic@tip.nl                 Packet: QBAPI.ABC
'===========================================================================
DEFINT A-Z
DECLARE SUB intializeqbapi ()
DECLARE SUB execute2 (program$, commandline$)
DECLARE SUB getdisk ()
DECLARE SUB execute (program$, commandline$)


'Uncomment the line below out if you not already installed
'QBAPI either from the commmandline or with a batfile
'inside your v86 box, or better yet before you run
'vmm(which is working horse windows).

'SHELL "c:\asm\sources\qbapi9.exe "

CLS

'1. INITIALIZING QBAPI interface...
CALL intializeqbapi

'2. EXAMPLE USAGES..
'   Although this TSR interface is specially there
'   for people to use it as they wish I have added
'   a few examples of usefullness..

'2A)SHARED "STATIC" DATA
'   (returning some info on the machine such as DOS version ,WIN version
'   current execution mode, vesa version etc..)

qbapi$ = asm$ + MKI$(4): DIM shareddata(16)
DEF SEG = VARSEG(qbapi$): CALL ABSOLUTE(shareddata(), &H100, SADD(qbapi$))
'At this point I say leave asm$,and shareddata() read only
'-----------------------------------------------------------------------------
PRINT "Shared DATA"
FOR i = 0 TO 16: PRINT HEX$(shareddata(i)), : NEXT

PRINT : PRINT "Press a key for next demo!": SLEEP: CLS

'2B)INTEGER ARRAYSORT
REDIM c(1001)       'redimming makes erase give free the memory!
FOR i = 0 TO 1000 STEP 4: c(i) = -i: NEXT
FOR i = 1 TO 1000 STEP 4: c(i) = i: NEXT
FOR i = 2 TO 1000 STEP 4: c(i) = (i ^ 2) / 32: NEXT
FOR i = 3 TO 1000 STEP 4: c(i) = -(i ^ 2) / 40: NEXT

t! = TIMER: qbapi$ = asm$ + MKI$(6): upb = UBOUND(c)
CALL ABSOLUTE(c(), upb, &H200, SADD(qbapi$))
k! = TIMER: CLS : FOR i = 0 TO 1000: PRINT c(i); : NEXT
PRINT : PRINT k! - t!: ERASE c
PRINT : PRINT "Press a key for next": SLEEP: CLS

'2C)DIR REPLACEMENTS

'1)Get nrfiles which are equal to search$
'2)Get a nr of the files which match the search$
'function 0=return in stringarray
'function 1=return number of hits

qbapi$ = asm$ + MKI$(8)
search$ = "dos\*.*":
CALL ABSOLUTE(search$, nrhits, errs, &H601, SADD(qbapi$))
IF errs THEN
  PRINT "Error : "; errs
ELSE
  '2) Get all of them in basic string array...
  PRINT search$; " "; "has :"; nrhits; " nr of hits"
  REDIM result$(nrhits): qbapi$ = asm$ + MKI$(10)
  FOR i = 0 TO nrhits: result$(i) = SPACE$(12): NEXT
  CALL ABSOLUTE(result$(), search$, 350, errs, &H600, SADD(qbapi$))
  IF errs THEN
    PRINT "Error finding files : "; errs
  ELSE
    PRINT "Press a key for files!"
    SLEEP: CLS
    FOR i = 0 TO nrhits: PRINT result$(i), : NEXT
  END IF
END IF
ERASE result$
PRINT : PRINT "Press a key for next demo!": SLEEP: CLS

'2D)MEMORY ROUTINES
'-)meminit(must be called first before any memory routine)
qbapi$ = asm$ + MKI$(4)
CALL ABSOLUTE(errs, &H300, SADD(qbapi$))
IF errs THEN
  PRINT "Error initializing heap manager"
ELSE
  PRINT "Installed heapmanager"
END IF

PRINT "Press a key for next demos!": SLEEP: CLS
CALL getdisk
PRINT "Press a key for next demos!": SLEEP: CLS

CALL execute("c:\dos\mem.exe", c$)
PRINT "Press a key for next demos!": SLEEP: CLS


'When you have installed the TSR below qbasic then you can
'uncomment this one below: it will return to dos commandline
'
'CALL execute2("c:\dos\mem.exe", "/d /p")


CALL execute("C:\asm\sources\qbapi9.exe", "remove")
'After this you get horrible errors when calling qbapi again-;(


END

'
SUB dirs

END SUB

'
'Executes a program with some commandline
'This is a SHELL replacement. Its faster.
'Can be used under all circumstances.
'
SUB execute (program$, commandline$)

SHARED asm$
qbapi$ = asm$ + MKI$(8)
DEF SEG = VARSEG(qbapi$)
CALL ABSOLUTE(program$, commandline$, errs, &H500, SADD(qbapi$))
DEF SEG
IF errs THEN
  PRINT "error : "; errs
END IF


END SUB

'
'This is a chain replacement.
'Can ONLY be USED when QBASIC is top
'of memory and NOT QBAPI!
'Its better then chain because it
'first deallocates QBASIC.
'
'DO NOT USE WHEN QBAPI IS INSTALLED
'INSIDE YOUR QBASIC PROGRAM.
'
'
SUB execute2 (program$, commandline$)

SHARED asm$

qbapi$ = asm$ + MKI$(8)
DEF SEG = VARSEG(qbapi$)
CALL ABSOLUTE(program$, commandline$, errs, &H501, SADD(qbapi$))
DEF SEG
IF errs THEN
  PRINT "error : "; errs
END IF

END SUB

'
'
SUB getdisk

SHARED asm$

qbapi$ = asm$ + MKI$(6)
disk$ = SPACE$(1)
DEF SEG = VARSEG(qbapi$)
CALL ABSOLUTE(disk$, errs, &H400, SADD(qbapi$))
IF errs THEN
  PRINT "Error : "; errs
ELSE
  PRINT "Current disk:"; disk$
END IF

curdir$ = SPACE$(64)
CALL ABSOLUTE(curdir$, errs, &H401, SADD(qbapi$))
DEF SEG
IF errs THEN
  PRINT "Error : "; errs
ELSE
  PRINT "Current dir :"; curdir$
END IF


END SUB

SUB intializeqbapi
'
'This sub is doing all intializing for the qb_api:
'1. See if TSR installed.
'2. Initialize the calling string asm$
'3. Find out at what INT qb_api is installed
'   and change asm$ accordingly.
'
'After this the only thing you have to do is:
'1. Adjust the string by adding MKI$(returnbytes)
'2. Be sure your segment points to the string(DEF SEG=Varseg($)
'3  CALL ABSOLUTE([variables]*n, functionid, sadd(a$))
'

'1)First test if something at vector 80h
'(can be ommitted if f.i. qbapi.bat batch file used)
DEF SEG = 0:
IF (PEEK(&H80 * 4) OR PEEK(&H80 * 4 + 2)) = 0 THEN
  PRINT "You have to install the TSR first!": END
END IF
DEF SEG

'2)INITIALIZE DISPATCHER
SHARED asm$
asm$ = CHR$(&HCD) + CHR$(&H80)    'int 80h
asm$ = asm$ + CHR$(&HCA)
qbapi$ = asm$ + MKI$(4)           'retf 4(2 for variable,2 for functionid)

'2a)Get int_use( we are assuming int 80h for now)
DEF SEG = VARSEG(qbapi$): CALL ABSOLUTE(intuse, CVI("RE"), SADD(qbapi$))
DEF SEG : MID$(asm$, 2, 1) = CHR$(intuse AND &HFF)

'This in fact is all. After this asm$ is a constant.
'You should precede your call absolute with
'adding the number of return bytes with:
'   qbapi$=asm$+MKI$(returnbytes)


END SUB