(*****************************************************************************)
(* MODULE: BTRDBASE                                                          *)
(* RIGHTS: Reggatta Systems - COPYRIGHT 1995 - 2000                          *)
(* DESCR.: This module contains the database classes.                        *)
(*****************************************************************************)
Unit BtrDbase;
{$I BSE.INC}
{$I BAPI.INC}
Interface
Uses
  Windows,
  Bde,

  BseTypes,
  BseBapi,
  BseColl,
  BseTable,
  BseDbase,

  BtrWObj,
  BtrTypes,
  BtrTable;

Type
  TBtrDatabase =
  Class( TBaseDatabase )
    Protected
      FPClientID : PBtrClientID;
    Public
      Property ClientID : PBtrClientID
        Read  FPClientID
        Write FPCLientID;
      Function    GetObjType : PChar; Override;

      Procedure   SetDirectory( pszDir : PChar ); Override;
      Procedure   GetDirectory( bDefault : Bool; pszDir : PChar ); Override;

      Function  GetPassword : String;
      Function  BuildDDFName( DDFName : PChar ) : String;
      Procedure OpenFileDDF( Var H : hDBICur );
      Procedure OpenFieldDDF( Var H : hDBICur );
      Procedure OpenIndexDDF( Var H : hDBICur );
{$IFDEF SMITHWARE_EXTENDED}
      Procedure OpenExtFieldDDF( Var H : hDBICur );
{$ENDIF}
      Procedure   LoadTableDDFInfo( Table : TBtrTable; Var DDFInfo : TFileDDF;
                    SearchName, PathToFile : PChar );

      Procedure   LoadFieldDDFInfo( Table : TBtrTable; pszTableName : PChar; TableID : SmallInt );

      Procedure   DeleteTable (                             { Delete a table }
                    pszTableName  : PChar;                  { Name including any path }
                    pszDriverType : PChar                   { Driver type /NULL }
                  ); Override;

      Procedure   RenameTable (                             { Rename table & family }
                    pszOldName    : PChar;                  { Old name }
                    pszDriverType : PChar;                  { Driver type /NULL }
                    pszNewName    : PChar                   { New name }
                  ); Override;

      Procedure   OpenTable (                               { Open a table }
                    pszTableName  : PChar;                  { Table name or file name }
                    pszDriverType : PChar;                  { Driver type                 /NULL }
                    pszIndexName  : PChar;                  { Index to be used for access /NULL }
                    pszIndexTagName : PChar;                { Index tag name              /NULL }
                    iIndexId      : Word;                   { Index number                /0 }
                    eOpenMode     : DBIOpenMode;            { Read or RW }
                    eShareMode    : DBIShareMode;           { Excl or Share }
                    exltMode      : XLTMode;                { Xlate mode }
                    bUniDirectional : Bool;                 { Uni or Bi directional }
                    pOptParams    : Pointer;                { Optional params /NULL }
                    var   hCursor : hDBICur                 { Returns Cursor handle }
                  ); Override;

      Procedure   OpenTableList (                           { Open a cursor on "Tables" }
                    bExtended     : Bool;                   { True for extended info }
                    bSystem       : Bool;                   { True to include system tables }
                    pszWild       : PChar;                  { Wild card name }
                    var   hCur    : hDBICur                 { Returned cursor }
                  ); Override;

      Procedure   OpenFieldListLocal(                       { Return "Fields" for a table }
                    pszTableName  : PChar;                  { Table name }
                    bPhyTypes     : Bool;                   { True, for physical types }
                    var   hCur    : hDBICur;                { Returned cursor on "Fields" }
                    pTableDDF     : PFileDDF
                  );

      Procedure   OpenFieldList (                           { Return "Fields" for a table }
                    pszTableName  : PChar;                  { Table name }
                    pszDriverType : PChar;                  { Driver type }
                    bPhyTypes     : Bool;                   { True, for physical types }
                    var   hCur    : hDBICur                 { Returned cursor on "Fields" }
                  ); Override;

      Procedure   BeginTran (                               { Begin a transaction }
                    eXIL          : eXILType;               { Transaction isolation level }
                    var hXact     : hDBIXact                { Returned Xact handle }
                  ); Override;

      Procedure   EndTran (                                 { End a transaction }
                    hXact         : hDBIXact;               { Xact handle }
                    eEnd          : eXEnd                   { Xact end type }
                  ); Override;

      Procedure   CreateTempTable (                         { Create temporary table (Physical) }
                    var crTblDsc  : CRTblDesc;              { Table description }
                    var hCursor   : hDBICur                 { Returned cursor on table }
                  ); Override;

 end;

