(*****************************************************************************)
(* MODULE: BSETABLE^                                                         *)
(* RIGHTS: Reggatta Systems, Inc. - COPYRIGHT 1995 - 2001                    *)
(* DESCR.: This module contains the table classes.                           *)
(*                                                                           *)
(*                                                                           *)
(* NOTES :                                                                   *)
(*                                                                           *)
(* TBaseTable:         This is the base class for all table classes.         *)
(*                     functions for retrieving records and moving through   *)
(*                     a table are contained in this class.                  *)
(*                                                                           *)
(*****************************************************************************)
Unit BseTable;
{$I BSE.INC}
{$I BAPI.INC}
Interface
Uses
  Classes,
  IniFiles,

  Windows,
  BDE,

  BseRgtry,
  BseBapi,
  BseColl,
  BseTypes;

Type
  pBufferFlags = ^TBufferFlags;
  TBufferFlags =
  Record
    IsNULL     : SmallInt; { -1 if field is NULL }
    HasChanged : Bool;     { -1 if TRUE          }
  end;

  TFieldCacheItem =
  Class( TCollectionItem )
    Private
      FDesc      : FldDesc;
      FBuffer    : Pointer;
      FData      : Pointer;
      FNullData  : pBufferFlags;
      Function    GetLocalSize : Word;
      Procedure   SetLocalSize( S : Word );
      Function    GetLocalType : Word;
      Procedure   SetLocalType( S : Word );
      Function    GetFieldName : String;
      Procedure   SetFieldName( Const Value : String );
      Procedure   SetBuffer( pRecBuff : Pointer );
      Function    GetChanged : Boolean;
      Procedure   SetChanged( Flag : Boolean );
      Function    GetNull : Boolean;
      Procedure   SetNull( Flag : Boolean );
    Public
      Constructor CreateField( Owner : TCollection; P : pFldDesc; FNum, LType, LSize : Word );

      Property Buffer : Pointer
        Read   FBuffer
        Write  SetBuffer;
      Property Data : Pointer
        Read   FData;
      Property DataOffset : Word
        Read   FDesc.iOffset
        Write  FDesc.iOffset;
      Property Description : FLDDesc
        Read   FDesc
        Write  FDesc;
      Property HasChanged : Boolean
        Read   GetChanged
        Write  SetChanged;
      Property Null : Boolean
        Read   GetNull
        Write  SetNull;
      Property NullData : pBufferFlags
        Read   FNullData;
      Property NullOffset : Word
        Read   FDesc.iNullOffset
        Write  FDesc.iNullOffset;
    Published
      Property FieldNumber : Word
        Read   FDesc.iFldNum
        Write  FDesc.iFldNum;
      Property FieldName : String
        Read   GetFieldName
        Write  SetFieldName;
      Property FieldType : Word
        Read   FDesc.iFldType
        Write  FDesc.iFldType;
      Property FieldSubType : Word
        Read   FDesc.iSubType
        Write  FDesc.iSubType;
      Property FieldUnits1 : SmallInt
        Read   FDesc.iUnits1
        Write  FDesc.iUnits1;
      Property FieldUnits2 : SmallInt
        Read   FDesc.iUnits2
        Write  FDesc.iUnits2;
      Property FieldLength : Word
        Read   FDesc.iLen
        Write  FDesc.iLen;
      Property LocalType : Word
        Read   GetLocalType
        Write  SetLocalType;
      Property LocalSize : Word
        Read   GetLocalSize
        Write  SetLocalSize;
  end;

  TFieldCacheItemClass = Class of TFieldCacheItem;

  TBaseTable = Class;

  TTitanFieldCache =
  Class( TCollection )
    Private
      FTable : TBaseTable;
      Function GetField( Index : Integer ) : TFieldCacheItem;
    Public
      Constructor Create( Table : TBaseTable );
      Property Field[ Index : Integer ] : TFieldCacheItem
        Read  GetField; Default;
      Property DataSet : TBaseTable
        Read  FTable
        Write FTable;
      Procedure InitializeFlags( pRecBuff : Pointer );
      Function  FieldNumberFromName( SearchName : PChar ) : Integer;
  end;

  TTableState = ( TblNoPos, TblHasPos, TblOnFirst, TblOnLast, TblOnCrack, TblClosed );
  TTableLastDir = ( TblDirUndefined, TblDirNext, TblDirPrev );

  TKeyDescFlagRec =
  Record
    Flag      : Boolean;
    Len       : Integer;
    KeyType   : Integer;
    ActOffset : Word;
  end;

  TKeyDescFlagArray = Array[1..64] of TKeyDescFlagRec;

  TBaseTableClass = Class of TBaseTable;

  TBaseTable =
  Class( TBapiListItem )
    Protected
      FUnidirectional : Boolean;
      FLocale         : Pointer;
      FRecSize        : Word;
      FBufferSize     : Word;
      FCurrentBuffer  : Pointer;
      FDriverBuffer   : Pointer;
      FState          : TTableState;
      FLastDir        : TTableLastDir;
      FStartRange     : TKeyRange;
      FEndRange       : TKeyRange;
      FFilterActive   : Boolean;
      FExtDesc        : TBLExtDesc;
      FOpenMode       : DBIOpenMode;
      FShareMode      : DBIShareMode;
      FInTransact     : Boolean;
      FCheckTrans     : Boolean;
      FDriverHeader   : Pointer;
      FDelOnClose     : Boolean;
      FKeyDesc        : IDXDesc;
      FKeyDescendInfo : TKeyDescFlagArray;
      FActualKeyDesc  : Boolean;
      FFieldDescs     : TTitanFieldCache;
      FFilters        : TTitanCollection;
      FSameRange      : Boolean;
      FReRead         : Boolean;
      FIndexName      : DBITBLNAME;

      Function    GetDriverHeaderSize : SmallInt; Virtual;
      Function    GetDriverBuffer : Pointer; Virtual;
      Procedure   SetDriverBuffer( P : Pointer ); Virtual;
      Function    GetCurrentBuffer : Pointer; Virtual;
      Procedure   SetCurrentBuffer( pRecBuff : Pointer ); Virtual;

      Function    GetTableName : PChar;
        Virtual;
      Procedure   SetTableName( P : PChar ); Virtual;
      Function    GetFileName : PChar; Virtual;
      Procedure   SetFileName( P : PChar ); Virtual;

      Procedure   TestTransactionState;

      Procedure   TestRangeAndFilter( pRecBuff : Pointer );

      Procedure   WithinRange( pRecBuff : Pointer ); Virtual;

      Procedure   ActivateRanges( StartR, EndR : Boolean );
      Procedure   SetRangeParams( Start, KeyD : Boolean; Fields, Len : Word;
                    P : Pointer; Edge : Boolean );

    Public
      FBaseDesc : TBLBaseDesc;

      Function GetBufferSize : Word; Virtual;
      Function GetWorkBufferSize : Word; Virtual;
      Function GetBookMarkSize : Integer; Virtual;

      Function RangeActive : Boolean;

      Property DriverHeader : Pointer
        Read  FDriverHeader
        Write FDriverHeader;
      Property DriverHeaderSize : SmallInt
        Read  GetDriverHeaderSize;
      Property BookMarkSize : Integer
        Read  GetBookMarkSize;
      Property BufferSize : Word
        Read  GetBufferSize
        Write FBufferSize;
      Property CurrentBuffer : Pointer
        Read  GetCurrentBuffer
        Write SetCurrentBuffer;
      Property DriverBuffer : Pointer
        Read  GetDriverBuffer
        Write SetDriverBuffer;
      Property FileName : PChar
        Read  GetFileName
        Write SetFileName;
      Property State : TTableState
        Read  FState
        Write FState;
      Property TableName : PChar
        Read  GetTableName
        Write SetTableName;
      Property Fields : TTitanFieldCache
        Read  FFieldDescs;
      Property Unidirectional : Boolean
        Read  FUnidirectional
        Write FUnidirectional;

      Constructor Create( P : TObject; Container : TTitanCollection;
                    Name, IndexName : PChar; Index : Word; OMode : DBIOpenMode;
                    Share : DBIShareMode );
      Destructor  Destroy; Override;

      Procedure   GetFieldFromOffset( Offset, Size : Integer; pFDesc : pFLDDesc ); Virtual;
      Function    GetSearchAction( bKeyIncl, bNext : Boolean ) : TCmpType; Virtual;

      Procedure   InitTableStruct; Virtual;
      Procedure   DoneTableStruct; Virtual;

      Procedure   FirstRecordRaw; Virtual;
      Procedure   LastRecordRaw; Virtual;
      Procedure   NextRecordRaw; Virtual;
      Procedure   PrevRecordRaw; Virtual;

      Procedure   UpdateTableState;

      Procedure   MapGet( Dtype, DSize, DDec, LSize : SmallInt;
                    Src, Dest : Pointer; Var Blank : Bool ); Virtual;

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

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

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

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

      Procedure   LoadDriverHeader; Virtual;

      Function    UseNulls : Boolean; Virtual;
      Procedure   GetFieldCount( Var iFields, RecSize : Word ); Virtual;

      Procedure   OpenTable; Virtual;
      Procedure   CloseTable; Virtual;

      Procedure   OpenNestedTable(                          { Get nested table }
                    iFieldNo      : Word;                   { FieldID of nested table field }
                    bReadOnly     : Bool;                   { if TRUE, read only mode }
                    bUniDirectional: Bool;                  { if TRUE, unidirectional }
                    var hCursorNested : hDBICur             { Returns Cursor handle for nested table }
                  ); Virtual;

      Procedure   OpenRef(
                    iFieldNo      : Word;                   { FieldID }
                    bReadOnly     : Bool;                   { if TRUE, read only mode }
                    bUniDirectional: Bool;                  { If TRUE, Uni directional }
                    var hRefCursor : hDBICur                { Returns Cursor handle for REF }
                  ); Virtual;
      Procedure   RegenIndexes; Virtual;

      Procedure   Clone(                                    { Return a duplicate cursor }
                    bReadOnly       : Bool;                 { If TRUE, read only mode }
                    bUniDirectional : Bool;                 { If TRUE, Uni directional }
                    var   hCurNew   : hDBICur               { Destination cursor address }
                  ); Virtual;

      Procedure   OpenIndex (                               { Open an index }
                    pszIndexName  : PChar;                  { Index Name }
                    iIndexId      : Word                    { Index number (if applicable) }
                  ); Virtual;

      Procedure   CloseIndex (                              { Close an index }
                    pszIndexName  : PChar;                  { Index Name }
                    iIndexId      : Word                    { Index number (if applicable) }
                  ); Virtual;

      Procedure   GetNativeDesc( iField : Integer; Src : Pointer; P : pFldDesc;
                    Var LocType, LocSize : Word ); Virtual;

      Procedure   SetFieldNullOffsets;

      Procedure   GetFieldDescs( pFDesc : pFLDDesc ); Virtual;

      Procedure   SetToBegin; Virtual;
      Procedure   SetToEnd; Virtual;
      Procedure   SetToCursor( hDest : hDBICur ); Virtual;

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

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

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

      Procedure   FirstRecord   ; Virtual;
      Procedure   LastRecord    ; Virtual;

      Procedure   LoadProperties( pRecProps : pRECProps ); Virtual;

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

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

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

      Procedure   GetRecord (                               { Gets the current record }
                    eLock         : DBILockType;            { Optional lock request }
                    pRecBuff      : Pointer;                { Record buffer(client) }
                    pRecProps     : pRECProps               { Optional record properties }
                  ); Virtual;

      Procedure   GetRelativeRecord (                       { Find/Get a record by record number }
                    iPosOffset    : Longint;                { offset from current position }
                    eLock         : DBILockType;            { Optional lock request }
                    pRecBuff      : Pointer;                { Record buffer(client) }
                    pRecProps     : pRECProps               { Optional record properties }
                  ); Virtual;

      Procedure   GetRecordForKey ( bDirectKey : Bool; iFields, iLen : Word; pKey, pRecBuff : Pointer );
        Virtual;

      Procedure   GetVchkDesc (                             { Get valcheck descriptor }
                    iValSeqNo     : Word;                   { Valcheck sequence number }
                    pvalDesc      : pVCHKDesc               { Returned valcheck description }
                  ); Virtual;

      Procedure   GetRintDesc (                             { Get referential integrity descriptor }
                    iRintSeqNo    : Word;                   { Rint sequence number }
                    printDesc     : pRINTDesc               { Returned rint description }
                  ); Virtual;

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

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

      Procedure   RelRecordLockRaw;
        Virtual;

      Procedure   RelRecordLock (                           { Releases record level locks }
                    bAll          : Bool                    { True for all. Default Current. }
                  );
        Virtual;

      Procedure   IsRecordLocked (                          { Check if current record is locked }
                    var bLocked   : Bool                    { Rec lock status }
                  );
        Virtual;

      Procedure   IsTableLocked (                           { Verify if Table is locked }
                    epdxLock      : DBILockType;            { Lock type to verify }
                    var iLocks    : Word                    { Nbr of locks of the given type }
                  ); Virtual;

      Procedure   IsTableShared (                           { Verify if this is a shared table }
                    var bShared   : Bool                    { Shared status }
                  ); Virtual;

      Procedure   InitRecord( pRecBuff : Pointer ); Virtual;
      Procedure   InsertRecord( eLock : DBILockType; pRecBuff : Pointer ); Virtual;

      Procedure   AppendRecord ( pRecBuff : Pointer ); Virtual;
      Procedure   ModifyRecord( pRecBuff : Pointer; bFreeLock : Bool ); Virtual;
      Procedure   DeleteRecord( pRecBuff : Pointer ); Virtual;
      Procedure   UnDeleteRecord; Virtual;

      Procedure   ReadBlock ( Var iRecords : Longint; pBuf : Pointer ); Virtual;
      Procedure   WriteBlock ( Var iRecords : Longint; pBuf : Pointer ); Virtual;

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

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

      Procedure   GetCursorProps( var curProps : CURProps ); Virtual;
      Procedure   GetRecordCount( Var iRecCount : Longint ); Virtual;
      Procedure   GetExactRecordCount( Var iRecCount : Longint ); Virtual;
      Procedure   GetRecordNo (                             { Position to Physical Rec# }
                    var iRecNo    : Longint                 { Physical record number }
                  );
        Virtual;

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

      Procedure   SaveChanges; Virtual;
      Procedure   ForceReread; Virtual;
      Procedure   ForceRecordReread (                       { Force Reread of current record from Server }
                    pRecBuff      : Pointer                 { Returned : record buffer }
                  );
                    Virtual;
      Procedure   OpenLockList (                            { Get a list of locks }
                    bAllUsers     : Bool;                   { True, for all Users locks }
                    bAllLockTypes : Bool;                   { True, for all lock types }
                    var hLocks    : hDBICur                 { Returned cursor on Lock list }
                  ); Virtual;

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

      Procedure   SetRange (                                { Set cursor to a range }
                    bKeyItself    : Bool;                   { Whether Key or Record buffer }
                    iFields1      : Word;                   { Key fields to be mathced in full }
                    iLen1         : Word;                   { Key length to compare }
                    pKey1         : Pointer;                { Top/Left key in Range }
                    bKey1Incl     : Bool;                   { If Inclusive of Key1 }
                    iFields2      : Word;                   { Key fields to be mathced in full }
                    iLen2         : Word;                   { Key length to compare }
                    pKey2         : Pointer;                { Bottom/Right key in Range }
                    bKey2Incl     : Bool                    { If Inclusive of Key2 }
                  ); Virtual;

      Procedure   ResetRange; Virtual;

      Procedure   CompareKeys (                             { Compare two keys }
                    pKey1         : Pointer;                { Key buffer 1 to compare }
                    pKey2         : Pointer;                { Key buffer 2 (Or NULL) }
                    iFields       : Word;                   { Fields to compare in full }
                    iLen          : Word;                   { Partial key to compare }
                    var iResult   : SmallInt                { Compare result }
                  ); Virtual;

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

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

      Procedure   SetToKey (                                { Set key condition }
                    eSearchCond   : DBISearchCond;          { 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 }
                  ); Virtual;

      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 }
                  ); Virtual;

      Procedure   ExtractKey (                              { Get the key value of current record }
                    pRecBuf       : Pointer;                { Record buffer (optional) }
                    pKeyBuf       : Pointer                 { Returned. Key bytes. }
                  ); Virtual;

      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
                  ); Virtual;

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

      Procedure   GetIndexDescs (                           { Get index properties }
                    Desc   : PIDXDesc                       { Returned index description }
                  );
                    Virtual;

      Procedure   GetIndexForField(                         { Get index properties }
                    iFld          : Word;                   { Field Number (1..N) }
                    bProdTagOnly  : Bool;                   { If TRUE, only xBASE prod tags will be returned }
                    var   idxDesc : IDXDesc                 { Returned index description }
                  ); Virtual;

      Procedure   GetIndexSeqNo (                           { Get index sequence number }
                    pszIndexName  : PChar;                  { Index name }
                    pszTagName    : PChar;                  { Tag name (if applicable) }
                    iIndexId      : Word;                   { Index number }
                    var iIndexSeqNo  : Word                 { Index number }
                  ); Virtual;

      Procedure   EmptyTableWork; Virtual;      { Performs Delete for Empty Table }

      Procedure   EmptyTable; Virtual;

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

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

      Procedure   BeginDelayedUpdates (                     { put cursor in delayed update mode }
                    var hCursor   : hDBICur                 { In/Out : returns new Cursor }
                  ); Virtual;

      Procedure   EndDelayedUpdates (                       { Convert cursor back to normal cursor }
                    var hCursor   : hDBICur                 { In/Out : returns original Cursor }
                  ); Virtual;

      Procedure   ApplyDelayedUpdates (                     { Perform the specified operation. }
                    eUpdCmd       : DBIDelayedUpdCmd        { Op Type: Commit or Rollback. }
                  );
        Virtual;

      Procedure   GetDelayedUpdates (
                    var hCache    : hDBICur                 { In/Out: returns cursor on cache }
                  );
        Virtual;

      Procedure   LockRecord( eLock : DBILockType ); Virtual;
      Procedure   CacheLockRecord( eLock : DBILockType ); Virtual;


      Procedure   GetLdObj (                                { Get language driver }
                    var   pLdObj  : Pointer                 { Returned language driver object }
                  ); Virtual;

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

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

      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 }
                  ); 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 }
                  ); Virtual;

      Procedure   TruncateBlob (                            { Reduces the blob size }
                    pRecBuf       : Pointer;                { Record Buffer }
                    iField        : Word;                   { Field number of blob (1..n) }
                    iLen          : Longint                 { New blob length }
                  ); Virtual;

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

      Procedure   GetBlobHeading (                          { Get Blob Heading }
                    iField        : Word;                   { Field number of blob (1..n) }
                    pRecBuf       : Pointer;                { Record buffer of owner record }
                    pDest         : Pointer                 { Destination buffer }
                  ); Virtual;

      Procedure   SetFieldMap (                             { Set a fieldmap }
                    iFields       : Word;                   { Number of fields }
                    pFldDesc      : pFLDDesc                { Array of field descriptions }
                  ); Virtual;

      Procedure   GetField(                                 { Get Field value }
                    iField        : Word;                   { Field # (1..n) }
                    pRecBuff      : Pointer;                { Record buffer }
                    pDest         : Pointer;                { Destination field buffer }
                    var bBlank    : Bool                    { Returned : is field blank }
                  ); Virtual;

      Procedure   PutField (                                { Put a value in the record buffer }
                    iField        : Word;                   { Field # (1..n) }
                    pRecBuff      : Pointer;                { Record buffer }
                    pSrc          : Pointer                 { Source field buffer }
                  ); Virtual;

      Procedure   VerifyField (                             { Verifies the field value }
                    iField        : Word;                   { Field # (1..n) }
                    pSrc          : Pointer;                { Field Value }
                    var bBlank    : Bool                    { Field is Blank (Returned) }
                  ); Virtual;

      Procedure   UpdateFilterStatus; Virtual;
      Function    WithinFilter( pRecBuff : Pointer ) :  Boolean;

      Procedure   AddFilter (                               { Add a filter to the cursor }
                    iClientData   : Longint;                { Client supplied data      (opt) }
                    iPriority     : Word;                   { 1..N with 1 being highest (opt) }
                    bCanAbort     : Bool;                   { TRUE if pfFiltercan return ABORT (opt) }
                    pcanExpr      : pCANExpr;               { Expression tree        (opt) }
                    pfFilter      : pfGENFilter;            { ptr to filter function (opt) }
                    var hFilter   : hDBIFilter              { Returns filter handle }
                  ); Virtual;

      Procedure   DropFilter (                              { Drop a filter }
                    hFilter       : hDBIFilter              { Filter handle }
                  ); Virtual;

      Procedure   ActivateFilter (                          { Activate a Filter }
                    hFilter       : hDBIFilter              { Filter handle }
                  ); Virtual;

      Procedure   DeactivateFilter (                        { Deactivate Filter }
                    hFilter       : hDBIFilter              { Filter handle }
                  ); Virtual;

      Procedure   GetFilterInfo (                           { Get filter information }
                    hFilter       : hDBIFilter;             { Filter handle          /NULL }
                    iFilterId     : Word;                   { Filter id              /0 }
                    iFilterSeqNo  : Word;                   { Filter sequence number /0 }
                    var Filterinfo : FilterInfo             { Returns filter info }
                  ); Virtual;

      Procedure   GetProp (                                 { Get property }
                    iProp         : Longint;                { Property to retrieve }
                    PropValue     : Pointer;                { == NULL, validate iProp for getting }
                    iMaxLen       : Word;                   { Length of buffer pPropValue }
                    var   iLen    : Word                    { Returns required length }
                  ); Override;
      Procedure   SetProp (                                 { Get property }
                    iProp         : Longint;                { Property to retrieve }
                    PropValue     : Longint                 { == NULL, validate iProp for getting }
                  ); Override;

      Procedure   ValidateProp (                            { Validate a property }
                    iProp         : Longint;                { property to validate }
                    bSetting      : Bool                    { TRUE:setting, FALSE:getting }
                  ); Override;

      Procedure   BeginLinkMode; Virtual;
      Procedure   EndLinkMode; Virtual;

      Procedure   LinkDetail (                              { Link detail to master }
                    hDetlCursor   : hDBICur;                { Detail cursor }
                    iLnkFields    : Word;                   { Number of link fields }
                    piMstrFields  : PWord;                  { Array of fields in master }
                    piDetlFields  : PWord                   { Array of fields in detail }
                  ); Virtual;

      Procedure   LinkDetailToExp (                         { Link detail to a master using exp }
                    hCursorDetl   : hDBICur;                { Detail cursor }
                    iKeyLen       : Word;                   { Key length to match }
                    pszMstrExp    : PChar                   { Expression string }
                  ); Virtual;

      Procedure   UnlinkDetail; Virtual;

      Procedure   GetLinkStatus (                           { Query linkage info for table }
                    var hCursorMstr : hDBICur;              { Returns master cursor, if any   (opt) }
                    var hCursorDet  : hDBICur;              { Returns first detail cursor, if any (opt) }
                    var hCursorSib  : hDBICur               { Returns next sibling detail cursor, if any (opt) }
                  ); Virtual;

      Procedure   RegisterCallBack (                        { Register a call back fn }
                    ecbType       : CBType;                 { Type of call back }
                    iClientData   : Longint;                { Pass-thru client data }
                    iCbBufLen     : Word;                   { Callback buffer len }
                    CbBuf         : Pointer;                { Pointer to callback buffer }
                    pfCb          : pfDBICallBack           { Call back fn being registered }
                  ); Virtual;

      Procedure   GetCallBack (                             { Register a call back fn }
                    ecbType       : CBType;                 { Type of call back }
                    piClientData  : PLongint;               { Pass-thru client data }
                    piCbBufLen    : PWord;                  { Callback buffer len }
                    ppCbBuf       : Pointer;                { Pointer to callback buffer }
                    var pfCb      : pfDBICallBack           { Call back fn being registered }
                  ); Virtual;
 end;


 TBaseDBListTable =
 Class( TBaseTable )
   Protected
     FpTitanEnv : pTitanEnvInfo;
     Rec_Count  : Integer;
     FDriver    : DBINAME;
     FCfgRecs   : TTitanCollection;
     FCfgPos    : Word;
   Public
     Constructor Create( P : TObject; Container, CfgRecs : TTitanCollection;
                   Driver : PChar; pTitanEnv : pTitanEnvInfo );
     Procedure DoneTableStruct; Override;
     Procedure GetNextRecord (                                { Find/Get the next record }
                 eLock         : DBILockType;                 { Optional lock request }
                 pRecBuff      : Pointer;                     { Record buffer(client) }
                 pRecProps     : pRECProps                    { Optional record properties }
               ); Override;
 end;

 TRegDBListTable =
 Class( TBaseDBListTable )
   Protected
     FAliases : TStringList;
     FSource  : TRightsRegistry;
   Public
     Constructor Create( P : TObject; Container, CfgRecs : TTitanCollection;
                   Driver : PChar; pTitanEnv : pTitanEnvInfo );
     Destructor Destroy; Override;

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


 TBaseListTable =
 Class( TBaseTable )
   Private
     Descs     : Pointer;
     Items     : Word;
     Position  : Word;
   Public
     Constructor Create( P : TObject; Container: TTitanCollection; D : Pointer; TotalCount : Word );
     Destructor  Destroy; Override;

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

 TIndexListTable =
 Class( TBaseListTable )
   Public
     Function    GetBufferSize : Word; Override;
 end;

 TFieldListTable =
 Class( TIndexListTable )
   Public
     Function    GetBufferSize : Word; Override;
 end;

Type
  TBaseCfgrecord =
  Class( TBapiListItem )
    Public
      FPath       : String;
      FFields     : Integer;
      FFieldDescs : pFLDDesc;
      FRec        : Pointer;
      
      Constructor Create( P : TObject; Container : TTitanCollection;
        Path : PChar; Fields : Integer; Descs : pFLDDesc; Rec : Pointer );
      Destructor  Destroy; Override;
      Procedure SetPath( Path : PChar );
      Procedure SetFields( Fields : Integer; Descs : pFLDDesc; Rec : Pointer );
      Function  RecordSize : LongInt;
  end;


 Type
  PDescArray = ^TDescArray;
  TDescArray = Array[ 0..( $FFE0 Div SizeOf( FLDDesc ) ) ] of FLDDesc;


Implementation
Uses

  Forms,
  SysUtils,


  BseUtils,
  BseConst,
  BseCache,
  BseFilt,
  BseDbase,
  BseErrs,
  BseSess;



Constructor TFieldCacheItem.CreateField( Owner : TCollection; P : pFldDesc; FNum, LType, LSize : Word );
begin
  Create( Owner );
  Move( P^, FDesc, SizeOf( FldDesc ) );
  FieldNumber := FNum;
  LocalType   := LType;
  LocalSize   := LSize;
end;


Function TFieldCacheItem.GetFieldName : String;
begin
  Result := StrPas( FDesc.szName );
end;


Procedure TFieldCacheItem.SetFieldName( Const Value : String );
begin
  StrPCopy( @FDesc.szName, Copy( Value, 1, Pred( SizeOf( FDesc.szName ) ) ) );
end;


Procedure TFieldCacheItem.SetBuffer( pRecBuff : Pointer );
begin
  FBuffer := pRecBuff;
  if ( FBuffer <> NIL ) then
  begin
    FData := FBuffer;
    Inc( PChar( FData ), FDesc.iOffset );
    If ( FDesc.INullOffset > 0 ) then
    begin
      FNullData := FBuffer;
      Inc( PChar( FNullData ), FDesc.iNullOffset );
    end
    else
      FNullData := NIL;
  end
  else
  begin
    FData     := NIL;
    FNullData := NIL;
  end;
end;


Function TFieldCacheItem.GetNull : Boolean;
begin
  If ( FNullData <> NIL ) then
    Result := ( TBufferFlags( FNullData^ ).IsNull = -1 )
  else
    Result := FALSE;
end;


Procedure TFieldCacheItem.SetNull( Flag : Boolean );
Const
  VALUES : Array[ Boolean ] of SmallInt = ( 0, -1 );
begin
  If ( FNullData <> NIL ) then
    FNullData^.IsNull := VALUES[ Flag ];
end;


Function TFieldCacheItem.GetChanged : Boolean;
begin
  if ( FNullData <> NIL ) then
    Result := ( TBufferFlags( FNullData^ ).HasChanged )
  else
    Result := TRUE;
end;


Procedure TFieldCacheItem.SetChanged( Flag : Boolean );
begin
  If ( FNullData <> NIL ) then
    TBufferFlags( FNullData^ ).HasChanged := Flag;
end;

Function TFieldCacheItem.GetLocalSize : Word;
begin
  Result := FDesc.iUnused[ 1 ];
end;

Procedure TFieldCacheItem.SetLocalSize( S : Word );
begin
  FDesc.iUnused[ 1 ] := S;
end;

Function TFieldCacheItem.GetLocalType : Word;
begin
  Result := FDesc.iUnused[ 0 ];
end;

Procedure TFieldCacheItem.SetLocalType( S : Word );
begin
  FDesc.iUnused[ 0 ] := S;
end;


Constructor TTitanFieldCache.Create( Table : TBaseTable );
begin
  Inherited Create( TFieldCacheItem );
  FTable := Table;
end;


Function TTitanFieldCache.GetField( Index : Integer ) : TFieldCacheItem;
var
  LocType : Word;
  LocSize : Word;
  Desc    : FldDesc;
begin
  if ( Count >= Index ) and ( Index > 0 ) then
    Result := TFieldCacheItem( Items[ Pred( Index ) ] )
  else
  begin
    ValidateValue( ( Index > 0 ) and ( FTable <> NIL ), DBIERR_INVALIDRECSTRUCT );
    FTable.GetNativeDesc( Index, NIL, @Desc, LocType, LocSize );
    Result := TFieldCacheItem.CreateField( Self, @Desc, Index, LocType, LocSize );
  end;
end;


Procedure TTitanFieldCache.InitializeFlags( pRecBuff : Pointer );
var
  i : Word;
begin
  For i := 1 to Count do
  begin
    With Field[ i ] do
    begin
      Buffer     := pRecBuff;
      HasChanged := FALSE;
      Null       := TRUE;
    end;
  end;
end;


Function TTitanFieldCache.FieldNumberFromName( SearchName : PChar ) : Integer;
var
  I   : Integer;
begin
  Result := 0;
  For i := 1 to Count do
  begin
    With GetField( i ) do
    begin
      if ( StrIComp( SearchName, PChar( FieldName ) ) = 0 ) then
      begin
        Result := Integer( FieldNumber );
        Exit;
      end;
    end;
  end;
end;


Constructor TBaseTable.Create( P : TObject; Container : TTitanCollection;
              Name, IndexName : PChar; Index : Word; OMode : DBIOpenMode; Share : DBIShareMode );
begin
  Inherited Create( P, Container );

  State      := TblClosed;
  FOpenMode  := OMode;
  FShareMode := Share;

  TableName  := Name;

  If ( IndexName <> NIL ) then
    StrLCopy( @FIndexName, IndexName, Pred( SizeOf( DBITBLNAME ) ) );

  If ( DriverHeaderSize > 0 ) then
    FDriverHeader := AllocMem( DriverHeaderSize );

  FFieldDescs := TTitanFieldCache.Create( Self );
  FFilters    := TTitanCollection.Create;
  FUniDirectional := TRUE;
  InitTableStruct;
end;


Destructor TBaseTable.Destroy;
begin
  DoneTableStruct;

  FFilters.Free;

  FFieldDescs.Free;


  If ( DriverHeaderSize > 0 ) then
    FreeMem( FDriverHeader, DriverHeaderSize );

  Inherited Destroy;
end;


Procedure TBaseTable.LoadDriverHeader;
begin
end;


Procedure TBaseTable.InitTableStruct;
begin
end;


Procedure TBaseTable.DoneTableStruct;
begin
end;


Procedure TBaseTable.FirstRecordRaw;
begin
  ThrowBOFException;
end;


Procedure TBaseTable.LastRecordRaw;
begin
  ThrowEOFException;
end;


Procedure TBaseTable.NextRecordRaw;
begin
  ThrowEOFException;
end;


Procedure TBaseTable.PrevRecordRaw;
begin
  ThrowBOFException;
end;


Function TBaseTable.GetDriverHeaderSize : SmallInt;
begin
  Result := 0;
end;


Function TBaseTable.GetDriverBuffer : Pointer;
begin
  Result := FDriverBuffer;
end;


Procedure TBaseTable.SetDriverBuffer( P : Pointer );
begin
  FDriverBuffer := P;
end;


Procedure TBaseTable.SetFieldNullOffsets;
var
  i          : Word;
  NullOffset : Word;
  iFields    : Word;
  RecSize    : Word;
begin
  If UseNulls then
  begin
    GetFieldCount( iFields, RecSize );
    NullOffset := Succ( RecSize );
    For i := 1 to Fields.Count do
    begin
      Fields[ i ].NullOffset := NullOffset;
      Inc( NullOffset, SizeOf( TBufferFlags ) );
    end;
  end;
end;


Function TBaseTable.UseNulls : Boolean;
begin
  Result := FALSE;
end;


Procedure TBaseTable.GetFieldCount( Var iFields, RecSize : Word );
var
  i,j : Word;
  T   : TFieldCacheItem;
begin
  iFields := Fields.Count;
  ValidateValue( ( iFields > 0 ), DBIERR_INVALIDRECSTRUCT );
  If ( FRecSize = 0 ) then
  begin
    For i := 1 to iFields do
    begin
      T := Fields[ i ];
      { this code is meant to deal with overlapping fields }
      j := T.DataOffset + T.FieldLength;
      if ( j > FRecSize ) then
        FRecSize := j;
    end;
  end;
  RecSize := FRecSize;
end;


Function TBaseTable.GetSearchAction( bKeyIncl, bNext : Boolean ) : TCmpType;
Const
  NEXTLOOKUP : Array[ Boolean ] of TCmpType = ( cmpKeyGREATER, cmpKeyGREATEREQ );
  PREVLOOKUP : Array[ Boolean ] of TCmpType = ( cmpKeyLESS,    cmpKeyLESSEQ    );
begin
  if ( bNext ) then
    Result := NEXTLOOKUP[ bKeyIncl ]
  else
    Result := PREVLOOKUP[ bKeyIncl ];
end;


Procedure TBaseTable.GetFieldFromOffset( Offset, Size : Integer; pFDesc : pFLDDesc );
var
  T          : TFieldCacheItem;
  SameOffset : TFieldCacheItem;
  I          : Integer;
  Found      : Boolean;
begin
  if ( Fields.Count > 0 ) then
  begin
    T          := NIL;
    Found      := FALSE;
    SameOffset := NIL;
    For i := 1 to Fields.Count do
    begin
      T := Fields[ i ];
      Found := ( Succ( T.DataOffset ) = Offset );
      If Found then
      begin
        Found      := ( T.FieldLength = Size );
        SameOffset := T;
        If Found then
          Break;
      end;
    end;
    If not Found then
      T := SameOffset;
    if ( T <> NIL ) then
    begin
      pFDesc^ := T.Description;
      Exit;
    end;
  end;
  ThrowExceptionMsg( DBIERR_INVALIDRECSTRUCT, 'Table: ' + StrPas( TableName ) );
end;


Procedure TBaseTable.TestTransactionState;
begin
  If FCheckTrans and not FInTransact then
    Try
      AcqTableLock( dbiWRITELOCK );
    Except
      On E:ETitanEngineError do
        FInTransact := TRUE;
    end;
end;


Procedure TBaseTable.UpdateTableState;
begin
  State := TblHasPos;
end;


Procedure TBaseTable.SetToBegin;
begin
  State  := TblOnFirst;
end;


Procedure TBaseTable.SetToEnd;
begin
  State  := TblOnLast;
end;


Procedure TBaseTable.SetToCursor( hDest : hDBICur );
var
  M : Pointer;
begin
  ValidateParameter( hDest );
  M := AllocMem( BookMarkSize );
  Try
    GetBookMark( M );
    TBaseTable( hDest ).SetToBookMark( M );
  Finally
    FreeMem( M, BookMarkSize );
  end;
end;


Procedure TBaseTable.GetBookMark( P : Pointer );
begin
  Not_Supported( fnGETBOOKMARK );
end;


Procedure TBaseTable.SetToBookmark( P : Pointer );
begin
  Not_Supported( fnSETTOBOOKMARK );
end;


Procedure TBaseTable.GetRecordWithBookMark( P, pRecBuff : Pointer; eLock : DBILockType );
begin
  Not_Supported( fnGETRECORDWITHBOOKMK );
  { This function in overriden methods should call LockRecord }
end;


Function TBaseTable.BookMarkToKeyPtr( P : Pointer ) : Pointer;
begin
  Result := P;
end;


Procedure TBaseTable.CompareBookMarks( pBookMark1, pBookMark2 : pointer;
           var CmpBkmkResult : CmpBkmkRslt );


var
  i      : SmallInt;
  B1, B2 : Pointer;
begin
  B1 := ValidateParameter( BookMarkToKeyPtr( pBookMark1 ) );
  B2 := ValidateParameter( BookMarkToKeyPtr( pBookMark2 ) );
  CompareKeys( B1, B2, 0, 0, i );
  If ( i < 0 ) then
    CmpBkMkResult := CMPLess
  else
    if ( i > 0 ) then
     CmpBkMkResult := CMPGtr
    else
      CmpBkMkResult := CMPEql;
end;


Function TBaseTable.GetBookMarkSize : Integer;
begin
  Result := SizeOf( TttKeyBuffer );
end;


Function TBaseTable.RangeActive : Boolean;
begin
  Result := FStartRange.Active or FEndRange.Active;
end;


Procedure TBaseTable.FirstRecord;
begin
  With FStartRange do
  begin
    If Active then
      SetToKeySpecial( GetSearchAction( bKeyIncl, TRUE ), bKeyItself, iFields, iLen, pKey, DriverBuffer )
    else
      FirstRecordRaw;
  end;
end;


Procedure TBaseTable.LastRecord;
begin
  With FEndRange do
  begin
    If Active then
      SetToKeySpecial( GetSearchAction( bKeyIncl, FALSE ), bKeyItself, iFields, iLen, pKey, DriverBuffer )
    else
      LastRecordRaw;
  end;
end;


Procedure TBaseTable.TestRangeAndFilter( pRecBuff : Pointer );
begin
  if ( pRecBuff <> NIL ) then
  begin
    WithinRange( PRecBuff );
    if FFilterActive then
      While not WithinFilter( pRecBuff ) do
      begin
        DriverBuffer := pRecBuff;
        if ( FLastDir <> TblDirPrev ) then
          NextRecordRaw
        else
          PrevRecordRaw;
        WithinRange( pRecBuff );
      end;
  end;
end;


Procedure TBaseTable.LoadProperties( pRecProps : pRECProps );
begin
end;


Procedure TBaseTable.GetRecordWork(
           eLock     : DBILockType;
           pRecBuff  : Pointer
         );
var
  P : Pointer;
begin
  GetMem( P, BookMarkSize );
  Try
    GetBookMark( P );
    GetRecordWithBookmark( P, pRecBuff, eLock );
  Finally
    Freemem( P, BookMarkSize );
  end;
end;


Procedure TBaseTable.GetRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
begin
  DriverBuffer := pRecBuff;
  Case State of
    TblHasPos:
      begin
        GetRecordWork( eLock, pRecBuff );
        Try
            TestRangeAndFilter( pRecBuff );
        Except
          On E:ETitanEngineError do
          begin
            if FReRead then
            begin
              FReRead := FALSE;
              State  := TblNoPos;
              GetNextRecord( eLock, pRecBuff, pRecProps );
            end
            else
            begin
              If ( eLock = dbiWRITELOCK ) then
                RelRecordLock( FALSE );
              Raise;
            end;
          end;
        end;
        LoadProperties( pRecProps );
      end;
    TblOnFirst:
      ThrowEOFException;
    TblOnLast:
      ThrowBOFException;
    TblOnCrack:
      begin
        { Try to get the next record...}
        Try
          GetNextRecord( eLock, pRecBuff, pRecProps );
        Except
          On E:ETitanEngineError do
          begin
            Try
              GetPriorRecord( eLock, pRecBuff, pRecProps );
            Except
              On E:ETitanEngineError do
              begin
                { Then try to get the first record...}
                State  := TblNoPos;
                GetNextRecord( eLock, pRecBuff, pRecProps );
              end;
            end;
          end;
        end;
      end;
    else
      ThrowException( DBIERR_NOCURRREC );
  end;
end;


Procedure TBaseTable.GetNextRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
begin
  FLastDir     := TblDirNext;
  DriverBuffer := PRecBuff;
  Case State of
    TblHasPos,
    TblOnCrack:
      NextRecordRaw;
    TblOnFirst,
    TblNoPos:
      FirstRecord;
    else
      ThrowEOFException;
  end;
  TestRangeAndFilter( pRecBuff );
  if ( eLock <> dbiNOLOCK ) then
    GetRecord( eLock, pRecBuff, pRecProps )
  else
    LoadProperties( pRecProps );
  UpdateTableState;
end;


Procedure TBaseTable.GetPriorRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
begin
  FLastDir     := TblDirPrev;
  DriverBuffer := PRecBuff;
  Case State of
    TblHasPos,
    TblOnCrack:
      PrevRecordRaw;
    TblOnLast,
    TblNoPos:
      LastRecord;
    else
      ThrowBOFException;
  end;
  TestRangeAndFilter( pRecBuff );
  if ( eLock <> dbiNOLOCK ) then
    GetRecord( eLock, pRecBuff, pRecProps )
  else
    LoadProperties( pRecProps );
  UpdateTableState;
end;


Procedure TBaseTable.GetRelativeRecord(
           iPosOffset : Longint;
           eLock      : DBILockType;
           pRecBuff   : Pointer;
           pRecProps  : PRECProps
         );
var
  count : Longint;
  tLock : DBILockType;
begin
  if ( iPosOffset <> 0 ) then
  begin
    tLock := dbiNOLOCK;
    Count := Abs( iPosOffset );
    Repeat
      if ( Count = 1 ) then
        tLock := eLock;
      If ( iPosOffset > 0 ) then
        GetNextRecord( tLock, pRecBuff, pRecProps )
      else
        GetPriorRecord( tLock, pRecBuff, pRecProps );
      Dec( Count );
      if ( Count = 0 ) then
        Break;
    Until FALSE;
  end
  else
    ValidateParameter( NIL );
end;


Procedure TBaseTable.GetRecordForKey( bDirectKey : Bool; iFields, iLen : Word; pKey, pRecBuff : Pointer );
begin
  ThrowException( DBIERR_INVALIDHNDL );
end;


Procedure TBaseTable.GetVchkDesc (                          { Get valcheck descriptor }
           iValSeqNo     : Word;                            { Valcheck sequence number }
           pvalDesc      : pVCHKDesc                        { Returned valcheck description }
         );
begin
  Not_Supported( fnGETVCHKDESC );
end;


Procedure TBaseTable.GetRintDesc (                          { Get referential integrity descriptor }
           iRintSeqNo    : Word;                            { Rint sequence number }
           printDesc     : pRINTDesc                        { Returned rint description }
         );
begin
  Not_Supported( fnGETRINTDESC );
end;


Procedure TBaseTable.AcqTableLock (                         { Lock a table }
           eLockType     : DBILockType                      { Lock type }
         );
begin
  Not_Supported( fnACQTABLELOCK );
end;


Procedure TBaseTable.RelTableLock (                         { Unlocks Table level locks }
           bAll          : Bool;                            { True for all table level locks }
           eLockType     : DBILockType                      { Specific lock type }
         );
begin
  Not_Supported( fnRELTABLELOCK );
end;


Procedure TBaseTable.RelRecordLockRaw;
begin
end;


Procedure TBaseTable.RelRecordLock (                        { Releases record level locks }
           bAll          : Bool                             { True for all. Default Current. }
         );
begin
  RelRecordLockRaw;
end;


Procedure TBaseTable.IsRecordLocked (                       { Check if current record is locked }
           var bLocked   : Bool                             { Rec lock status }
         );
begin
  Not_Supported( fnISRECORDLOCKED );
end;


Procedure TBaseTable.IsTableLocked (                        { Verify if Table is locked }
            epdxLock      : DBILockType;                    { Lock type to verify }
            var iLocks    : Word                            { Nbr of locks of the given type }
          );
begin
  iLocks := 0;
end;


Procedure TBaseTable.IsTableShared (                        { Verify if this is a shared table }
           var bShared   : Bool                             { Shared status }
         );
begin
  bShared := TRUE;
end;


Procedure TBaseTable.InitRecord( pRecBuff : Pointer );
begin
  ValidateParameter( pRecBuff );
  MoveZero( pRecBuff^, GetWorkBufferSize );
  If UseNulls then
    FFieldDescs.InitializeFlags( pRecBuff );
  CurrentBuffer := pRecBuff;
end;


Procedure TBaseTable.InsertRecord( eLock : DBILockType; pRecBuff : Pointer );
begin
end;


Procedure TBaseTable.ModifyRecord( pRecBuff : Pointer; bFreeLock : Bool );
begin
end;


Procedure TBaseTable.DeleteRecord( pRecBuff : Pointer );
begin
end;


Procedure TBaseTable.UnDeleteRecord;
begin
  Not_Supported( fnUNDELETERECORD );
end;


Procedure TBaseTable.GetSeqNo (                             { Get logical record number }
           var iSeqNo    : Longint                          { Pointer to sequence number }
         );
begin
  Not_Supported( fnGETSEQNO );
end;



Procedure TBaseTable.SetToSeqNo (                            { Position to a logical record number }
            iSeqNo        : Longint                          { Sequence number }
          );
begin
  Not_Supported( fnSETTOSEQNO );
end;


Procedure TBaseTable.AppendRecord ( pRecBuff : Pointer );
begin
  InsertRecord( dbiNOLOCK, pRecBuff );
end;


Procedure TBaseTable.ReadBlock ( Var iRecords : Longint; pBuf : Pointer );
var
  M     : MemPtr;
  i     : Word;
  Limit : longint;
begin
  Limit     := iRecords;
  iRecords  := 0;
  ValidateParameter( pBuf );
  M := pBuf;
  i := 0;
  Repeat
    GetNextRecord( dbiNOLOCK, @M^[ i ], NIL );
    Inc( iRecords );
    if ( iRecords >= Limit ) then
      Break
    else
      Inc( i, GetWorkBufferSize );
  until FALSE;
end;


Procedure TBaseTable.WriteBlock ( Var iRecords : Longint; pBuf : Pointer );
type
  MemPtr   = ^MemArray;
  MemArray = Array[0..$FFFE] of Byte;
var
  M     : MemPtr;
  i     : Word;
  Limit : longint;
begin
  Limit     := iRecords;
  iRecords  := 0;
  ValidateParameter( pBuf );
  M := pBuf;
  i := 0;
  Repeat
    InsertRecord( dbiNOLOCK, @M^[ i ] );
    Inc( iRecords );
    if ( iRecords >= Limit ) then
      Break
    else
      Inc( i, GetWorkBufferSize );
  until FALSE;
end;


Procedure TBaseTable.GetCursorProps( var curProps : CURProps );
begin
  MoveZero( curProps, SizeOf( curProps ) );
  With curProps do
  begin
    GetFieldCount( iFields, iRecSize );
    If UseNulls then
      iRecBufSize := GetWorkBufferSize
    else
      iRecBufSize   := iRecSize;                            { Record size (physical record) }
    iKeySize        := FKeyDesc.iKeyLen;                    { Key size }
    iBookMarkSize   := BookMarkSize;                        { Bookmark size }
    bBookMarkStable := ( FShareMode = DBIOPENEXCL );        { Stable book marks }
    eOpenMode       := FOpenMode;                           { ReadOnly / RW }
    eShareMode      := FShareMode;                          { Excl / Share }
    iSeqNums        := -1;                                  { 1: Has Seqnums; 0: Has Record# }
    exltMode        := xltNONE;                             { Translate Mode }
    bUniDirectional := FUniDirectional;                     { Cursor is uni-directional }
    eprvRights      := prvUNKNOWN;                          { Table  rights }
    iFilters        := FFilters.Count;                      { Number of Filters }
  end;
end;


Function TBaseTable.GetBufferSize : Word;
begin
  Result := FBufferSize;
end;


Function TBaseTable.GetWorkBufferSize : Word;
begin
  Result := GetBufferSize;
  If UseNulls then
    Inc( Result, Succ( FFieldDescs.Count * SizeOf( TBufferFLags ) ) );
end;


Procedure TBaseTable.GetRecordCount( Var iRecCount : Longint );
var
  P      : Pointer;
  Buff   : Pointer;
  Marked : Boolean;
begin
  iRecCount := 0;
  GetMem( Buff, GetWorkBufferSize );
  GetMem( P,    BookMarkSize      );
  Try
    Try
      GetBookMark( P );
      Marked := TRUE;
    Except
      On E:ETitanEngineError do
        Marked := FALSE;
    end;
    SetToBegin;
    Try
      Repeat
        GetNextRecord( dbiNOLOCK, Buff, NIL );
        Inc( iRecCount );
        If ( ( iRecCount Mod 16 ) = 0 ) then
          Application.ProcessMessages;
      Until FALSE;
    Except
      On E:ETitanBoundryError do
        ;
    end;
    If Marked then
      SetToBookMark( P )
    else
      SetToBegin;
  Finally
    If ( P <> NIL ) then
      FreeMem( P, BookMarkSize );
    If ( Buff <> NIL ) then
      FreeMem( Buff, GetWorkBufferSize );
  end;
end;


Procedure TBaseTable.GetExactRecordCount( Var iRecCount : Longint );
begin
  GetRecordCount( iRecCount );
end;


Procedure TBaseTable.GetRecordNo (                          { Get Physical Rec# }
           var iRecNo        : Longint                      { Physical record number }
         );
begin
  Not_Used( fnGETRECORDNO );
end;


Procedure TBaseTable.SetToRecordNo (                        { Position to Physical Rec# }
           iRecNo        : Longint                          { Physical record number }
         );
begin
  Not_Used( fnSETTORECORDNO );
end;


Procedure TBaseTable.SaveChanges;                           { flush all buffered changes }
begin
  FDelOnClose := FALSE;
end;


Procedure TBaseTable.ForceReread;                           { flush all buffered changes }
begin
  FReRead := TRUE;
end;


Procedure TBaseTable.ForceRecordReread (                    { Force Reread of current record from Server }
                    pRecBuff      : Pointer                 { Returned : record buffer }
                  );
begin
  ForceReread;
  GetRecord( dbiNOLOCK, pRecBuff, NIL );
end;


Procedure TBaseTable.OpenLockList (                         { Get a list of locks }
           bAllUsers     : Bool;                            { True, for all Users locks }
           bAllLockTypes : Bool;                            { True, for all lock types }
           var hLocks    : hDBICur                          { Returned cursor on Lock list }
         );
begin
  Not_Supported( fnOPENLOCKLIST );
end;


Procedure TBaseTable.MakePermanent (                        { Make temporary table permanent }
           pszName       : PChar;                           { Rename temporary table }
           bOverWrite    : Bool                             { Overwrite existing file }
         );
begin
  SaveChanges;
end;


Procedure TBaseTable.SetRange (                             { Set cursor to a range }
           bKeyItself    : Bool;                            { Whether Key or Record buffer }
           iFields1      : Word;                            { Key fields to be mathced in full }
           iLen1         : Word;                            { Key length to compare }
           pKey1         : Pointer;                         { Top/Left key in Range }
           bKey1Incl     : Bool;                            { If Inclusive of Key1 }
           iFields2      : Word;                            { Key fields to be matched in full }
           iLen2         : Word;                            { Key length to compare }
           pKey2         : Pointer;                         { Bottom/Right key in Range }
           bKey2Incl     : Bool                             { If Inclusive of Key2 }
         );
begin
  ResetRange;
  SetRangeParams( TRUE,  bKeyItself, iFields1, iLen1, pKey1, bKey1Incl );
  SetRangeParams( FALSE, bKeyItself, iFields2, iLen2, pKey2, bKey2Incl );
  ActivateRanges( FStartRange.Active, FEndRange.Active );
end;


Procedure TBaseTable.ResetRange;
begin
  ActivateRanges( FALSE, FALSE );
end;


Procedure TBaseTable.CompareKeys (                          { Compare two keys }
           pKey1         : Pointer;                         { Key buffer 1 to compare }
           pKey2         : Pointer;                         { Key buffer 2 (Or NULL) }
           iFields       : Word;                            { Fields to compare in full }
           iLen          : Word;                            { Partial key to compare }
           var iResult   : SmallInt                         { Compare result }
         );
var
  i       : SmallInt;
  T       : TFieldCacheItem;
  MKey1   : PChar;
  MKey2   : PChar;
  Size    : SmallInt;
  wType   : Word;
begin
  iResult := 0;
  ValidateParameter( pKey1 );
  if ( iFields = 0 ) and ( iLen = 0 ) then
    iFields := FKeyDesc.iFldsinKey;
  MKey1 := PChar( pKey1 );
  If ( pKey2 <> NIL ) then
    MKey2 := PChar( pKey2 )
  else
    MKey2 := PChar( DriverBuffer );
  For i := 0 to Pred( iFields ) do
  begin
    T := Fields[ FKeyDesc.aiKeyFld[ i ] ];
    wType := T.LocalType;
    if ( iLen > 0 ) and ( i = Pred( iFields ) ) then
      Size := iLen
    else
    begin
      With FKeyDescendInfo[ Succ( i ) ] do
      begin
        If ( ActOffSet > 0 ) then
        begin
          T.LocalType := KeyType;
          Size        := Len;
        end
        else
          Size  := T.LocalSize;
      end;
    end;
    iResult := TranslateCmp( T.FieldType, T, Size, FKeyDesc.bCaseInsensitive, MKey1, MKey2 );
    T.LocalType := wType;
    if ( iResult <> 0 ) then
    begin
      { Reverse the comparison result when descending key involved }
      If FKeyDescendInfo[ Succ( i ) ].Flag then
      begin
        If ( iResult > 0 ) then
          iResult := -1
        else
          iResult := 1;
      end;
      Exit;
    end
    else
    begin
      Inc( MKey1, Size );
      Inc( MKey2, Size );
    end;
  end;
end;


Procedure TBaseTable.ParseIndexName(
           pszIndexName : PChar;
           Var iIndexId : Word;
           pszTrueName  : PChar
         );
Const
  FIELD_NAMES_INDEX_START = '@';
var
  S     : ShortString;
  Token : String;
  i,j   : Integer;
  Flds  : DBIKEY;
  Found : Boolean;
  Desc  : IDXDesc;
begin
  If ( pszIndexName <> NIL ) then
    s := StrPas( pszIndexName )
  else
    s := '';
  If ( Pos( FIELD_NAMES_INDEX_START, s ) > 0 ) then
  begin
    (*******************************************************)
    (* Index Name is currently shown as '@Field1@Field2'   *)
    (* This code parses the string and tries to find the   *)
    (* best matching index.  Special thanks to Terrence    *)
    (* Koehn at Orion Law Management Systems for a bug fix *)
    (* here!                                               *)
    (*******************************************************)
    MoveZero( Flds, SizeOf( Flds ) );
    i := 0;
    Repeat
      j := Pos( FIELD_NAMES_INDEX_START, s );
      If ( j > 0 ) then
      begin
        token := Copy( s, Succ( j ), Pred( SizeOf( ShortString ) ) );
        j     := Pos( FIELD_NAMES_INDEX_START, token );
        If ( j > 1 ) then
          Delete( token, j, Length( token ) - Pred( j ) );
          {token := Copy( token, 1, Pred( j ) );}
        Delete( s, 1, Length( token ) + 2 );
        {s := Copy( s, length( token ) + 2, Pred( SizeOf( ShortString ) ) );}
        Flds[ i ] := Fields.FieldNumberFromName( PChar( token ) );
        inc( i );
      end
      else
        Break;
    until FALSE;
    if ( i > 0 ) then
    begin
      Found    := FALSE;
      iIndexId := 0;
      Repeat
        GetIndexDesc( iIndexId, Desc );
        If ( Desc.iFldsInKey >= i ) then
        begin
          Found := TRUE;
          For j := 0 to i do
            if ( Desc.aiKeyFld[ j ] <> Flds[ j ] ) then
            begin
              Found := FALSE;
              Break;
            end;
        end;
        Inc( iIndexId );
      Until Found;
      If Found and ( iIndexId > 0 ) then
      begin
        If ( pszTrueName <> NIL ) then
          StrLCopy( pszTrueName, @Desc.szName, DBIMAXNAMELEN );
        Dec( iIndexId );
        Exit;
      end;
    end;
  end
  else
  begin
    If ( pszTrueName <> NIL ) and ( pszIndexName <> NIL ) then
      StrLCopy( pszTrueName, pszIndexName, DBIMAXNAMELEN );
    Exit;
  end;
  ThrowException( DBIERR_INVALIDINDEXNAME );
end;


Procedure TBaseTable.SwitchToIndex(
           pszIndexName  : PChar;
           pszTagName    : PChar;
           iIndexId      : Word;
           bCurrRec      : Bool
         );
begin
  Not_Supported( fnSWITCHTOINDEX );
end;


Procedure TBaseTable.SetToKey (                             { Set key condition }
           eSearchCond   : DBISearchCond;                   { 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 }
         );
var
  sType : TCmpType;
  Buff  : Pointer;
begin
  Case eSearchCond of
    keySEARCHGT:
      stype := cmpKeyGREATER;
    keySEARCHGEQ:
      stype := cmpKeyGREATEREQ;
  else
    { keySEARCHEQ }
    stype := cmpKeyEQUAL;
  end;
  Buff := AllocMem( GetWorkBufferSize );
  Try
    Try
      SetToKeySpecial( sType, bDirectKey, iFields, ilen, pBuff, Buff );
    Except
      on E:ETitanEngineError do
        If ( eSearchCond <> keySEARCHEQ ) then
          SetToEnd
        else
          Raise;
    end;
    FLastDir := TblDirNext;
    TestRangeAndFilter( Buff );
  Finally
    FreeMem( Buff, GetWorkBufferSize );
  end;
end;


Procedure TBaseTable.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 }
         );
begin
  ThrowException( DBIERR_NA );
end;



Procedure TBaseTable.ExtractKey (                           { Get the key value of current record }
           pRecBuf       : Pointer;                         { Record buffer (optional) }
           pKeyBuf       : Pointer                          { Returned. Key bytes. }
         );
var
  i : Word;
begin
  ExtractKeyPrecise( pRecBuf, pKeyBuf, 0, 0, i );
end;


Procedure TBaseTable.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
         );
begin
  ThrowException( DBIERR_NA );
end;


Procedure TBaseTable.GetIndexDesc (                         { Get index properties }
           iIndexSeqNo   : Word;                            { Index number }
           var   idxDesc : IDXDesc                          { Returned index description }
         );
begin
  MoveZero( idxDesc, SizeOf( idxDesc ) );
  ValidateHandle( NIL );
end;


Procedure TBaseTable.GetIndexDescs (                        { Get index properties }
           Desc   : PIDXDesc                                { Returned index description }
         );
var
  Props : CURProps;
  i     : Word;
  P     : Pointer;
begin
  GetCursorProps( Props );
  If ( Props.iIndexes > 0 ) then
  begin
    FActualKeyDesc := TRUE;
    Try
      P := Pointer( Desc );
      for i := 0 to Pred( Props.iIndexes ) do
      begin
        MoveZero( P^, SizeOf( IDXDesc ) );
        GetIndexDesc( i, IDXDesc( P^ ) );
        Inc( LongInt( P ), SizeOf( IDXDesc ) );
      end;
    Finally
      FActualKeyDesc := FALSE;
    end;
  end;
end;




Procedure TBaseTable.GetIndexForField(                      { Get index properties }
           iFld          : Word;                            { Field Number (1..N) }
           bProdTagOnly  : Bool;                            { If TRUE, only xBASE prod tags will be returned }
           var   idxDesc : IDXDesc                          { Returned index description }
         );
begin
  ThrowException( DBIERR_INVALIDHNDL );
end;


Procedure TBaseTable.GetIndexSeqNo (                        { Get index sequence number }
           pszIndexName  : PChar;                           { Index name }
           pszTagName    : PChar;                           { Tag name (if applicable) }
           iIndexId      : Word;                            { Index number }
           var iIndexSeqNo  : Word                          { Index number }
         );
begin
  ThrowException( DBIERR_INVALIDHNDL );
end;


Procedure TBaseTable.EmptyTableWork;                        { Deletes all records }
Const
  MAX_LOOPS = 4;
var
  Recs  : Longint;
  Loops : Integer;
begin
  Loops := 0;
  Repeat
    Try
      Repeat
        FirstRecord;
        DeleteRecord( NIL );
        Application.ProcessMessages;
      Until FALSE;
    Except
      On E:ETitanEngineError do
        ;
    end;
    GetRecordCount( Recs );
    (* The code below handles the case where the deletes have *)
    (* not completed for some reason.                         *)
    if ( Recs > 0 ) then
    begin
      Inc( Loops );
      if ( Loops > MAX_LOOPS ) then
        Break;
    end
    else
      Break;
  until FALSE;
  SetToBegin;
end;


Procedure TBaseTable.EmptyTable;                            { Deletes all records }
Var
  LastMode  : dbiShareMode;
  WasClosed : Boolean;
  CP        : CURProps;
begin
  LastMode  := FShareMode;
  WasClosed := ( State = TblClosed );
  If ( WasClosed ) or ( FShareMode <> dbiOPENEXCL ) then
  begin
    CloseTable;
    FShareMode := dbiOPENEXCL;
    OpenTable;
  end;
  Try
    GetCursorProps( CP );
    EmptyTableWork;
    FShareMode := LastMode;
    CloseTable;
  Finally
    If not WasClosed and ( LastMode <> dbiOPENEXCL ) then
    begin
      OpenTable;
      GetCursorProps( CP );
    end;
  end;
end;


Procedure TBaseTable.AddIndex (                             { Add a new index }
           var   IdxDesc       : IDXDesc;                   { Description of the index }
           pszKeyviolName : PChar                           { Keyviol table name (optional) }
         );
begin
  Not_Supported( fnADDINDEX );
end;


Procedure TBaseTable.DeleteIndex (                          { Delete index }
           pszIndexName  : PChar;                           { Index name }
           pszIndexTagName : PChar;                         { Index tagname (xbase MDX) }
           iIndexId      : Word                             { Index number }
         );
begin
  Not_Supported( fnDELETEINDEX );
end;


Procedure TBaseTable.BeginDelayedUpdates (                  { put cursor in delayed update mode }
           var hCursor   : hDBICur                          { In/Out : returns new Cursor }
         );
var
  NewTable : TBaseCacheTable;
begin
  NewTable := TBaseCacheTable.Create( Self );
  hCursor  := hDBICur( NewTable );
  ValidateParameter( hCursor );
end;


Procedure TBaseTable.EndDelayedUpdates (                    { Convert cursor back to normal cursor }
           var hCursor   : hDBICur                          { In/Out : returns original Cursor }
         );
begin
  Not_Supported( fnENDDELAYEDUPDATES );
end;


Procedure TBaseTable.ApplyDelayedUpdates (                 { Perform the specified operation. }
           eUpdCmd       : DBIDelayedUpdCmd                { Op Type: Commit or Rollback. }
         );
begin
  Not_Supported( fnAPPLYDELAYEDUPDATES );
end;


Procedure TBaseTable.GetDelayedUpdates (
           var hCache    : hDBICur                         { In/Out: returns cursor on cache }
         );
begin
  Not_Supported( fnGETDELAYEDUPDATES );
end;


Procedure TBaseTable.LockRecord( eLock : DBILockType );
begin
end;


Procedure TBaseTable.CacheLockRecord( eLock : DBILockType );
begin
end;

Procedure TBaseTable.SetCurrentBuffer( pRecBuff : Pointer );
begin
  FCurrentBuffer := pRecBuff;
end;


Function TBaseTable.GetCurrentBuffer : Pointer;
begin
  Result := FCurrentBuffer;
end;


Function TBaseTable.GetTableName : PChar;
begin
  Result := @FBaseDesc.szName;
end;


Procedure TBaseTable.SetTableName( P : PChar );
begin
  If Assigned( P ) then
    With FBaseDesc Do
      StrLCopy( @szName, P, Pred( SizeOf( szName ) ) );     { Table name(No extension or Dir) }
end;


Function TBaseTable.GetFileName : PChar;
begin
  Result := @FBaseDesc.szFileName;
end;


Procedure TBaseTable.SetFileName( P : PChar );
var
  tmp : ShortString;
begin
  tmp := Trim( StrPas( P ) );
  StrPCopy( @FBaseDesc.szFileName, tmp );
end;


Procedure TBaseTable.WithinRange( pRecBuff : Pointer );
var
  iKeyLen  : Word;
  CurrBuff : TttKeyBuffer;
  cmp      : SmallInt;
begin
  If FStartRange.Active then
  begin
    With FStartRange Do
    begin
      MoveZero( CurrBuff, SizeOf( CurrBuff ) );
      ExtractKeyPrecise( pRecBuff, @CurrBuff, iFields, iLen, iKeyLen );
      CompareKeys( @CurrBuff, @Buffer, iFields, iLen, cmp );
      If ( cmp < 0 ) or ( ( cmp = 0 ) and not bKeyIncl ) then
        ThrowBOFException;
    end;
  end;
  If FEndRange.Active then
  begin
    With FEndRange Do
    begin
      If not FSameRange then
      begin
        MoveZero( CurrBuff, SizeOf( CurrBuff ) );
        ExtractKeyPrecise( pRecBuff, @CurrBuff, iFields, iLen, iKeyLen );
      end;
      CompareKeys( @CurrBuff, @Buffer, iFields, iLen, cmp );
      if ( cmp > 0 ) or ( ( cmp = 0 ) and not bKeyIncl )then
        ThrowEOFException;
    end;
  end;
end;


Procedure TBaseTable.ActivateRanges( StartR, EndR : Boolean );

  Procedure LoadKeyInfo( Var Range : TKeyRange; IsLast : Boolean );
  var
    iKeyLen : Word;
  begin
    With Range Do
    begin
      If Active and not bKeyItself then
      begin
        Try
          ExtractKeyPrecise( pKey, @Buffer, iFields, iLen, iKeyLen );
        Except
          On E:ETitanEngineError do
            Active := FALSE;
        end;
      end;
    end;
  end;

begin
  FStartRange.Active := StartR;
  If StartR then
    LoadKeyInfo( FStartRange, FALSE );

  FEndRange.Active   := EndR;
  If EndR then
    LoadKeyInfo( FEndRange, TRUE );

  If StartR and EndR then
    FSameRange := ( FStartRange.iFields = FEndRange.iFields ) and
                  ( FStartRange.iLen    = FEndRange.iLen    )
  else
    FSameRange := FALSE;
end;


Procedure TBaseTable.SetRangeParams( Start, KeyD : Boolean; Fields, Len : Word;
                  P : Pointer; Edge : Boolean );
var
  pRange    : PKeyRange;
  bBlank    : Bool;
  i         : Integer;
  T         : TFieldCacheItem;
  tmpBuff   : TttKeyBuffer;
  pKeyBuff  : PChar;
  OldOffset : Integer;
begin
  If Start then
    pRange := @FStartRange
  else
    pRange := @FEndRange;
  MoveZero( pRange^, SizeOf( TKeyRange ) );
  with pRange^ do
  begin
    bKeyItself := KeyD;
    Active     := ( P <> NIL );
    iFields    := Fields;
    iLen       := Len;
    If bKeyItself then
    begin
      pKey := @Buffer;
      If ( P <> NIL ) then
        Move( P^, Buffer, FKeyDesc.iKeyLen )
      else
        MoveZero( Buffer, FKeyDesc.iKeyLen );
      If ( Fields = 0 ) then
      begin
        iFields  := FKeyDesc.iFldsinKey;
        pKeyBuff := @Buffer;
        For i := 0 to Pred( FKeyDesc.iFldsinKey ) do
        begin
          T := FFieldDescs[ FKeyDesc.aiKeyFld[ i ] ];
          OldOffset := T.DataOffset;
          T.DataOffset := 0;
          TranslateGet( T, Pointer( pKeyBuff ), @tmpBuff, bBlank );
          T.DataOffset := OldOffset;
          if bBlank or ( UseNulls and T.Null ) then
          begin
            Dec( iFields );
            If ( iFields = 0 ) then
            begin
              Active := FALSE;
              Break;
            end;
          end;
          Inc( pKeyBuff, T.LocalSize );
        end;
      end;
    end
    else
      pKey     := P;
    bKeyIncl   := Edge;
    Entire     := ( ( Fields + Len ) = 0 );
  end;
end;




Procedure TBaseTable.GetFieldDescs( pFDesc : pFLDDesc );
var
  i : Integer;
  M : PDescArray;
begin
  M  := PDescArray( pFDesc );
  For i := 1 to FFieldDescs.Count do
    FLDDesc( M^[ Pred( i ) ] ) := FFieldDescs.Field[ i ].Description;
end;


Procedure TBaseTable.OpenTable;
begin
  State := TblNoPos;
end;


Procedure TBaseTable.CloseTable;
begin
  State  := TblClosed;
end;

Procedure TBaseTable.OpenNestedTable(                       { Get nested table }
           iFieldNo      : Word;                            { FieldID of nested table field }
           bReadOnly     : Bool;                            { if TRUE, read only mode }
           bUniDirectional: Bool;                           { if TRUE, unidirectional }
           var hCursorNested : hDBICur                      { Returns Cursor handle for nested table }
         );
begin
  ThrowException( DBIERR_NOTSUPPORTED );
end;


Procedure TBaseTable.OpenRef(
           iFieldNo      : Word;                            { FieldID }
           bReadOnly     : Bool;                            { if TRUE, read only mode }
           bUniDirectional: Bool;                           { If TRUE, Uni directional }
           var hRefCursor : hDBICur                         { Returns Cursor handle for REF }
         );
begin
  ThrowException( DBIERR_NOTSUPPORTED );
end;

Procedure TBaseTable.RegenIndexes;
begin
  Not_Supported( fnREGENINDEXES );
end;


Procedure TBaseTable.Clone( bReadOnly : Bool; bUniDirectional : Bool;
                             var hCurNew : hDBICur );
begin
  ValidateParameter( Parent );
  ValidateValue( ( Parent is TBaseDatabase ), DBIERR_INVALIDPARAM );
  TBaseDatabase( Parent ).OpenTable( TableName, NIL, FIndexName, NIL,
    0, FOpenMode, FShareMode, xltNONE, bUniDirectional, NIL, hCurNew );
end;


Procedure TBaseTable.OpenIndex (                            { Open an index }
           pszIndexName  : PChar;                           { Index Name }
           iIndexId      : Word                             { Index number (if applicable) }
         );
begin
  ThrowException( DBIERR_NA );
end;


Procedure TBaseTable.CloseIndex (                           { Close an index }
           pszIndexName  : PChar;                           { Index Name }
           iIndexId      : Word                             { Index number (if applicable) }
         );
begin
  ThrowException( DBIERR_NA );
end;


Procedure TBaseTable.GetNativeDesc( iField : Integer; Src : Pointer; P : pFldDesc;
           Var LocType, LocSize : Word );
begin
  Not_Supported( fnGETNATIVEDESC );
end;


Procedure TBaseTable.GetLdObj (                             { Get language driver }
           var   pLdObj  : Pointer                          { Returned language driver object }
         );
begin
  pLdObj := @FLocale;
end;


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


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


Procedure TBaseTable.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 }
         );
begin
  Not_Supported( fnGETBLOB );
end;


Procedure TBaseTable.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 }
         );
