Datatid 1999 #6/Datatid_1999-06.iso/internet/Tango352Promo/P.SQL/PTKPKG.1/BTRAPID.PAS

Pascal/Delphi Source File | 1997-06-12 | 58.5 KB | 1,773 lines

{*************************************************************************
**
**  Copyright 1982-1997 Pervasive Software Inc. All Rights Reserved
**
*************************************************************************}
{***********************************************************************
   BTRAPID.PAS
      This is the PASCAL unit for DOS Btrieve to be called by Borland Turbo
      PASCAL v5.x-6.0 and Borland PASCAL 7.0.


      You must define one of the following to your compiler in order to
      compile for a particular platform:

        BTI_DOS     - DOS Real Mode      ( 16-bit Applications )
        BTI_DOS_16P - DOS Protected Mode ( 16-bit Applications )

      Before your application can use this program, it must be compiled to
      a '.tpu' file for Real Mode or a '.tpp' file for Protected Mode.
      See the Borland documentation for how to create a
      '.tpu' or ',tpp' file.  Also, see 'btrsampd.pas' for a sample
      application which references 'btrapid.tpu'.

      This routine sets up the parameter block expected by Btrieve, and
      issues interrupt 7B.

      Calling procedure:

      STAT := BTRV( operation, positionBlock, dataBuffer, dataLen,
                    keyBuffer, keyNumber );

        where
          operation      - Btrieve Operation
          positionBlock  - pointer to 128-byte position block
          dataBuffer     - pointer to data buffer
          dataLen        - pointer to length in bytes of data buffer
          keyBuffer      - pointer to keyBuffer ( 255 bytes in size )
          KeyNumber      - key Number

      There should never be any string variables declared in the
      data or key records, because strings store an extra byte for
      the length, which affects the total size of the record.

      IMPORTANT
      ---------
      Pervasive Software Inc., invites you to modify this file
      if you find it necessary for your particular situation.  However,
      we cannot provide technical support for this module if you
      do modify it.

*****************************************************************************}
UNIT BTRAPID;

{*****************************************************************************

   Interface Section

*****************************************************************************}
INTERFACE

{$IFDEF BTI_DOS}
USES DOS,
     BTRCONST;
{$ENDIF}

{$IFDEF BTI_DOS_16P}
USES DOS,
     WINAPI,
     BTRCONST,                                       {Btrieve Constants Unit }
     BLOBHDR;                       {Btrieve Chunk Operations Constants Unit }
{$ENDIF}

FUNCTION BTRV(
                operation      : WORD;
            VAR positionBlock;
            VAR dataBuffer;
            VAR dataLength     : WORD;
            VAR keyBuffer;
                keyNumber      : INTEGER ) : INTEGER;


FUNCTION BTRVID(   operation      : WORD;
               VAR positionBlock;
               VAR dataBuffer;
               VAR dataLength     : WORD;
               VAR keyBuffer;
                   keyNumber      : INTEGER;
               VAR clientID    ): INTEGER;

{=============================================================================
 Constants defined for the BTRV() and BTRVID() functions.
=============================================================================}
CONST
  BTR_INTRPT            = $7B;                    { Btrieve interrupt vector }
  BTR_OFFSET            = $33;               { Btrieve offset within segment }
  VARIABLE_ID           = $6176;     { id for variable length records - 'va' }
  VERSION_OFFSET        = 0;
  REVISION_OFFSET       = 2;
  TYPE_OFFSET           = 4;
  VERSION_BUF_SIZE      = 5;
  BTRV_CODE             = 7;
  CLIENT_ID_SIZE        = 16;


{$IFDEF BTI_DOS_16P}
{============================================================================
 Data structure definitions for use with the protected mode BTRV and
 BTRVID functions.
============================================================================}
TYPE
                                { Definition for the Btrieve parameter block }
   BTR_PARMS = RECORD
      USER_BUF_ADDR:   LongInt;       { data buffer address                  }
      USER_BUF_LEN:    Word;          { data buffer length                   }
      USER_CUR_ADDR:   LongInt;       { currency block address               }
      USER_FCB_ADDR:   LongInt;       { file control block address           }
      USER_FUNCTION:   Word;          { Btrieve operation                    }
      USER_KEY_ADDR:   LongInt;       { key buffer address                   }
      USER_KEY_LENGTH: Byte;          { key buffer length                    }
      USER_KEY_NUMBER: ShortInt;      { key number                           }
      USER_STAT_ADDR:  LongInt;       { return status address                }
      XFACE_ID:        Word;          { language interface id                }
   end;

   {==========================================================================
   This structure defines the real mode data buffer that is sent to Btrieve.
   The DATA_BUF parameter is set up as one byte for reference.  Memory needs
   to be declared large enough for data buffers that will be returned.
   ==========================================================================}
   RMBUFF = RECORD
      XDATA:          BTR_PARMS;               { The Btrieve parameter block }
      STATUS:         Integer;                 { Btrieve Status              }
      POS_BLOCK:      Array [1..128] of Char;  { Position Block              }
      KEY_BUFFER:     Array [1..255] of Char;  { Key Buffer                  }
      DATA_BUF:       Byte;                    { Data Buffer                 }
   end;

                                   { Define pointer types that will be used. }
   RMBUFFPTR  = ^RMBUFF;
   BytePtr    = ^BYTE;
   LongIntPtr = ^LongInt;
   XTRACTRPTR = ^XTRACTR;
{$ENDIF}

{*****************************************************************************

   Implementation Section

*****************************************************************************}
IMPLEMENTATION


{$R-}    {Range checking off}
{$B+}    {Boolean complete evaluation on}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$V-}    {Strict var-string off}


{$IFDEF BTI_DOS}
{=============================================================================
   This section contains the Btrieve interface code for real mode
   applications.
=============================================================================}
FUNCTION BTRV(   operation      : WORD;
             VAR positionBlock;
             VAR dataBuffer;
             VAR dataLength     : WORD;
             VAR keyBuffer;
                 keyNumber      : INTEGER ): INTEGER;


TYPE
     ADDR32 = RECORD                                      { 32 bit address   }
        OFFSET:  Word;                                    { &&&old->integer  }
        SEGMENT: Word;                                    { &&&used->integer }
     END;

     BTR_PARMS = RECORD
        USER_BUF_ADDR:   ADDR32;                { data buffer address        }
        USER_BUF_LEN:    Word;                  { data buffer length         }
        USER_CUR_ADDR:   ADDR32;                { currency block address     }
        USER_FCB_ADDR:   ADDR32;                { file control block address }
        USER_FUNCTION:   Word;                  { Btrieve operation          }
        USER_KEY_ADDR:   ADDR32;                { key buffer address         }
        USER_KEY_LENGTH: Byte;                  { key buffer length          }
        USER_KEY_NUMBER: ShortInt;              { key number&&&old->BYTE     }
        USER_STAT_ADDR:  ADDR32;                { return status address      }
        XFACE_ID:        Integer;               { language interface id      }
     end;

