home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR36 / BTV200.ZIP / BTRVDPMI.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-18  |  8KB  |  289 lines
  1. {*
  2. * This is a protected mode interface to the Btrieve TSR.
  3. *
  4. * IT CANNOT BE USED FOR REAL MODE!!!!!
  5. *
  6. *========================================================================= 
  7. *  BTRVDPMI.PAS  for BTV.PAS Version 1.50                        
  8. *                                                                
  9. *  BTRIEVE object oriented interface for Turbo Pascal 6.0, 7.0   
  10. *                                                                
  11. *  Copyright (c) 1992 by Richard W. Hansen, all rights reserved. 
  12. *
  13. *
  14. *  Requires Turbo Pascal version 7.0
  15. *
  16. *
  17. *  Registration and payment of a license fee is required for any use, whether
  18. *  in whole or part, of this source code.
  19. *========================================================================= 
  20. *
  21. *}
  22.  
  23. UNIT BTRVDPMI;
  24. {$X+}
  25. {$V-}
  26.  
  27. INTERFACE
  28.  
  29. {$IFDEF DPMI}
  30. USES
  31.   BtvConst,
  32.   WinDos, WINApi;
  33.  
  34.  
  35. CONST
  36.   BTR_INT        : Byte = $7B;
  37.  
  38.  
  39. { 
  40.   The paramters to this function must be exactly right. If they are not
  41.   then a GPF error is just about guaranteed. The buffer sizes must be
  42.   right, or else a memory overwrite will result. Buffer sizes of zero
  43.   are allowed and should be handled properly. 
  44.  
  45.   The KeyLen parameter is new, make sure it is correct for the operation
  46.   you are executing. All other parameters are the same.
  47. }
  48.  
  49. Function BTRV(    Op       : Integer;
  50.               var PosBlock;
  51.               var DataBuff;
  52.               var DataLen  : Word;
  53.               var KeyBuff;
  54.                   KeyLen   : Byte;
  55.                   KeyNumber: Integer): Integer;
  56.  
  57.  
  58.  
  59. IMPLEMENTATION
  60.  
  61. TYPE
  62.   MemPtr = record
  63.     Selector: Word;  {Protected mode}
  64.     Segment : Word;  {Real mode}
  65.   end;
  66.  
  67.  
  68. VAR
  69.   {these could be setup once, if enough memory is available }
  70.   pPosBlock : MemPtr;
  71.   pDataBuff : MemPtr;
  72.   pKeyBuff  : MemPtr;
  73.   pStatus   : MemPtr;
  74.   pParams   : MemPtr;
  75.  
  76.  
  77. Function BTRV(    Op       : Integer;
  78.               var PosBlock;
  79.               var DataBuff;
  80.               var DataLen  : Word;
  81.               var KeyBuff;
  82.                   KeyLen   : Byte;
  83.                   KeyNumber: Integer
  84.               ): Integer;
  85.  
  86.   const
  87.     VAR_ID         = $6176;     {id for variable length records - 'va'}
  88.     BTR_OFFSET     = $0033;
  89.     DPMI_INTR      = $31;
  90.  
  91.  
  92.   type
  93.     Addr32 = record             {32 bit address}
  94.       Offset : Word;
  95.       Segment: Word;
  96.     end;
  97.  
  98.     BtrieveBuff = record
  99.       USER_BUF_ADDR  : Addr32;  {data buffer address}
  100.       USER_BUF_LEN   : Word;    {data buffer length}
  101.       USER_CUR_ADDR  : Addr32;  {currency block address}
  102.       USER_FCB_ADDR  : Addr32;  {file control block address}
  103.       USER_FUNCTION  : Word;    {Btrieve operation}
  104.       USER_KEY_ADDR  : Addr32;  {key buffer address}
  105.       USER_KEY_LENGTH: Byte;    {key buffer length}
  106.       USER_KEY_NUMBER: Byte;    {key number}
  107.       USER_STAT_ADDR : Addr32;  {return status address}
  108.       XFACE_ID       : Word;    {language interface id}
  109.     end;
  110.  
  111.     TDPMIRegisters = record     { DPMI call structure }
  112.       EDI     : LongInt;
  113.       ESI     : LongInt;
  114.       EBP     : LongInt;
  115.       Reserved: LongInt;
  116.       EBX     : LongInt;
  117.       EDX     : LongInt;
  118.       ECX     : LongInt;
  119.       EAX     : LongInt;
  120.       Flags   : Word;
  121.       ES      : Word;
  122.       DS      : Word;
  123.       FS      : Word;
  124.       GS      : Word;
  125.       IP      : Word;
  126.       CS      : Word;
  127.       SP      : Word;
  128.       SS      : Word;
  129.     end;
  130.  
  131.  
  132.   Function GetMem(var Mem : MemPtr; Size : Word): Boolean;
  133.     begin
  134.       if (Size > 0) then
  135.       begin
  136.         LongInt(Mem) := GlobalDOSAlloc(Size);
  137.         GetMem := (LongInt(Mem) <> 0);
  138.       end
  139.  
  140.       else
  141.       begin
  142.         LongInt(Mem) := 0;
  143.         GetMem := True;
  144.       end;
  145.     end;
  146.  
  147.   Procedure FreeMem(Mem : MemPtr; Size : Word);
  148.     begin
  149.       if (Size > 0) then
  150.         GlobalDOSFree(Mem.Selector);
  151.     end;
  152.  
  153.   Function MakePtr(Mem : MemPtr): Pointer;
  154.     begin
  155.       MakePtr := Ptr(Mem.Selector, 0);
  156.     end;
  157.  
  158.  
  159.   var
  160.     Regs    : TRegisters;
  161.     DPMIRegs: TDPMIRegisters;
  162.  
  163.   begin
  164.     FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
  165.     DPMIRegs.EAX := $3500 + BTR_INT;
  166.     Regs.AX := $0300;
  167.     Regs.BL := $21;
  168.     Regs.BH := 0;
  169.     Regs.CX := 0;
  170.     Regs.ES := Seg(DPMIRegs);
  171.     Regs.DI := Ofs(DPMIRegs);
  172.     Intr(DPMI_INTR, Regs);
  173.  
  174.     if (DPMIRegs.EBX <> BTR_OFFSET) then
  175.     begin
  176.       Btrv := bNotLoaded;
  177.       EXIT;
  178.     end;
  179.  
  180.     { Allocate and initialize real mode storage for Btrieve }
  181.     { Btrieve call/return parameter block }
  182.     if not GetMem(pParams, SizeOf(BtrieveBuff)) then
  183.     begin
  184.       Btrv := bOutOfMemory;
  185.       EXIT;
  186.     end;
  187.  
  188.     { Status code }
  189.     if not GetMem(pStatus, SizeOf(Integer)) then
  190.     begin
  191.       FreeMem(pParams, SizeOf(BtrieveBuff));
  192.       Btrv := bOutOfMemory;
  193.       EXIT;
  194.     end;
  195.  
  196.     { position block }
  197.     if not GetMem(pPosBlock, 128) then
  198.     begin
  199.       FreeMem(pParams, SizeOf(BtrieveBuff));
  200.       FreeMem(pStatus, SizeOf(Integer));
  201.       Btrv := bOutOfMemory;
  202.       EXIT;
  203.     end;
  204.  
  205.     { data buffer }
  206.     if not GetMem(pDataBuff, DataLen) then
  207.     begin
  208.       FreeMem(pParams, SizeOf(BtrieveBuff));
  209.       FreeMem(pStatus, SizeOf(Integer));
  210.       FreeMem(pPosBlock, 128);
  211.       Btrv := bOutOfMemory;
  212.       EXIT;
  213.     end;
  214.  
  215.     { key buffer }
  216.     if not GetMem(pKeyBuff, 255) then
  217.     begin
  218.       FreeMem(pParams, SizeOf(BtrieveBuff));
  219.       FreeMem(pStatus, SizeOf(Integer));
  220.       FreeMem(pPosBlock, 128);
  221.       FreeMem(pDataBuff, DataLen);
  222.       Btrv := bOutOfMemory;
  223.       EXIT;
  224.     end;
  225.  
  226.     { Copy to transfer buffers }
  227.     if (DataLen > 0) then
  228.       Move(DataBuff, MakePtr(pDataBuff)^, DataLen);
  229.  
  230.     Move(PosBlock, MakePtr(pPosBlock)^, 128);
  231.  
  232.     if (KeyLen > 0) then
  233.       Move(KeyBuff,  MakePtr(pKeyBuff)^,  KeyLen);
  234.  
  235.     { Setup Btrieve call/return parameter block }
  236.     with BtrieveBuff(MakePtr(pParams)^) do
  237.     begin
  238.       USER_BUF_ADDR.Segment := pDataBuff.Segment;
  239.       USER_BUF_ADDR.Offset  := 0;
  240.       USER_BUF_LEN          := DataLen;
  241.       USER_FCB_ADDR.Segment := pPosBlock.Segment;
  242.       USER_FCB_ADDR.Offset  := 0;
  243.       USER_CUR_ADDR.Segment := USER_FCB_ADDR.Segment;
  244.       USER_CUR_ADDR.Offset  := 38;
  245.       USER_FUNCTION         := Op;
  246.       USER_KEY_ADDR.Segment := pKeyBuff.Segment;
  247.       USER_KEY_ADDR.Offset  := 0;
  248.       USER_KEY_LENGTH       := 255;        {assume its large enough}
  249.       USER_KEY_NUMBER       := KeyNumber;
  250.       USER_STAT_ADDR.SEGMENT:= pStatus.Segment;
  251.       USER_STAT_ADDR.OFFSET := 0;
  252.       XFACE_ID              := VAR_ID;
  253.     end;
  254.  
  255.  
  256.     { Use DPMI interface to issue real mode interrupt to call Btrieve }
  257.     FillChar(DPMIRegs, SizeOf(TDPMIRegisters), 0);
  258.     DPMIRegs.DS  := pParams.Segment;
  259.     DPMIRegs.EDX := 0;
  260.     Regs.AX := $0300;
  261.     Regs.BL := BTR_INT;
  262.     Regs.BH := 0;
  263.     Regs.CX := 0;
  264.     Regs.ES := Seg(DPMIRegs);
  265.     Regs.DI := Ofs(DPMIRegs);
  266.     Intr(DPMI_INTR, Regs);
  267.  
  268.     { Copy from transfer buffers }
  269.     if (DataLen > 0) then
  270.       Move(MakePtr(pDataBuff)^, DataBuff, DataLen);
  271.  
  272.     Move(MakePtr(pPosBlock)^, PosBlock, 128);
  273.  
  274.     if (KeyLen > 0) then
  275.       Move(MakePtr(pKeyBuff)^,  KeyBuff,  KeyLen);
  276.  
  277.     BTRV := Integer(MakePtr(pStatus)^);
  278.  
  279.     FreeMem(pParams, SizeOf(BtrieveBuff));
  280.     FreeMem(pStatus, SizeOf(Integer));
  281.     FreeMem(pPosBlock, 128);
  282.     FreeMem(pDataBuff, DataLen);
  283.     FreeMem(pKeyBuff, 255);
  284.   end;
  285. {$ENDIF}
  286.  
  287. end.
  288.  
  289.