home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / btrvpas.zip / BTRV5.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-07  |  7KB  |  231 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. unit
  52.    Btrv5;
  53.  
  54. interface
  55.  
  56. uses
  57.   Dos, Crt;
  58.  
  59. const
  60.   Dublicates = 1;
  61.   Modifiable = 2;
  62.   Segmented  = 16;
  63.   LString    = 10;
  64.   ExtType    = 256;
  65.  
  66.   BOpen      = 0;
  67.   BClose     = 1;
  68.   BInsert    = 2;
  69.   BUpdate    = 3;
  70.   BDelete    = 4;
  71.   BEqual     = 5;
  72.   BNext      = 6;
  73.   BPrev      = 7;
  74.   BGreater   = 8;
  75.   BGrEqual   = 9;
  76.   BLess      = 10;
  77.   BLsEqual   = 11;
  78.   BFirst     = 12;
  79.   BLast      = 13;
  80.   BCreate    = 14;
  81.   BStat      = 15;
  82.   BBeginTr   = 19;
  83.   BEndTr     = 20;
  84.   BAbortTr   = 21;
  85.   BGetPos    = 22;
  86.   BGetDirect = 23;
  87. type
  88.   KeySpec = record
  89.                KeyPos, KeyLen,
  90.                KeyFlags      : integer;
  91.                NotUsed       : array[1..4] of char;
  92.                KeyRsv        : array[1..6] of byte
  93.              end;
  94.   FSpec  = record
  95.              RecLen, PageSize  ,
  96.              NdxCnt            : integer;
  97.              NOfRec            : longint;
  98.              Variable, Reserved,
  99.              PreAllc           : integer;
  100.              KeyBuf            : array[0..30] of KeySpec
  101.            end;
  102.  
  103. function BTRV (OP:integer; var POS,DATA; var DATALEN: integer;
  104.            var KBUF; KEY: integer): integer;
  105.  
  106. implementation
  107.  
  108. function BTRV;
  109.  
  110. const
  111.      VAR_ID        = $6176;    {id for variable length records - 'va'}
  112.      BTR_INT        = $7B;
  113.      BTR2_INT        = $2F;
  114.      BTR_OFFSET     = $0033;
  115.      MULTI_FUNCTION    = $AB;
  116.  
  117. {  ProcId is used for communicating with the Multi Tasking Version of          }
  118. {  Btrieve. It contains the process id returned from BMulti and should          }
  119. {  not be changed once it has been set.                       }
  120. {                                          }
  121.      ProcId: integer = 0;            { initialize to no process id }
  122.      MULTI: boolean = false;            { set to true if BMulti is loaded }
  123.      VSet: boolean = false;      { set to true if we have checked for BMulti }
  124.  
  125. type
  126.      ADDR32 = record                           {32 bit address}
  127.     OFFSET: integer;
  128.     SEGMENT: integer;
  129.      end;
  130.  
  131.      BTR_PARMS = record
  132.     USER_BUF_ADDR: ADDR32;                  {data buffer address}
  133.     USER_BUF_LEN: integer;                   {data buffer length}
  134.     USER_CUR_ADDR: ADDR32;                   {currency block address}
  135.     USER_FCB_ADDR: ADDR32;               {file control block address}
  136.     USER_FUNCTION: integer;                 {Btrieve operation}
  137.     USER_KEY_ADDR: ADDR32;                   {key buffer address}
  138.     USER_KEY_LENGTH: BYTE;                    {key buffer length}
  139.     USER_KEY_NUMBER: BYTE;                       {key number}
  140.     USER_STAT_ADDR: ADDR32;             {return status address}
  141.     XFACE_ID: integer;                {language interface id}
  142.      end;
  143.  
  144. var
  145.      STAT: integer;                     {Btrieve status code}
  146.      XDATA: BTR_PARMS;                     {Btrieve parameter block}
  147.      REGS: Dos.Registers;      {register structure used on interrrupt call}
  148.      DONE: boolean;
  149.  
  150. begin
  151.      if Op = 19 then
  152.      begin
  153.        GotoXY(2, 25);
  154.        Write('Bekleyiniz...')
  155.      end;
  156.      REGS.AX := $3500 + BTR_INT;
  157.      INTR ($21, REGS);
  158.      if (REGS.BX <> BTR_OFFSET) then          {make sure Btrieve is installed}
  159.     STAT := 20
  160.      else
  161.     begin
  162.        if (not VSet) then    {if we haven't checked for Multi-User version}
  163.           begin
  164.          REGS.AX := $3000;
  165.          INTR ($21, REGS);
  166.          if ((REGS.AX AND $00FF) >= 3) then
  167.             begin
  168.                VSet := true;
  169.                REGS.AX := MULTI_FUNCTION * 256;
  170.                INTR (BTR2_INT, REGS);
  171.                MULTI := ((REGS.AX AND $00FF) = $004D);
  172.             end
  173.          else
  174.             MULTI := false;
  175.           end;
  176.                             {make normal btrieve call}
  177.        with XDATA do
  178.           begin
  179.          USER_BUF_ADDR.SEGMENT := SEG (DATA);
  180.          USER_BUF_ADDR.OFFSET := OFS (DATA); {set data buffer address}
  181.          USER_BUF_LEN := DATALEN;
  182.          USER_FCB_ADDR.SEGMENT := SEG (POS);
  183.          USER_FCB_ADDR.OFFSET := OFS (POS);         {set FCB address}
  184.          USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
  185.          USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
  186.          USER_FUNCTION := OP;          {set Btrieve operation code}
  187.          USER_KEY_ADDR.SEGMENT := SEG (KBUF);
  188.          USER_KEY_ADDR.OFFSET := OFS (KBUF);  {set key buffer address}
  189.          USER_KEY_LENGTH := 255;         {assume its large enough}
  190.          USER_KEY_NUMBER := KEY;              {set key number}
  191.          USER_STAT_ADDR.SEGMENT := SEG (STAT);
  192.          USER_STAT_ADDR.OFFSET := OFS (STAT);      {set status address}
  193.          XFACE_ID := VAR_ID;                 {set lamguage id}
  194.           end;
  195.  
  196.        REGS.DX := OFS (XDATA);
  197.        REGS.DS := SEG (XDATA);
  198.  
  199.        if (NOT MULTI) then             {MultiUser version not installed}
  200.           INTR (BTR_INT, REGS)
  201.        else
  202.           begin
  203.          DONE := FALSE;
  204.          repeat
  205.             REGS.BX := ProcId;
  206.             REGS.AX := 1;
  207.             if (REGS.BX <> 0) then
  208.                REGS.AX := 2;
  209.             REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
  210.             INTR (BTR2_INT, REGS);
  211.             if ((REGS.AX AND $00FF) = 0) then
  212.                DONE := TRUE
  213.             else begin
  214.                REGS.AX := $0200;
  215.                INTR ($7F, REGS);
  216.                DONE := FALSE;
  217.             end;
  218.          until (DONE);
  219.          if (ProcId = 0) then
  220.             ProcId := REGS.BX;
  221.           end;
  222.        DATALEN := XDATA.USER_BUF_LEN;
  223.     end;
  224.      if Op in [20, 21] then
  225.      begin
  226.        GotoXY(2, 25);
  227.        Write(' ':13)
  228.      end;
  229.      BTRV := STAT;
  230. end;
  231. end.