' 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