begin
  Not_Supported( fnPUTBLOB );
end;


Procedure TBaseTable.TruncateBlob (                         { Reduces the blob size }
           pRecBuf       : Pointer;                         { Record Buffer }
           iField        : Word;                            { Field number of blob (1..n) }
           iLen          : Longint                          { New blob length }
         );
begin
  PutBlob( pRecBuf, iField, 0, iLen, NIL );
end;


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


Procedure TBaseTable.GetBlobHeading (                       { Get Blob Heading }
           iField        : Word;                            { Field number of blob (1..n) }
           pRecBuf       : Pointer;                         { Record buffer of owner record }
           pDest         : Pointer                          { Destination buffer }
          );
begin
  Not_Supported( fnGETBLOBHEADING );
end;


Procedure TBaseTable.SetFieldMap (                          { Set a fieldmap }
           iFields       : Word;                            { Number of fields }
           pFldDesc      : pFLDDesc                         { Array of field descriptions }
         );
begin
  Not_Supported( fnSETFIELDMAP );
end;


Procedure TBaseTable.MapGet( DType, DSize, DDec, LSize : SmallInt;
           Src, Dest : Pointer; Var Blank : Bool );
begin
  Blank  := FALSE;
end;


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


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

  Function CompareBool( lb1, lb2 : longBool ) : boolean;
  begin
    Result := ( lb1 AND lb2 ) OR ( NOT (lb1 or lb2 ) );
  end;

