Category : BASIC Source Code
Archive   : FONBOOK.ZIP
Filename : BTRV.INC

'-----------------------------------------------------------------------------

' This SUBprocedure provides the interface between Spectra Publishing's
' PowerBASIC 2.00 compiler and Novell's BTRIEVE file system on PCDOS/MSDOS
' machines.

' In order to use the SUB, include its source code in your program with the
' $INCLUDE metastatement: $INCLUDE "POWERBBT.BAS"

' Each time you wish to perform a BTRIEVE operation, use the CALL statement
' to call the SUB with the following parameters:

' CALL BTRV(OPERATION%, RETSTATUS%, FCBPOSBLOCK$, DATABUFFER$, _
' DATABUFLEN%, KEYBUFFER$, KEYNUMBER%)

' where: OPERATION% is the BTRIEVE operation code for the desired function.
' RETSTATUS% is a BTRIEVE status code returned after the desired
' function is attempted.
' FCBPOSBLOCK$ is a 128-byte data area containing file control block
' (FCB) and position information which must not be changed by
' your program.
' DATABUFFER$ is a data buffer used to specify special information
' such as file specifications, key characteristics, etc. Its
' structure will be defined by your program with a FIELD
' statement.
' DATABUFLEN% is the length of the data buffer, DATABUFFER$.
' KEYBUFFER$ is the key buffer.
' KEYNUMBER% is the key number to be processed.

' Important note: The BTRV routine resets the currently-active PowerBASIC
' data segment to the default data segment (by executing a DEF SEG state-
' ment with no argument). If you set a different segment with DEF SEG in
' your main program and then call BTRV, you will need to execute your DEF
' SEG statement again (after the call), if you wish to continue using your
' segment as PowerBASIC's data segment; otherwise, the default data segment
' will be active when BTRV returns to your main program.


sub BTRV(Operation%, RetStatus%, FCBPosBlock$, DataBuffer$, DataBufLen%, _
KeyBuffer$, KeyNumber%)

static VersionDetermined%, BMULTIPresent%, BMULTIProcessID%
local CriticalErrorVec$ 'holds critical error handler vector

dim ParamBlock%(0:13) 'local array holds 14-word parameter block

%AX = 1 : %BX = 2 : %DX = 4 : %DS = 8 'register equates for use with REG

'parameter positions within ParamBlock% array
%DBOfst = 0 : %DBSeg = 1 : %DBLength = 2 : %PosOfst = 3 : %PosSeg = 4
%FCBOfst = 5 : %FCBSeg = 6 : %OpCode = 7 : %KBOfst = 8 : %KBSeg = 9
%KeyInfo = 10: %StatOfst = 11 : %StatSeg = 12 : %IfaceID = 13

%FCBPosSize = 128 '128 = correct size for FCB + position info
%FCBPosLenErr = 23 'status code returned if size exceeded
%NoBTRIEVEErr = 20 'status code returned if BTRIEVE not loaded


'First, swap critical error handler and check for presence of BTRIEVE

def seg = 0 'use segment zero (DOS INT vectors)
CriticalErrorVec$ = peek$(&h90,4) 'get critical error handler vector
poke$ &h90, peek$(&h51A,4) 'tell DOS to handle errors

'if INT 7B offset = 33 hex, BTRIEVE handler
if peeki(&h7B * 4) = &h33 then ' has been loaded
if VersionDetermined% = 0 then 'DOS version has yet to be determined
incr VersionDetermined% 'set flag since we're determining now
reg %AX, &h3000 'use DOS function 30 hex to get the
call interrupt &h21 ' DOS version number in register AX
if (reg(%AX) AND &h00FF) >= 3 then 'we have DOS 3.00 or above
reg %AX, &hAB00 'so check to see if BMULTI loaded
call interrupt &h2F
if (reg(%AX) AND &h00FF) = 77 then
BMULTIPresent% = 1 'it is loaded, so flag it
else
BMULTIPresent% = 0 'otherwise set flag to zero
end if
end if
end if
else 'BTRIEVE handler isn't loaded, so warn user
RetStatus% = %NoBTRIEVEErr
poke$ &h90, CriticalErrorVec$ 'restore critical error handler
def seg 'and PB default data segment
exit sub 'then quit
end if

if len(FCBPosBlock$) < %FCBPosSize then 'make sure the passed FCBPosBlock$
RetStatus% = %FCBPosLenErr ' is long enough to hold FCB and
' position info -- quit if not
poke$ &h90, CriticalErrorVec$ 'restore critical error handler
def seg 'and PB default data segment
exit sub
end if


'Now set up 14-word parameter block for the BTRIEVE interrupt

ParamBlock%(%DBOfst) = cvi(mkl$(strptr(DataBuffer$))) 'offset and segment
ParamBlock%(%DBSeg) = cvi(mkl$(strseg(DataBuffer$))) 'of data buffer

ParamBlock%(%DBLength) = DataBufLen% 'data buffer length

ParamBlock%(%FCBOfst) = cvi(mkl$(strptr(FCBPosBlock$))) 'offset and segment
ParamBlock%(%FCBSeg) = cvi(mkl$(strseg(FCBPosBlock$))) 'of FCB block

ParamBlock%(%PosOfst) = ParamBlock%(%FCBOfst) + 38 'offset and segment
ParamBlock%(%PosSeg) = ParamBlock%(%FCBSeg) 'of position block

ParamBlock%(%OpCode) = Operation% 'BTRIEVE operation code

ParamBlock%(%KBOfst) = cvi(mkl$(strptr(KeyBuffer$))) 'offset and segment
ParamBlock%(%KBSeg) = cvi(mkl$(strseg(KeyBuffer$))) 'of key buffer

ParamBlock%(%KeyInfo) = len(KeyBuffer$)+(KeyNumber%*256) 'key info word

ParamBlock%(%StatOfst) = cvi(mkl$(varptr(RetStatus%))) 'offset and segment
ParamBlock%(%StatSeg) = cvi(mkl$(varseg(RetStatus%))) 'of status variable

ParamBlock%(%IfaceID) = &h6176 'interface ID


'Now do the interrupt with DS:DX pointing to the parameter block

reg %DX, varptr(ParamBlock%(0))
reg %DS, varseg(ParamBlock%(0))

if BMULTIPresent% = 0 then 'BMULTI not present, so use INT 7B
call interrupt &h7B
else
do 'use BMULTI to do it
if BMULTIProcessID% = 0 then 'get process ID if haven't yet
reg %AX, &hAB01
else
reg %AX, &hAB02 'here if we have process ID -- need
reg %BX, BMULTIProcessID% ' to set it now
end if
call interrupt &h2F 'invoke BMULTI
if (reg(%AX) AND &h00FF) = 0 then exit loop 'go on if done processing
reg %AX, &h0200 'otherwise allow task
call interrupt &h7F ' switch and try request
loop ' again
if BMULTIProcessID% = 0 then BMULTIProcessID% = reg(%BX) 'assign proc ID
end if

DataBufLen% = ParamBlock%(%DBLength) 'pass new data buffer length back


'Now restore critical error handler vector and PB's default data segment

poke$ &h90, CriticalErrorVec$
def seg

end sub

'-----------------------------------------------------------------------------