(*****************************************************************************)
(* MODULE: BTRTABLE*                                                         *)
(* RIGHTS: Reggatta Systems - COPYRIGHT 1995 - 2000                          *)
(* DESCR.: This module contains the table classes.                           *)
(*                                                                           *)
(*                                                                           *)
(* NOTES :                                                                   *)
(*                                                                           *)
(* TBtrTable:          This class is derived from the TBaseTable class and   *)
(*                     provides Btrieve record operations for the table.     *)
(*                                                                           *)
(* TDatabaseTable:     This class is derived from the TBaseTable class and   *)
(*                     provides for a table of database names.  This table   *)
(*                     simply provides one record that indicates Btrieve as  *)
(*                     the only database.                                    *)
(*                                                                           *)
(*                                                                           *)
(*****************************************************************************)
Unit BtrTable;
{$I BSE.INC}
{$I BAPI.INC}
Interface
Uses
  Classes,

  Windows,
  BDE,

  BseBapi,
  BseColl,
  BseTypes,
  BseTable,

  BtrTypes,
  BtrWObj,
  BtrIntrf;

Const
  MAX_BTR_BLOB_FIELDS = 16;

Type
  TBtrBlobRec =
  Record
    Field  : Integer;
    Dirty  : Boolean;
    Source : TMemoryStream;
  end;

{..$DEFINE BTRIEVE_NULLS}