Var
  tmp : Integer;
begin
  Result := 0;
  Case fldType of
    fldZSTRING:
      begin
        If IgnoreCase then
          tmp := StrLIComp( F1, F2, CmpSize )
        else
          tmp := StrLComp( F1, F2, CmpSize );
        If ( tmp < 0 ) then
          Result := -1
        else
          If ( tmp > 0 ) then
            Result := 1;
      end;
    fldINT16:
      begin
        Case CmpSize of
          1 : begin
                If ( ShortInt( F1^ ) < ShortInt( F2^ ) ) then
                   Result := -1
                else
                  If ( ShortInt( F1^ ) > ShortInt( F2^ ) ) then
                     Result := 1;
              end;
          2 : begin
                If ( SmallInt( F1^ ) < SmallInt( F2^ ) ) then
                   Result := -1
                else
                  If ( SmallInt( F1^ ) > SmallInt( F2^ ) ) then
                     Result := 1;
              end;
        end;
      end;
    fldUINT16:
      begin
        Case CmpSize of
          1 : begin
                If ( Byte( F1^ ) < Byte( F2^ ) ) then
                   Result := -1
                else
                  If ( Byte( F1^ ) > Byte( F2^ ) ) then
                     Result := 1;
              end;
          2 : begin
                If ( Word( F1^ ) < Word( F2^ ) ) then
                   Result := -1
                else
                  If ( Word( F1^ ) > Word( F2^ ) ) then
                     Result := 1;
              end;
        end;
      end;
    fldFLOAT:
      begin
        If ( Double( F1^ ) < Double( F2^ ) ) then
          Result := -1
        else
          If ( Double( F1^ ) > Double( F2^ ) ) then
            Result := 1;
      end;
    fldINT32:
      begin
        If ( LongInt( F1^ ) < LongInt( F2^ ) ) then
          Result := -1
        else
          If ( LongInt( F1^ ) > LongInt( F2^ ) ) then
            Result := 1;
      end;
    fldTIMESTAMP:
      begin
        If ( Comp( F1^ ) < Comp( F2^ ) ) then
          Result := -1
        else
          If ( Comp( F1^ ) > Comp( F2^ ) ) then
            Result := 1;
      end;
    fldUINT32:
      begin
        If ( Cardinal( F1^ ) < Cardinal( F2^ ) ) then
          Result := -1
        else
          If ( Cardinal( F1^ ) > Cardinal( F2^ ) ) then
            Result := 1;
      end;
    fldBOOL:
      begin
        Case cmpSize of
          1 : if Not CompareBool( boolean( f1^ ), Boolean( f2^ ) ) then 
                Result := 1;
          2 : if Not CompareBool( WordBool( f1^ ), WordBool( f2^ ) ) then 
                Result := 1;
          4 : if Not CompareBool( LongBool( f1^ ), LongBool( f2^ ) ) then 
                Result := 1;
        end;
      end;
    else
      Result := Compare( F1^, F2^, CmpSize );
  end;
