home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR36 / BTV200.ZIP / BTRVDOS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-18  |  5KB  |  123 lines
  1. {* This is a real mode interface to the Btrieve TSR.
  2. *  Requires Turbo Pascal version 6.0, 7.0
  3. *
  4. *  IT CANNOT BE USED FOR PROTECTED MODE OR WINDOWS!!!!!
  5. *
  6. *}
  7.  
  8. UNIT BTRVDOS;
  9. {$R-}    {Range checking off}
  10. {$B+}    {Boolean complete evaluation on}
  11. {$S+}    {Stack checking on}
  12. {$N-}    {No numeric coprocessor}
  13.  
  14. {****************************************************************************}
  15. {*   REVISION HISTORY                                                       *}
  16. {*                                                                          *}
  17. {*  Date     Who  What                                                      *}
  18. {* ======================================================================== *}
  19. {* 02/01/92  RWH  Changed all instances of Data Buffer Length from Integer  *}
  20. {*                to Word so variable length records can be up to 64K.      *}
  21. {* 07/28/93  RWH  Removed all code for some obscure multi-tasking operating *}
  22. {*                system that Novell once supported and is not needed for   *}
  23. {*                Turbo Pascal. Should speed access up somewhat.            *}
  24. {****************************************************************************}
  25.  
  26. INTERFACE
  27.  
  28.  
  29. USES
  30.    Dos;
  31.  
  32. CONST
  33.   BTR_INT        : Byte = $7B;
  34.  
  35.  
  36. Function BTRV(    OP       : Integer;     { operation code     }
  37.               var POS,                    { position block     }
  38.                   DATA;                   { data buffer        }
  39.               var DATALEN  : Word;        { data buffer length }
  40.               var KBUF;                   { key buffer         }
  41.                   KEY      : Integer      { index/key path     }
  42.               ): Integer;
  43.  
  44. {============================================================================}
  45. IMPLEMENTATION
  46.  
  47.  
  48. Function BTRV(    OP       : Integer;
  49.               var POS,
  50.                   DATA;
  51.               var DATALEN  : Word;
  52.               var KBUF;
  53.                   KEY      : Integer
  54.               ): Integer;
  55.  
  56.   const
  57.     VAR_ID         = $6176;   {id for variable length records - 'va'}
  58.     BTR_OFFSET     = $0033;
  59.  
  60.   type
  61.     ADDR32 = record               {32 bit address}
  62.       OFFSET : Integer;
  63.       SEGMENT: Integer;
  64.     end;
  65.  
  66.     BTR_PARMS = record
  67.       USER_BUF_ADDR  : ADDR32;  {data buffer address}
  68.       USER_BUF_LEN   : Word;    {data buffer length}
  69.       USER_CUR_ADDR  : ADDR32;  {currency block address}
  70.       USER_FCB_ADDR  : ADDR32;  {file control block address}
  71.       USER_FUNCTION  : Integer; {Btrieve operation}
  72.       USER_KEY_ADDR  : ADDR32;  {key buffer address}
  73.       USER_KEY_LENGTH: Byte;    {key buffer length}
  74.       USER_KEY_NUMBER: Byte;    {key number}
  75.       USER_STAT_ADDR : ADDR32;  {return status address}
  76.       XFACE_ID       : Integer; {language interface id}
  77.     end;
  78.  
  79.   var
  80.     STAT : Integer;             {Btrieve status code}
  81.     XDATA: BTR_PARMS;           {Btrieve parameter block}
  82.     REGS : Dos.Registers;       {register structure used on interrrupt call}
  83.  
  84.   begin
  85.     REGS.AX := $3500 + BTR_INT;
  86.     INTR($21, REGS);
  87.  
  88.     if (REGS.BX <> BTR_OFFSET) then         {make sure Btrieve is installed}
  89.       STAT := 20
  90.  
  91.     else
  92.     begin
  93.       {make normal btrieve call}
  94.       with XDATA do
  95.       begin
  96.         USER_BUF_ADDR.SEGMENT  := SEG(DATA);
  97.         USER_BUF_ADDR.OFFSET   := OFS(DATA);              {set data buffer address}
  98.         USER_BUF_LEN           := DATALEN;
  99.         USER_FCB_ADDR.SEGMENT  := SEG(POS);
  100.         USER_FCB_ADDR.OFFSET   := OFS(POS);               {set FCB address}
  101.         USER_CUR_ADDR.SEGMENT  := USER_FCB_ADDR.SEGMENT;  {set cur seg}
  102.         USER_CUR_ADDR.OFFSET   := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
  103.         USER_FUNCTION          := OP;                     {set Btrieve operation code}
  104.         USER_KEY_ADDR.SEGMENT  := SEG(KBUF);
  105.         USER_KEY_ADDR.OFFSET   := OFS(KBUF);              {set key buffer address}
  106.         USER_KEY_LENGTH        := 255;                    {assume its large enough}
  107.         USER_KEY_NUMBER        := KEY;                    {set key number}
  108.         USER_STAT_ADDR.SEGMENT := SEG(STAT);
  109.         USER_STAT_ADDR.OFFSET  := OFS(STAT);              {set status address}
  110.         XFACE_ID               := VAR_ID;                 {set language id}
  111.       end;
  112.  
  113.       REGS.DX := OFS(XDATA);
  114.       REGS.DS := SEG(XDATA);
  115.       INTR(BTR_INT, REGS);
  116.       DATALEN := XDATA.USER_BUF_LEN;
  117.     end;
  118.  
  119.     BTRV := STAT;
  120.   end;
  121.  
  122. End.
  123.