home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a011 / 2.ddi / TURXBTRV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-04-28  |  5.9 KB  |  163 lines
  1. {                                          }
  2. {  Module Name: TURXBTRV.PAS                              }
  3. {                                          }
  4. {  Description: This is the Btrieve interface for Turbo Pascal (MS-DOS).      }
  5. {        This routine sets up the parameter block expected by          }
  6. {        Btrieve, and issues interrupt 7B.  It should be compiled      }
  7. {        with the $V- switch so that runtime checks will not be          }
  8. {        performed on the variable parameters.                  }
  9. {                                          }
  10. {  Synopsis:    STAT := BTRV (OP, POS.START, DATA.START, DATALEN,          }
  11. {                 KBUF.START, KEY);                  }
  12. {                  where                          }
  13. {            OP is an integer,                      }
  14. {            POS is a 128 byte array,                  }
  15. {            DATA is an untyped parameter for the data buffer,     }
  16. {            DATALEN is the integer length of the data buffer,     }
  17. {            KBUF is the untyped parameter for the key buffer,     }
  18. {            and KEY is an integer.                      }
  19. {                                          }
  20. {  Returns:    Btrieve status code (see Appendix B of the Btrieve Manual).   }
  21. {                                          }
  22. {  Note:    The Btrieve manual states that the 2nd, 3rd, and 5th          }
  23. {        parameters be declared as variant records, with an integer    }
  24. {        type as one of the variants (used only for Btrieve calls),    }
  25. {        as is shown in the example below.  This is supported, but     }
  26. {        the restriction is no longer necessary.  In other words, any  }
  27. {        variable can be sent in those spots as long as the variable   }
  28. {        uses the correct amount of memory so Btrieve does not          }
  29. {        overwrite other variables.                      }
  30. {                                          }
  31. {           var DATA = record case boolean of                  }
  32. {              FALSE: ( START: integer );                  }
  33. {              TRUE:  ( EMPLOYEE_ID: 0..99999;                  }
  34. {                   EMPLOYEE_NAME: packed array[1..50] of char;    }
  35. {                   SALARY: real;                      }
  36. {                   DATA_OF_HIRE: DATE_TYPE );              }
  37. {              end;                              }
  38. {                                          }
  39. {        There should NEVER be any string variables declared in the    }
  40. {        data or key records, because strings store an extra byte for  }
  41. {        the length, which affects the total size of the record.       }
  42. {                                          }
  43. {                                          }
  44.  
  45. function BTRV (OP:integer; var POS,DATA; var DATALEN: integer;
  46.            var KBUF; KEY: integer): integer;
  47. const
  48.      PASCAL_ID        = $AAAA;               {Pascal language id}
  49.      VAR_ID        = $6176;    {id for variable length records - 'va'}
  50.      BTR_INT        = $7B;
  51.      BTR2_INT        = $2F;
  52.      BTR_OFFSET     = $0033;
  53.      MULTI_FUNCTION    = $AB;
  54.  
  55. {  ProcId is used for communicating with the Multi Tasking Version of          }
  56. {  Btrieve. It contains the process id returned from BMulti and should          }
  57. {  not be changed once it has been set.                       }
  58. {                                          }
  59.      ProcId: integer = 0;            { initialize to no process id }
  60.      MULTI: boolean = false;            { set to true if BMulti is loaded }
  61.      VSet: boolean = false;      { set to true if we have checked for BMulti }
  62.  
  63. type
  64.      ADDR32 = record                           {32 bit address}
  65.     OFFSET: integer;
  66.     SEGMENT: integer;
  67.      end;
  68.  
  69.      BTR_PARMS = record
  70.     USER_BUF_ADDR: ADDR32;                  {data buffer address}
  71.     USER_BUF_LEN: integer;                   {data buffer length}
  72.     USER_CUR_ADDR: ADDR32;                   {currency block address}
  73.     USER_FCB_ADDR: ADDR32;               {file control block address}
  74.     USER_FUNCTION: integer;                 {Btrieve operation}
  75.     USER_KEY_ADDR: ADDR32;                   {key buffer address}
  76.     USER_KEY_LENGTH: BYTE;                    {key buffer length}
  77.     USER_KEY_NUMBER: BYTE;                       {key number}
  78.     USER_STAT_ADDR: ADDR32;             {return status address}
  79.     XFACE_ID: integer;                {language interface id}
  80.      end;
  81.  
  82.      Result = record
  83.            AX,BX,CX,DX,BP,SI,DI,DS,ES,fLAGS: integer;
  84.           end;
  85.  
  86. var
  87.      STAT: integer;                     {Btrieve status code}
  88.      XDATA: BTR_PARMS;                     {Btrieve parameter block}
  89.      REGS: Result;          {register structure used on interrrupt call}
  90.      DONE: boolean;
  91.  
  92. begin
  93.      REGS.AX := $3500 + BTR_INT;
  94.      INTR ($21, REGS);
  95.      if (REGS.BX <> BTR_OFFSET) then          {make sure Btrieve is installed}
  96.     STAT := 20
  97.      else
  98.     begin
  99.        if (not VSet) then    {if we haven't checked for Multi-User version}
  100.           begin
  101.          REGS.AX := $3000;
  102.          INTR ($21, REGS);
  103.          if ((REGS.AX AND $00FF) >= 3) then
  104.             begin
  105.                VSet := true;
  106.                REGS.AX := MULTI_FUNCTION * 256;
  107.                INTR (BTR2_INT, REGS);
  108.                MULTI := ((REGS.AX AND $00FF) = $004D);
  109.             end
  110.          else
  111.             MULTI := false;
  112.           end;
  113.                             {make normal btrieve call}
  114.        with XDATA do
  115.           begin
  116.          USER_BUF_ADDR.SEGMENT := SEG (DATA);
  117.          USER_BUF_ADDR.OFFSET := OFS (DATA); {set data buffer address}
  118.          USER_BUF_LEN := DATALEN;
  119.          USER_FCB_ADDR.SEGMENT := SEG (POS);
  120.          USER_FCB_ADDR.OFFSET := OFS (POS);         {set FCB address}
  121.          USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
  122.          USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
  123.          USER_FUNCTION := OP;          {set Btrieve operation code}
  124.          USER_KEY_ADDR.SEGMENT := SEG (KBUF);
  125.          USER_KEY_ADDR.OFFSET := OFS (KBUF);  {set key buffer address}
  126.          USER_KEY_LENGTH := 255;         {assume its large enough}
  127.          USER_KEY_NUMBER := KEY;              {set key number}
  128.          USER_STAT_ADDR.SEGMENT := SEG (STAT);
  129.          USER_STAT_ADDR.OFFSET := OFS (STAT);      {set status address}
  130.          XFACE_ID := VAR_ID;                 {set lamguage id}
  131.           end;
  132.  
  133.        REGS.DX := OFS (XDATA);
  134.        REGS.DS := SEG (XDATA);
  135.  
  136.        if (NOT MULTI) then             {MultiUser version not installed}
  137.           INTR (BTR_INT, REGS)
  138.        else
  139.           begin
  140.          DONE := FALSE;
  141.          repeat
  142.             REGS.BX := ProcId;
  143.             REGS.AX := 1;
  144.             if (REGS.BX <> 0) then
  145.                REGS.AX := 2;
  146.             REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
  147.             INTR (BTR2_INT, REGS);
  148.             if ((REGS.AX AND $00FF) = 0) then
  149.                DONE := TRUE
  150.             else begin
  151.                REGS.AX := $0200;
  152.                INTR ($7F, REGS);
  153.                DONE := FALSE;
  154.             end;
  155.          until (DONE);
  156.          if (ProcId = 0) then
  157.             ProcId := REGS.BX;
  158.           end;
  159.        DATALEN := XDATA.USER_BUF_LEN;
  160.     end;
  161.      BTRV := STAT;
  162. end;
  163.