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