home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library1 / btriev.bas next >
Encoding:
BASIC Source File  |  1990-05-03  |  6.1 KB  |  153 lines
  1. ' This SUBprocedure provides the interface between Spectra Publishing's
  2. ' PowerBASIC 2.00 compiler and Novell's BTRIEVE file system on PCDOS/MSDOS
  3. ' machines.
  4.  
  5. ' In order to use the SUB, include its source code in your program with the
  6. ' $INCLUDE metastatement:     $INCLUDE "POWERBBT.BAS"
  7.  
  8. ' Each time you wish to perform a BTRIEVE operation, use the CALL statement
  9. ' to call the SUB with the following parameters:
  10.  
  11. ' CALL BTRV(OPERATION%, RETSTATUS%, FCBPOSBLOCK$, DATABUFFER$, _
  12. '           DATABUFLEN%, KEYBUFFER$, KEYNUMBER%)
  13.  
  14. ' where:  OPERATION% is the BTRIEVE operation code for the desired function.
  15. '         RETSTATUS% is a BTRIEVE status code returned after the desired
  16. '            function is attempted.
  17. '         FCBPOSBLOCK$ is a 128-byte data area containing file control block
  18. '            (FCB) and position information which must not be changed by
  19. '            your program.
  20. '         DATABUFFER$ is a data buffer used to specify special information
  21. '            such as file specifications, key characteristics, etc.  Its
  22. '            structure will be defined by your program with a FIELD
  23. '            statement.
  24. '         DATABUFLEN% is the length of the data buffer, DATABUFFER$.
  25. '         KEYBUFFER$ is the key buffer.
  26. '         KEYNUMBER% is the key number to be processed.
  27.  
  28. ' Important note: The BTRV routine resets the currently-active PowerBASIC
  29. ' data segment to the default data segment (by executing a DEF SEG state-
  30. ' ment with no argument).  If you set a different segment with DEF SEG in
  31. ' your main program and then call BTRV, you will need to execute your DEF
  32. ' SEG statement again (after the call), if you wish to continue using your
  33. ' segment as PowerBASIC's data segment; otherwise, the default data segment
  34. ' will be active when BTRV returns to your main program.
  35.  
  36.  
  37. sub BTRV(Operation%, RetStatus%, FCBPosBlock$, DataBuffer$, DataBufLen%, _
  38.      KeyBuffer$, KeyNumber%)
  39.  
  40. static VersionDetermined%, BMULTIPresent%, BMULTIProcessID%
  41. local CriticalErrorVec$        'holds critical error handler vector
  42.  
  43. dim ParamBlock%(0:13)        'local array holds 14-word parameter block
  44.  
  45. %AX = 1 : %BX = 2 : %DX = 4 : %DS = 8    'register equates for use with REG
  46.  
  47. 'parameter positions within ParamBlock% array
  48. %DBOfst = 0 : %DBSeg = 1 : %DBLength = 2 : %PosOfst = 3 : %PosSeg = 4
  49. %FCBOfst = 5 : %FCBSeg = 6 : %OpCode = 7 : %KBOfst = 8 : %KBSeg = 9
  50. %KeyInfo = 10: %StatOfst = 11 : %StatSeg = 12 : %IfaceID = 13
  51.  
  52. %FCBPosSize = 128        '128 = correct size for FCB + position info
  53. %FCBPosLenErr = 23        'status code returned if size exceeded
  54. %NoBTRIEVEErr = 20        'status code returned if BTRIEVE not loaded
  55.  
  56.  
  57. 'First, swap critical error handler and check for presence of BTRIEVE
  58.  
  59. def seg = 0              'use segment zero (DOS INT vectors)
  60. CriticalErrorVec$ = peek$(&h90,4) 'get critical error handler vector
  61. poke$ &h90, peek$(&h51A,4)      'tell DOS to handle errors
  62.  
  63.                 'if INT 7B offset = 33 hex, BTRIEVE handler
  64. if peeki(&h7B * 4) = &h33 then       '  has been loaded
  65.   if VersionDetermined% = 0 then   'DOS version has yet to be determined
  66.     incr VersionDetermined%       'set flag since we're determining now
  67.     reg %AX, &h3000           'use DOS function 30 hex to get the
  68.     call interrupt &h21           '  DOS version number in register AX
  69.     if (reg(%AX) AND &h00FF) >= 3 then     'we have DOS 3.00 or above
  70.       reg %AX, &hAB00                      'so check to see if BMULTI loaded
  71.       call interrupt &h2F
  72.       if (reg(%AX) AND &h00FF) = 77 then
  73.     BMULTIPresent% = 1           'it is loaded, so flag it
  74.       else
  75.     BMULTIPresent% = 0           'otherwise set flag to zero
  76.       end if
  77.     end if
  78.   end if
  79. else                'BTRIEVE handler isn't loaded, so warn user
  80.   RetStatus% = %NoBTRIEVEErr
  81.   poke$ &h90, CriticalErrorVec$    'restore critical error handler
  82.   def seg            'and PB default data segment
  83.   exit sub            'then quit
  84. end if
  85.  
  86. if len(FCBPosBlock$) < %FCBPosSize then    'make sure the passed FCBPosBlock$
  87.   RetStatus% = %FCBPosLenErr        '  is long enough to hold FCB and
  88.                     '  position info -- quit if not
  89.   poke$ &h90, CriticalErrorVec$        'restore critical error handler
  90.   def seg                'and PB default data segment
  91.   exit sub
  92. end if
  93.  
  94.  
  95. 'Now set up 14-word parameter block for the BTRIEVE interrupt
  96.  
  97. ParamBlock%(%DBOfst) = cvi(mkl$(strptr(DataBuffer$)))    'offset and segment
  98. ParamBlock%(%DBSeg) = cvi(mkl$(strseg(DataBuffer$)))    'of data buffer
  99.  
  100. ParamBlock%(%DBLength)  = DataBufLen%            'data buffer length
  101.  
  102. ParamBlock%(%FCBOfst) = cvi(mkl$(strptr(FCBPosBlock$))) 'offset and segment
  103. ParamBlock%(%FCBSeg) = cvi(mkl$(strseg(FCBPosBlock$)))  'of FCB block
  104.  
  105. ParamBlock%(%PosOfst) = ParamBlock%(%FCBOfst) + 38    'offset and segment
  106. ParamBlock%(%PosSeg) = ParamBlock%(%FCBSeg)        'of position block
  107.  
  108. ParamBlock%(%OpCode) = Operation%        'BTRIEVE operation code
  109.  
  110. ParamBlock%(%KBOfst) = cvi(mkl$(strptr(KeyBuffer$)))    'offset and segment
  111. ParamBlock%(%KBSeg) = cvi(mkl$(strseg(KeyBuffer$)))    'of key buffer
  112.  
  113. ParamBlock%(%KeyInfo) = len(KeyBuffer$)+(KeyNumber%*256) 'key info word
  114.  
  115. ParamBlock%(%StatOfst) = cvi(mkl$(varptr(RetStatus%)))    'offset and segment
  116. ParamBlock%(%StatSeg) = cvi(mkl$(varseg(RetStatus%)))    'of status variable
  117.  
  118. ParamBlock%(%IfaceID) = &h6176                'interface ID
  119.  
  120.  
  121. 'Now do the interrupt with DS:DX pointing to the parameter block
  122.  
  123. reg %DX, varptr(ParamBlock%(0))
  124. reg %DS, varseg(ParamBlock%(0))
  125.  
  126. if BMULTIPresent% = 0 then        'BMULTI not present, so use INT 7B
  127.   call interrupt &h7B
  128. else
  129.   do                    'use BMULTI to do it
  130.     if BMULTIProcessID% = 0 then    'get process ID if haven't yet
  131.       reg %AX, &hAB01
  132.     else
  133.       reg %AX, &hAB02            'here if we have process ID -- need
  134.       reg %BX, BMULTIProcessID%        '  to set it now
  135.     end if
  136.     call interrupt &h2F                  'invoke BMULTI
  137.     if (reg(%AX) AND &h00FF) = 0 then exit loop   'go on if done processing
  138.     reg %AX, &h0200                  'otherwise allow task
  139.     call interrupt &h7F                  '  switch and try request
  140.   loop                          '  again
  141.   if BMULTIProcessID% = 0 then BMULTIProcessID% = reg(%BX)  'assign proc ID
  142. end if
  143.  
  144.   DataBufLen% = ParamBlock%(%DBLength)    'pass new data buffer length back
  145.  
  146.  
  147. 'Now restore critical error handler vector and PB's default data segment
  148.  
  149. poke$ &h90, CriticalErrorVec$
  150. def seg
  151.  
  152. end sub
  153.