VAR
     STAT:  Integer;                                     {Btrieve status code}
     XDATA: BTR_PARMS;                               {Btrieve parameter block}
     REGS:  DOS.REGISTERS;        {register structure used on interrrupt call}
     DONE:  Boolean;

BEGIN
     REGS.AX := $3500 + BTR_INTRPT;
     INTR ($21, REGS);
     IF (REGS.BX <> BTR_OFFSET) THEN          {make sure Btrieve is installed}
        STAT := 20
     ELSE
                                   { If Btrieve is installed, make the call. }
        BEGIN
           WITH XDATA DO
              BEGIN
                 USER_BUF_ADDR.SEGMENT  := SEG (dataBuffer);
                 USER_BUF_ADDR.OFFSET   := OFS (dataBuffer);
                 USER_BUF_LEN           := dataLength;
                 USER_FCB_ADDR.SEGMENT  := SEG (positionBlock);
                 USER_FCB_ADDR.OFFSET   := OFS (positionBlock);
                 USER_CUR_ADDR.SEGMENT  := USER_FCB_ADDR.SEGMENT;
                 USER_CUR_ADDR.OFFSET   := USER_FCB_ADDR.OFFSET+38;
                 USER_FUNCTION          := operation;
                 USER_KEY_ADDR.SEGMENT  := SEG (keyBuffer);
                 USER_KEY_ADDR.OFFSET   := OFS (keyBuffer);
                 USER_KEY_LENGTH        := 255;{keyBuffer must hold 255 bytes}
                 USER_KEY_NUMBER        := keyNumber;
                 USER_STAT_ADDR.SEGMENT := SEG (STAT);
                 USER_STAT_ADDR.OFFSET  := OFS (STAT);  { set status address }
                 XFACE_ID               := VARIABLE_ID;    { set language id }
              END;

           REGS.DX := OFS (XDATA);
           REGS.DS := SEG (XDATA);

           INTR (BTR_INTRPT, REGS);
           dataLength := XDATA.USER_BUF_LEN;
        END;
     BTRV := STAT;
END;

{*****************************************************************************
BTRVID
*****************************************************************************}
FUNCTION BTRVID( operation      : WORD;
             VAR positionBlock;
             VAR dataBuffer;
             VAR dataLength     : WORD;
             VAR keyBuffer;
                 keyNumber      : INTEGER;
             VAR clientID ): INTEGER;


TYPE
     ADDR32 = RECORD                                      { 32 bit address   }
        OFFSET:  Word;                                    { &&&old->integer  }
        SEGMENT: Word;                                    { &&&used->integer }
     END;

     PMPARMBLOCK = RECORD
        sign:           array[1..4] of char;
        flags:          LongInt;
        functionCode:   LongInt;
        pmSwitchStatus: LongInt;
        dataLength:     LongInt;
        dataPtr:        ADDR32;
     end;

     BTR_PARMS = RECORD
        USER_BUF_ADDR:   ADDR32;                { data buffer address        }
        USER_BUF_LEN:    Word;                  { data buffer length         }
        USER_CUR_ADDR:   ADDR32;                { currency block address     }
        USER_FCB_ADDR:   ADDR32;                { file control block address }
        USER_FUNCTION:   Word;                  { Btrieve operation          }
        USER_KEY_ADDR:   ADDR32;                { key buffer address         }
        USER_KEY_LENGTH: Byte;                  { key buffer length          }
        USER_KEY_NUMBER: ShortInt;              { key number&&&old->BYTE     }
        USER_STAT_ADDR:  ADDR32;                { return status address      }
        XFACE_ID:        Integer;               { language interface id      }
     end;

     TWO_POINTERS = RECORD
        xDataPtr:    ADDR32;
        clientIdPtr: ADDR32;
     end;

VAR

     btrieveVersionOkay: Boolean;                     { Btrieve Version Flag }
     versionOffset:      Byte;
     revisionOffset:     Byte;
     typeOffset:         Byte;
     done:               Boolean;
     typeP:              ^Byte;
     versionP:           ^Word;
     revisionP:          ^Byte;
     stat:               Integer;                      { Btrieve status code }
     XDATA:              BTR_PARMS;                { Btrieve parameter block }
     REGS:               DOS.REGISTERS;  {register struct for interrupt call }
     newParms:           PMPARMBLOCK;
     twoPointers:        TWO_POINTERS;

                                          { Btrieve Parameters for stat call }
     posBlockx: array[1..128] of char;
     dataBufx:  array[1..255] of char;
     keyBufx:   array[1..255] of char;
     dataLenx:  Word;
     keyNumx:   Word;

