option explicit
option private
defint a-z
'$include: "btrv.bi"
'$include: "dos/sys/farptr.bi"
'$include: "dos/dpmi.bi"
'$include: "dos/go32.bi"
'$include: "dos/dos.bi"
'parameter positions within ParamBlock array
const Btr.Param.DBOfst = 0
const Btr.Param.DBSeg = 1
const Btr.Param.DBLength = 2
const Btr.Param.PosOfst = 3
const Btr.Param.PosSeg = 4
const Btr.Param.FCBOfst = 5
const Btr.Param.FCBSeg = 6
const Btr.Param.OpCode = 7
const Btr.Param.KBOfst = 8
const Btr.Param.KBSeg = 9
const Btr.Param.KeyInfo = 10
const Btr.Param.StatOfst = 11
const Btr.Param.StatSeg = 12
const Btr.Param.IfaceID = 13
const FCBPosSize = 128 '128 = correct size for FCB + position info
public function BTRVFarNew(byval Operation as integer, _
FCBPosBlock as string, _
DataBufferPtr as any ptr, _
DataBufLen as integer, _
KeyBuffer as string, _
byval KeyNumber as integer) as integer
dim RetStatus as integer
dim r as __dpmi_regs
dim iParamDosSelector as integer
dim iParamDosSegment as integer
dim iParamDosLength as integer
' length of the parameter block
iParamDosLength = _
(14*2) + _
DataBufLen + _
len(FCBPosBlock) + _
len(KeyBuffer) + _
2
iParamDosSegment = __dpmi_allocate_dos_memory((iParamDosLength + 15) \ 16, @iParamDosSelector)
if iParamDosSegment=0 then
function = 999
exit function
end if
static VersionDetermined as integer
static BMULTIPresent as integer
static BMULTIProcessID as integer
dim DosErrorVec as integer
dosmemget(&H51A, 4, @DosErrorVec)
dim CriticalErrorVec as uinteger 'holds critical error handler vector
dosmemget(&H24*4, 4, @CriticalErrorVec) 'get critical error handler vector
dosmemput(@DosErrorVec, 4, &H24*4) 'tell DOS to handle errors
dim int_7b_offset as ushort
dosmemget( &H7b*4, 2, @int_7b_offset )
'if INT 7B offset = 33 hex, BTRIEVE handler
if int_7b_offset = &h33 then ' has been loaded
if VersionDetermined = 0 then 'DOS version has yet to be determined
VersionDetermined += 1 'set flag since we're determining now
dim iDosVersion as integer
iDosVersion = _get_dos_version(0) ' reported version
if (iDosVersion and &Hff) >= 3 then 'we have DOS 3.00 or above
r.x.ax = &Hab00 'so check to see if BMULTI loaded
__dpmi_simulate_real_mode_interrupt &H2F, @r
BMULTIPresent = (r.x.ax and &HFF)=77
end if
end if
else 'BTRIEVE handler isn't loaded, so warn user
function = Btr.Err.BtrieveNotLoaded
__dpmi_free_dos_memory(iParamDosSelector)
dosmemput(@CriticalErrorVec, 4, &H24*4) 'restore critical error handler
exit function 'then quit
end if
if len(FCBPosBlock$) < FCBPosSize then 'make sure the passed FCBPosBlock$
function = Btr.Err.FCBPosLen ' is long enough to hold FCB and
' position info -- quit if not
__dpmi_free_dos_memory(iParamDosSelector)
dosmemput(@CriticalErrorVec, 4, &H24*4) 'restore critical error handler
exit function
end if
'Now set up 14-word parameter block for the BTRIEVE interrupt
dim ParamBlock(0 to 13) as ushort 'local array holds 14-word parameter block
ParamBlock(Btr.Param.DBOfst) = 14*2 'offset and segment
ParamBlock(Btr.Param.DBSeg) = iParamDosSegment 'of data buffer
ParamBlock(Btr.Param.DBLength) = DataBufLen 'data buffer length
ParamBlock(Btr.Param.FCBOfst) = _
ParamBlock(Btr.Param.DBOfst) + DataBufLen 'offset and segment
ParamBlock(Btr.Param.FCBSeg) = iParamDosSegment 'of FCB block
ParamBlock(Btr.Param.PosOfst) = _
ParamBlock(Btr.Param.FCBOfst) + 38 'offset and segment
ParamBlock(Btr.Param.PosSeg) = iParamDosSegment 'of position block
ParamBlock(Btr.Param.OpCode) = Operation% 'BTRIEVE operation code
ParamBlock(Btr.Param.KBOfst) = _
ParamBlock(Btr.Param.FCBOfst) + len(FCBPosBlock) 'offset and segment
ParamBlock(Btr.Param.KBSeg) = iParamDosSegment 'of key buffer
ParamBlock(Btr.Param.KeyInfo) = _
len(KeyBuffer$)+(KeyNumber%*256) 'key info word
ParamBlock(Btr.Param.StatOfst) = _
ParamBlock(Btr.Param.KBOfst) + len(KeyBuffer) 'offset and segment
ParamBlock(Btr.Param.StatSeg) = iParamDosSegment 'of status variable
ParamBlock(Btr.Param.IfaceID) = &h6176 'interface ID
' copy data to DOS memory
movedata( _
_my_ds(), @ParamBlock(0), _
iParamDosSelector, 0, _
14*2)
movedata( _
_my_ds(), DataBufferPtr, _
iParamDosSelector, ParamBlock(Btr.Param.DBOfst), _
DataBufLen)
movedata( _
_my_ds(), @FCBPosBlock[0], _
iParamDosSelector, ParamBlock(Btr.Param.FCBOfst), _
len(FCBPosBlock))
movedata( _
_my_ds(), @KeyBuffer[0], _
iParamDosSelector, ParamBlock(Btr.Param.KBOfst), _
len(KeyBuffer))
movedata( _
_my_ds(), @RetStatus, _
iParamDosSelector, ParamBlock(Btr.Param.StatOfst), _
2)
' WColor 15, 1
' ShowMemory iParamDosSelector, 0, iParamDosLength
'Now do the interrupt with DS:DX pointing to the parameter block
r.x.dx = 0
r.x.ds = iParamDosSegment
if not BMULTIPresent then 'BMULTI not present, so use INT 7B
__dpmi_simulate_real_mode_interrupt &H7B, @r
else
do 'use BMULTI to do it
if BMULTIProcessID% = 0 then 'get process ID if haven't yet
r.x.ax = &HAB01
else
r.x.ax = &hAB02 'here if we have process ID -- need
r.x.bx = BMULTIProcessID ' to set it now
end if
__dpmi_simulate_real_mode_interrupt &H2F, @r 'invoke BMULTI
if (r.x.ax and &HFF)=0 then exit do 'go on if done processing
r.x.ax = &h0200 'otherwise allow task
__dpmi_simulate_real_mode_interrupt &h7F, @r ' switch and try request
loop ' again
if BMULTIProcessID% = 0 then
BMULTIProcessID% = r.x.bx 'assign proc ID
end if
end if
' copy data from DOS memory
movedata( _
iParamDosSelector, 0, _
_my_ds(), @ParamBlock(0), _
14*2)
movedata( _
iParamDosSelector, ParamBlock(Btr.Param.DBOfst), _
_my_ds(), DataBufferPtr, _
DataBufLen)
movedata( _
iParamDosSelector, ParamBlock(Btr.Param.FCBOfst), _
_my_ds(), @FCBPosBlock[0], _
len(FCBPosBlock))
movedata( _
iParamDosSelector, ParamBlock(Btr.Param.KBOfst), _
_my_ds(), @KeyBuffer[0], _
len(KeyBuffer))
movedata( _
iParamDosSelector, ParamBlock(Btr.Param.StatOfst), _
_my_ds(), @RetStatus, _
2)
__dpmi_free_dos_memory(iParamDosSelector)
DataBufLen = ParamBlock(Btr.Param.DBLength) 'pass new data buffer length back
'Now restore critical error handler vector
dosmemput(@CriticalErrorVec, 4, &H24*4)
function = RetStatus
end function