Implementation
Uses
  SysUtils,

  BseConst,
  BseUtils,
  BseErrs,

  BtrConst,
  BtrErrs,
  BtrConv
  ,BseRes
  ;

Function TBtrDatabase.GetObjType : PChar;
const
  T : PChar = 'BTRIEVE';
begin
  Result := T;
end;


Procedure TBtrDatabase.SetDirectory(
           pszDir : PChar
         );
var
  WinBtr : TWinBtr;
begin
  WinBtr := TWinBtr.Create( ClientID );
  Try
    WinBtr.SetDirectory( pszDir );
  Finally
    WinBtr.Free;
  end;
end;


Procedure TBtrDatabase.GetDirectory(
           bDefault : Bool;
           pszDir   : PChar
         );
var
  WinBtr : TWinBtr;
begin
  WinBtr := TWinBtr.Create( ClientID );
  Try
    WinBtr.GetDirectory( pszDir, DBIMAXPATHLEN );
  Finally
    WinBtr.Free;
  end;
end;


Function TBtrDatabase.GetPassword : String;
begin
  If ( StrLen( Password ) > 0 ) then
    Result := StrPas( Password )
  else
    Result := StrPas( WBTRV_DDF_OWNER );
end;


Function TBtrDatabase.BuildDDFName( DDFName : PChar ) : String;
begin
  Result := AddBackSlash( StrPas( @Description.szPhyName ) ) +
            ExtractFileName( StrPas( DDFName ) ) +
            StrPas( BAPI_OWNER_TOKEN ) +
            GetPassword;
end;


Procedure TBtrDatabase.OpenFileDDF( Var H : hDBICur );
Var
  Buffer : Array[0..255] of Char;
begin
  StrPCopy( @Buffer, BuildDDFName( WBTRV_TABLE_FILE ) );
  OpenTable( @Buffer, NIL, NIL, NIL, 0, dbiREADWRITE, dbiOPENEXCL,
      XLTNONE, TRUE, NIL, H );
end;


Procedure TBtrDatabase.OpenFieldDDF( Var H : hDBICur );
Var
  Buffer : Array[0..255] of Char;
begin
  StrPCopy( @Buffer, BuildDDFName( WBTRV_FIELD_FILE ) );
  OpenTable( @Buffer, NIL, NIL, NIL, 0, dbiREADWRITE, dbiOPENEXCL,
      XLTNONE, TRUE, NIL, H );
end;


Procedure TBtrDatabase.OpenIndexDDF( Var H : hDBICur );
Var
  Buffer : Array[0..255] of Char;
begin
  StrPCopy( @Buffer, BuildDDFName( WBTRV_INDEX_FILE ) );
  OpenTable( @Buffer, NIL, NIL, NIL, 0, dbiREADWRITE, dbiOPENEXCL,
      XLTNONE, TRUE, NIL, H );
end;


{$IFDEF SMITHWARE_EXTENDED}
Procedure TBtrDatabase.OpenExtFieldDDF( Var H : hDBICur );
Var
  Buffer : Array[0..255] of Char;
begin
  StrPCopy( @Buffer, BuildDDFName( WBTRV_EXTFIELD_FILE ) );
  OpenTable( @Buffer, NIL, NIL, NIL, 0, dbiREADWRITE, dbiOPENEXCL,
      XLTNONE, TRUE, NIL, H );
end;
{$ENDIF}


Procedure TBtrDatabase.DeleteTable (                         { Delete a table }
            pszTableName  : PChar;                           { Name including any path }
            pszDriverType : PChar                            { Driver type /NULL }
          );
var
  P     : TBtrTable;
  Info  : TFileDDF;
  tmp   : ShortString;

  Procedure Delete_Field_Definitions;
  var
    F      : TBaseTable;
    FInfo  : TFieldDDF;
  begin
    OpenFieldDDF( hDBICur( F ) );
    Try
      Try
        Repeat
          F.GetNextRecord( dbiNOLOCK, @FInfo, NIL );
          if ( Info.Xf_Id = FInfo.Xe_File ) then
            F.DeleteRecord( @FInfo );
        Until FALSE;
      Except
        On E:ETitanEngineError do
          ;
      end;
    Finally
      F.Free;
    end;
  end;