end;


Procedure TBaseTable.TranslateGet(
           P             : TFieldCacheItem;                 { Field Description Info }
           pRecBuff      : Pointer;                         { Record buffer }
           pDest         : Pointer;                         { Destination field buffer }
           var bBlank    : Bool                             { Returned : is field blank }
         );
begin
  ValidateParameter( pRecBuff );
  P.Buffer := pRecBuff;
  bBlank   := P.Null;
  if not bBlank and ( pDest <> NIL ) then
    with P do
      MapGet( LocalType, LocalSize, FieldUnits2, FieldLength, Data, pDest, bBlank );
end;


Procedure TBaseTable.GetField(                              { Get Field value }
           iField        : Word;                            { Field # (1..n) }
           pRecBuff      : Pointer;                         { Record buffer }
           pDest         : Pointer;                         { Destination field buffer }
           var bBlank    : Bool                             { Returned : is field blank }
         );
var
  T    : TFieldCacheItem;
  M    : Pointer;
  Buff : TttKeyBuffer;
begin
  ValidateParameter( pRecBuff );
  T := FFieldDescs[ iField ];
  T.Buffer := pRecBuff;
  If Assigned( pDest ) then
    TranslateGet( T, pRecBuff, pDest, bBlank )
  else
  begin
    If UseNulls then
    begin
      bBlank := T.Null;
      Exit;
    end;
    If ( Succ( T.FieldLength ) > SizeOf( TttKeyBuffer ) ) then
    begin
      M := AllocMem( Succ( T.FieldLength ) );
      Try
        TranslateGet( T, pRecBuff, M, bBlank );
      Finally
        FreeMem( M, Succ( T.FieldLength ) );
      end;
    end
    else
      TranslateGet( T, pRecBuff, @Buff, bBlank );
  end;
  T.Null := bBlank;
end;


Procedure TBaseTable.VerifyField (                          { Verifies the field value }
           iField        : Word;                            { Field # (1..n) }
           pSrc          : Pointer;                         { Field Value }
           var bBlank    : Bool                             { Field is Blank (Returned) }
         );
begin
  GetField( iField, pSrc, NIL, bBlank );
end;


Procedure TBaseTable.TranslatePut(
           P             : TFieldCacheItem;                 { Field Description Info }
           pRecBuff      : Pointer;                         { Record buffer }
           pSrc          : Pointer                          { Source field buffer }
         );
begin
  With P do
    MapPut( LocalType, LocalSize, FieldUnits2, FieldLength, pSrc, P.Data );
end;


Procedure TBaseTable.PutField (                             { Put a value in the record buffer }
           iField        : Word;                            { Field # (1..n) }
           pRecBuff      : Pointer;                         { Record buffer }
           pSrc          : Pointer                          { Source field buffer }
         );
var
  T : TFieldCacheItem;
begin
  ValidateParameter( pRecBuff );
  T := FFieldDescs[ iField ];
  With T Do
  begin
    Buffer := pRecBuff;
    TranslatePut( T, pRecBuff, pSrc );
    HasChanged := TRUE;
    Null       := ( pSrc = NIL );
  end;  
end;


Procedure TBaseTable.UpdateFilterStatus;
Var
  P : TFilterListItem;
  I : Integer;
begin
  For i := 0 to Pred( FFilters.Count ) do
  begin
    P := FFilters.Items[ i ];
    If ( P <> NIL ) and ( P.Active ) then
    begin
      FFilterActive := TRUE;
      Exit;
    end;
  end;
  FFilterActive := FALSE;
end;


Function TBaseTable.WithinFilter( pRecBuff : Pointer ) :  Boolean;
var
  P    : TFilterListItem;
  I    : Integer;
begin
  Result := TRUE;
  If FFilterActive then
  begin
    For i := 0 to Pred( FFilters.Count ) do
    begin
      P := FFilters.Items[ i ];
      if P.Active and not P.EvaluateExpression( pRecBuff ) then
      begin
        Result := FALSE;
        Exit;
      end;
    end;
  end;
end;


Procedure TBaseTable.AddFilter (                            { Add a filter to the cursor }
           iClientData   : Longint;                         { Client supplied data      (opt) }
           iPriority     : Word;                            { 1..N with 1 being highest (opt) }
           bCanAbort     : Bool;                            { TRUE if pfFiltercan return ABORT (opt) }
           pcanExpr      : pCANExpr;                        { Expression tree        (opt) }
           pfFilter      : pfGENFilter;                     { ptr to filter function (opt) }
           var hFilter   : hDBIFilter                       { Returns filter handle }
         );
var
  P : TFilterListItem;
begin
  P := TFilterListItem.Create( Self, iClientData, iPriority, bCanAbort, pcanExpr, pfFilter );
  FFilters.Insert( P );
  UpdateFilterStatus;
  hFilter := hDBIFilter( P );
end;


Procedure TBaseTable.DropFilter (                           { Drop a filter }
           hFilter       : hDBIFilter                       { Filter handle }
         );
var
  Count : Integer;
begin
  if ( hFilter = NIL ) then
    FFilters.FreeAll
  else
  begin
    Count := FFilters.Count;
    FFilters.Delete( hFilter );
    If ( Count <> FFilters.Count ) then
    begin
      TFilterListItem( hFilter ).Free;
      UpdateFilterStatus;
    end;
  end;
end;


Procedure TBaseTable.ActivateFilter (                       { Activate a Filter }
           hFilter       : hDBIFilter                       { Filter handle }
         );
var
  i     : Integer;
  P     : TFilterListItem;
  Found : Boolean;
begin
  Found := FALSE;
  For i := 0 to Pred( FFilters.Count ) do
  begin
    P := FFilters.Items[ i ];
    If ( hFilter = NIL ) or ( hFilter = hDBIFilter( P ) ) then
    begin
      P.Active      := TRUE;
      FFilterActive := TRUE;
      Found         := TRUE;
    end;
  end;
  If not Found and ( hFilter <> NIL ) then
    ThrowException( DBIERR_NOSUCHFILTER );
end;


Procedure TBaseTable.DeactivateFilter (                     { Deactivate Filter }
           hFilter       : hDBIFilter                       { Filter handle }
         );
var
  i : Integer;
  P : TFilterListItem;
begin
  if ( hFilter = NIL ) then
  begin
    For i := 0 to Pred( FFilters.Count ) do
    begin
      P := FFilters.Items[ i ];
      P.Active := FALSE;
    end;
    FFilterActive := FALSE;
  end
  else
  begin
    ValidateValue( ( FFilters.IndexOf( hFilter ) <> -1 ), DBIERR_NOSUCHFILTER );
    if TFilterListItem( hFilter ).Active then
    begin
      TFilterListItem( hFilter ).Active := FALSE;
      UpdateFilterStatus;
    end;
  end;
end;


Procedure TBaseTable.GetFilterInfo (                        { Get filter information }
           hFilter       : hDBIFilter;                      { Filter handle          /NULL }
           iFilterId     : Word;                            { Filter id              /0 }
           iFilterSeqNo  : Word;                            { Filter sequence number /0 }
           var Filterinfo : FilterInfo                      { Returns filter info }
         );
var
  P     : TFilterListItem;
  Index : Word;
begin
  if ( hFilter = NIL ) then
  begin
    P     := FFilters.At( 0 );
    Index := 0;
  end
  else
  begin
    P     := TFilterListItem( hFilter );
    Index := FFilters.IndexOf( P );
  end;
  If Assigned( P ) then
    P.GetFilterInfo( Index, FilterInfo )
  else
    MoveZero( FilterInfo, SizeOf( FilterInfo ) );
end;


Procedure TBaseTable.GetProp (                              { Get property }
           iProp         : Longint;                         { Property to retrieve }
           PropValue     : Pointer;                         { == NULL, validate iProp for getting }
           iMaxLen       : Word;                            { Length of buffer pPropValue }
           var   iLen    : Word                             { Returns required length }
         );
begin
  iLen := 0;
  Case TPropertyRec( iProp ).Prop of
    Word( curMAXPROPS ):                                    { ro UINT16   , Number of defined properties }
      begin
        iLen := SizeOf( Word );
        Word( PropValue^ ) := maxCurProps;
      end;
    Word( curTABLENAME ):                                   { ro pTBLNAME , Table name }
      { PGB - Should code this up }
      ;
    Word( curXLTMODE ):                                     { rw XLTMode  , Translate mode }
      begin
        iLen := SizeOf( xltMODE );
        xltMODE( PropValue^ ) := xltNONE;
      end;
    Word( curMAXFIELDID ):                                  { Max number of field descs }
      begin
        iLen := iMaxLen;
        Integer( PropValue^ ) := FFieldDescs.Count;
      end;
  else
    Inherited GetProp( iProp, PropValue, iMaxLen, iLen );
  end;
end;

Procedure TBaseTable.SetProp (                              { Set property }
            iProp         : Longint;                        { Property to retrieve }
            PropValue     : Longint                         { == NULL, validate iProp for getting }
         );
begin
  Case TPropertyRec( iProp ).Prop of
    Word( curMAKECRACK ):                                   { Set state to crack }
      State := TblOnCrack;
  else
    Inherited SetProp( iProp, PropValue );
  end;
end;

Procedure TBaseTable.ValidateProp (                         { Validate a property }
           iProp         : Longint;                         { property to validate }
           bSetting      : Bool                             { TRUE:setting, FALSE:getting }
         );
begin
  Case TPropertyRec( iProp ).Prop of
    Word( curMAXPROPS ),                                    { ro UINT16   , Number of defined properties }
    Word( curTABLENAME ):                                   { ro pTBLNAME , Table name }
      ValidateValue( bSetting, DBIERR_NOTSUPPORTED );
  else
    Inherited ValidateProp( iProp, bSetting );
  end;
end;


Procedure TBaseTable.BeginLinkMode;                         { Convert cursor to a link cursor }
begin
  Not_Supported( fnBEGINLINKMODE );
end;


Procedure TBaseTable.EndLinkMode;                           { Convert cursor to a link cursor }
begin
  Not_Supported( fnENDLINKMODE );
end;


Procedure TBaseTable.LinkDetail (                           { Link detail to master }
           hDetlCursor   : hDBICur;                         { Detail cursor }
           iLnkFields    : Word;                            { Number of link fields }
           piMstrFields  : PWord;                           { Array of fields in master }
           piDetlFields  : PWord                            { Array of fields in detail }
         );
begin
  Not_Supported( fnLINKDETAIL );
end;


Procedure TBaseTable.LinkDetailToExp (                      { Link detail to a master using exp }
           hCursorDetl   : hDBICur;                         { Detail cursor }
           iKeyLen       : Word;                            { Key length to match }
           pszMstrExp    : PChar                            { Expression string }
         );
begin
  Not_Supported( fnLINKDETAILTOEXP );
end;


Procedure TBaseTable.UnlinkDetail;                          { Unlink detail from master }
begin
  Not_Supported( fnUNLINKDETAIL );
end;


Procedure TBaseTable.GetLinkStatus (                        { Query linkage info for table }
           var hCursorMstr : hDBICur;                       { Returns master cursor, if any   (opt) }
           var hCursorDet : hDBICur;                        { Returns first detail cursor, if any (opt) }
           var hCursorSib : hDBICur                         { Returns next sibling detail cursor, if any (opt) }
         );
begin
  Not_Supported( fnGETLINKSTATUS );
end;


Procedure TBaseTable.RegisterCallBack (                     { Register a call back fn }
           ecbType       : CBType;                          { Type of call back }
           iClientData   : Longint;                         { Pass-thru client data }
           iCbBufLen     : Word;                            { Callback buffer len }
           CbBuf         : Pointer;                         { Pointer to callback buffer }
           pfCb          : pfDBICallBack                    { Call back fn being registered }
         );
begin
  Not_Used( fnREGISTERCALLBACK );
end;


Procedure TBaseTable.GetCallBack (                          { Register a call back fn }
                    ecbType       : CBType;                 { Type of call back }
                    piClientData  : PLongint;               { Pass-thru client data }
                    piCbBufLen    : PWord;                  { Callback buffer len }
                    ppCbBuf       : Pointer;                { Pointer to callback buffer }
                    var pfCb      : pfDBICallBack           { Call back fn being registered }
                  );
begin
  Not_Used( fnGETCALLBACK );
end;






Constructor TBaseDBListTable.Create( P : TObject; Container, CfgRecs : TTitanCollection;
              Driver : PChar; pTitanEnv : pTitanEnvInfo );
begin
  Inherited Create( P, Container, Driver, NIL, 0, dbiREADONLY, dbiOPENEXCL );
  FCfgRecs := CfgRecs;
  If ( Driver <> NIL ) then
    StrLCopy( @FDriver, Driver, SizeOf( FDriver ) - 1 );
  FpTitanEnv := pTitanEnv;
end;


Procedure TBaseDBListTable.DoneTableStruct;
begin
  CloseTable;
end;


Procedure TBaseDBListTable.GetNextRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
var
  P : TBaseCfgRecord;
  S : ShortString;
  i : Word;

  Function GetPhysicalName : ShortString;
  var
    i    : word;
    Fld  : pFldDesc;
    Z    : PChar;
  begin
    Fld := P.FFieldDescs;
    For i := 1 to P.FFields do
    begin
      With Fld^ Do
      begin
        If ( StrComp( szName, 'PATH' ) = 0 )
           or ( StrComp( szName, REG_PHYSICALNAME ) = 0 )
        then
        begin
          Z := P.FRec;
          Inc( Z, iOffset );
          Result := StrPas( Z );
          Exit;
        end;
      end;
      Inc( Fld );
    end;
    Result := '';
  end;

begin
  MoveZero( pRecBuff^, SizeOf( DBDesc ) );
  If ( FCfgRecs <> NIL ) then
  begin
    P := NIL;
    i := 0;
    While ( FCfgPos < FCfgRecs.Count ) do
    begin
      P := FCfgRecs.At( FCfgPos );
      Inc( FCfgPos );
      If ( P <> NIL ) then
      begin
        i := Pos( 'DB INFO', P.FPath );
        if ( i > 0 ) then
          Break;
      end;
    end;
    if ( i > 0 ) then
    begin
      S := Copy( P.FPath, 12, 255 );
      i := Pos( '\', S );
      if ( i > 0 ) then
      begin
        Delete( s, i, Length( s ) - Pred( i ) );
        AddChar( s, #0 );
        {S := Copy( S, 1, Pred( i ) ) + #0;}
      end;
      With DBDesc( pRecBuff^ ) do
      begin
        StrPCopy( @szName, S );                   { Logical name (Or alias) }
        StrPCopy( @szPhyName, GetPhysicalName );  { Physical name/path }
        StrCopy( @szDbType,  FDriver );           { Database type }
      end;
      Exit;
    end;
  end;
  ThrowEOFException;
end;


Constructor TRegDBListTable.Create( P : TObject; Container, CfgRecs : TTitanCollection;
              Driver : PChar; pTitanEnv : pTitanEnvInfo );
begin
  Inherited Create( P, Container, CfgRecs, Driver, pTitanEnv );
  FAliases := TStringList.Create;
end;


Destructor TRegDBListTable.Destroy;
begin
  FAliases.Free;
  Inherited Destroy;
end;


Procedure TRegDBListTable.OpenTable;
begin
  Rec_Count := 0;
  FCfgPos   := 0;
  FAliases.Clear;
  FSource   := TRightsRegistry.Create;
  ValidatePointer( FSource, DBIERR_NOSUCHTABLE );
  FSource.RootKey := FpTitanEnv^.RootKey;
  FSource.Rights  := KEY_READ;
  if FSource.OpenKey( FpTitanEnv^.ClientPath + '\' + REG_ALIASES, FALSE ) then
    FSource.GetKeyNames( FAliases );
  State  := TblNoPos;
end;


Procedure TRegDBListTable.CloseTable;
begin
  If ( State <> TblClosed ) then
  begin
    State  := TblClosed;
    FSource.Free;
  end;
end;


Procedure TRegDBListTable.GetNextRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
Var
  Key  : String;

  Function GetPhysicalName : String;
  begin
    if FSource.ValueExists( REG_PHYSICALNAME ) then
    begin
      Result := FSource.ReadString( REG_PHYSICALNAME );
      If Not TBaseSession( Parent ).FNoDBNameBackSlash then
        If ( Result[ Length( Result ) ] <> '\' ) then
          Result := Result + '\';
    end
    else
      Result := '';
  end;

begin
  If ( Rec_Count = 0 ) then
  begin
    { Check the config records first }
    Try
      Inherited GetNextRecord( eLock, pRecBuff, pRecProps );
      Exit;
    Except
      On ETitanBoundryError do
        ;
    end;
  end;
  if ( Rec_Count < FAliases.Count ) then
  begin
    MoveZero( pRecBuff^, SizeOf( DBDesc ) );
    Key := FpTitanEnv^.ClientPath + '\' + REG_ALIASES + '\' + FAliases.Strings[ Rec_Count ];
    If FSource.OpenKey( Key, FALSE ) then
    begin
      With DBDesc( pRecBuff^ ) do
      begin
        StrPCopy( @szName, PChar( FAliases.Strings[ Rec_Count ] ) );{ Logical name (Or alias) }
        If FSource.ValueExists( REG_DESCRIPTION ) then
          Key := FSource.ReadString( REG_DESCRIPTION )
        else
          Key := '';
        StrLCopy( @szText,  PChar( Key ), Pred( SizeOf( szText ) ) ); { Descriptive text }
        Key := GetPhysicalName;
        StrLCopy( @szPhyName,  PChar( Key ), Pred( SizeOf( szPhyName ) ) ); {Physical name/path }
        StrCopy( @szDbType,  FDriver );                     { Database type }
      end;
      Inc( Rec_Count );
    end
    else
      ThrowEOFException;
  end
    else
      ThrowEOFException;
end;




Constructor TBaseListTable.Create( P : TObject; Container: TTitanCollection;
              D : Pointer; TotalCount : Word );
var
  MemSize : Cardinal;
begin
  Inherited Create( P, Container, NIL, NIL, 0, dbiREADONLY, dbiOPENSHARED );
  Items   := TotalCount;
  if ( D <> NIL ) then
  begin
    MemSize := Items * GetWorkBufferSize;
    GetMem( Descs, MemSize );
    If ( Descs <> NIL ) then
      Move( D^, Descs^, MemSize );
  end;
  SetToBegin;
end;


Procedure TBaseListTable.SetToBegin;
begin
  inherited SetToBegin;
  Position := 0;
end;


Destructor TBaseListTable.Destroy;
begin
  If ( Descs <> NIL ) then
    FreeMem( Descs, Items * GetWorkBufferSize );
  Inherited Destroy;
end;


Procedure TBaseListTable.GetNextRecord(
           eLock     : DBILockType;
           pRecBuff  : Pointer;
           pRecProps : pRECProps
         );
var
  P : PChar;
begin
  If ( Position = Items ) then
    ThrowEOFException
  else
  begin
    P := Descs;
    Inc( P, Position * GetWorkBufferSize );
    Move( P^, pRecBuff^, GetWorkBufferSize );
    Inc( Position );
  end;
end;


Function TIndexListTable.GetBufferSize : Word;
begin
  Result := SizeOf( idxDESC );
end;


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


Constructor TBaseCfgRecord.Create( P : TObject; Container : TTitanCollection;
              Path : PChar; Fields : Integer; Descs : pFLDDesc; Rec : Pointer );
begin
  Inherited Create( P, Container );
  SetPath( Path );
  SetFields( Fields, Descs, Rec );
end;


Destructor TBaseCfgRecord.Destroy;
begin
  SetFields( 0, NIL, NIL );
  Inherited Destroy;
end;


Procedure TBaseCfgRecord.SetPath( Path : PChar );
begin
  FPath := StrPas( Path );
end;


Procedure TBaseCfgRecord.SetFields( Fields : Integer; Descs : pFLDDesc; Rec : Pointer );
begin
  if ( FFieldDescs <> NIL ) then
  begin
    if ( FRec <> NIL ) then
    begin
      FreeMem( FRec, RecordSize );
      FRec := NIL;
    end;
    FreeMem( FFieldDescs, SizeOf( FLDDesc ) * FFields );
  end;
  if ( Fields > 0 ) then
  begin
    FFields := Fields;
    GetMem( FFieldDescs, SizeOf( FLDDesc ) * FFields );
    if ( FFieldDescs <> NIL ) then
    begin
      Move( Descs^, FFieldDescs^, SizeOf( FLDDesc ) * FFields );
      If ( Rec <> NIL ) then
      begin
        GetMem( FRec, RecordSize );
        If ( FRec <> NIL ) then
          Move( Rec^, FRec^, RecordSize );
      end
      else
        FRec := NIL;
    end;
  end;
end;


Function TBaseCfgRecord.RecordSize : LongInt;
var
  i : Word;
  P : pFldDesc;
begin
  Result := 0;
  P      := FFieldDescs;
  For i := 1 to FFields do
  begin
    Inc( Result, P^.iLen );
    Inc( P );
  end;
end;




end.

