' The following Btrieve functions were written for Microsoft
' BASIC and Microsoft 'C', and should be portable from DOS
' to Windows (Visual) compilers as well as other platforms.
'
' Each function contains the same number of lines, and in fact
' is quite similar, illustrating some of the similarities and
' differences in the two languages.

' The following 3 lines are specific to BASIC for DOS;
' use individual DIM statements in Visual Basic code.

defstr c
defint i
deflng l

'/* BTRIEVE.BAS  27.10.2000 */

dim ibtrvds(14)                                   '/* Btrieve data structure */
ibtrvid = 0                                           '/* Btrieve process ID */
ibtrvmu = 0                          '/* TRUE when multi-user Btrieve loaded */
ibtrvvs = 0                       '/* TRUE when Btrieve version has been set */
ibtrvas = varseg(ibtrvds(0))               '/* current array-segment address */
ibtrvns = varseg(ibtrvid)                '/* current numeric-segment address */
ibtrvss = varseg(char(0))                 '/* current string-segment address */

function BTRV(ioper, cfcb, cbuf, ilen, ckey, ikey)
   istat = 0                                   '/* status returned by BTRV() */

   if not ibtrvvs then                  '/* Btrieve version has not been set */
      ibtrvvs = not 0                       '/* set Btrieve-version-set flag */
      srg.ax = &h3000                                   '/* DOS version code */
      call interruptx(&h21, srg, srg)              '/* check the DOS version */
      if (srg.ax and &h00ff) >= 3 then            '/* DOS version is >= 3.xx */
         srg.ax = BTRV.IV2                          '/* set DOS interrupt 2F */
         call interruptx(BTRV.IVM, srg, srg)       '/* call DOS interrupt 2F */
         ibtrvmu = ((srg.ax and &hff) = asc("M"))  '/* TRUE if multi-user ON */
      end if
      if not ibtrvmu then                  '/* multi-user Btrieve not loaded */
         srg.ax = &h3500 + BTRV.IVS        '/* set test for standard version */
         call interruptx(&h21, srg, srg)    '/* do test for standard version */
         if srg.bx <> BTRV.OWS then    '/* if BX != offset-within-segment... */
            BTRV = BTRV.ERR             '/* Btrieve not loaded; return error */
            exit function                 '/* exit to return the error value */
         end if
      end if
   end if
   ibtrvds(0) = sadd(cbuf)            '/* calling program data buffer offset */
   ibtrvds(1) = ibtrvss              '/* calling program data buffer segment */
   ibtrvds(2) = ilen                  '/* calling program data buffer length */
   ibtrvds(3) = sadd(cfcb) + &h26                        '/* disk FCB offset */
   ibtrvds(4) = ibtrvss                                 '/* disk FCB segment */
   ibtrvds(5) = sadd(cfcb)         '/* calling program position block offset */
   ibtrvds(6) = ibtrvss           '/* calling program position block segment */
   ibtrvds(7) = ioper                             '/* Btrieve operation code */
   ibtrvds(8) = sadd(ckey)             '/* calling program key buffer offset */
   ibtrvds(9) = ibtrvss               '/* calling program key buffer segment */
   ibtrvds(10) = ikey * 256 + 255        '/* key path# and key buffer length */
   ibtrvds(11) = varptr(istat)                      '/* return-status offset */
   ibtrvds(12) = ibtrvns                           '/* return-status segment */
   ibtrvds(13) = BTRV.VLN                      '/* variable-length-record ID */
   srg.dx = varptr(ibtrvds(0))              '/* put parameter offset into DX */
   srg.ds = ibtrvas                        '/* put parameter segment into DS */
   if ibtrvmu then                          '/* multi-user Btrieve is loaded */
      do while ibtrvmu                     '/* begin Btrieve processing loop */
         srg.bx = ibtrvid                         '/* put process ID into BX */
         if srg.bx then                               '/* process ID is TRUE */
            srg.ax = BTRV.IV2 + 2    '/* set AX to int 2F; adjust for procid */
         else                                        '/* process ID is FALSE */
            srg.ax = BTRV.IV2 + 1        '/* set AX to int 2F; no adjustment */
         end if
         call interruptx(BTRV.IVM, srg, srg)     '/* call Btrieve multi-user */
         if (srg.ax and &h00ff) = 0 then    '/* if Btrieve call processed... */
            exit do                         '/* exit Btrieve processing loop */
         end if
      loop
      if ibtrvid = 0 then                    '/* process ID has not been set */
         ibtrvid = srg.bx                            '/* set process ID flag */
      end if
   else                               '/* Btrieve standard version is loaded */
      call interruptx(BTRV.IVS, srg, srg)  '/* call Btrieve standard version */
   end if
   ilen = ibtrvds(2)                    '/* reset data length as appropriate */
   BTRV = istat                 '/* return Btrieve status to calling program */