BEGIN
     stat := B_NO_ERROR;
     keyNumx := 0;
     btrieveVersionOKay := FALSE;

     REGS.AX := $3500 + BTR_INTRPT;
     INTR ($21, REGS);
     if (REGS.BX <> BTR_OFFSET) then        { make sure Btrieve is installed }
        stat := B_RECORD_MANAGER_INACTIVE
     else                          { If Btrieve is installed, make the call. }
       begin
          {==================================================================
           Check for correct versions of requester and engine.  This check is
           done only once per applicaton
          ==================================================================}
          if (btrieveVersionOkay = FALSE) then
            begin
              versionOffset  := VERSION_OFFSET;
              revisionOffset := REVISION_OFFSET;
              typeOffset     := TYPE_OFFSET;
              done           := FALSE;
              dataLenx       := SizeOf( dataBufx );

              stat := BTRV(
                        B_VERSION,
                        posBlockx,
                        dataBufx,
                        dataLenx,
                        keyBufx,
                        keyNumx );
              if ( stat = B_NO_ERROR ) then
                begin
                  while ( done = FALSE ) do
                    begin
                      revisionP := Ptr(
                                     Seg( dataBufx ),
                                     Ofs( dataBufx ) + REVISION_OFFSET );

                      versionP := Ptr(
                                    Seg(dataBufx),
                                    Ofs(dataBufx) + VERSION_OFFSET );
                      typeP := Ptr(
                                 Seg(dataBufx),
                                 Ofs(dataBufx) + typeOffset );

                      case ( typeP^ ) of

                          $78:  { 'N' }

                             begin { Must have requester ver. 6.16 or higher }
                                if ( versionP^ < 6 ) or
                                   ( ( versionP^ = 6 ) and ( revisionP^ < 16 ) ) then
                                  begin
                                    stat := B_RECORD_MANAGER_INACTIVE;
                                    done := TRUE;
                                  end;
                             end;


                           $68:  {'D'}
                              begin   { Must have engine version 6 or higher }
                                if versionP^ < 6 then
                                  begin
                                    stat := B_INVALID_INTERFACE;
                                    done := TRUE;
                                  end;
                              end;

                           0:
                              begin
                                done := TRUE;
                              end;

                      end;  { end case }

                      if ( done = FALSE ) then
                        begin
                          versionOffset := versionOffset + VERSION_BUF_SIZE;
                          revisionOffset := revisionOffset + VERSION_BUF_SIZE;
                          typeOffset := typeOffset + VERSION_BUF_SIZE;
                        end;

                    end; { end while }

                end
                else
                  stat := B_INVALID_INTERFACE;
            end;

       end;

     if ( stat = B_NO_ERROR ) then
       begin
         btrieveVersionOkay := TRUE;
         twoPointers.xdataPtr.SEGMENT := Seg( XDATA );
         twoPointers.xdataPtr.OFFSET  := Ofs( XDATA );
         twoPointers.clientIdPtr.SEGMENT := SEG( clientID );
         twoPointers.clientIdPtr.OFFSET  := OFS( clientID );
         newParms.sign := 'PMSW';
         newParms.flags := 0;
         newParms.functionCode := BTRV_CODE;
         newParms.dataLength := SizeOf( PMPARMBLOCK );
         newParms.dataPtr.SEGMENT := SEG( twoPointers );
         newParms.dataPtr.OFFSET  := OFS( twoPointers );

         {===================================================================
         Move user parameters to XDATA, the block where Btrieve expects them.
         ===================================================================}
         with XDATA do
           begin
             USER_BUF_ADDR.SEGMENT  := SEG( dataBuffer );
             USER_BUF_ADDR.OFFSET   := OFS( dataBuffer );
             USER_BUF_LEN           := dataLength;
             USER_FCB_ADDR.SEGMENT  := SEG( positionBlock );
             USER_FCB_ADDR.OFFSET   := OFS( positionBlock );
             USER_CUR_ADDR.SEGMENT  := USER_FCB_ADDR.SEGMENT;
             USER_CUR_ADDR.OFFSET   := USER_FCB_ADDR.OFFSET+38;
             USER_FUNCTION          := operation;
             USER_KEY_ADDR.SEGMENT  := SEG( keyBuffer );
             USER_KEY_ADDR.OFFSET   := OFS( keyBuffer );
             USER_KEY_LENGTH        := 255;    {keyBuffer must hold 255 bytes}
             USER_KEY_NUMBER        := keyNumber;
             USER_STAT_ADDR.SEGMENT := SEG( STAT );
             USER_STAT_ADDR.OFFSET  := OFS( STAT );       {set status address}
             XFACE_ID               := VARIABLE_ID;          {set language id}
           end;

         REGS.DX := OFS( newParms );
         REGS.DS := SEG( newParms );

         INTR( BTR_INTRPT, REGS );
         dataLength := XDATA.USER_BUF_LEN
       end;
     BTRVID := stat;
END;
{$ENDIF}



{$IFDEF BTI_DOS_16P}
{=============================================================================
   This section contains the Btrieve interface code for 16-bit protected mode
   applications.
=============================================================================}

{*
*****************************************************************************
**
**  Prototype:
**
**      FUNCTION GetRealModeBuffer(
**                      VAR protectedP:    Pointer;
**                      VAR realAddr:      LONGINT;
**                          requestedSize: LONGINT ): INTEGER;
**
**  Description:
**
**      This function returns a protected mode pointer and a real mode
**      pointer to a block of memory allocated in DOS real memory.
**      This memory is used for the Btrieve parameter block information.
**      When BTI_DOS_32B is defined, this function allocates DOS real
**      memory.  When BTI_DOS_32P is defined, this function uses a
**      DOS buffer that is preallocated by PharLap.
**
**  Preconditions:
**
**      None.
**
**  Parameters:
**
**      protectedP:         On output, protectedP is the protected mode
**        <output>          pointer to the real memory Btrieve parameter
**                          block.
**
**      realAddr:           On output, realAddr contains the real mode
**        <output>          pointer the Btrieve parameter block in DOS
**                          real memory.
**
**      requestedSize:      Contains the size of memory to allocate.
**        <input>
**
**
**  Return value:
**
**      B_NO_ERROR          GetRealModeBuffer is successful.
**
**      B_DATALENGTH_ERROR  If BTI_DOS_32B is defined, this status code is
**                          returned if the int386 call fails to allocate
**                          the DOS real memory block.
**
**                          If BTI_DOS_32P is defined, this status is
**                          returned when the requestedSize + dataLength
**                          is smaller than the size of the DOS buffer.
**                          As an enhancement to the interface, a call to
**                          _dx_dosbuf_set could be made to set the
**                          size of the PharLap DOS buffer before the call
**                          to _dx_dosbuf_get instead of relying on the
**                          default buffer size.
**
**  Globals:
**
**      None.
**
**  Called Functions:
**
**      GlobalDOSAlloc()
**
**  Comments:
**
**      None.
**
*****************************************************************************
*}
FUNCTION GetRealModeBuffer(
            VAR protectedP: Pointer;     { protected mode ptr to real memory }
            VAR realAddr: LONGINT;        { real mode pointer to real memory }
                requestedSize: LONGINT ): INTEGER;        { size to allocate }
var

   allocStatus: INTEGER;
   memBlock:    LONGINT;
   protSel:     WORD;
   realSeg:     WORD;

begin

   memBlock := GlobalDOSAlloc( requestedSize );

   if memBlock = 0 then
      allocStatus := B_DATALENGTH_ERROR
   else
      begin
         protSel := LoWord( memBlock );
         realSeg := HiWord( memBlock );

           { Make protected mode pointer using protected mode selector and }
           { offset zero                                                   }
         protectedP := Ptr( protSel, 0 );

           { Make real mode pointer with real mode segment and offset zero }
         realAddr := MakeLong( 0, realSeg );

         allocStatus := B_NO_ERROR;
      end;

   GetRealModeBuffer := allocStatus;

end;


{*
*****************************************************************************
**
**  Prototype:
**
**      PROCEDURE FreeRealModeBuffer( sel: WORD );
**
**
**  Description:
**
**      FreeRealModeBuffer frees the memory allocated by GetRealModeBuffer
**      when BTI_DOS_32B is defined.  For BTI_DOS_32P there is nothing to do.
**
**  Preconditions:
**
**      None.
**
**  Parameters:
**
**      sel:            Protected mode selector of the Real Mode buffer to
**        <input>       free.
**
**
**  Return value:
**
**      None.
**
**  Globals:
**
**      None.
**
**  Called Functions:
**
**      GlobalDOSFree()
**
**  Comments:
**
**      None.
**
*****************************************************************************
*}
PROCEDURE FreeRealModeBuffer( sel: WORD );

BEGIN
                       { Free real mode memory using protected mode selector }
    GlobalDOSFree( sel );

END;