{$IFDEF SMITHWARE_EXTENDED}
  Procedure Delete_ExtField_Definitions;
  var
    F      : TBtrTable;
    FInfo  : TExtFieldDDF;
  begin
    OpenExtFieldDDF( hDBICur( F ) );
    Try
      Try
        Repeat
          F.GetNextRecord( dbiNOLOCK, @FInfo, NIL );
          if ( Info.Xf_Id = FInfo.Xx_File ) then
            F.DeleteRecord( @FInfo );
        Until FALSE;
      Except
        On E:ETitanEngineError do
          ;
      end;
    Finally
      F.Free;
    end;
  end;
{$ENDIF SMITHWARE_EXTENDED}

  Procedure Delete_Index_Definitions;
  var
    F      : TBaseTable;
    FInfo  : TIndexDDF;
  begin
    OpenIndexDDF( hDBICur( F ) );
    Try
      Try
        Repeat
          F.GetNextRecord( dbiNOLOCK, @FInfo, NIL );
          if ( Info.Xf_Id = FInfo.Xi_File ) then
            F.DeleteRecord( @FInfo );
        until FALSE;
      Except
        On E:ETitanEngineError do
          ;
      end;
    Finally
      F.Free;
    end;
  end;

begin
  (* This function simply deletes the name of the table in the DDF, the file itself *)
  (* is not touched.                                                                *)
  OpenFileDDF( hDBICur( P ) );
  Try
    Try
      Repeat
        P.GetNextRecord( dbiNOLOCK, @Info, NIL );
        if ( StrPos( StrUpper( @Info.Xf_Name ), pszTableName ) <> NIL ) then
        begin
          P.DeleteRecord( @Info );
          Delete_Field_Definitions;
          Delete_Index_Definitions;
{$IFDEF SMITHWARE_EXTENDED}
          Delete_ExtField_Definitions;
{$ENDIF SMITHWARE_EXTENDED}
          Break;
        end
      Until FALSE;
    Except
      On E:ETitanBoundryError do
        ThrowBtrieveExceptionMsg( ISAM_NO_SUCH_TABLE, StrPas( pszTableName ) );
    end;
  Finally
    P.Free;
  end;
end;


Procedure TBtrDatabase.RenameTable (                         { Rename table & family }
            pszOldName    : PChar;                           { Old name }
            pszDriverType : PChar;                           { Driver type /NULL }
            pszNewName    : PChar                            { New name }
          );
var
  P     : TBaseTable;
  Info  : TFileDDF;
begin
  (* This function simply changes the name of the table in the DDF, the data file *)
  (* is not touched.                                                              *)
  OpenTable( WBTRV_TABLE_FILE, NIL, NIL, NIL, 0, dbiREADWRITE, dbiOPENEXCL,
    XLTNONE, TRUE, NIL, hDBICur( P ) );
  Try
    Try
      Repeat
        P.GetNextRecord( dbiNOLOCK, @Info, NIL );
        if ( StrPos( StrUpper( @Info.Xf_Name ), pszOldName ) <> NIL ) then
        begin
          P.GetRecord( dbiWRITELOCK, @Info, NIL );
          StrLCopy( @Info.Xf_Name, pszNewName, Pred( Sizeof( Info.Xf_Name ) ) );
          P.ModifyRecord( @Info, TRUE );
          Break;
        end;
      Until FALSE;
    Except
      on E:ETitanBoundryError do
        ThrowBtrieveExceptionMsg( ISAM_NO_SUCH_TABLE, StrPas( pszOldName ) );
    end;
  Finally
    P.Free;
  end;
end;


Procedure TBtrDatabase.OpenTable (                           { Open a table }
            pszTableName  : PChar;                           { Table name or file name }
            pszDriverType : PChar;                           { Driver type                 /NULL }
            pszIndexName  : PChar;                           { Index to be used for access /NULL }
            pszIndexTagName : PChar;                         { Index tag name              /NULL }
            iIndexId      : Word;                            { Index number                /0 }
            eOpenMode     : DBIOpenMode;                     { Read or RW }
            eShareMode    : DBIShareMode;                    { Excl or Share }
            exltMode      : XLTMode;                         { Xlate mode }
            bUniDirectional : Bool;                          { Uni or Bi directional }
            pOptParams    : Pointer;                         { Optional params /NULL }
            var hCursor   : hDBICur                          { Returns Cursor handle }
          );