end function

' -----------------------------------------------------------------------------
' The following 2 lines are used to specify the
' shortcut declarations for the below function.

typedef char C;                                        /* character (signed) */
typedef int  I;                                    /* short integer (signed) */

/* BTRIEVE.C  27.10.2000 */

I ibtrvds[14];                                     /* Btrieve data structure */
I ibtrvid = 0;                                         /* Btrieve process ID */
I ibtrvmu = 0;                        /* TRUE when multi-user Btrieve loaded */
I ibtrvvs = 0;                     /* TRUE when Btrieve version has been set */
struct SREGS srg;                                   /* DOS segment registers */

I BTRV(I ioper, C *cfcb, C *cbuf, I *ilen, C *ckey, I ikey) {
   I istat = 0;                                 /* status returned by BTRV() */

   if (!ibtrvvs) {                       /* Btrieve version has not been set */
      ibtrvvs = 1;                           /* set Btrieve-version-set flag */
      rg.x.ax = 0x3000;                                  /* DOS version code */
      int86x(0x21, &rg, &rg, &srg);                 /* check the DOS version */
      if ((rg.x.ax & 0x00ff) >= 3) {               /* DOS version is >= 3.xx */
         rg.x.ax = BTRV_IV2;                         /* set DOS interrupt 2F */
         int86x(BTRV_IVM, &rg, &rg, &srg);          /* call DOS interrupt 2F */
         ibtrvmu = ((rg.x.ax & 0xff) == 'M');       /* TRUE if multi-user ON */
      }
      if (!ibtrvmu) {                       /* multi-user Btrieve not loaded */
         rg.x.ax = 0x3500 + BTRV_IVS;       /* set test for standard version */
         int86x(0x21, &rg, &rg, &srg);       /* do test for standard version */
         if (rg.x.bx != BTRV_OWS) {     /* if BX != offset-within-segment... */
            return(BTRV_ERR);            /* Btrieve not loaded; return error */
         }
      }
   }
   segread(&srg);                          /* retrieve DOS segment registers */
   ibtrvds[0] = (I)cbuf;               /* calling program data buffer offset */
   ibtrvds[1] = (I)srg.ss;            /* calling program data buffer segment */
   ibtrvds[2] = *ilen;                 /* calling program data buffer length */
   ibtrvds[3] = (I)(cfcb + 0x26);                         /* disk FCB offset */
   ibtrvds[4] = (I)srg.ss;                               /* disk FCB segment */
   ibtrvds[5] = (I)cfcb;            /* calling program position block offset */
   ibtrvds[6] = (I)srg.ss;         /* calling program position block segment */
   ibtrvds[7] = ioper;                             /* Btrieve operation code */
   ibtrvds[8] = (I)ckey;                /* calling program key buffer offset */
   ibtrvds[9] = (I)srg.ss;             /* calling program key buffer segment */
   ibtrvds[10] = ikey * 256 + 255;        /* key path# and key buffer length */
   ibtrvds[11] = (I)&istat;                          /* return-status offset */
   ibtrvds[12] = (I)srg.ss;                         /* return-status segment */
   ibtrvds[13] = BTRV_VLN;                      /* variable-length-record ID */
   rg.x.dx = (I)ibtrvds;                     /* put parameter offset into DX */
   srg.ds = srg.ss;                         /* put parameter segment into DS */
   if (ibtrvmu) {                            /* multi-user Btrieve is loaded */
      while (ibtrvmu) {                     /* begin Btrieve processing loop */
         rg.x.bx = (U)ibtrvid;                     /* put process ID into BX */
         if (rg.x.bx) {                                /* process ID is TRUE */
            rg.x.ax = BTRV_IV2 + 2;   /* set AX to int 2F; adjust for procid */
         } else {                                     /* process ID is FALSE */
            rg.x.ax = BTRV_IV2 + 1;       /* set AX to int 2F; no adjustment */
         }
         int86x(BTRV_IVM, &rg, &rg, &srg);        /* call Btrieve multi-user */
         if ((rg.x.ax & 0x00ff) == 0) {      /* if Btrieve call processed... */
            break;                           /* exit Btrieve processing loop */
         }
      }
      if (!ibtrvid) {                         /* process ID has not been set */
         ibtrvid = (I)rg.x.bx;                        /* set process ID flag */
      }
   } else {                            /* Btrieve standard version is loaded */
      int86x(BTRV_IVS, &rg, &rg, &srg);     /* call Btrieve standard version */
   }
   *ilen = ibtrvds[2];                   /* reset data length as appropriate */
   return istat;                 /* return Btrieve status to calling program */
}