{*
*****************************************************************************
**
**  Prototype:
**
**      FUNCTION BlobInputDBlen( xtractP: XTRACTRPTR )
**
**  Description:
**
**      Returns the size of the Chunk Extractors based on the signature
**      field.
**
**  Preconditions:
**
**      None.
**
**  Parameters:
**
**      XTRACTRPTR:             Pointer to the chunk extractor.
**        <input>
**
**
**  Return value:
**
**      Returns the number of bytes in the extractor descriptor.
**
**  Globals:
**
**      None.
**
**  Called Functions:
**
**      None.
**
**  Comments:
**
**      None.
**
*****************************************************************************
*}
FUNCTION BlobInputDBlen( xtractP: XTRACTRPTR ): Word;
VAR
   chunkSize:   Word;

BEGIN

   {*
   ** The size returned is based on the Signature field.
   *}

   if ( xtractP^.Signature and RECTANGLE_BIT ) > 0 then
      chunkSize := SizeOf (PUT_RECTANGLE)
   else
      chunkSize := (xtractP^.NumChunks * SizeOf( CHUNK_REC ))
                      + (2 * SizeOf(LongInt));
   BlobInputDBLen := chunkSize;

END;

{*
*****************************************************************************
**
**  Prototype:
**
**      FUNCTION VerifyChunk(
**                   userDB:            Pointer;
**                   bytesToProtect:    Word;
**                   ChunkP:            Pointer;
**                   ChunkLen:          Word;
**                   bytesDone:         Word;
**                   maxlen:            Word ): Word;
**
**  Description:
**
**      VerifyChunk makes sure the data will not overwrite the end of the
**      output buffer.  It also catches attempts to overwrite the
**      descriptors with the returned data.
**
**
**  Preconditions:
**
**      None.
**
**  Parameters:
**
**      userDB:                 pointer to the user's data buffer.
**        <input>
**
**      bytesToProtect:         Size of request buffer that must not be
**        <input>               overwritten with returned data.
**
**      ChunkP:                 Pointer to the chunk data.
**        <input>
**
**      ChunkLen:
**        <input>               Length of the chunk data.
**
**      bytesDone:              Number of bytes copied so far to user's
**        <input>               data buffer.
**
**      maxlen:                 Maximum length of the user's data buffer.
**        <input>
**
**
**  Return value:
**
**      B_NO_ERROR               Success
**
**      B_DATA_MESSAGE_TOO_SMALL Chunk cannot fit in the user's data buffer
**
**      B_INVALID_GET_EXPRESSION Chunk data overwrites chunk descriptors
**
**
**  Globals:
**
**      None.
**
**  Called Functions:
**
**      None.
**
**  Comments:
**
**      None.
**
*****************************************************************************
*}
FUNCTION VerifyChunk(
           userDB:              Pointer;
           bytesToProtect:      Word;
           ChunkP:              Pointer;
           ChunkLen:            Word;
           bytesDone:           Word;
           maxlen:              Word ):      Word;
VAR
  uNorm: LongInt;
  cNorm: LongInt;
  stat:  Word;

BEGIN
   {*
   **   Check for buffer overrun
   *}
   if ( bytesDone + ChunkLen > maxlen )  then
      stat := B_DATA_MESSAGE_TOO_SMALL
   else
     begin
       uNorm := MakeLong( Ofs( userDB^ ), Seg( userDB^ ) );
       cNorm := MakeLong( Ofs( ChunkP^ ), Seg( ChunkP^ ) );
       {*
       **   Check if chunk about to be written overlaps with the extractors
       *}
       if ( (cNorm + ChunkLen < uNorm) or (cNorm >= uNorm + bytesToProtect) ) then
         stat := 0
       else
         stat := B_INVALID_GET_EXPRESSION;
     end;

   VerifyChunk := stat;
END;