var
  P   : TBtrTable;
  DDF : PFileDDF;
  S   : ShortString;

  Function Read_Resource( Table : TBtrTable ) : Boolean;
  var
    ResR : TTblResReader;
    T    : TFieldCacheItem;
    i    : Integer;
  begin
    Result:= FALSE;
    if ( Table.FFieldsResFlag ) then
    begin
      ResR := TTblResReader.CreateWithTitan( Table );
      Try
        if ResR.ReadResource( StrPas( Table.FFieldsResName ) ) then
        begin
          (* Check for Blobs and set flags accordingly *)
          For i := 1 to Table.Fields.Count do
          begin
            T := Table.Fields[ i ];
            if ( T <> NIL ) then
              Table.TestForBlob( i, @T.Description );
          end;
          Result := TRUE;
        end;
      Finally
        ResR.Free;
      End;
    end;
  end;

{ This code needs to deal with the RES: on the table name and also what to
  do with the filename/location }
begin
  S       := '';
  hCursor := NIL;
  P := TBtrTable.Create( Self, Tables, pszTableName, iIndexId, eOpenMode, eShareMode, ClientID );
  hCursor := hDBICur( P );
  If P.FFieldsResFlag and HasPath( P.TableName, TRUE ) then
  begin
    S                := BuildPath( StrPas( P.TableName ), StrPas( @Description.szPhyName ) );
    StrPCopy( P.FileName, S );
    P.FFieldsResFlag := Read_Resource( P );
  end;
  If Not P.FFieldsResFlag then
  begin
    DDF  := P.DriverHeader;
    LoadTableDDFInfo( P, DDF^, P.TableName, P.FileName );
  end;
  P.OpenTable;
  Try
    If Not P.FFieldsResFlag then
      LoadFieldDDFInfo( P, P.TableName, DDF^.Xf_Id );
    P.SetBlobFieldInfo;
    if Assigned( pszIndexName ) and ( StrLen( pszIndexName ) > 0 ) then
      P.SwitchToIndex( pszIndexName, NIL, 0, FALSE )
    else
      P.InitIndexInfo;
  Except
    On E:ETitanEngineError do
    begin
      P.CloseTable;
      Raise;
    end;
  end;
end;


Procedure TBtrDatabase.OpenTableList (                      { Open a cursor on "Tables" }
           bExtended     : Bool;                            { True for extended info }
           bSystem       : Bool;                            { True to include system tables }
           pszWild       : PChar;                           { Wild card name }
           var   hCur    : hDBICur                          { Returned cursor }
         );
begin
  hCur := hDBICur( TBtrTblListTable.Create( Self, Tables, @Description, bExtended, bSystem, pszWild, ClientID ) );
  ValidateHandle( hCur );
  TBtrTblListTable( hCur ).OpenTable;
end;


Procedure TBtrDatabase.OpenFieldListLocal(                   { Return "Fields" for a table }
            pszTableName  : PChar;                           { Table name }
            bPhyTypes     : Bool;                            { True, for physical types }
            var   hCur    : hDBICur;                         { Returned cursor on "Fields" }
            pTableDDF     : PFileDDF
          );
var
  P : TBaseTable;
  S : ShortString;

  Procedure OpenDefaultList;
  Var
    Buffer : Array[0..255] of Char;
  begin
    P := TBtrFieldListTable.Create( Self, Tables, @Description, bPhyTypes, ClientID );
    P.OpenTable;
    If Assigned ( pTableDDF ) then
      Move( pTableDDF^, TBtrFieldListTable( P ).OwnerDDF, Sizeof( TFileDDF ) )
    else
      LoadTableDDFInfo( TBtrFieldListTable( P ), TBtrFieldListTable( P ).OwnerDDF, pszTableName, @Buffer );
    TBtrTable( P ).SetKeyNumber( WBTRV_FIELD_TABLE_KEY );
  end;