Type
  TBtrBaseTable =
  Class( TBaseTable )
    Protected
      FPClientID : PBtrClientID;
    Public
      FBlobCount  : Integer;
      FBlobFields : Array[1..MAX_BTR_BLOB_FIELDS] of TBtrBlobRec;
      FOwner      : Array[0..WBTRV_OWNER_LENGTH] of Char;
      FFieldsResFlag : Boolean;
      FFieldsResName : DBITBLNAME;
      FIndexNames    : TStringList;
      Property ClientID : PBtrClientID
        Read  FPClientID
        Write FPCLientID;

      Constructor Create( P : TObject; Container : TTitanCollection; Name : PChar;
                    Index : Word; OMode : DBIOpenMode; Share : DBIShareMode; pClientID : PBtrClientID );

      Destructor Destroy; Override;

      Procedure   Clone( bReadOnly : Bool; bUniDirectional : Bool;
                          var hCurNew : hDBICur ); Override;

      Procedure   SetBlobFieldInfo;
      Procedure   HandleBlobChanges( pRecBuf : Pointer );
      Procedure   TestForBlob( iField : Integer; Fld : pFldDesc );
      Function    GetBlobFieldIndex( iField : Word ) : Word;

      Function    MapCmpToBtrieveOp( Action : TCmpType ) : SmallInt;

      Function    GetDriverBufferSize : Word; Virtual;
      Procedure   SetDriverBufferSize( NewSize : Word ); Virtual;

      Procedure   SetTableName( P : PChar ); Override;

      Procedure   MapPut( Dtype, DSize, DDec, LSize : SmallInt;
                     Src, Dest : Pointer ); Override;

      Function    TranslateCmp(
                    fldType       : Word;                   { Field Description Info }
                    fldInfo       : TFieldCacheItem;
                    CmpSize       : SmallInt;
                    IgnoreCase    : Boolean;
                    F1            : Pointer;
                    F2            : Pointer
                  ) : SmallInt; Override;

      Procedure   TranslateGet(
                    P             : TFieldCacheItem;          { Field Description Info }
                    pRecBuff      : Pointer;                  { Record buffer }
                    pDest         : Pointer;                  { Destination field buffer }
                    var bBlank    : Bool                      { Returned : is field blank }
                  ); Override;

      Procedure   TranslatePut(
                    P             : TFieldCacheItem;          { Field Description Info }
                    pRecBuff      : Pointer;                  { Record buffer }
                    pSrc          : Pointer                   { Source field buffer }
                  ); Override;

      Procedure   CompareBookMarks( pBookMark1, pBookMark2 : Pointer;
                    var CmpBkmkResult : CmpBkmkRslt ); Override;

      Function    BookMarkToKeyPtr( P : Pointer ) : Pointer; Override;

      Procedure   OpenBlob (                                { Open a blob for access }
                    pRecBuf       : Pointer;                { Record Buffer }
                    iField        : Word;                   { Field number (1..n) }
                    eOpenMode     : DBIOpenMode             { Open for Read or RW }
                  ); Override;

      Procedure   GetBlobSize (                             { Get Blob Size }
                    pRecBuf       : Pointer;                { Record Buffer }
                    iField        : Word;                   { Field number (1..n) }
                    var iSize     : Longint                 { returned size }
                  ); Override;

      Procedure  GetBlob (                                  { Read bytes from blob }
                   pRecBuf       : Pointer;                 { Record Buffer }
                   iField        : Word;                    { Field number of blob (1..n) }
                   iOffSet       : Longint;                 { Starting position   }
                   iLen          : Longint;                 { No of bytes to be read   }
                   pDest         : Pointer;                 { Destination }
                   var iRead     : Longint                  { Actual no of bytes read }
                 ); Override;

      Procedure   FreeBlob (                                { Free the blob }
                    pRecBuf       : Pointer;                { Record Buffer }
                    iField        : Word                    { Field number of blob (1..n) }
                  ); Override;

     Procedure   GetRecordWork (                            { Gets the current record using a bookmark }
                   eLock         : DBILockType;             { Optional lock request }
                   pRecBuff      : Pointer                  { Record buffer(client) }
                 ); Override;

     Procedure   UpdateRecordBufferSize(
                   pRecBuf       : Pointer;
                   T             : TFieldCacheItem;
                   iLen          : LongInt
                 ); Virtual;

     Procedure   PutBlob (                                  { Write bytes to blob }
                   pRecBuf       : Pointer;                 { Record Buffer }
                   iField        : Word;                    { Field number of blob (1..n) }
                   iOffSet       : Longint;                 { Starting position   }
                   iLen          : Longint;                 { No of bytes to put   }
                   pSrc          : Pointer                  { pntr to Source }
                 ); Override;

     Procedure   MakePermanent (                            { Make temporary table permanent }
                    pszName       : PChar;                  { Rename temporary table }
                    bOverWrite    : Bool                    { Overwrite existing file }
                 ); Override;

 end;


 TBtrTable =
 Class( TBtrBaseTable )
   Public
     FBtrDriver    : TWinBtr;
     FIndexHasACS  : Boolean;
     FIndexACS     : TACSSpec;

     Procedure   SetDriverBuffer( P : Pointer ); Override;
     Function    GetDriverHeaderSize : SmallInt; Override;
     Function    GetDriverBuffer : Pointer; Override;
     Function    GetBookMarkSize : Integer; Override;
     Function    GetDriverBufferSize : Word; Override;
     Procedure   SetDriverBufferSize( NewSize : Word ); Override;

     Procedure   InitTableStruct; Override;
     Procedure   DoneTableStruct; Override;
     Function    GetBufferSize : Word; Override;
     Property    Handle : TWinBtr
       Read  FBtrDriver;
     Procedure   GetNativeDesc( iField : Integer; Src : Pointer; P : pFldDesc;
                   Var LocType, LocSize : Word ); Override;

     Procedure   OpenTable; Override;
     Procedure   CloseTable; Override;

     Procedure   GetDDFInfo( var T : TFileDDF );

     Procedure   FirstRecordRaw; Override;
     Procedure   LastRecordRaw ; Override;
     Procedure   NextRecordRaw ; Override;
     Procedure   PrevRecordRaw ; Override;

     Procedure   GetBookMark( P : Pointer ); Override;
     Procedure   SetToBookmark( P : Pointer ); Override;
     Procedure   GetRecordWithBookMark( P, pRecBuff : Pointer; eLock : DBILockType ); Override;

     Procedure   InitKeyBuffer( var Buffer : TttKeyBuffer; iFields : Word; Action : TCmpType; IsGreater : Boolean );
     Procedure   GetRecordForKey ( bDirectKey : Bool; iFields, iLen : Word; pKey, pRecBuff : Pointer ); Override;
     Procedure   TestGetRecordForKeyResult( Action : SmallInt; iFields, iLen :
                    Word; Buff, pRecBuf : Pointer ); Virtual;

     Procedure   AcqTableLock (                            { Lock a table }
                   eLockType     : DBILockType             { Lock type }
                 ); Override;

     Procedure   RelTableLock (                            { Unlocks Table level locks }
                   bAll          : Bool;                   { True for all table level locks }
                   eLockType     : DBILockType             { Specific lock type }
                 ); Override;

     Procedure   RelRecordLockRaw; Override;
     
     Procedure   InsertRecord( eLock : DBILockType; pRecBuff : Pointer ); Override;
     Procedure   ModifyRecord( pRecBuff : Pointer; bFreeLock : Bool ); Override;
     Procedure   DeleteRecord( pRecBuff : Pointer ); Override;


     Procedure   GetSeqNo (                                { Get logical record number }
                   var iSeqNo    : Longint                 { Pointer to sequence number }
                 ); Override;

     Procedure   SetToSeqNo (                              { Position to a logical record number }
                   iSeqNo        : Longint                 { Sequence number }
                 ); Override;

     Procedure   GetRecordNo (                             { Position to Physical Rec# }
                   var iRecNo    : Longint                 { Physical record number }
                 ); Override;

     Procedure   SetToRecordNo (                           { Position to Physical Rec# }
                   iRecNo        : Longint                 { Physical record number }
                 ); Override;

     Procedure   GetCursorProps( var curProps : CURProps ); Override;
     Procedure   GetRecordCount( Var iRecCount : Longint ); Override;
     Procedure   SetKeyNumber( Key : Integer );
     Function    GetKeyNumber : Integer; 

     Procedure   ParseIndexName(
                   pszIndexName : PChar;
                   Var iIndexId : Word;
                   pszTrueName  : PChar
                 ); Override;

     Procedure   SwitchToIndex(
                   pszIndexName  : PChar;
                   pszTagName    : PChar;
                   iIndexId      : Word;
                   bCurrRec      : Bool
                 ); Override;

     Procedure   InitIndexInfo;

     Procedure   ExtractKeyPrecise(                        { Get the key value of current record }
                   pRecBuf       : Pointer;                { Record buffer (optional) }
                   pKeyBuf       : Pointer;                { Returned. Key bytes. }
                   iFields       : word;                   { # of Fields or 0 }
                   iLen          : word;                   { len of last field }
                   var iKeyLen   : word
                 ); Override;

     Procedure   SetToKeySpecial(                          { Set key condition }
                   Action        : TCmpType;               { Search condition (default is =) }
                   bDirectKey    : Bool;                   { Key is supplied directly }
                   iFields       : Word;                   { No of full fields to match }
                   iLen          : Word;                   { Partial key len of last field }
                   pBuff         : Pointer;                { Either Record buffer or Key itself }
                   pRetBuff      : Pointer                 { Return Buffer }
                 ); Override;

     Procedure   GetIndexDesc (                            { Get index properties }
                   iIndexSeqNo   : Word;                   { Index number }
                   var idxDesc   : IDXDesc                 { Returned index description }
                 ); Override;

     Procedure   GetIndexDescInternal (                    { Get index properties }
                   iIndexSeqNo   : Word;                   { Index number }
                   var idxDesc   : IDXDesc;                { Returned index description }
                   var DescFlags : TKeyDescFlagArray       { Flags for descending keys }
                 );

     Procedure   EmptyTableWork; Override;                 { Performs Delete }

     Procedure   AddIndex (                                { Add a new index }
                   var IdxDesc   : IDXDesc;                { Description of the index }
                   pszKeyviolName : PChar                  { Keyviol table name (optional) }
                 ); Override;

     Procedure   DeleteIndex (                             { Delete index }
                   pszIndexName  : PChar;                  { Index name }
                   pszIndexTagName : PChar;                { Index tagname (xbase MDX) }
                   iIndexId      : Word                    { Index number }
                 ); Override;

     Function    TranslateCmp(
                   fldType       : Word;                   { Field Description Info }
                   fldInfo       : TFieldCacheItem;
                   CmpSize       : SmallInt;
                   IgnoreCase    : Boolean;
                   F1            : Pointer;
                   F2            : Pointer
                 ) : SmallInt; Override;

     Procedure   LockRecord( eLock : DBILockType ); Override;

 end;


 TBtrTblListTable =
 Class( TBtrTable )
   Public
     Extended  : Bool;
     Wild      : PChar;
     System    : Bool;

     Function    GetBufferSize : Word; Override;

     Constructor Create( P : TObject; Container : TTitanCollection; Desc : pDbDesc;
                   E, S : Bool; W : PChar; pClientID : PBtrClientID );

     Procedure   GetNextRecord (                            { Find/Get the next record }
                   eLock         : DBILockType;             { Optional lock request }
                   pRecBuff      : Pointer;                 { Record buffer(client) }
                   pRecProps     : pRECProps                { Optional record properties }
                 ); Override;

     Procedure   GetNextRecordRaw( eLock : DBILockType; pRecBuff : Pointer ); Virtual;
 end;

 TResFieldListTable =
 Class( TBaseTable )
   Private
     FCount    : Word;
   Public
     Constructor Create( P : TObject; Container : TTitanCollection; pszTableName : PChar );
     Procedure   OpenTable; Override;
     Procedure   GetNextRecord (                            { Find/Get the next record }
                   eLock         : DBILockType;             { Optional lock request }
                   pRecBuff      : Pointer;                 { Record buffer(client) }
                   pRecProps     : pRECProps                { Optional record properties }
                 ); Override;
     Procedure   GetRecordCount( Var iRecCount : Longint ); Override;
 end;


 TBtrFieldListTable =
 Class( TBtrTable )
   Public
     Physical  : Bool;
     FCount    : Word;
     OwnerDDF  : TFileDDF;
{$IFDEF SMITHWARE_EXTENDED}
     Extended  : TWinBtr;
{$ENDIF SMITHWARE_EXTENDED}
     Function    GetBufferSize : Word; Override;

     Constructor Create( P : TObject; Container : TTitanCollection; Desc : pDbDesc;
                   PhysTypes : Bool; pClientID : pBtrClientID );
{$IFDEF SMITHWARE_EXTENDED}
     Destructor  Destroy; Override;
{$ENDIF SMITHWARE_EXTENDED}

     Procedure   GetNextRecord (                            { Find/Get the next record }
                   eLock         : DBILockType;             { Optional lock request }
                   pRecBuff      : Pointer;                 { Record buffer(client) }
                   pRecProps     : pRECProps                { Optional record properties }
                 ); Override;

     Procedure   GetNextRecordRaw( eLock : DBILockType; pRecBuff : Pointer ); Virtual;

     Procedure   TestGetRecordForKeyResult( Action : SmallInt; iFields, iLen :
                    Word; Buff, pRecBuf : Pointer ); Override;
     Procedure   GetRecordCount( Var iRecCount : Longint ); Override;
 end;


Implementation
Uses

  Forms,
  SysUtils,


  BseConst,
  BseUtils,
  BseErrs,
  BseRes,
  BseFilt,
  BseDbase,

  BtrConst,
  BtrConv,
  BtrBlob,
  BtrDbase,
  BtrErrs;


Constructor TBtrBaseTable.Create( P : TObject; Container : TTitanCollection; Name : PChar;
              Index : Word; OMode : DBIOpenMode; Share : DBIShareMode; pClientID : PBtrClientID );
begin
  ClientID    := pClientID;
  FIndexNames := TStringList.Create;
  Inherited Create( P, Container, Name, NIL, Index, OMode, Share );
end;


Destructor TBtrBaseTable.Destroy;
Var
  i : Integer;
begin
  For i := Low( FBlobFields ) to High( FBlobFields ) do
  begin
    With FBlobFields[ i ] do
      If ( Source <> NIL ) then
        Source.Free;
  end;
  Inherited Destroy;
  FIndexNames.Free;
end;


Function TBtrBaseTable.MapCmpToBtrieveOp( Action : TCmpType ) : SmallInt;
begin
  Case Action of
    cmpKeyGREATEREQ:
      Result := ISAM_GET_GREATER_OR_EQUAL;
    cmpKeyGREATER:
      Result := ISAM_GET_GREATER;
    cmpKeyLESS:
      Result := ISAM_GET_LESS_THAN;
    cmpKeyLESSEQ:
      Result := ISAM_GET_LESS_THAN_OR_EQUAL;
  else
    Result := ISAM_GET_EQUAL;
  end
end;


Procedure TBtrBaseTable.MapPut( DType, DSize, DDec, LSize : SmallInt;
            Src, Dest : Pointer );
begin
  BtrConv.MapPut( DType, DSize, DDec, LSize, Src, Dest );
end;



Function TBtrBaseTable.TranslateCmp(
           fldType       : Word;                   { Field Description Info }
           fldInfo       : TFieldCacheItem;
           CmpSize       : SmallInt;
           IgnoreCase    : Boolean;
           F1            : Pointer;
           F2            : Pointer
         ) : SmallInt;

  Function SetValue( P : Pointer ) : Double;
  var
    blank : Bool;
  begin
    Try
      With fldInfo do
        BtrConv.MapGet( LocalType, LocalSize, FieldUnits2, FieldLength, P, @Result, Blank );
    Except
      Result := 0.0;
    end;
  end;

Var
  V1  : Double;
  V2  : Double;
  tmp : Integer;
begin
  Result := 0;
  Case fldType of
    fldZSTRING:
      if ( FldInfo <> NIL ) and ( FldInfo.LocalType = btrFLDLSTRING ) then
      begin
        If IgnoreCase then
          tmp := StrLIComp( @ShortString( F1^ )[ 1 ], @ShortString( F2^ )[ 1 ], CmpSize )
        else
          tmp := StrLComp( @Shortstring( F1^ )[ 1 ], @ShortString( F2^ )[ 1 ],  CmpSize );
        If ( tmp < 0 ) then
          Result := -1
        else
          If ( tmp > 0 ) then
            Result := 1;
      end
      else
        Result := Inherited TranslateCmp( fldType, fldInfo, CmpSize, IgnoreCase, F1, F2 );
    fldDATE:
      begin
        Result := Inherited TranslateCmp( fldINT16, fldInfo, SizeOf( Word ), IgnoreCase,
                    @BtrieveDateType( F1^ ).Year, @BtrieveDateType( F2^ ).Year );
        if ( Result = 0 ) then
        begin
          Result := Compare( BtrieveDateType( F1^ ).Month, BtrieveDateType( F2^ ).Month, SizeOf( Byte ) );
          if ( Result = 0 ) then
            Result := Compare( BtrieveDateType( F1^ ).Day, BtrieveDateType( F2^ ).Day, SizeOf( Byte ) );
        end;
      end;
    fldTIME:
      begin
        Result := Compare( BtrieveTimeType( F1^ ).Hour, BtrieveTimeType( F2^ ).Hour, SizeOf( Byte ) );
        if ( Result = 0 ) then
        begin
          Result := Compare( BtrieveTimeType( F1^ ).Minute, BtrieveTimeType( F2^ ).Minute, SizeOf( Byte ) );
          if ( Result = 0 ) then
          begin
            Result := Compare( BtrieveTimeType( F1^ ).Second, BtrieveTimeType( F2^ ).Second, SizeOf( Byte ) );
            if ( Result = 0 ) then
              Result := Compare( BtrieveTimeType( F1^ ).Hundredth, BtrieveTimeType( F2^ ).Hundredth, SizeOf( Byte ) );
          end;
        end;
      end;
    fldFLOAT:
      begin
        If ( fldInfo <> NIL ) then
        begin
          V1 := SetValue( F1 );
          V2 := SetValue( F2 );
        end
        else
        begin
          V1 := Double( F1^ );
          V2 := Double( F2^ );
        end;
        If ( V1 < V2 ) then
          Result := -1
        else
          If ( V1 > V2 ) then
            Result := 1;
      end;
    else
      Result := Inherited TranslateCmp( fldType, fldInfo, CmpSize, IgnoreCase, F1, F2 );
  end;
end;


Procedure TBtrBaseTable.TranslateGet(
            P             : TFieldCacheItem;                 { Field descript }
            pRecBuff      : Pointer;                         { Record buffer }
            pDest         : Pointer;                         { Destination field buffer }
            var bBlank    : Bool                             { Returned : is field blank }
          );
begin
  bBlank := TRUE;
  ValidateParameter( pRecBuff );
  With P do
  begin
    Buffer := pRecBuff;
    BtrConv.MapGet( LocalType, LocalSize, FieldUnits2, FieldLength, Data, pDest, bBlank );
    if bBlank and Assigned( pDest ) then
      MoveZero( pDest^, GetBDEFieldBufferSize( FieldType, LocalType, FieldLength ) );
  end;
end;


Procedure TBtrBaseTable.TranslatePut(
            P             : TFieldCacheItem;                 { Field descript }
            pRecBuff      : Pointer;                         { Record buffer }
            pSrc          : Pointer                          { Source field buffer }
          );
begin
  If ( pSrc = NIL ) then
    MoveZero( P.Data^, P.LocalSize )
  else
    Inherited TranslatePut( P, pRecBuff, pSrc );
end;


Procedure TBtrBaseTable.CompareBookMarks( pBookMark1, pBookMark2 : Pointer;
            var CmpBkmkResult : CmpBkmkRslt );
Var
  pPos1 : LongInt;
  pPos2 : LongInt;
begin
  ValidateParameter( pBookMark1 );
  ValidateParameter( pBookMark2 );
  pPos1 := TBtrBookMark( pBookMark1^ ).Position;
  pPos2 := TBtrBookMark( pBookMark2^ ).Position;
  If ( pPos1 <> 0 ) and ( pPos2 <> 0 ) then
  begin
    { If the positions are equal, then we have the same record.        }
    If ( pPos1 = pPos2 ) then
      CmpBkMkResult := CMPEql
    else
    begin
      Inherited CompareBookMarks( pBookMark1, pBookMark2, CmpBkmkResult );
      { Handle the case where the positions are different, but the key }
      { values are the same, as with duplicate key values.  When this  }
      { happens, Titan simply compares the position values to return a }
      { greater or less than result.                                   }
      If ( CmpBkMkResult = CMPEql ) and ( not FKeyDesc.bUnique ) then
        If ( pPos1 < pPos2 ) then
          CmpBkMkResult := CMPLess
        else
          CmpBkMkResult := CMPGtr;
    end;
  end
  else
    Inherited CompareBookMarks( pBookMark1, pBookMark2, CmpBkmkResult );
end;


Function TBtrBaseTable.BookMarkToKeyPtr( P : Pointer ) : Pointer;
begin
  Result := @TBtrBookMark( P^ ).Buffer;
end;


Function ExtractToken( SearchStr, Source, Value : PChar; MaxSize : Word ) : Boolean;
var
  Token  : PChar;
  tmp    : PChar;
  Buffer : Array[0..255] of Char;
begin
  Result := FALSE;
  If Assigned( Source ) then
  begin
    StrLCopy( @Buffer, Source, SizeOf( Buffer ) - 1 );
    Token := StrPos( StrUpper( @Buffer ), SearchStr );
    if ( Token <> NIL ) then
    begin
      Token^ := #0;
      Inc( Token, StrLen( SearchStr ) );
      tmp := StrScan( Token, BAPI_FIELD_DELIM );
      if ( tmp <> NIL ) then
        MaxSize := Min( tmp - Token, MaxSize );
      tmp := Source;
      Inc( tmp, Token - Buffer );
      StrLCopy( Value, tmp, MaxSize );
      Result := TRUE;
    end;
  end;
end;


(*---------------------------------------------------------*)
(* This procedure extracts the table name from the string  *)
(* passed in P.  Titan supports the Btrieve Owner name     *)
(* embedded in the Table Name like:                        *)
(*                                                         *)
(* Certificates;OWNER:TITAN;...                            *)
(*                                                         *)
(* Where Certificates is the name of the Table             *)
(*   and TITAN is the Owner name passed to Btrieve.        *)
(*                                                         *)
(*---------------------------------------------------------*)
(*---------------------------------------------------------*)
(* This procedure extracts the table name from the string  *)
(* passed in P.  Titan supports the DDF Field info to be   *)
(* read from a windows resource as follows:                *)
(*                                                         *)
(* Certificates;RES:CUSTOM;....                            *)
(*                                                         *)
(* Where Certificates is the name of the Table             *)
(*   and CUSTOM is the Windows resource name.              *)
(*                                                         *)
(*---------------------------------------------------------*)
Procedure TBtrBaseTable.SetTableName( P : PChar );
Var
  tmp : Array[0..255] of Char;
begin
  if ( P <> NIL ) then
  begin
    ExtractToken( BAPI_OWNER_TOKEN, P, @FOwner, WBTRV_OWNER_LENGTH );
    FFieldsResFlag := ExtractToken( BAPI_RESOURCE_TOKEN, P, @FFieldsResName, Pred( SizeOf( DBITBLNAME ) ) );
    (* FFieldsResFlag := FALSE; *)
    StrLCopy( @Tmp, P, SizeOf( Tmp ) - 1 );
    CutString( @Tmp, BAPI_FIELD_DELIM );
    Inherited SetTableName( @Tmp );
  end;
end;


Function TBtrBaseTable.GetDriverBufferSize : Word;
begin
  Result := 0;
end;


Procedure TBtrBaseTable.SetDriverBufferSize( NewSize : Word );
begin
end;


(*---------------------------------------------------------*)
(* This function exists to handle the case where a cursor  *)
(* is cloned on a table that may have a owner name and/or  *)
(* a compiled DDF resource.                                *)
(*---------------------------------------------------------*)
Procedure TBtrBaseTable.Clone( bReadOnly : Bool; bUniDirectional : Bool;
            var hCurNew : hDBICur );
Var
  tmp         : Array[0..255] of Char;
  CursorProps : CurProps;
begin
  ValidateParameter( Parent );
  ValidateValue( ( Parent is TBaseDatabase ), DBIERR_INVALIDPARAM );
  StrLCopy( @tmp, TableName, SizeOf( tmp ) - 1 );
  (* Handle the Resource Token first *)
  If FFieldsResFlag then
  begin
    StrCat( @tmp, BAPI_RESOURCE_TOKEN );
    StrCat( @tmp, @FFieldsResName );
  end;
  (* Handle the Owner Name next *)
  If ( StrLen( @FOwner ) > 0 ) then
  begin
    StrCat( @tmp, BAPI_OWNER_TOKEN );
    StrCat( @tmp, @FOwner );
  end;
  TBaseDatabase( Parent ).OpenTable( @tmp, NIL, FIndexName, NIL,
    0, FOpenMode, FShareMode, xltNONE, bUniDirectional, NIL, hCurNew );
  ValidateParameter( hCurNew );
  TBaseTable( hCurNew ).GetCursorProps( CursorProps ); (* This is required to get Buffer Size right *)
end;


Procedure TBtrBaseTable.SetBlobFieldInfo;
var
  i   : Integer;
  T   : TFieldCacheItem;
begin
  { Reset Blob Field Info }
  FBlobCount := 0;
  MoveZero( FBlobFields, SizeOf( FBlobFields ) );
  For i := 1 to Fields.Count do
  begin
    T := Fields[ i ];
    TestForBlob( i, @T.Description );
  end;
end;


Procedure TBtrBaseTable.HandleBlobChanges( pRecBuf : Pointer );
Var
  iLen : Longint;
  fLen : LongInt;
  P    : PChar;
  T    : TFieldCacheItem;
  i    : Integer;
  Temp : TMemoryStream;
  ch   : Char;
begin
  If ( FBlobCount > 0 ) then
  begin
    For i := 1 to FBlobCount do
    begin
      T := Fields[ FBlobFields[ i ].Field ];
      Case T.FieldSubType of
        fldstMEMO:
          begin
            GetBlobSize( pRecBuf, FBlobFields[ i ].Field, iLen );
            fLen := T.FieldLength;
            if ( iLen < fLen ) then { NULL Required for SSQL to see the data }
            begin
              Inc( iLen ); { Add 1 for NULL }
              P := pRecBuf;
              Inc( P, T.DataOffset + iLen );
              P^ := #0;
            end;
            {----------------------------------------------------------}
            { Only if the field is the last field in the record should }
            { we adjust the length of the record buffer.               }
            {----------------------------------------------------------}
            If ( FBlobFields[ i ].Field = Fields.Count ) then
              SetDriverBufferSize( GetDriverBufferSize - ( fLen ) + iLen );
          end;
        fldstGRAPHIC,
        fldstBINARY:
          begin
            With FBlobFields[ i ] do
            begin
              If Dirty then
              begin
                if ( Source.Size > 0 ) then
                begin
                  Temp := TMemoryStream.Create;
                  Try
                    StreamtoBase64Stream( Source, Temp );
                    Ch := #0;
                    Temp.Write( Ch, Sizeof( Ch ) ); { Tack a null on }
                    iLen := Temp.Size;
                    if ( iLen > T.FieldLength ) then
                      ThrowException( DBIERR_INVALIDBLOBLEN );
                    P := T.Data;
                    Temp.Seek( 0, soFROMBEGINNING );
                    Temp.ReadBuffer( P^, iLen );
                  Finally
                    Temp.Free;
                  end;
                end
                else
                  iLen := 0;
                {----------------------------------------------------------}
                { Only if the field is the last field in the record should }
                { we adjust the length of the record buffer.               }
                { Thanks to Ralph Eisenbach for this fix.                  }
                {----------------------------------------------------------}
                If ( Field = Fields.Count ) then
                  UpdateRecordBufferSize( pRecBuf, T, iLen );
              end
              else
                iLen := 0;
              If ( Source <> NIL ) then
                Source.Clear;
              Dirty := FALSE;
            end;
          end;
      end;
    end;
  end;
end;


Procedure TBtrBaseTable.TestForBlob( iField : Integer; Fld : pFldDesc );
begin
  if ( Fld^.iSubType in [ fldstMEMO, fldstGRAPHIC, fldstBINARY ] ) then
  begin
    Inc( FBlobCount );
    with FBlobFields[ FBlobCount ] do
    begin
      Field  := iField;
      Source := NIL;
      Dirty  := FALSE;
    end;
  end;
end;


Function TBtrBaseTable.GetBlobFieldIndex( iField : Word ) : Word;
var
  i : Word;
begin
  If ( FBlobCount > 0 ) then
    For i := 1 to FBlobCount do
      If ( FBlobFields[ i ].Field = iField ) then
      begin
        Result := i;
        Exit;
      end;
  ThrowException( DBIERR_NOTABLOB );
end;


Procedure TBtrBaseTable.OpenBlob (                          { Open a blob for access }
           pRecBuf       : Pointer;                         { Record Buffer }
           iField        : Word;                            { Field number (1..n) }
           eOpenMode     : DBIOpenMode                      { Open for Read or RW }
         );
Var
  i : Word;
begin
  i := GetBlobFieldIndex( iField );
  with FBlobFields[ i ] do
  begin
    If ( Source = NIL ) then
      Source := TMemoryStream.Create;
    Source.Clear;
    Dirty := FALSE;
  end;
end;


{--------------------------------------------------------------------}
{ The Blob Code has been changed to leave off the NULL at the end of }
{ the blob. 4/10/96                                                  }
{--------------------------------------------------------------------}
Procedure TBtrBaseTable.GetBlobSize (                       { Get Blob Size }
           pRecBuf       : Pointer;                         { Record Buffer }
           iField        : Word;                            { Field number (1..n) }
           var iSize     : Longint                          { returned size }
         );
var
  T      : TFieldCacheItem;
  Q      : PChar;
  Temp   : TMemoryStream;
  i      : Word;
begin
  T := Fields[ iField ];
  T.Buffer := pRecBuf;
  Case T.FieldSubType of
    fldstMEMO:
      begin
        Q := T.Data;
        Inc( Q, Pred( T.FieldLength ) );
        Q^ := #0;
        Try
          iSize := StrLen( T.Data );
        Except
          iSize := 0;
        end;
        if ( iSize > T.FieldLength ) then
          iSize := T.FieldLength;
      end;
    fldstGRAPHIC,
    fldstBINARY:
      begin
        i := GetBlobFieldIndex( iField );
        with FBlobFields[ i ] do
        begin
          If not Dirty then
          begin
            Q := T.Data;
            Inc( Q, Pred( T.FieldLength ) );
            Q^ := #0;
            Try
              iSize := StrLen( T.Data );
            Except
              iSize := 0;
            end;
            If ( iSize > 0 ) then
            begin
              Temp := TMemoryStream.Create;
              Try
                Source.Clear;
                Temp.WriteBuffer( T.Data^, iSize );
                Try
                  Base64StreamtoStream( Temp, Source );
                  iSize := Source.Size;
                Except
                  on E:EConvertError do
                    iSize := 0;
                end;
              Finally
                Temp.Free;
              end;
            end;
          end
          else
            iSize := Source.Size;
        end;
      end;
  else
    ThrowException( DBIERR_INVALIDPARAM );
  end;
end;


Procedure TBtrBaseTable.GetBlob (                            { Read bytes from blob }
            pRecBuf       : Pointer;                         { Record Buffer }
            iField        : Word;                            { Field number of blob (1..n) }
            iOffSet       : Longint;                         { Starting position   }
            iLen          : Longint;                         { No of bytes to be read   }
            pDest         : Pointer;                         { Destination }
            var iRead     : Longint                          { Actual no of bytes read }
          );
var
  T      : TFieldCacheItem;
  i      : Word;
  P      : PChar;
  D      : PChar;
begin
  iRead  := 0;
  ValidateParameter( pDest );
  ValidateValue( ( iLen > 0 ), DBIERR_INVALIDPARAM );
  T := Fields[ iField ];
  ValidateValue( ( iOffset <= T.FieldLength ), DBIERR_INVALIDBLOBOFFSET );
  T.Buffer := pRecBuf;
  P := T.Data;
  Inc( P, iOffset );
  D := pDest;
  Case T.FieldSubType of
    fldstMEMO:
      begin
        i := StrLen( P );
        if ( i > 0 ) then
        begin
          if ( ( i + iOffset ) > T.FieldLength ) then
            i := T.FieldLength;
          if ( i > iLen ) then
            i := iLen;
          Move( P^, D^, i );
        end;
        If ( i < iLen ) then  { Fill the rest with zeros }
        begin
          Inc( D, i );
          MoveZero( D^, iLen - i );
        end;
        iRead := i;
        ThrowException( DBIERR_ENDOFBLOB );
      end;
    fldstGRAPHIC,
    fldstBINARY:
      begin
        MoveZero( D^, iLen );
        i := GetBlobFieldIndex( iField );
        with FBlobFields[ i ] do
        begin
          If not Dirty and ( Source.Size = 0 ) then
            GetBlobSize( pRecBuf, iField, iRead );
          Source.Seek( iOffset, soFROMBEGINNING );
          iRead := Source.Read( pDest^, iLen );
          If ( Source.Position >= Source.Size ) then
            ThrowException( DBIERR_ENDOFBLOB );
        end;
      end;
  else
    ThrowException( DBIERR_INVALIDPARAM );
  end;
end;


Procedure TBtrBaseTable.GetRecordWork(
           eLock     : DBILockType;
           pRecBuff  : Pointer
         );
var
  P : TBtrBookmark;
begin
  GetBookMark( @P );
  GetRecordWithBookmark( @P, pRecBuff, eLock );
end;


Procedure TBtrBaseTable.UpdateRecordBufferSize( pRecBuf : Pointer; T : TFieldCacheItem; iLen : LongInt );
var
  i : Word;
begin
  i := GetDriverBufferSize - ( T.FieldLength );
  Inc( i, iLen );
  SetDriverBufferSize( i );
end;


Procedure TBtrBaseTable.PutBlob (                           { Write bytes to blob }
           pRecBuf       : Pointer;                         { Record Buffer }
           iField        : Word;                            { Field number of blob (1..n) }
           iOffSet       : Longint;                         { Starting position   }
           iLen          : Longint;                         { No of bytes to put   }
           pSrc          : Pointer                          { pntr to Source }
         );
var
  T  : TFieldCacheItem;
  P  : PChar;
  i  : Word;
begin
  T := Fields[ iField ];
  T.Buffer := pRecBuf;
  P := T.Data;
  Case T.FieldSubType of
    fldstMEMO:
      begin
        FBlobFields[ GetBlobFieldIndex( iField ) ].Dirty := TRUE;
        If ( iLen + iOffset >= T.FieldLength ) then
          iLen := Pred( T.FieldLength ) - iOffset;
        Try
          Inc( P, iOffset );
          If ( pSrc <> NIL ) then
            Move( pSrc^, P^, iLen )
          else
            If ( iLen > 0 ) then
              MoveZero( P^, iLen );
          If ( iLen > 0 ) then
          begin
            Inc( P, iLen );
            Inc( iLen );
          end;
          P^ := #0;
          If ( iField = FFieldDescs.Count ) then
            UpdateRecordBufferSize( pRecBuf, T, iLen );
        Except
          ThrowException( DBIERR_INVALIDPARAM );
        end;
      end;
    fldstGRAPHIC,
    fldstBINARY:
      begin
        i := GetBlobFieldIndex( iField );
        with FBlobFields[ i ] do
        begin
          Dirty := TRUE;
          If ( iLen + iOffset > 0 ) then
          begin
            Source.Seek( iOffset, soFROMBEGINNING );
            if ( iLen > 0 ) then
              Source.WriteBuffer( pSrc^, iLen );
          end
          else
            Source.Clear;
        end;
      end;
  else
    ThrowException( DBIERR_INVALIDPARAM );
  end;
end;


Procedure TBtrBaseTable.FreeBlob (                          { Free the blob }
                    pRecBuf       : Pointer;                { Record Buffer }
                    iField        : Word                    { Field number of blob (1..n) }
                  );
Var
  i : Word;
begin
  i := GetBlobFieldIndex( iField );
  with FBlobFields[ i ] do
  begin
    If ( Source <> NIL ) then
      Source.Free;
    Source := NIL;
    Dirty  := FALSE;
  end;
end;


Procedure TBtrBaseTable.MakePermanent (                     { Make temporary table permanent }
           pszName       : PChar;                           { Rename temporary table }
           bOverWrite    : Bool                             { Overwrite existing file }
         );
Var
  FileDDF  : TFileDDF;
  FieldDDF : TFieldDDF;
  IndexDDF : TIndexDDF;
  H        : hDBIXact;
  S        : ShortString;
  i        : Word;
  FStartId : SmallInt;


  Function GetDDFPassword : PChar;
  begin
    If ( StrLen( TBaseDatabase( Parent ).Password ) > 0 ) then
      Result := @TBaseDatabase( Parent ).Password
    else
      Result := WBTRV_DDF_OWNER;
  end;


  Procedure HandleFileDDF;
  Var
    WinBtr : TWinBtr;
    tmp    : Array[0..255] of Char;
    S      : ShortString;
  begin
    WinBtr := TWinBtr.Create( ClientID );
    Try
      S := BuildPath( StrPas( WBTRV_TABLE_FILE ), StrPas( @TBaseDatabase( Parent ).Description.szPhyName ) ) + #0;
      WinBtr.Open( @S[ 1 ], GetDDFPassword, 0 );
      WinBtr.BufferAddress := @FileDDF;
      WinBtr.Last_Item;
      (* Populate fields *)
      Inc( FileDDF.Xf_ID );
      StrToSpacePaddedArray( @FileDDF.Xf_Name, pszName, SizeOf( FileDDF.Xf_Name ) );
      StrPCopy( @tmp, ExcludeTrailingBackSlash( ExtractFilePath( StrPas( FileName ) ) ) );
      If ( StrIComp( @tmp, @TBaseDatabase( Parent ).Description.szPhyName ) = 0 ) then
        S := ExtractFileName( StrPas( FileName ) )
      else
        S := StrPas( FileName );
      StrToSpacePaddedArray( @FileDDF.Xf_Location, UpperCase( S ), SizeOf( FileDDF.Xf_Location ) );
      FileDDF.Xf_Flags := 0;
      WinBtr.BufferAddress := @FileDDF;
      WinBtr.Insert_Item;
    Finally
      WinBtr.Free;
    end;
  end;


  Procedure HandleFieldDDF;
  Var
    WinBtr  : TWinBtr;
    i       : Integer;
    T       : TFieldCacheItem;
  begin
    WinBtr := TWinBtr.Create( ClientID );
    Try
      S := BuildPath( StrPas( WBTRV_FIELD_FILE ), StrPas( @TBaseDatabase( Parent ).Description.szPhyName ) ) + #0;
      WinBtr.Open( @S[ 1 ], GetDDFPassword, 0 );
      WinBtr.BufferAddress := @FieldDDF;
      WinBtr.Last_Item;
      FStartID := FieldDDF.Xe_ID;

      For i := 1 to Fields.Count do
      begin
        MoveZero( FieldDDF, SizeOf( FieldDDF ) );
        T := Fields[ i ];
        FieldDDF.Xe_File := FileDDF.Xf_ID;
        FieldDDF.Xe_ID   := FStartId + i;
        S := Pad( T.FieldName, SizeOf( FieldDDF.Xe_Name ) );
        Move( S[ 1 ], FieldDDF.Xe_Name, SizeOf( FieldDDF.Xe_Name ) );
        FieldDDF.Xe_DataType := T.FieldType;
        FieldDDF.Xe_Offset   := T.DataOffset;
        FieldDDF.Xe_Size     := T.FieldLength;
        FieldDDF.Xe_Dec      := T.FieldUnits1;
        WinBtr.BufferAddress := @FieldDDF;
        WinBtr.Insert_Item;
      end;

    Finally
      WinBtr.Free;
    end;
  end;

begin
  SaveChanges;
  TBaseDatabase( Parent ).BeginTran( xilREPEATABLEREAD, H );
  Try
    HandleFileDDF;
    HandleFieldDDF;
    TBaseDatabase( Parent ).EndTran( H, xendCOMMIT );
  Except
    TBaseDatabase( Parent ).EndTran( H, xendABORT );
    Raise;
  end;
end;



Procedure TBtrTable.InitTableStruct;
begin
  FBtrDriver := TWinBtr.Create( ClientID );
end;


Procedure TBtrTable.DoneTableStruct;
begin
  ValidateParameter( FBtrDriver );
  CloseTable;
  FBtrDriver.Free;
end;


Procedure TBtrTable.GetNativeDesc( iField : Integer; Src : Pointer; P : pFldDesc;
           Var LocType, LocSize : Word );
begin
  if Assigned( Src ) then
  begin
    MapFieldDDFToDBIFieldInfo( TFieldDDF( Src^ ), iField, P );
    With TFieldDDF( Src^ ) do
    begin
      LocType := Word( Xe_DataType );
      LocSize := Word( Xe_Size );
    end;
  end;
end;


Procedure TBtrTable.OpenTable;
var
  mode : ShortInt;
begin
  Inherited OpenTable;
  mode := NORMAL;
  if ( FShareMode = dbiOPENEXCL ) then
    mode := EXCLUSIVE
  else
    if ( FOpenMode = dbiREADONLY ) then
      mode := READ_ONLY;
  State := TblClosed;
  FBtrDriver.Open( FileName, @FOwner, mode );
  State := TblNoPos;
end;


Procedure TBtrTable.CloseTable;
begin
  Inherited CloseTable;
  Try
    FBtrDriver.Close;
  Except
    On E:EBtrieveEngineError do
      If ( E.NativeError <> ISAM_FILE_NOT_OPEN ) then
        Raise;
  end;
end;


Procedure TBtrTable.GetDDFInfo( var T : TFileDDF );
begin
  Move( FDriverHeader^, T, DriverHeaderSize );
end;


Procedure TBtrTable.GetBookMark( P : Pointer );
begin
  MoveZero( P^, BookMarkSize );
  With TBtrBookMark( P^ ) do
  begin
    Buffer   := FBtrDriver.KeyBuffer;
    Position := FBtrDriver.RecPosition;
    If FReRead then
      FBtrDriver.RecPosition := Position;
  end;
end;


Procedure TBtrTable.SetToBookmark( P : Pointer );
Var
  Buff  : Pointer;
  SType : TCmpType;
begin
  ValidateParameter( P );
  if ( TBtrBookMark( P^ ).Position <> 0 ) then
  begin
    { Try to get the record using the position...}
    Try
      FBtrDriver.RecPosition := TBtrBookMark( P^ ).Position;
      FBtrDriver.KeyBuffer   := TBtrBookMark( P^ ).Buffer;
      UpdateTableState;
      Exit;
    Except
      On E:EBtrieveEngineError do
       ;
    end;
  end;
  If RangeActive or FFilterActive then
    Buff := AllocMem( BufferSize )
  else
    Buff := NIL;
  Try
    SType := cmpKeyGREATEREQ;
    Repeat
      Try
        SetToKeySpecial( sType, TRUE, 0, 0, @TBtrBookMark( P^ ).Buffer, Buff );
        If RangeActive or FFilterActive then
        begin
          FLastDir := TblDirNext;
          TestRangeAndFilter( Buff );
        end;
        Break;
      Except
        on E:ETitanBoundryError do
        begin
          If ( SType <> cmpKeyLESSEQ ) then
            SType := cmpKeyLESSEQ
          else
          begin
            SetToBegin;
            Break;
          end;
        end;
      end;
    Until FALSE;
  Finally
    If RangeActive or FFilterActive then
      FreeMem( Buff, BufferSize );
  end;
end;


Procedure TBtrTable.GetRecordWithBookMark( P, pRecBuff : Pointer; eLock : DBILockType );
begin
  ValidateParameter( P );
  DriverBuffer := pRecBuff;
  LockRecord( eLock );
  Try
    FBtrDriver.Item_Direct( TBtrBookMark( P^ ).Position );
    FBtrDriver.KeyBuffer   := TBtrBookMark( P^ ).Buffer;
  Except
    On E:EBtrieveEngineError do
      begin
        if ( eLock <> dbiNOLOCK ) then
        begin
          { If we failed to get the lock, refresh the buffer }
          DriverBuffer := pRecBuff;
          FBtrDriver.Item_Direct( TBtrBookMark( P^ ).Position );
          Raise; {Thanks to Steve Belkin! 12/21/97}
        end
        else
          SetToKey( keySEARCHGEQ, TRUE, 0, 0, @TBtrBookMark( P^ ).Buffer );
      end;
  end;
  UpdateTableState;
end;


Function TBtrTable.GetBookMarkSize : Integer;
begin
  Result := SizeOf( TBtrBookMark );
end;


Procedure TBtrTable.FirstRecordRaw;
begin
  FBtrDriver.First_Item;
end;


Procedure TBtrTable.LastRecordRaw;
begin
  FBtrDriver.Last_Item;
end;


Procedure TBtrTable.NextRecordRaw;
begin
  FBtrDriver.Next_Item;
end;


Procedure TBtrTable.PrevRecordRaw;
begin
  FBtrDriver.Previous_Item;
end;


Function TBtrTable.GetDriverHeaderSize : SmallInt;
begin
  Result := SizeOf( TFileDDF );
end;


Function TBtrTable.GetDriverBuffer : Pointer;
begin
  Result := FBtrDriver.BufferAddress;
end;


Procedure TBtrTable.SetDriverBuffer( P : Pointer );
begin
  FBtrDriver.BufferAddress := P;
  FCurrentBuffer := P;
end;


Procedure TBtrTable.InitKeyBuffer( Var Buffer : TttKeyBuffer; iFields : Word; Action : TCmpType; IsGreater : Boolean );
Const
  MINDOUBLE   : Double = 5.0e-324;
  MAXDOUBLE   : Double = 1.7e+308;
  MAXWORD     = $FFFF;
  MAXSMALLINT =  32767;
  MINSMALLINT = -32768;
Var
  P : PChar;
  i : Integer;
begin
  P := @Buffer;
  for i := 1 to FKeyDesc.iFldsInKey do
  begin
    With FKeyDescendInfo[ i ] do
    begin
      If ( i > iFields ) then
      begin
        if ( flag = IsGreater ) then
        begin
          Case KeyType of
            fldUINT16:
              If ( Len = 1 ) then
                P^ := Chr( $FF )
              else
                Word( Pointer( P )^ )   := MAXWORD;
            fldINT16:
              SmallInt( Pointer( P )^ ) := MAXSMALLINT;
            fldUINT32:
              LongWord( Pointer( P )^ )  := High( LongWord );
            fldINT32:
              LongInt( Pointer( P )^ )  := MAXLONGINT;
            fldINT64:
	      Int64( Pointer( P )^ )    := High( Int64 );
            fldFLOAT:
              Double( Pointer( P )^ )   := MAXDOUBLE;
          else
            FillChar( P^, Len, Chr( $FF ) );
          end;
        end
        else
        begin
          Case KeyType of
            fldINT16:
              SmallInt( Pointer( P )^ ) := MINSMALLINT;
            fldINT32:
              Integer( Pointer( P )^ )  := 0 - MAXINT;
            fldINT64:
	      Int64( Pointer( P )^ )    := Low( Int64 );
            fldFLOAT:
              Double( Pointer( P )^ )   := MINDOUBLE;
          else
            MoveZero( P^, Len );
          end;
        end;
      end;
      Inc( P, Len );
    end;
  end;
  P^ := #0;
end;


Procedure TBtrTable.GetRecordForKey( bDirectKey : Bool; iFields, iLen : Word; pKey, pRecBuff : Pointer );
var
  Buff    : TttKeyBuffer;
  P       : Pointer;
  iKeyLen : word;
  Action  : SmallInt;
begin
  if not bDirectkey then
  begin
    InitKeyBuffer( Buff, iFields, cmpKeyEQUAL, TRUE );
    P := @Buff;
    ExtractKeyPrecise( pKey, P, iFields, iLen, iKeyLen );
    iKeyLen := FKeyDesc.iKeyLen;
  end
  else
  begin
    P := pKey;
    If ( iLen > 0 ) then
      iKeyLen := iLen
    else
      iKeyLen := FKeyDesc.iKeyLen;
    Move( P^, Buff, iKeyLen );
  end;
  If ( pRecBuff <> NIL ) then
    DriverBuffer := pRecBuff;
  If ( ( iFields > 0 ) and ( iFields < FKeyDesc.iFldsInKey ) ) or ( iLen > 0 ) then
    Action := ISAM_GET_GREATER_OR_EQUAL
  else
    Action := ISAM_GET_EQUAL;
  FBtrDriver.ClearKeyBuffer( FKeyDesc.iKeyLen );
  FBtrDriver.Find_Item_Special( Action, P, iKeyLen, FBtrDriver.KeyNumber );
  TestGetRecordForKeyResult( Action, iFields, iLen, @Buff, pRecBuff );
  UpdateTableState;
end;


Procedure TBtrTable.TestGetRecordForKeyResult( Action : SmallInt; iFields, iLen : Word;
           Buff, pRecBuf : Pointer );
var
  NewBuff : TttKeyBuffer;
  iResult : SmallInt;
begin
  If ( Action = ISAM_GET_GREATER_OR_EQUAL ) then
  begin
    If ( iFields > 0 ) or ( iLen > 0 ) then
    begin
      If ( iFields = 0 ) and ( iLen > 0 ) then
        Inc( iFields );
      NewBuff := FBtrDriver.KeyBuffer;
      CompareKeys( Buff, @NewBuff, iFields, iLen, iResult );
      if ( iResult <> 0 ) then
        ThrowBtrieveException( ISAM_KEYNOTFOUND );
    end;
  end;
  FLastDir := TblDirNext;
  TestRangeAndFilter( pRecBuf );
end;


Procedure TBtrTable.AcqTableLock (                          { Lock a table }
           eLockType     : DBILockType                      { Lock type }
         );
begin
  if ( eLockType <> dbiNOLOCK ) then
  begin
    If not FInTransact then
    begin
      FBtrDriver.BeginTransaction( TRANSACTIONSCONCURRENT );
      FInTransact := TRUE;
    end
    else
      ThrowBtrieveException( ISAM_FILE_IN_USE );
  end;
end;


Procedure TBtrTable.RelTableLock (                          { Unlocks Table level locks }
           bAll          : Bool;                            { True for all table level locks }
           eLockType     : DBILockType                      { Specific lock type }
         );
begin
  if ( eLockType <> dbiNOLOCK ) and FInTransact then
    FBtrDriver.EndTransaction;
  FInTransact := FALSE;
end;


Procedure TBtrTable.RelRecordLockRaw;
begin
  FBtrDriver.Unlock_Item;
end;


Procedure TBtrTable.InsertRecord( eLock : DBILockType; pRecBuff : Pointer );
Var
  i      : Integer;
  T      : TFieldCacheItem;
  bBlank : Bool;
  Buffer : Array[0..255] of Char;
begin
  DriverBuffer := pRecBuff;
  { We need to make sure that any string fields are filled with spaces }
  { when inserting records if StringPaddedSpaces = TRUE                }
  if STRINGPADDEDSPACES then
  begin
    For i := 1 to Fields.Count do
    begin
      T := Fields[ i ];
      If ( T.LocalType = btrFLDSTRING ) then
      begin
        TranslateGet( T, pRecBuff, NIL, bBlank );
        if bBlank then
        begin
          Buffer[ 0 ] := #0;
          TranslatePut( T, pRecBuff, @Buffer );
        end;
      end;
    end
  end;
  If ( FBlobCount > 0 ) then
    HandleBlobChanges( pRecBuff );
  FBtrDriver.Insert_Item;
  if ( eLock = dbiWRITELOCK ) then
    GetRecord( eLock, NIL, NIL );
  UpdateTableState;
end;


Procedure TBtrTable.ModifyRecord( pRecBuff : Pointer; bFreeLock : Bool );
begin
  DriverBuffer := pRecBuff;
  If ( FBlobCount > 0 ) then
    HandleBlobChanges( pRecBuff );
  FBtrDriver.Update_Item;
  if not ( bFreeLock ) then
    GetRecord( dbiWRITELOCK, NIL, NIL )
end;


Procedure TBtrTable.DeleteRecord( pRecBuff : Pointer );
begin
  DriverBuffer := pRecBuff;
  FBtrDriver.Delete_Item;
  State := TblOnCrack;
end;


Procedure TBtrTable.GetSeqNo (                              { Get logical record number }
           var iSeqNo    : Longint                          { Pointer to sequence number }
         );
var
  Recs    : Longint;
  Percent : Longint;
  Buffer  : Pointer;
begin
  iSeqNo := 0;
  Buffer := DriverBuffer;
  FBtrDriver.FindPercentage( TRUE, Percent );
  GetRecordCount( Recs );
  iSeqNo := Trunc( Recs * ( Percent / MAXBTRIEVEPERCENT ) );
  If ( iSeqNo > Recs ) then
    iSeqNo := Recs;
  Inc( iSeqNo );
  DriverBuffer := Buffer;
end;


Procedure TBtrTable.SetToSeqNo (                            { Position to a logical record number }
           iSeqNo        : Longint                          { Sequence number }
         );
var
  Recs    : Longint;
  Percent : Longint;
  Buffer  : Pointer;
begin
  Buffer := DriverBuffer;
  GetRecordCount( Recs );
  If ( iSeqNo >= Recs ) then
    Percent := MAXBTRIEVEPERCENT
  else
    Percent := Trunc( iSeqNo * ( MAXBTRIEVEPERCENT / Recs ) );
  FBtrDriver.GetByPercentage( TRUE, Percent );
  DriverBuffer := Buffer;
end;


Procedure TBtrTable.GetRecordNo (                           { Get Physical Rec# }
           var iRecNo        : Longint                      { Physical record number }
         );
begin
  iRecNo := FBtrDriver.RecPosition;
end;


Procedure TBtrTable.SetToRecordNo (                         { Position to Physical Rec# }
           iRecNo        : Longint                          { Physical record number }
         );
begin
  FBtrDriver.RecPosition := iRecNo;
end;


Procedure TBtrTable.GetCursorProps( var curProps : CURProps );
var
  rs : LongInt;
begin
  Inherited GetCursorProps( curProps );
  With curProps do
  begin
    StrCopy( @szName, TableName );                        { table name (no extension, if it can be derived) }
    GetFieldCount( iFields, iRecSize );
    { This code is intended to deal with tables that have variable length    }
    { records.  Since a DDF is required, the variable fields must be defined }
    { in the DDF, so we can use the sum of the field sizes to get the true   }
    { record size.  The buffer size needs to be set to the maximum record    }
    { we might possibly need.                                                }
    FBtrDriver.Record_Size( rs );                         { Record size (logical record) }
    if ( iRecSize > rs ) then
      FBtrDriver.BufferSize := iRecSize
    else
      If ( rs > iRecSize ) then
        iRecSize := rs;
    iRecBufSize     := iRecSize;                          { Record size (physical record) }

    iIndexes        := FBtrDriver.Indexes;                { Number of indexes }
    FBtrDriver.Page_Size( iBlockSize );                   { Physical file blocksize in K }
  end;
end;


Function TBtrTable.GetBufferSize : Word;
begin
  Result := FBtrDriver.BufferSize;
end;


Procedure TBtrTable.GetRecordCount( Var iRecCount : Longint );
begin
  If TRUERECORDCOUNT and ( FStartRange.Active or FEndRange.Active or FFilterActive )  then
    Inherited GetRecordCount( iRecCount )
  else
    iRecCount := FBtrDriver.Records;
end;


Procedure TBtrTable.SetKeyNumber( Key : Integer );
begin
  If ( Key <= FBtrDriver.Indexes ) then
  begin
    FBtrDriver.KeyNumber := ShortInt( Key );
    FIndexHasACS := FBtrDriver.IndexHasACS;
    If FIndexHasACS then
      FBtrDriver.GetIndexACS( @FIndexACS );
  end
  else
    ThrowBtrieveExceptionMsg( ISAM_INVALID_KEY_NO, IntToStr( Key ) );
end;


Function TBtrTable.GetKeyNumber : Integer;
begin
  Result := Integer( FBtrDriver.KeyNumber );
end;


Procedure TBtrTable.ParseIndexName(
           pszIndexName : PChar;
           Var iIndexId : Word;
           pszTrueName  : PChar
         );
Const
  FIELD_NAMES_INDEX_START = '@';
var
  S : ShortString;
  i : Integer;
begin
  S := StrPas( pszIndexName );
  i := FIndexNames.IndexOf( S );
  if ( i >= 0 ) then
  begin
    iIndexId := Word( i );
    Exit;
  end;
  If ( PosOfCh( FIELD_NAMES_INDEX_START, S ) = 0 ) then
  begin
    (* Index Name is currently shown as '0 - Field 1' etc *)
    (* So this code grabs the index from the beginning of *)
    (* the string.                                        *)
    (* Index names can also be 'key0', 'key1', etc.       *)
    i := PosOfCh( ' ', S );
    If ( i > 1 ) then
      S := Copy( S, 1, Pred( i ) );
    S := Strip( S );
    if ( Length( S ) > 0 ) then
      Val( S, iIndexId, i )
    else
      ThrowException( DBIERR_INVALIDINDEXNAME );
  end
  else
    Inherited ParseIndexName( pszIndexName, iIndexId, pszTrueName );
end;


Procedure TBtrTable.SwitchToIndex( pszIndexName, pszTagName : PChar;
           iIndexId : Word; bCurrRec : Bool );
var
  Rec : TBtrBookMark;
begin
  ValidateParameter( pszIndexName );
  ParseIndexName( pszIndexName, iIndexId, NIL );
  If bCurrRec then
  begin
    Try
      GetBookMark( @Rec );
    Except
      On E:EBtrieveEngineError do
        ThrowException ( DBIERR_NOCURRREC );
    end;
  end;
  ResetRange;
  SetKeyNumber( Integer( iIndexId ) );
  GetIndexDescInternal( iIndexId, FKeyDesc, FKeyDescendInfo );
  if BCurrRec then
    SetToBookmark( @Rec );
end;


Procedure TBtrTable.InitIndexInfo;
begin
  GetIndexDescInternal( 0, FKeyDesc, FKeyDescendInfo );
end;


Procedure TBtrTable.SetToKeySpecial(                        { Set key condition }
           Action        : TCmpType;                        { Search condition (default is =) }
           bDirectKey    : Bool;                            { Key is supplied directly }
           iFields       : Word;                            { No of full fields to match }
           iLen          : Word;                            { Partial key len of last field }
           pBuff         : Pointer;                         { Either Record buffer or Key itself }
           pRetBuff      : Pointer                          { Return Buffer }
         );
var
  Buff    : TttKeyBuffer;
  P       : PChar;
  T       : PChar;
  kLen    : word;
  i,j     : integer;
begin
  if ( iLen = 0 ) then
    kLen := FKeyDesc.iKeyLen
  else
    kLen := iLen;
  if ( kLen = 0 ) then
    kLen := SizeOf( TttKeyBuffer );
  InitKeyBuffer( Buff, iFields, Action, ( Action in [ cmpKeyGREATER, cmpKeyGREATEREQ ] ) );
  if not bDirectKey then
    ExtractKeyPrecise( pBuff, @Buff, iFields, iLen, kLen )
  else
  begin
    P    := pBuff;
    T    := @Buff;
    If ( iFields = 0 ) then
      iFields := FKeyDesc.iFldsInKey;
    for i := 1 to iFields do
    begin
      j := FKeyDescendInfo[ i ].Len;
      Move( P^, T^, j );
      Inc( P, j );
      Inc( T, j );
    end;
  end;
  DriverBuffer := CurrentBuffer;
  FBtrDriver.ClearKeyBuffer( FKeyDesc.iKeyLen );
  FBtrDriver.Find_Item_Special( MapCmpToBtrieveOp( Action ),
    @Buff, FKeyDesc.iKeyLen, FBtrDriver.KeyNumber );
  If ( pRetBuff <> NIL ) and ( CurrentBuffer <> NIL ) then
    Move( CurrentBuffer^, pRetBuff^, BufferSize );
  UpdateTableState;
end;


Procedure TBtrTable.ExtractKeyPrecise(                      { Get the key value of current record }
           pRecBuf       : Pointer;                         { Record buffer (optional) }
           pKeyBuf       : Pointer;                         { Returned. Key bytes. }
           iFields       : word;                            { # of Fields or 0 }
           iLen          : word;                            { len of last field }
           var iKeyLen   : word
         );
var
  i       : integer;
  MKey    : PChar;
  T       : TFieldCacheItem;
  bBlank  : bool;
  Buffer  : TttKeyBuffer;
  P       : PChar;
  tmpSize : Word;
begin
  if not Assigned( pRecBuf ) then
    PRecBuf := CurrentBuffer;
  MKey    := PChar( pKeyBuf );
  iKeyLen := 0;
  if ( iFields = 0 ) and ( iLen = 0 ) then
    iFields := FKeyDesc.iFldsinKey
  else
    if ( iFields = 0 ) and ( iLen > 0 ) then
      iFields := 1;

  (*-------------------------------------------------------------------*)
  (* The code below extracts field values out of the record buffer     *)
  (* and then writes them to a key buffer compatible with the Btrieve  *)
  (* key.  The key passed to Btrieve must be in native format and not  *)
  (* in BDE mapped data types.  For example, a Btrieve Data field maps *)
  (* to a Delphi Double type, which could not be used in a key passed  *)
  (* to Btrieve. The call to MapPut converts the data back to Btrieve  *)
  (* format.  All of this is required to handle cases where the data   *)
  (* file has junk data in the field.  For example, as Pascal String   *)
  (* field 10 characters long may have a current value which is 5      *)
  (* characters long.  The remaining 5 characters are undefined and    *)
  (* not always filled with the same value. TranslateGet takes care of *)
  (* these kinds of problems.                                          *)
  (*-------------------------------------------------------------------*)
  For i := 0 to Pred( iFields ) do
  begin
    T := Fields[ FKeyDesc.aiKeyFld[ i ] ];
    tmpSize := T.LocalSize;
    If ( FKeyDescendInfo[ Succ( i ) ].ActOffset = 0 ) then
    begin
      TranslateGet( T, PRecBuf, @Buffer, bBlank );
      If ( i = Pred( iFields ) ) and ( ilen > 0 ) then
      begin
        P := @Buffer;
        Inc( P, iLen );
        P^ := #0;
      end;
      if not bBlank then
      begin
        Try
          BtrConv.MapPut( T.LocalType, tmpSize, T.FieldUnits2, T.FieldLength, @Buffer, MKey );
        Except
          On E:EBtrieveEngineError do
            bBlank := TRUE;
        end;
      end;
      if bBlank then
        MoveZero( MKey^, tmpSize );
    end
    else
    begin
      With FKeyDescendInfo[ Succ( i ) ] do
      begin
        P := pRecBuf;
        Inc( P, Pred( ActOffset ) );
        If ( i = Pred( iFields ) ) and ( ilen > 0 ) then
          tmpSize := iLen
        else
          tmpSize := Len;
        Move( P^, MKey^, tmpSize );
      end;
    end;
    Inc( MKey,    tmpSize );
    Inc( iKeyLen, tmpSize );
  end;
end;


Procedure TBtrTable.GetIndexDescInternal(                   { Get index properties }
      iIndexSeqNo   : Word;                                 { Index number }
var   idxDesc       : IDXDesc;                              { Returned index description }
var   DescFlags     : TKeyDescFlagArray                     { Local flags for descending keys}
   );

  Procedure RangeOffset( Position : Word; pDesc : pFldDesc );
  var
    T    : TFieldCacheItem;
    Last : TFieldCacheItem;
    I    : Integer;

    Procedure ReturnFieldInfo;
    var
      S : ShortString;
    begin
      pDesc^ := Last.Description;
      S := '>' + Last.FieldName;
      StrPCopy( @pDesc^.szName, S );
    end;

  begin
    Last := NIL;
    For i := 1 to Fields.Count do
    begin
      T := Fields[ i ];
      If ( Position > T.DataOffset ) then
        Last := T
      else
      begin
        If ( Last = NIL ) then
          Last := T;
        ReturnFieldInfo;
        Exit;
      end;
    end;
    { If we can't find a field, could the last field suffice? }
    If ( Last <> NIL ) and ( ( Last.DataOffset + Last.FieldLength ) >= Position ) then
    begin
      ReturnFieldInfo;
      Exit;
    end;
    ThrowExceptionMsg( DBIERR_INVALIDIDXDESC, 'Table: ' + StrPas( TableName ) );
  end;

var
  idx     : word;
  Stats   : TFileSpecs;
  i       : word;
  Info    : TIndexDDF;
  part    : integer;
  Found   : Boolean;
  name    : ShortString;
  Desc    : FldDesc;
  KType   : Word;
  tmpW1   : Word;
  tmpW2   : Word;
  tmpW3   : Word;
begin
  MoveZero( idxDesc,   SizeOf( idxDesc   ) );
  MoveZero( DescFlags, SizeOf( DescFlags ) );
  if ( FBtrDriver.IsOpen ) then
  begin
    FBtrDriver.GetFileStats( Stats );
    If ( iIndexSeqNo = 0 ) and not FActualKeyDesc then
      iIndexSeqNo := GetKeyNumber;
    name  := '';
    Found := FALSE;
    idx   := 0;
    part  := 0;
    For i := Low( Stats.Keys ) to High( Stats.Keys ) do
    begin
      if ( idx = iIndexSeqNo ) then
      begin
        MoveZero( Info, SizeOf( Info ) );
        MoveZero( Desc, SizeOf( Desc ) );
        inc( part );
        With Stats.Keys[ i ] Do
        begin
          Try
            GetFieldFromOffset( Key_Position, Key_Length, @Desc );
          Except
            On E:ETitanEngineError do
            begin
              Try
                GetFieldFromOffset( Succ( Key_Position ), Key_Length, @Desc );
              Except
                On E:ETitanEngineError do
                begin
                  RangeOffset( Key_Position, @Desc );
                  DescFlags[ Part ].ActOffSet := Key_Position;
                end;
              end;
            end;
          end;
          Info.Xi_File              := TFileDDF( DriverHeader^ ).Xf_Id;
          Info.Xi_Number            := idx;
          Info.Xi_Flags             := key_flags;
          DescFlags[ Part ].Len     := Key_Length;
          { Need to map Btrieve key type into BDE type.  The Btrieve key type }
          { for a field in an index can be different from the field type      }
          { defined in the FIELD.DDF.                                         }
          MapBtrToDbi( Extended_Key, Key_Length, KType, tmpW1, tmpW2, tmpW3 );
          DescFlags[ Part ].KeyType := Integer( KType );
          if ( ( Info.Xi_Flags and BtrIdxDescending ) = BtrIdxDescending ) then
            DescFlags[ Part ].Flag := TRUE;
        end;
        MapIndexDDFToDBIIndexDesc( idxDesc, Info, Desc, Part );
        If ( FIndexNames.Count = 0 ) then
        begin
          if ( part > 1 ) then
            AddChar( Name, '+' )
          else
            Name := Format( '%2d - ', [ Stats.Keys[ i ].Key_number ] );
          Name  := Name + StrPas( Desc.szName );
        end;
        Found := TRUE;
      end;
      if ( ( Stats.Keys[ i ].Key_Flags and BtrIdxSegmented ) <> BtrIdxSegmented ) then
        Inc( idx );
      If ( idx > iIndexSeqNo ) then
      begin
        If ( FIndexNames.Count > 0 ) and ( iIndexSeqNo <= FIndexNames.Count ) then
          Name  := FIndexNames[ iIndexSeqNo ];
        if Found then
          StrPCopy( idxDesc.szName, Name );
        Break;
      end;
    end;
    if not Found then
      ThrowException( DBIERR_NOSUCHINDEX );
  end
  else
    ThrowBtrieveExceptionMsg( ISAM_FILE_NOT_OPEN, StrPas( TableName ) );
end;


Procedure TBtrTable.GetIndexDesc (                          { Get index properties }
      iIndexSeqNo   : Word;                                 { Index number }
var   idxDesc       : IDXDesc                               { Returned index description }
   );
var
  DescFlags : TKeyDescFlagArray;
begin
  GetIndexDescInternal( iIndexSeqNo, idxDesc, DescFlags );
end;


Procedure TBtrTable.EmptyTableWork;                         { Deletes all records }
Const
  BACKUP_EXTENSION = '.BAK';
  TEMP_EXTENSION   = '.TMP';
Var
  Path         : ShortString;
  Name         : ShortString;
  Ext          : ShortString;
  Hnd          : File;
  i            : Integer;
  OriginalFile : ShortString;
  BackUpFile   : ShortString;
  TempFile     : ShortString;
begin
  If CLONETABLEEMPTY then
  begin
    MoveZero( TempFile, SizeOf( TempFile ) );

    OriginalFile := StrPas( FileName );
    Path := ExtractFilePath( OriginalFile );
    Name := ExtractFileName( OriginalFile );
    Ext  := ExtractFileExt( OriginalFile );
    if ( Length( Ext ) > 0 ) then
      Name := Copy( Name, 1, Length( Name ) - Length( Ext ) );

    BackupFile := Path + Name + BACKUP_EXTENSION;
    TempFile   := Path + Name + TEMP_EXTENSION;

    FBtrDriver.CloneTable( @TempFile[ 1 ] );
    CloseTable;

    AssignFile( Hnd, BackupFile );                        { Erase any backup that might exist }
    {$I-} Erase( Hnd ); {$I+}
    i := IOResult;                                        { Don't care about result }

    AssignFile( Hnd, OriginalFile );
    {$I-} Rename( Hnd, BackupFile ); {$I+}                { Create a backup table }
    i := IOResult;
    If ( i = 0 ) then
    begin
      AssignFile( Hnd, TempFile );
      {$I-} ReName( Hnd, OriginalFile ); {$I+}            { Rename the temp table to the real one }
      i := IOResult;
      If ( i = 0 ) then
      begin
        AssignFile( Hnd, BackupFile );                    { if OK, then delete the backup }
        {$I-} Erase( Hnd ); {$I+}
      end
      else
      begin
        AssignFile( Hnd, BackupFile );                    { if not OK, try to put back the backup }
        {$I-} ReName( Hnd, OriginalFile ); {$I+}
      end;
      if ( IOResult = 0 ) then
      begin
        OpenTable;
        Exit;
      end;
    end;
  end;
  Inherited EmptyTableWork;
end;


Procedure TBtrTable.AddIndex (                              { Add a new index }
           var IdxDesc    : IDXDesc;                        { Description of the index }
           pszKeyviolName : PChar                           { Keyviol table name (optional) }
         );
Var
  Buffer : TFileSpecs;
  i      : Integer;
  T      : TFieldCacheItem;
begin
  MoveZero( Buffer, SizeOf( Buffer ) );
  For i := 0 to Pred( IdxDesc.iFldsInKey ) do
  begin
    T := Fields[ IdxDesc.aiKeyFld[ i ] ];
    With Buffer.Keys[ i ] do
    begin
      key_position := SmallInt( Succ( T.DataOffset ) );
      key_length   := SmallInt( T.LocalSize );
      Key_Flags    := btrIdxModifiable;
      If ( IdxDesc.iFldsInKey > 1 ) and ( i < Pred( IdxDesc.iFldsInKey ) ) then
        Key_Flags := ( Key_Flags or btrIdxSegmented );
      if not iDxDesc.bUnique then
        Key_Flags := ( Key_Flags or btrIdxDuplicates );
      if iDxDesc.bDescending then
        Key_Flags := ( Key_Flags or btrIdxDescending );
      if iDxDesc.bCaseInsensitive then
        Key_Flags := ( Key_Flags or btrIdxCaseInsensitive );
      extended_key  := Byte( T.LocalType );
    end;
  end;
  FBtrDriver.AddIndex( @Buffer.Keys, IdxDesc.iFldsInKey, IdxDesc.iIndexId );
  FIndexNames.Insert( IdxDesc.iIndexId, StrPas( @IdxDesc.szName ) );
end;


Procedure TBtrTable.DeleteIndex (                           { Delete index }
           pszIndexName  : PChar;                           { Index name }
           pszIndexTagName : PChar;                         { Index tagname (xbase MDX) }
           iIndexId      : Word                             { Index number }
         );
Var
  i : Integer;
begin
  ParseIndexName( pszIndexName, iIndexID, NIL );
  FBtrDriver.DropIndex( ShortInt( iIndexId ) );
  i := FIndexNames.IndexOf( pszIndexName );
  if ( i >= 0 ) then
    FIndexNames.Delete( i );
end;


Function TBtrTable.TranslateCmp(
           fldType       : Word;                            { Field Description Info }
           fldInfo       : TFieldCacheItem;
           CmpSize       : SmallInt;
           IgnoreCase    : Boolean;
           F1            : Pointer;
           F2            : Pointer
         ) : SmallInt;

  Procedure MapStrToACSStr( S : ShortString; P : PChar );
  var
    i : Integer;
  begin
    P^ := Chr( Length( S ) );
    Inc( P );
    for i := 1 to Length( S ) do
    begin
      P^ := FIndexACS.Table[ Byte( S[ i ] ) ];
      Inc( P );
    end;
  end;

  Procedure MapPCharToACSStr( S, P : PChar );
  begin
    While ( S^ <> #0 ) do
    begin
      P^ := FIndexACS.Table[ Byte( S^ ) ];
      Inc( P );
      Inc( S );
    end;
    P^ := #0;
  end;

Var
  S1  : Array[0..255] of Char;
  S2  : Array[0..255] of Char;
begin
  If ( fldType = fldZSTRING ) then
  begin
    If FIndexHasACS then
    begin
      if ( FldInfo <> NIL ) then
      begin
        MoveZero( S1, SizeOf( S1 ) );
        MoveZero( S2, SizeOf( S2 ) );
        If ( FldInfo.LocalType = btrFLDLSTRING ) then
        begin
          MapStrToACSStr( ShortString( F1^ ), @S1 );
          MapStrToACSStr( ShortString( F2^ ), @S2 );
        end
        else
        begin
          MapPCharToACSStr( F1, @S1 );
          MapPCharToACSStr( F2, @S2 );
        end;
        F1 := @S1;
        F2 := @S2;
      end;
    end;
  end;
  Result := Inherited TranslateCmp( fldType, fldInfo, CmpSize, IgnoreCase, F1, F2 );
end;


Procedure TBtrTable.LockRecord( eLock : DBILockType );
begin
  if ( eLock = dbiWRITELOCK ) then
    FBtrDriver.Lock_Item;
end;


Function TBtrTable.GetDriverBufferSize : Word;
begin
  Result := FBtrDriver.BufferSize;
end;


Procedure TBtrTable.SetDriverBufferSize( NewSize : Word );
begin
  FBtrDriver.VarBufferSize := NewSize;
end;



Constructor TBtrTblListTable.Create( P : TObject; Container : TTitanCollection;
              Desc : pDBDesc; E, S : Bool; W : PChar; pClientID : PBtrClientID );

  Function GetDDFPassword : PChar;
  begin
    If ( StrLen( TBaseDatabase( Parent ).Password ) > 0 ) then
      Result := @TBaseDatabase( Parent ).Password
    else
      Result := WBTRV_DDF_OWNER;
  end;

var
  tmp : ShortString;
begin
  tmp := TBtrDatabase( P ).BuildDDFName( WBTRV_TABLE_FILE ) + #0;
  Inherited Create( P, Container, @tmp[ 1 ], 0, dbiREADONLY, dbiOPENSHARED, pClientID );
  StrLCopy( @FBaseDesc.szFileName, TableName, SizeOf( FBaseDesc.szFileName ) - 1 );
  Extended  := E;
  Wild      := W;
  System    := S;
end;


Procedure TBtrTblListTable.GetNextRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
var
  size : word;
  Info : TFileDDF;
  buff : Shortstring;
begin
  GetNextRecordRaw( eLock, @Info );
  if Assigned( pRecBuff ) then
  begin
    size := SizeOf( FBaseDesc );
    With FBaseDesc Do
    begin
      Buff := ArrayToStrZ( Info.Xf_Name, SizeOf( Info.Xf_Name ) );
      StrLCopy( @szName, @Buff[ 1 ], Pred( SizeOf( szName ) ) );{ Table name(No extension or Dir) }
      Buff := ArrayToStrZ( Info.Xf_Location, SizeOf( Info.Xf_Location ) );
      StrLCopy( @szFileName, @Buff[ 1 ], Pred( SizeOf( szFileName ) ) );{ File name }
    end;

    If Extended then
    begin
      Inc( size, SizeOf( FExtDesc ) );
      With FExtDesc Do
        iRecSize := GetBufferSize;                          { Physical record size }
    end;
    Move( FBaseDesc, pRecBuff^, Size );
  end;
end;


Procedure TBtrTblListTable.GetNextRecordRaw( eLock : DBILockType; pRecBuff : Pointer );
var
  Info : TFileDDF;
begin
  Repeat
    Inherited GetNextRecord( eLock, @Info, NIL );
    if System then
      Break
    else
    begin
      if not ( ( Info.Xf_Flags and WBTRV_DICTIONARY_FLAG ) = WBTRV_DICTIONARY_FLAG ) then
        Break;
      {This Code does not address wildcards yet!}
    end;
  Until FALSE;
  if Assigned( pRecBuff ) then
    Move( Info, pRecBuff^, SizeOf( Info ) );
end;


Function TBtrTblListTable.GetBufferSize : Word;
begin
  Result := SizeOf( FBaseDesc );
  If Extended then
    Inc( Result, SizeOf( FExtDesc ) );
end;


Constructor TResFieldListTable.Create( P : TObject; Container : TTitanCollection;
               pszTableName : PChar );
var
  ResR    : TTblResReader;
  ResName : DBITBLNAME;
begin
  Inherited Create( P, Container, pszTableName, NIL, 0, dbiREADONLY, dbiOPENSHARED );
  ExtractToken( BAPI_RESOURCE_TOKEN, pszTableName, @ResName, Pred( SizeOf( DBITBLNAME ) ) );
  FCount := 1;
  ResR   := TTblResReader.CreateWithTitan( Self );
  Try
    ResR.ReadResource( StrPas( ResName ) );
  Finally
    ResR.Free;
  end;
end;


Procedure TResFieldListTable.GetNextRecord (                { Find/Get the next record }
           eLock         : DBILockType;                     { Optional lock request }
           pRecBuff      : Pointer;                         { Record buffer(client) }
           pRecProps     : pRECProps                        { Optional record properties }
         );
begin
  If ( FCount < FFieldDescs.Count ) then
  begin
    Inc( FCount );
    If ( pRecBuff <> NIL ) then
      Move( Fields[ FCount ].Description, pRecBuff^, SizeOf( FldDesc ) );
  end
  else
    ThrowEOFException;
end;


Procedure TResFieldListTable.OpenTable;
begin
  If ( FFieldDescs.Count = 0 ) then
    ValidateParameter( NIL );
  FCount := 0;
end;


Procedure TResFieldListTable.GetRecordCount( Var iRecCount : Longint );
begin
  iRecCount := FFieldDescs.Count;
end;


Constructor TBtrFieldListTable.Create( P : TObject; Container : TTitanCollection;
              Desc : pDBDesc; physTypes : Bool; pClientID : PBtrClientID );
var
  S  : ShortString;
  i  : Integer;
begin
  S := TBtrDatabase( P ).BuildDDFName( WBTRV_FIELD_FILE ) + #0;
  Inherited Create( P, Container, @S[ 1 ], 0, dbiREADONLY, dbiOPENSHARED, pClientID );
  StrLCopy( FileName, TableName, DBIMAXTBLNAMELEN );
  FCount    := 0;
  Physical  := PhysTypes;
  Extended  := NIL;
{$IFDEF SMITHWARE_EXTENDED}
  S  := TBtrDatabase( Parent ).BuildDDFName( WBTRV_EXTFIELD_FILE );
  i := Pos( BAPI_OWNER_TOKEN, S );
  If ( i > 2 ) then
    S := Copy( S, 1, Pred( i ) );
  If FileExists( S ) then
  begin
    Extended := TWinBtr.Create( ClientID );
    if Assigned( Extended ) then
    begin
      AddChar( S, #0 );
      Extended.Open( @S[ 1 ], @FOwner, READ_ONLY );
    end;
  end;
{$ENDIF SMITHWARE_EXTENDED}
end;

{$IFDEF SMITHWARE_EXTENDED}
Destructor TBtrFieldListTable.Destroy;
begin
  If ( Extended <> NIL ) then
    Extended.Free;
  Inherited Destroy;
end;
{$ENDIF SMITHWARE_EXTENDED}


Procedure TBtrFieldListTable.GetNextRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
var
  Info : TFieldDDF;
begin
  GetNextRecordRaw( eLock, @Info );
  if Assigned( pRecBuff ) then
  begin
    MapFieldDDFToDBIFieldInfo( Info, FCount, pRecBuff );
    Inc( FCount );
  end;
end;


Procedure TBtrFieldListTable.GetNextRecordRaw( eLock : DBILockType; pRecBuff : Pointer );
var
  Info    : PFieldDDF;
{$IFDEF SMITHWARE_EXTENDED}
  ExtInfo : TExtFieldDDF;
{$ENDIF SMITHWARE_EXTENDED}
begin
  ValidateParameter( pRecBuff );
  Info := PFieldDDF( pRecBuff );
  if ( State = TblNoPos ) then
    GetRecordForKey( TRUE, 0, SizeOf( OwnerDDF.Xf_Id ), @OwnerDDF.Xf_Id, pRecBuff )
  else
    Inherited GetNextRecord( eLock, pRecBuff, NIL );

  (*------------------------------------------------------------------*)
  (* This code is included to deal with nasty DDF builders that don't *)
  (* Delete records from the FIELD.DDF.  They instead set the field   *)
  (* length to zero which was causing problems here.                  *)
  (*------------------------------------------------------------------*)
  Repeat
    if ( Info^.Xe_File = OwnerDDF.Xf_Id ) then
    begin
      if ( Info^.Xe_Size = 0 ) and ( Info^.Xe_Datatype <> btrfldNAMEDINDEX ) then
        Inherited GetNextRecord( eLock, pRecBuff, NIL )
      else
        Break;
    end
    else
      ThrowEOFException;
  Until FALSE;

{$IFDEF SMITHWARE_EXTENDED}
  if Assigned( Extended ) and ( Extended.IsOpen ) then
  begin
    Case Info^.Xe_DataType of
      btrFldSTRING,
      btrFldINTEGER,
      btrFldFLOAT,
      btrFldDECIMAL,
      btrFldUBINARY:
        begin
          ExtInfo.Xx_File := Info^.Xe_File;
          ExtInfo.Xx_ID   := Info^.Xe_ID;
          Extended.BufferAddress := @ExtInfo;
          Try
            Extended.Find_Item( @ExtInfo, SizeOf( ExtInfo ), 0 );
            Info^.Xe_DataType := ExtInfo.Xx_Datatype;
          Except
            On E:EBtrieveEngineError do
              ;
          end;
        end;
    end;
  end;
{$ENDIF SMITHWARE_EXTENDED}
end;


Function TBtrFieldListTable.GetBufferSize : Word;
begin
  Result := SizeOf( FLDDesc );
end;


Procedure TBtrFieldListTable.TestGetRecordForKeyResult( Action : SmallInt; iFields, iLen :
           Word; Buff, pRecBuf : Pointer );
begin
end;


Procedure TBtrFieldListTable.GetRecordCount( Var iRecCount : Longint );
begin
  State := tblNoPos;
  iRecCount := 0;
  Try
    Repeat
      GetNextRecord( dbiNOLOCK, NIL, NIL );
      Inc( iRecCount );
    Until FALSE;
  Except
    On E:ETitanBoundryError do
      ;
  end;
  State := TblNoPos;
end;

end.