{*
*****************************************************************************
**
**  Prototype:
**
**      FUNCTIONn ProcessIndirect(
**                      reqB:           Pointer;
**                      usersDataBuf:   Pointer;
**                      maxlen:         Word;
**                      Action:         Integer;
**                  VAR bytesDone:      Word ): Word;
**
**  Description:
**
**      ProcessIndirect() copies data to/from the address of the
**      application's chunk data.
**
**  Preconditions:
**
**      None.
**
**  Parameters:
**
**      reqB:                   Protected-mode pointer to the data buffer
**        <input/output>        in the Btrieve parameter block in DOS real
**                              memory.
**
**      usersDataBuf:           Pointer to application's data buffer.
**        <input/output>
**
**      maxlen:                 Maximum length of application's data buffer.
**        <input>
**
**      Action:                 Type of action to take (See below)
**        <input>
**
**      bytesDone:              Number of bytes copied.
**        <input/output>
**
**
**  Action can be one of the following:
**
**  PREPROCESS_BLOBGET
**      Chunk extractor information is copied from the user's data buffer
**      to the data buffer in the Btrieve parameter block.  The request
**      type is changed to a direct data request so that we do not
**      have to mess with pointer conversions between real and protected
**      mode.  It also makes it easier for us to copy data to/from
**      real-mode request buffer and user's buffer when request is
**      pre/post processed.
**
**
**  POSTPROCESS_BLOBGET
**      Chunk data is copied from the Btrieve parameter block to the
**      application's address given in the chunk extractor information
**      (still in the application's data buffer)
**
**
**  PREPROCESS_BLOBPUT
**
**      Chunk extractor information is copied from the user's data buffer
**      to the data buffer in the Btrieve parameter block.  The request
**      type is changed from indirect to direct so that the application's
**      data can be copied into the Btrieve parameter block.
**
**  Return value:
**
**      B_NO_ERROR               Success
**
**      B_DATA_MESSAGE_TOO_SMALL Chunk cannot fit in the user's data buffer
**
**      B_INVALID_GET_EXPRESSION Chunk data overwrites chunk descriptors
**
**
**  Globals:
**
**      None.
**
**  Called Functions:
**
**      BlobInputDBlen()
**      VerifyChunk()
**
**  Comments:
**
**      None.
**
*****************************************************************************
*}
FUNCTION ProcessIndirect(
                reqB:           Pointer;
                usersDataBuf:   Pointer;
                maxlen:         Word;
                Action:         Integer;
            VAR bytesDone:      Word ): Word;

   { Used 'goto' label because Turbo Pascal 6.0 does not have 'break'. }
   LABEL         100;

VAR
   xtr:          ^PUT_XTRACTR;
   dataPtr:      Pointer;
   rectP:        ^PUT_RECTANGLE;
   iP:           ^CHUNK_REC;
   protected:    Word;    { size of req. buffer that must not be overwritten }
   len:          Word;                                { Len of current chunk }
   tmpLen:       Word;
   i, limit:     Word;                                             { Helpers }
   stat:         Word;
   pSeg, pOff:   Word;
   verifyLength: Word;
   chunkP:       PChar;
   src:          PChar;
   dest:         PChar;
   tmpP:         LongIntPtr;
   flags:        LongInt;
   rectangle:    Integer;

BEGIN
  len := 0;
  stat := B_NO_ERROR;

  if (Action = PREPROCESS_BLOBGET) or (Action = POSTPROCESS_BLOBGET) then
    dataPtr := Ptr( Seg( usersDataBuf^ ), Ofs( usersDataBuf^ ) + 4 )
  else
    dataPtr := usersDataBuf;

  xtr := dataPtr;
  bytesDone := BlobInputDBlen( XTRACTRPTR(xtr) );
  protected := bytesDone;

  rectangle := xtr^.Signature and RECTANGLE_BIT;
  if ( rectangle > 0 ) then
    begin
      rectP := dataPtr;
      limit := rectP^.NumRows
    end
  else
    limit := xtr^.NumChunks;

  case Action of

      PREPROCESS_BLOBGET:
        begin
          bytesDone := bytesDone + 4;
          tmpP  := usersDataBuf;
          Move( tmpP^, reqB^, SizeOf( LongInt ) );
          reqB := Ptr( Seg( reqB^ ), Ofs( reqB^ ) + 4 );

          Move( xtr^, reqB^, protected );                  { copy extractors }

          {*
          ** Change the request to a direct data request so that we do not
          ** have to mess with pointer conversions between real and protected
          ** mode.  It also makes it easier for us to copy data to/from
          ** real-mode request buffer and user's buffer when request is
          ** pre/post processed.
          *}

          Move( reqB^, flags, SizeOf( LongInt ) );
          flags := flags and not(INDIRECT_BIT);
          Move( flags, reqB^, SizeOf( LongInt ) );

                                        { bump pointer in server req. buffer }
          reqB := Ptr( Seg( reqB^ ), Ofs( reqB^ ) + protected );

        end;

      PREPROCESS_BLOBPUT:
        begin                                         { move over extractors }
          Move( xtr^, reqB^, protected );

          {*
          ** Change the request to a direct data request so that we do not
          ** have to mess with pointer conversions between real and protected
          ** mode.  It also makes it easier for us to copy data to/from
          ** real-mode request buffer and user's buffer when request is
          ** pre/post processed.
          *}

          Move( reqB^, flags, SizeOf( LongInt ) );
          flags := flags and not(INDIRECT_BIT);
          Move( flags, reqB^, SizeOf( LongInt ) );
                                        { bump pointer in server req. buffer }
          reqB := Ptr( Seg( reqB^ ), Ofs( reqB^ ) + protected );
        end;

      POSTPROCESS_BLOBGET:
        bytesDone := 0;
   end;

   if (Action = PREPROCESS_BLOBGET) then
     {*
     ** Zero bytesDone so that it can now accumulate the number of bytes
     ** expected to be returned, looking for status 97.  This is done by
     ** calling VerifyChunk who also catches attempts to overwrite the
     ** descriptors with the returned data.
     *}
     bytesDone := 0;

   {=========================================================================
   Tack the chunks together at the end of the request buffer.
   =========================================================================}
   {*
   ** iP is always initialized and maintained, but not used if chunk type
   ** is rectangle.
   *}
   iP := Addr(xtr^.Chunk);

   for i := 0 to limit - 1 do
     begin
       if ( rectangle > 0 ) then
         begin
                                                   { must be 16-bit number }
           if (rectP^.BytesPerRow and $ffff0000) > 0 then
             stat := B_INVALID_GET_EXPRESSION               { return error }
           else
             begin
               len := rectP^.BytesPerRow;
               chunkP := Ptr(
                           Seg( rectP^.dataP^ ),
                           Ofs( rectP^.dataP^ )
                             + (i * rectP^.AppDistanceBetweenRows) );
             end;
         end

       else   { random chunk }
         begin

           chunkP := iP^.dataP;

           if (iP^.ChunkLen and $ffff0000) > 0 then  { must be 16-bit number }
             begin
               stat := B_INVALID_GET_EXPRESSION;              { return error }
               goto 100;
             end
           else
             len := iP^.ChunkLen;

         end;

       case Action of
           POSTPROCESS_BLOBGET:
             begin
               src  := reqB;
               dest := chunkP;
             end;

           PREPROCESS_BLOBPUT:
             begin
               src  := chunkP;
               dest := reqB;
             end;
       end;

       {======================================================================
       Does the chunk about to be written overlap with the extractors?
       ======================================================================}
       if ( Action = POSTPROCESS_BLOBGET ) then
          verifyLength := $FFFF
       else
          verifyLength := maxlen;

       stat := VerifyChunk(
                 xtr,
                 protected,
                 chunkP,
                 len,
                 bytesDone,
                 verifyLength );
       if  stat = 0 then
         if (bytesDone >= maxlen) then           { Already consumed buffer ? }
            stat := B_DATA_MESSAGE_TOO_SMALL;

       if stat = 0 then
         begin
           if (Action <> PREPROCESS_BLOBGET) then
             {*
             ** Nothing to do yet for PREPROCESS BLOB_GET.  We're just here
             ** looking for trouble in the chunkLens, and counting up
             ** bytesDone.
             *}
             begin
               if len < (maxlen - bytesDone ) then
                 tmpLen := len
               else
                 tmpLen := maxlen - bytesDone;

               Move( src^, dest^, tmpLen );
             end;

           reqB := Ptr( Seg( reqB^ ), Ofs( reqB^ ) + len );
           bytesDone := bytesDone + len;

           iP := Ptr( Seg( iP^ ), Ofs( iP^ ) + SizeOf( CHUNK_REC ) );
         end
       else
         goto 100;

     end;  { end for loop }

100:
   ProcessIndirect := stat;
END;  {ProcessIndirect}

{*
*****************************************************************************
**
**  Prototype:
**
**      FUNCTION SetUpBTRVData(
**                     protectedP: RMBUFFPTR;
**                 VAR posBlock;
**                 VAR dataBuffer;
**                 VAR keyBuffer ): Integer ;
**
**  Description:
**
**      This function copies Btrieve parameter data from the users
**      application to the Btrieve parameter block in DOS real memory.
**      It checks the Btrieve function code and key number parameters
**      that are already in the parameter block to see if the operation
**      processes indirect chunk data.  If so, ProcessIndirect() is called
**      to process the indirect Btrieve chunk data.
**
**  Preconditions:
**
**      Real Mode Btrieve parameter block is already initialized with
**      Function code, Key Number, Data buffer length.
**
**  Parameters:
**
**      protectedP:    Protected mode pointer to the Btrieve parameter
**       <input/output> block (RMBUFF data structure).
**
**      posBlock:       Application's parameter block
**        <input>
**
**      dataBuffer:     Application's data buffer
**        <input>
**
**      keyBuffer:      Application's key buffer
**        <input>
**
**
**  Return value:
**
**      B_NO_ERROR      SetUpBTRVData() is successful.
**
**      B_DATA_MESSAGE_TOO_SMALL Chunk cannot fit in the user's data buffer.
**
**      B_INVALID_GET_EXPRESSION Chunk data overwrites chunk descriptors.
**
**
**  Globals:
**
**      None.
**
**  Called Functions:
**
**      BlobInputDBlen()
**      ProcessIndirect()
**
**  Comments:
**
**      None.
**
*****************************************************************************
*}
FUNCTION SetUpBTRVData(
               protectedP: RMBUFFPTR;
           VAR posBlock;
           VAR dataBuffer;
           VAR keyBuffer ): Integer ;
VAR
   functionCode: Integer;
   copyLen:      Word;
   stat:         Integer;
   xtr:          ^PUT_XTRACTR;
   pSeg, pOff:   Word;
   dataBufP:     Pointer;

BEGIN
   stat := B_NO_ERROR;

   dataBufP := ADDR( protectedP^.DATA_BUF );

   functionCode := protectedP^.XDATA.USER_FUNCTION mod S_WAIT_LOCK;
   copyLen  := protectedP^.XDATA.USER_BUF_LEN;
   if (functionCode = B_GET_DIRECT) and
      (protectedP^.XDATA.USER_KEY_NUMBER = GET_DRTC_XTRACTOR_KEY ) then
     begin
       xtr  := Ptr( Seg( dataBuffer ), Ofs( dataBuffer ) + 4 );

       if  (xtr^.Signature and INDIRECT_BIT) > 0 then
         begin
           stat := ProcessIndirect(
                     dataBufP,
                     Ptr(Seg(dataBuffer), Ofs(dataBuffer)),
                     protectedP^.XDATA.USER_BUF_LEN,
                     PREPROCESS_BLOBGET,
                     copyLen );
           if stat = B_NO_ERROR then
             { Data was already copied in ProcessIndirect, so set copyLen to 0 }
             copyLen := 0;
         end

       else                 { Only copy the extractors & the record address. }
         copyLen := BlobInputDBlen( XTRACTRPTR(xtr) ) + 4;

     end;

   if functionCode = B_CHUNK_UPDATE then
     begin

        xtr  := Ptr( Seg( dataBuffer ), Ofs( dataBuffer ) );

        if  (xtr^.Signature and INDIRECT_BIT) > 0 then
          begin
            stat := ProcessIndirect(
                      dataBufP,
                      Ptr( Seg(dataBuffer), Ofs(dataBuffer) ),
                      protectedP^.XDATA.USER_BUF_LEN,
                      PREPROCESS_BLOBPUT,
                      copyLen );
            if stat = 0 then
           { Data was already copied in ProcessIndirect, so set copyLen to 0 }
              copyLen := 0;
          end;
     end;


   if stat = B_NO_ERROR then
     begin
                        { copy application's data to Btrieve parameter block }
       Move( posBlock, protectedP^.POS_BLOCK, 128 );
       Move( dataBuffer, dataBufP^, copyLen );
       Move( keyBuffer, protectedP^.KEY_BUFFER, 255 );

     end;

   SetUpBTRVData := stat;

END; { SetUpBTRVData }


{*
*****************************************************************************
**
**  Prototype:
**
**      PROCEDURE RetrieveBTRVData(
**                      protectedP: RMBUFFPTR;
**                  VAR posBlock;
**                  VAR dataBuffer;
**                  VAR keyBuffer );
**
**  Description:
**
**      RetrieveBTRVData() copies data from the Btrieve parameter block
**      in DOS real memory to the application's data area.  When there
**      is indirection in the destination of the data, then
**      RetrieveBTRVData() calls ProcessIndirect() to pull the data out
**      of the parameter block and place it at the correct address.
**
**  Preconditions:
**
**      None.
**
**  Parameters:
**
**      protectedP:             Protected-mode pointer to the Btrieve
**        <input>               parameter block (RMBUFF data structure)
**                              which contains data from the last
**                              Btrieve call.
**
**      posBlock:               Application's position block.
**        <output>
**
**      dataBuffer:             Application's data buffer.
**        <output>
**
**      keyBuffer:              Application's data buffer.
**        <output>
**
**
**  Return value:
**
**      B_NO_ERROR               RetrieveBTRVData() is successful.
**
**      B_DATA_MESSAGE_TOO_SMALL Chunk cannot fit in the user's data buffer.
**
**      B_INVALID_GET_EXPRESSION Chunk data overwrites chunk descriptors.
**
**  Globals:
**
**      None.
**
**  Called Functions:
**
**      ProcessIndirect()
**
**  Comments:
**
**      None.
**
*****************************************************************************
*}
PROCEDURE RetrieveBTRVData(
                protectedP: RMBUFFPTR;
            VAR posBlock;
            VAR dataBuffer;
            VAR keyBuffer );
VAR
   BtrvFunction:   Word;
   ignoredDataLen: Word;
   getP:           ^GET_XTRACTR;
   dataBufP:       Pointer;

BEGIN

   BtrvFunction := protectedP^.XDATA.USER_FUNCTION mod S_WAIT_LOCK;

   if  (BtrvFunction = B_GET_DIRECT) and
       (protectedP^.XDATA.USER_KEY_NUMBER = GET_DRTC_XTRACTOR_KEY ) then
     begin

        getP := ADDR( dataBuffer );
        if (getP^.Signature and INDIRECT_BIT) > 0 then
          begin
            ProcessIndirect(
              Ptr( Seg(protectedP^.DATA_BUF), Ofs(protectedP^.DATA_BUF)),
              PTR( Seg(dataBuffer), Ofs(dataBuffer)),
              protectedP^.XDATA.USER_BUF_LEN,
              POSTPROCESS_BLOBGET,
              ignoredDataLen );
          end
        else
          begin
            dataBufP := Addr( protectedP^.DATA_BUF );
            Move( dataBufP^, dataBuffer, protectedP^.XDATA.USER_BUF_LEN );
          end
     end
   else
     begin
       dataBufP := Addr( protectedP^.DATA_BUF );
       Move( dataBufP^, dataBuffer, protectedP^.XDATA.USER_BUF_LEN );
     end;


   Move( protectedP^.POS_BLOCK, posBlock, 128 );
   Move( protectedP^.KEY_BUFFER, keyBuffer, 255 );

END; { RetrieveBTRVData }

{*****************************************************************************

BTRV

*****************************************************************************}

FUNCTION BTRV(   operation      : WORD;
             VAR positionBlock;
             VAR dataBuffer;
             VAR dataLength     : WORD;
             VAR keyBuffer;
                 keyNumber      : INTEGER ): INTEGER;

TYPE
   {*
   **  Real mode register structure used for call to DPMI services to
   **  issue real mode INT 7B.
   *}
   REALREGS = RECORD
      DI:       LongInt;
      SI:       LongInt;
      BP:       LongInt;
      reserved: LongInt;
      BX:       LongInt;
      DX:       LongInt;
      CX:       LongInt;
      AX:       LongInt;
      CPUflag:  Word;
      ES:       Word;
      DS:       Word;
      fs:       Word;
      gs:       Word;
      ip:       Word;
      cs:       Word;
      sp:       Word;
      ss:       Word;
   end;


VAR
     stat:         Integer;                            { Btrieve status code }
     REGS:         DOS.REGISTERS;{ register structure used on interrupt call }
     bufferSize:   LongInt;                       { Size of real mode memory }
     realPtr:      LongInt;          { Real mode pointer to real mode memory }
     protectedP:   RMBUFFPTR;   { protected mode pointer to real mode memory }
     realmodeRegs: REALREGS;

BEGIN

     {*
     ** Use DPMI services to get the real mode interrupt vector 7B to
     ** determine whether or not Btrieve is loaded.
     *}
     REGS.AX := $200;
     REGS.BX := BTR_INTRPT;
     INTR( $31, REGS );
     if ( REGS.DX <> BTR_OFFSET ) then      { make sure Btrieve is installed }
       stat := B_RECORD_MANAGER_INACTIVE     { Return error status to caller }
     else
       begin

         bufferSize := SizeOf( RMBUFF ) + dataLength;
         {*
         ** Call function GetRealModeBuffer to allocate DOS real memory for
         ** the Btrieve parameter block.
         *}
         stat := GetRealModeBuffer(
                   Pointer(protectedP),
                   realPtr,
                   bufferSize );

         if stat = B_NO_ERROR then
           begin

             {*
             ** Establish pointer links inside real mode buffer.
             *}

             protectedP^.XDATA.USER_CUR_ADDR  := realPtr +
                Ofs( protectedP^.POS_BLOCK ) - Ofs( protectedP^ ) + 38;

             protectedP^.XDATA.USER_FCB_ADDR  := realPtr +
                Ofs( protectedP^.POS_BLOCK ) - Ofs( protectedP^ );

             protectedP^.XDATA.USER_STAT_ADDR := realPtr +
                Ofs( protectedP^.STATUS ) - Ofs( protectedP^ );

             protectedP^.XDATA.USER_KEY_ADDR  := realPtr +
                Ofs( protectedP^.KEY_BUFFER ) - Ofs( protectedP^ );

             protectedP^.XDATA.USER_BUF_ADDR  := realPtr +
                Ofs( protectedP^.DATA_BUF ) - Ofs( protectedP^ );

             protectedP^.XDATA.XFACE_ID       := VARIABLE_ID;

             protectedP^.XDATA.USER_FUNCTION  := operation;
             protectedP^.XDATA.USER_BUF_LEN   := dataLength;

                                { use maximum key length since we don't know }
             protectedP^.XDATA.USER_KEY_LENGTH := 255;
             protectedP^.XDATA.USER_KEY_NUMBER := keyNumber;

             stat := SetUpBTRVData(
                       protectedP,         { pointer to real mode parm block }
                       positionBlock,      { application's position block    }
                       dataBuffer,         { application's data buffer       }
                       keyBuffer );        { application's key buffer        }

             if stat = B_NO_ERROR then
               begin

                 {============================================================
                 Make call to Btrieve using DPMI.
                 ============================================================}

                 REGS.AX := $300;
                 REGS.BX := BTR_INTRPT ;
                 {*
                 **   CX = Number of words to copy from protected-mode to
                 **   real-mode stack
                 *}
                 REGS.CX := 0;

                 {*
                 ** Initialize real mode segment registers for call to Btrieve
                 *}

                 FillChar( realmodeRegs, SizeOf( REALREGS ), 0 );

                 realmodeRegs.DS := HiWord( realPtr );
                 realmodeRegs.DX := LoWord( realPtr );
                 REGS.ES := Seg( realmodeRegs );
                 REGS.DI := Ofs( realmodeRegs );

                 INTR( $31, REGS );

                 dataLength := protectedP^.XDATA.USER_BUF_LEN;
                 stat := protectedP^.STATUS;

                 {============================================================
                 Copy data from protected mode back to user's data
                 ============================================================}
                 RetrieveBTRVData(
                   protectedP,
                   positionBlock,
                   dataBuffer,
                   keyBuffer );
               end;

             FreeRealModeBuffer( Seg( protectedP^ ) );

           end;
        end;
     BTRV := stat;
END; { BTRV }

{*****************************************************************************

BTRVID

*****************************************************************************}

FUNCTION BTRVID(   operation      : WORD;
               VAR positionBlock;
               VAR dataBuffer;
               VAR dataLength     : WORD;
               VAR keyBuffer;
                   keyNumber      : INTEGER;
               VAR clientID    ): INTEGER;


TYPE
     PMPARMBLOCK = RECORD
        sign:           array[1..4] of char;
        flags:          LongInt;
        functionCode:   LongInt;
        pmSwitchStatus: LongInt;
        dataLength:     LongInt;
        dataPtr:        LongInt;
     end;

     TWO_POINTERS = RECORD
        xDataPtr:    LongInt;
        clientIdPtr: LongInt;
     end;

     IDSTRUCT = RECORD
       newParms:      PMPARMBLOCK;
       twoPointers:   TWO_POINTERS;
       clientID:      array[1..CLIENT_ID_SIZE] of char;
       btrv:          RMBUFF;
     end;

   {*
   **  Real mode register structure used for call to DPMI services to
   **  issue real mode INT 7B.
   *}
   REALREGS = RECORD
      DI:       LongInt;
      SI:       LongInt;
      BP:       LongInt;
      reserved: LongInt;
      BX:       LongInt;
      DX:       LongInt;
      CX:       LongInt;
      AX:       LongInt;
      CPUflag:  Word;
      ES:       Word;
      DS:       Word;
      fs:       Word;
      gs:       Word;
      ip:       Word;
      cs:       Word;
      sp:       Word;
      ss:       Word;
   end;


VAR
     btrieveVersionOkay: Boolean;
     versionOffset:      Byte;
     revisionOffset:     Byte;
     typeOffset:         Byte;
     done:               Boolean;
     typeP:              ^Byte;
     versionP:           ^Word;
     revisionP:          ^Byte;
     stat:               Integer;                      { Btrieve status code }
     REGS:               DOS.REGISTERS; { register struct for interrupt call }
     bufferSize:         LongInt;                 { Size of real mode memory }
     realPtr:            LongInt;    { Real mode pointer to real mode memory }
     protectedP:         ^IDSTRUCT;  { protected-mode pointer to real memory }
     realmodeRegs:       REALREGS;            { real-mode register structure }
     newParms:           PMPARMBLOCK;
     twoPointers:        TWO_POINTERS;
     RMBTRVID:           IDSTRUCT;
                                          { Btrieve Parameters for stat call }
     posBlockx:          array[1..128] of char;
     dataBufx:           array[1..255] of char;
     keyBufx:            array[1..255] of char;
     dataLenx:           Word;
     keyNumx:            Word;

BEGIN
     stat := B_NO_ERROR;
     keyNumx := 0;
     btrieveVersionOkay := FALSE;
     {*
     ** Use DPMI services to get the real mode interrupt vector 7B to
     ** determine whether or not Btrieve is loaded.
     *}
     REGS.AX := $200;
     REGS.BX := BTR_INTRPT;
     INTR( $31, REGS );
     if ( REGS.DX <> BTR_OFFSET ) then      { make sure Btrieve is installed }
       stat := B_RECORD_MANAGER_INACTIVE     { Return error status to caller }
     else
       begin

         {==================================================================
         Set up the new parmeter block if version is 6.x or later.  Request
         the Btrieve version only once per program invocation.
         ==================================================================}
         if ( btrieveVersionOkay = FALSE ) then
           begin
              versionOffset  := VERSION_OFFSET;
              revisionOffset := REVISION_OFFSET;
              typeOffset     := TYPE_OFFSET;
              done           := FALSE;
              dataLenx       := SizeOf( dataBufx );

              stat := BTRV(
                        B_VERSION,
                        posBlockx,
                        dataBufx,
                        dataLenx,
                        keyBufx,
                        keyNumx );
              if ( stat = B_NO_ERROR ) then
                begin
                  while ( done = FALSE ) do
                    begin
                      revisionP := Ptr(
                                     Seg( dataBufx ),
                                     Ofs( dataBufx ) + REVISION_OFFSET );

                      versionP := Ptr(
                                    Seg(dataBufx),
                                    Ofs(dataBufx) + VERSION_OFFSET );
                      typeP := Ptr(
                                 Seg(dataBufx),
                                 Ofs(dataBufx) + typeOffset );

                      case ( typeP^ ) of


                          $78:  { 'N' }
                             begin { Must have requester ver. 6.16 or higher }
                                if ( versionP^ < 6 ) or
                                   ( ( versionP^ = 6 ) and ( revisionP^ < 16 ) ) then
                                  begin
                                    stat := B_RECORD_MANAGER_INACTIVE;
                                    done := TRUE;
                                  end;
                             end;


                           $68:  {'D'}
                              begin   { Must have engine version 6 or higher }
                                if versionP^ < 6 then
                                  begin
                                    stat := B_INVALID_INTERFACE;
                                    done := TRUE;
                                  end;
                              end;

                           0:
                              begin
                                done := TRUE;
                              end;

                      end;  { end case }

                      if ( done = FALSE ) then
                        begin
                          versionOffset := versionOffset + VERSION_BUF_SIZE;
                          revisionOffset := revisionOffset + VERSION_BUF_SIZE;
                          typeOffset := typeOffset + VERSION_BUF_SIZE;
                        end;

                    end; { end while }

                end
                else
                  stat := B_INVALID_INTERFACE;
           end;
       end;

     if ( stat = B_NO_ERROR ) then
       begin
         btrieveVersionOkay := TRUE;

         bufferSize := SizeOf( IDSTRUCT ) + dataLength;
         {*
         ** Call function GetRealModeBuffer to allocate DOS real memory for
         ** the Btrieve parameter block.
         *}
         stat := GetRealModeBuffer(
                   Pointer(protectedP),
                   realPtr,
                   bufferSize );

         if stat = B_NO_ERROR then
           begin

             {*
             ** Establish pointer links inside real mode buffer.
             *}

             protectedP^.twoPointers.xdataPtr := realPtr +
                           Ofs(protectedP^.btrv.XDATA) - Ofs( protectedP^ );

             protectedP^.twoPointers.clientIdPtr := realPtr +
                           Ofs( protectedP^.clientID ) - Ofs( protectedP^ );

             Move( clientID, protectedP^.clientID, CLIENT_ID_SIZE );
             protectedP^.newParms.sign  := 'PMSW';
             protectedP^.newParms.flags := 0;
             protectedP^.newParms.functionCode := BTRV_CODE;
             protectedP^.newParms.dataLength   := SizeOf( PMPARMBLOCK );
             protectedP^.newParms.dataPtr := realPtr +
                           Ofs( protectedP^.twoPointers) - Ofs( protectedP^ );

             protectedP^.btrv.XDATA.USER_CUR_ADDR  := realPtr +
                 Ofs( protectedP^.btrv.POS_BLOCK ) - Ofs( protectedP^ ) + 38;

             protectedP^.btrv.XDATA.USER_FCB_ADDR  := realPtr +
                 Ofs( protectedP^.btrv.POS_BLOCK ) - Ofs( protectedP^ );

             protectedP^.btrv.XDATA.USER_STAT_ADDR := realPtr +
                 Ofs( protectedP^.btrv.STATUS ) - Ofs( protectedP^ );

             protectedP^.btrv.XDATA.USER_KEY_ADDR  := realPtr +
                 Ofs( protectedP^.btrv.KEY_BUFFER ) - Ofs( protectedP^ );

             protectedP^.btrv.XDATA.USER_BUF_ADDR  := realPtr +
                 Ofs( protectedP^.btrv.DATA_BUF ) - Ofs( protectedP^ );

             protectedP^.btrv.XDATA.XFACE_ID       := VARIABLE_ID;

             protectedP^.btrv.XDATA.USER_FUNCTION  := operation;
             protectedP^.btrv.XDATA.USER_BUF_LEN   := dataLength;

                                { use maximum key length since we don't know }
             protectedP^.btrv.XDATA.USER_KEY_LENGTH := 255;
             protectedP^.btrv.XDATA.USER_KEY_NUMBER := keyNumber;

             stat := SetUpBTRVData(
                       PTR(Seg(protectedP^.btrv),Ofs(protectedP^.btrv)),
                       positionBlock,      { application's position block    }
                       dataBuffer,         { application's data buffer       }
                       keyBuffer );        { application's key buffer        }

             if stat = B_NO_ERROR then
               begin

                 {============================================================
                 Make call to Btrieve using DPMI.
                 ============================================================}

                 REGS.AX := $300;
                 REGS.BX := BTR_INTRPT ;
                 {*
                 **   CX = Number of words to copy from protected-mode to
                 **   real-mode stack
                 *}
                 REGS.CX := 0;

                 {*
                 ** Initialize real mode segment registers for call to Btrieve
                 *}

                 FillChar( realmodeRegs, SizeOf( REALREGS ), 0 );

                 realmodeRegs.DS := HiWord( realPtr );
                 realmodeRegs.DX := LoWord( realPtr );
                 REGS.ES := Seg( realmodeRegs );
                 REGS.DI := Ofs( realmodeRegs );

                 INTR( $31, REGS );

                 dataLength := protectedP^.btrv.XDATA.USER_BUF_LEN;
                 stat := protectedP^.btrv.STATUS;

                 {============================================================
                 Copy data from protected mode back to user's data
                 ============================================================}
                 RetrieveBTRVData(
                   PTR(Seg(protectedP^.btrv),Ofs(protectedP^.btrv)),
                   positionBlock,
                   dataBuffer,
                   keyBuffer );
               end;

             FreeRealModeBuffer( Seg( protectedP^ ) );

           end;
       end;
     BTRVID := stat;

END; { BTRVID }
{$ENDIF}    { protected mode BTRV and BTRVID }

{$B-}

END.