begin
  P := NIL;
  S := UpperCase( StrPas( pszTableName ) );
  If ( Pos( StrPas( BAPI_RESOURCE_TOKEN ), S ) <> 0 ) then
  begin
    Try
      P := TResFieldListTable.Create( Self, Tables, pszTableName );
      P.OpenTable;
      hCur := hDBICur( P );
      Exit;
    Except
      on E:ETitanEngineError do
        P.Free;
    end;
  end;
  OpenDefaultList;
  hCur := hDBICur( P );
end;


Procedure TBtrDatabase.OpenFieldList (                        { Return "Fields" for a table }
             pszTableName  : PChar;                           { Table name }
             pszDriverType : PChar;                           { Driver type }
             bPhyTypes     : Bool;                            { True, for physical types }
             var   hCur    : hDBICur                          { Returned cursor on "Fields" }
           );
begin
  OpenFieldListLocal( pszTableName, bPhyTypes, hCur, NIL );
end;


Procedure TBtrDatabase.LoadTableDDFInfo( Table : TBtrTable; Var DDFInfo : TFileDDF;
            SearchName, PathToFile : PChar );

var
  P          : TBtrTblListTable;
  FDDF       : PFileDDF;
  TestName   : ShortString;
  SearchFile : ShortString;
  SearchDir  : ShortString;
  FilePath   : ShortString;
  SearchTmp  : DBIPATH;
  IsPath     : Boolean;
  IsDir      : Boolean;
  tmpTable   : TBaseTable;

  Procedure Read_Location;
  begin
    TestName := ArrayToStr( DDFInfo.Xf_Location, Pred( SizeOf( DDFInfo.Xf_Location ) ) );
    if IsDir then
      FilePath := BuildPath( TestName, SearchDir )
    else
      FilePath := BuildPath( TestName, StrPas( @Description.szPhyName ) );
  end;

  Procedure LoadValues;
  begin
    If ( PosOfCh( ':', SearchFile ) > 0 ) then
      FilePath := SearchFile
    else
      If ( PosOfCh( ':', FilePath ) = 0 ) and ( PosOfCh( '\', FilePath ) > 1 ) then
        FilePath := StrPas( @Description.szPhyName ) + FilePath;
    FDDF := Table.DriverHeader;
    if ( @DDFInfo = @FDDF ) then
      FDDF^.Xf_Id := DDFInfo.Xf_Id;
  end;

  Procedure UseTableList;
  begin
    IsPath := HasPath( @SearchTmp, TRUE );
    IsDir  := FALSE;
    If IsPath then
    begin
      SearchFile := StrPas( @SearchTmp );
      SearchDir  := ExtractFilePath( SearchFile );
      IsDir      := ( SearchDir <> '' );
    end;
    OpenTableList( FALSE, TRUE, NIL, hDBICur( P ) );
    Try
      Try
        Repeat
          P.GetNextRecordRaw( dbiNOLOCK, @DDFInfo );
          If IsPath then
          begin
            Read_Location;
            If ( AnsiCompareText( ExtractFileName( FilePath ), ExtractFileName( SearchFile ) ) = 0 ) then
              Break;
          end
          else
          begin
            TestName := ArrayToStrZ( DDFInfo.Xf_Name, WBTRV_NAME_LENGTH );
            If ( StrIComp( @TestName[ 1 ], @SearchTmp ) = 0 ) then
            begin
              Read_Location;
              Break;
            end;
          end;
        until FALSE;
        LoadValues;
      Except
        On E:ETitanBoundryError do
        begin
          MoveZero( DDFInfo, Sizeof( DDFInfo ) );
          FilePath := '';
          ThrowBtrieveExceptionMsg( ISAM_NO_SUCH_TABLE, StrPas( @SearchTmp ) );
        end;
      end;
    Finally
      P.Free;
    end;
  end;

begin
  MoveZero( DDFInfo, Sizeof( DDFInfo ) );
  SearchFile := '';
  FilePath   := '';
  SearchDir  := '';
  StrLCopy( @SearchTmp, SearchName, SizeOf( SearchTmp ) - 1 );
  CutString( @SearchTmp, BAPI_FIELD_DELIM );
  Try
    TableLoaded( SearchTmp, TBapiListItem( tmpTable ) );
    FilePath := StrPas( tmpTable.FileName );
    Move( tmpTable.DriverHeader^, DDFInfo, Sizeof( DDFInfo ) );
    LoadValues;
  Except
    On E:ETitanEngineError do
      UseTableList;
  end;
  StrPCopy( PathToFile, FilePath );
end;


Procedure TBtrDatabase.LoadFieldDDFInfo( Table : TBtrTable; pszTableName : PChar; TableID : SmallInt );
var
  tmp     : TBtrFieldListTable;
  DDFInfo : TFieldDDF;
  DBIDesc : FldDesc;
  Field   : Integer;
  Local   : Word;
  LocalSz : Word;
  i       : word;
  count   : word;
  size    : word;
  T       : TFieldCacheItem;
begin
  Try
    GetCursorForTable( pszTableName, NIL, hDbiCur( tmp ) );
    If ( tmp <> Table ) then
    begin
      tmp.GetFieldCount( count, size );
      for i := 1 to count do
      begin
        T := tmp.Fields[ i ];
        TFieldCacheItem.CreateField( Table.Fields, @T.Description, T.FieldNumber, T.LocalType, T.LocalSize );
      end;
    end
    else
      ThrowExceptionMsg( DBIERR_NOSUCHTABLE, StrPas( pszTableName ) );
  Except
    On E:ETitanEngineError do
    begin
      OpenFieldListLocal( pszTableName, TRUE, hDBICur( tmp ), Table.DriverHeader );
      Try
        Table.Fields.Clear;
        Field := 1;
        Try
          Repeat
            tmp.GetNextRecordRaw( dbiNOLOCK, @DDFInfo );
            Table.GetNativeDesc( Field, @DDFInfo, @DBIDesc, Local, LocalSz );
            If ( DDFInfo.Xe_DataType = btrFldNAMEDINDEX ) and ( DDFInfo.Xe_Size = 0 ) then
              Table.FIndexNames.Insert( DDFInfo.Xe_Offset, StrPas( @DBIDesc.szName ) )
            else
            begin
              TFieldCacheItem.CreateField( Table.Fields, @DBIDesc, Field, Local, LocalSz );
              Inc( Field );
            end;
          Until FALSE;
        Except
          on E:ETitanBoundryError do
            ;
        end;
        Table.GetFieldCount( count, i );
      Finally
        tmp.Free;
      end;
    end;
  end;
end;


Procedure TBtrDatabase.BeginTran (                           { Begin a transaction }
            eXIL          : eXILType;                        { Transaction isolation level }
            var hXact     : hDBIXact                         { Returned Xact handle }
          );
var
  WinBtr : TWinBtr;
  Flag   : Boolean;
begin
  if ( FexState <> xsActive ) then
  begin
    if ( xilREPEATABLEREAD = eXIL ) then
      Flag := TRUE
    else
      Flag := TRANSACTIONSCONCURRENT;
    hXact  := hDBIXact( Self );
    WinBtr := TWinBtr.Create( ClientID );
    Try
      WinBtr.BeginTransaction( Flag );
    Finally
      WinBtr.Free;
    end;
    FexState := xsActive;
  end
  else
    ThrowEXception( DBIERR_ACTIVETRAN );
end;


Procedure TBtrDatabase.EndTran (                             { End a transaction }
            hXact         : hDBIXact;                        { Xact handle }
            eEnd          : eXEnd                            { Xact end type }
          );
var
  WinBtr : TWinBtr;
begin
  WinBtr := TWinBtr.Create( ClientID );
  Try
    If ( eEnd = xendABORT ) then
      WinBtr.AbortTransaction
    else
      WinBtr.EndTransaction
  Finally
    WinBtr.Free;
  end;
  FexState := xsInactive;
end;


Procedure TBtrDatabase.CreateTempTable (                    { Create temporary table (Physical) }
           var crTblDsc  : CRTblDesc;                       { Table description }
           var hCursor   : hDBICur                          { Returned cursor on table }
         );
Var
  i,j      : Word;
  BtrIdx   : Word;
  h        : hDBIXact;
  BtrSpecs : TFileSpecs;
  F        : pFLDDesc;
  Idx      : PIDXDesc;
  WinBtr   : TWinBtr;
  KeyBuff  : TttKeyBuffer;
  Fname    : ShortString;
  P        : TBtrTable;
  Local    : Word;
  LocalSz  : Word;
begin
  hCursor := NIL;

  MoveZero( BtrSpecs, SizeOf( BtrSpecs ) );
  MoveZero( KeyBuff,  SizeOf( KeyBuff  ) );

  (* Set the TableName *)
  FName := BuildPath( StrPas( crTblDsc.szTblName ), StrPas( @Description.szPhyName ) );
  Move( FName[ 1 ], KeyBuff, Length( FName ) );

  (* Fill out the table header first *)
  With BtrSpecs.Header do
  begin
    F := crTblDsc.pfldDesc;
    For i := 1 to crTblDsc.iFldCount do
    begin
      If ( Record_length < F^.iOffset ) then
        Record_Length := F^.iOffset;
      Record_Length := Record_Length + F^.iLen;
      Inc( F );
    end;
    Page_Size  := TABLECREATE_PAGESIZE; { Consider optional params later}
    FileFlags  := TABLECREATE_FLAGS;    { Consider using database parameters }
    NumIndexes := crTblDsc.iIdxCount;
  end;

  (* Fill out the Index info next *)
  Idx    := crTblDsc.pidxDesc;
  BtrIdx := 0;
  For i := 1 to crTblDsc.iIdxCount do
  begin
    For j := 1 to Idx^.iFldsInKey do
    begin
      With BtrSpecs.Keys[ BtrIdx ] do
      begin
        F := crTblDsc.pfldDesc;
        Inc( F, Idx^.aiKeyFld[ j ] );
        key_position := SmallInt( Succ( F^.iOffset  ) );
        key_length   := SmallInt( F^.iLen );
        Key_Flags    := btrIdxModifiable;
        If ( Idx^.iFldsInKey > 1 ) and ( j < Pred( Idx^.iFldsInKey ) ) then
          Key_Flags := ( Key_Flags or btrIdxSegmented );
        if not Idx^.bUnique then
          Key_Flags := ( Key_Flags or btrIdxDuplicates );
        if Idx^.bDescending then
          Key_Flags := ( Key_Flags or btrIdxDescending );
        if Idx^.bCaseInsensitive then
          Key_Flags := ( Key_Flags or btrIdxCaseInsensitive );
        extended_key  := Byte( F^.iFldType );
      end;
      Inc( BtrIdx );
    end;
    Inc( Idx );
  end;

  (* Create the physical table *)
  WinBtr := TWinBtr.Create( ClientID );
  Try
    WinBtr.KeyBuffer := KeyBuff;
    WinBtr.Special( ISAM_CREATE, @BtrSpecs, SizeOf( BtrSpecs ) );

    (* Set Owner if appropriate *)
    j := StrLen( crTblDsc.szPassword );
    If ( ( j > 0 ) and ( j < 9 ) ) then
    begin
      MoveZero( KeyBuff, SizeOf( KeyBuff  ) );
      StrCopy( KeyBuff, crTblDsc.szPassword );
      WinBtr.KeyBuffer := KeyBuff;
      WinBtr.KeyNumber := TABLECREATE_OWNERMODE;
      WinBtr.Special( ISAM_SET_OWNER, @KeyBuff, Succ( j ) );
    end;
  Finally
    WinBtr.Free;
  end;

  (* Now that everything is ready, open the table and return the handle *)
  P := TBtrTable.Create( Self, Tables, StrPCopy( @KeyBuff, FName ), 0, dbiREADWRITE, dbiOPENSHARED, ClientID );
  hCursor := hDBICur( P );

  StrPCopy( P.FileName, FName );
  P.OpenTable;
  Try
    F := crTblDsc.pfldDesc;
    For i := 1 to crTblDsc.iFldCount do
    begin
      Local   := F^.iFldType;
      LocalSz := F^.iLen;
      (* Need to Map Btrieve types back to BDE types first *)
      MapBtrToDbi( Local, Localsz, F^.iFldType, F^.iSubType, F^.iLen, j );
      TFieldCacheItem.CreateField( P.Fields, F, i, Local, LocalSz );
      Inc( F );
    end;
    P.SetBlobFieldInfo;
    P.InitIndexInfo;
  Except
    On E:ETitanEngineError do
    begin
      P.CloseTable;
      Raise;
    end;
  end;
end;


end.
