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