(*****************************************************************************)
(* MODULE: BSEMAIN                                                           *)
(* AUTHOR: Peter Blair                                                       *)
(* RIGHTS: Reggatta Systems, Inc. - COPYRIGHT 1995 - 2001                    *)
(* DESCR.: This module contains the unit that defines the Titan components   *)
(*****************************************************************************)
Unit BseMain;
{$I BSE.INC}
{..$DEFINE USE_LOCALE_CODE}
{..$DEFINE USE_DBTABLES_STUFF}
{..$DEFINE USE_BDE_CALLBACKS}
{..$DEFINE USE_INDEX_FILES}
{$R-,T-,H+,X+}

Interface
Uses
  Variants,
  Windows,
  SysUtils,
  Graphics,
  Classes,
  Controls,
  Db,
  DBCommon,
  Bde,
  DbTables,
  BseEng,
  BseSess,
  BseTable;



type
  { Forward declarations }
  TttError         = Class;
  TttSession       = Class;
  TttDatabase      = Class;
  TttBDEDataset    = Class;
  TttDBDataset     = Class;
  TttTable         = Class;
  TttParams        = TParams;
  TttParam         = TParam;
  TttQuery         = Class;

  TttSessionClass  = Class of TttSession;
  TttDatabaseClass = Class of TttDatabase;
  TttTableClass    = Class of TttTable;
  TttQueryClass    = Class of TttQuery;

  { Exception Classes }

  ETDBEngineError =
  Class( EDatabaseError )
    Private
      FErrors: TList;
      Function GetError( Index: Integer ): TttError;
      Function GetErrorCount: Integer;
    Public
      constructor Create( Engine : TVirtEng; ErrorCode: DBIResult );
      destructor Destroy; Override;
      property ErrorCount: Integer read GetErrorCount;
      property Errors[Index: Integer]: TttError read GetError;
  end;

  { BDE error information type }
  TttError =
  Class( TObject )
    Private
      FErrorCode: DBIResult;
      FNativeError: Longint;
      FMessage: String;
      Function GetCategory: Byte;
      Function GetSubCode: Byte;
    Public
      constructor Create( Owner: ETDBEngineError; ErrorCode: DBIResult;
        NativeError: Longint; Message: PChar );
      property Category: Byte read GetCategory;
      property ErrorCode: DBIResult read FErrorCode;
      property SubCode: Byte read GetSubCode;
      property Message: String read FMessage;
      property NativeError: Longint read FNativeError;
  end;

  { TttBDECallback }
  TttBDECallbackEvent = Function( CBInfo: Pointer ): CBRType of Object;

  TttBDECallback =
  Class( TObject )
    Private
      FHandle: hDBICur;
      FOwner: TObject;
      FCBType: CBType;
      FOldCBData: Longint;
      FOldCBFunc: pfDBICallBack;
      FInstalled: Boolean;
      FCallbackEvent: TttBDECallbackEvent;
      FEngine : TVirtEng;
    Protected
      Function Invoke( CallType: CBType; CBInfo: Pointer ): CBRType;
    Public
      constructor Create( Engine : TVirtEng; AOwner: TObject; Handle: hDBICur; CBType: CBType;
        CBBuf: Pointer; CBBufSize: Integer; CallbackEvent: TttBDECallbackEvent;
        Chain: Boolean );
      destructor Destroy; Override;
  end;

  { TttSessionlist }
  TttSessionlist =
  Class( TObject )
    Private
      FDefault: TttSession;
      FSessions: TThreadList;
      FSessionNumbers: TBits;
      Procedure AddSession( ASession: TttSession );
      Procedure CloseAll;
      Function GetCount: Integer;
      Function GetSession( Index: Integer ): TttSession;
      Function GetCurrentSession: TttSession;
      Function GetSessionByName( const SessionName: String ): TttSession;
      Procedure SetCurrentSession( Value: TttSession );
    Protected
      Function  Engine : TVirtEng; Virtual; Abstract;
      Function  DefaultSession : TttSession; Virtual; Abstract;
      Function  GetSessionClass : TttSessionClass; Virtual; Abstract;
      Procedure OpenCriticalSection; Virtual; Abstract;
      Procedure CloseCriticalSection; Virtual; Abstract;
    Public
      constructor Create;
      destructor Destroy; Override;
      property CurrentSession: TttSession read GetCurrentSession write SetCurrentSession;
      Function FindSession( const SessionName: String ): TttSession;
      Procedure GetSessionNames( List: TStrings );
      Function OpenSession( const SessionName: String ): TttSession;
      property Count: Integer read GetCount;
      property Sessions[Index: Integer]: TttSession read GetSession; default;
      property List[const SessionName: String]: TttSession read GetSessionByName;
  end;

  { TttSession }
  TttSession =
  Class( TComponent, IDBSession )
    Private
      FHandle: HDBISes;
      FDatabases: TList;
      FCallbacks: TList;
      FStreamedActive: Boolean;
      FKeepConnections: Boolean;
      FDefault: Boolean;
      FSQLHourGlass: Boolean;
      FAutoSessionName: Boolean;
      FUpdatingAutoSessionName: Boolean;
      FDLLDetach: Boolean;
      FBDEOwnsLoginCbDb: Boolean;
      FSessionName: String;
      FSessionNumber: Integer;
      FNetFileDir: String;
      FPrivateDir: String;
      FCBSCType: CBSCType;
      FLockCount: Integer;
      FReserved: Integer;
      FCBDBLogin: TCBDBLogin;
      FOnPassword: TPasswordEvent;
      FOnStartup: TNotifyEvent;
      FOnDBNotify: TDatabaseNotifyEvent;
      Procedure AddDatabase( Value: TttDatabase );
      Procedure CallBDEInitProcs;
      Procedure CheckInactive;
      Procedure CheckConfigMode( CfgMode: TConfigMode );
      Procedure CloseDatabaseHandle( Database: TttDatabase );
      Function DBLoginCallback( CBInfo: Pointer ): CBRType;
      Procedure DBNotification( DBEvent: TDatabaseEvent; const Param );
      Procedure DeleteConfigPath( const Path, Node: String );
      Function DoFindDatabase( const DatabaseName: String; AOwner: TComponent ): TttDatabase;
      Function DoOpenDatabase( const DatabaseName: String; AOwner: TComponent ): TttDatabase;
      Function FindDatabaseHandle( const DatabaseName: String ): HDBIDB;
      Function GetActive: Boolean;
      Function GetConfigMode: TConfigMode;
      Function GetDatabase( Index: Integer ): TttDatabase;
      Function GetDatabaseCount: Integer;
      Function GetHandle: HDBISes;
      Function GetNetFileDir: String;
      Function GetPrivateDir: String;
      Procedure InitializeBDE;
      Procedure InternalAddAlias( const Name, Driver: String; List: TStrings;
        CfgMode: TConfigMode; RestoreMode: Boolean );
      Procedure InternalDeleteAlias( const Name: String; CfgMode: TConfigMode;
        RestoreMode: Boolean );
      Function  SessionNameStored: Boolean;
      Procedure LockSession;
      Procedure MakeCurrent;
      Procedure RegisterCallbacks( Value: Boolean );
      Procedure RemoveDatabase( Value: TttDatabase );
      Function  ServerCallback( CBInfo: Pointer ): CBRType;
      Procedure SetActive( Value: Boolean );
      Procedure SetAutoSessionName( Value: Boolean );
      Procedure SetConfigMode( Value: TConfigMode );
      Procedure SetConfigParams( const Path, Node: String; List: TStrings );
      Procedure SetNetFileDir( const Value: String );
      Procedure SetPrivateDir( const Value: String );
      Procedure SetSessionName( const Value: String );
      Procedure SetSessionNames;
      Procedure UnlockSession;
      Procedure UpdateAutoSessionName;
      Procedure ValidateAutoSession( AOwner: TComponent; AllSessions: Boolean );
    Protected
      FSessionList : TttSessionList;
      Function Engine : TVirtEng; Virtual; Abstract;
      Procedure SetEngineObject( FEngine : TVirtEng ); Virtual; Abstract;
      Procedure CriticalSectionStart; Virtual; Abstract;
      Procedure CriticalSectionEnd; Virtual; Abstract;
      Procedure Loaded; Override;
      Procedure ModifyConfigParams( const Path, Node: String; List: TStrings );
      Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
      property OnDBNotify: TDatabaseNotifyEvent read FOnDBNotify write FOnDBNotify;
      property BDEOwnsLoginCbDb: Boolean read FBDEOwnsLoginCbDb write FBDEOwnsLoginCbDb;
      Procedure SetName( const NewName: TComponentName ); Override;
      Procedure SetSessionList; Virtual; Abstract;
      Procedure AddtoSessionList;
      Procedure RemoveFromSessionList;
      Function  GetEngineClass : TBaseSessionClass; Virtual; Abstract;
      Function  DefaultSession : TttSession; Virtual; Abstract;
      Function  GetDatabaseClass : TttDatabaseClass; Virtual; Abstract;
    Public
      constructor Create( AOwner: TComponent ); Override;
      destructor Destroy; Override;
      Function  GetTableClass : TttTableClass; Virtual; Abstract;
      Procedure StartSession( Value: Boolean ); Virtual;
      Procedure AddTitanAlias( const Name : String; List: TStrings );
      Procedure DeleteTitanAlias( const Name: String );
      Procedure AddAlias( const Name, Driver: String; List: TStrings );
      Procedure AddDriver( const Name: String; List: TStrings );
      Procedure AddStandardAlias( const Name, Path, DefaultDriver: String );
      property ConfigMode: TConfigMode read GetConfigMode write SetConfigMode;
      Procedure AddPassword( const Password: String );
      Procedure Close;
      Procedure CloseDatabase( Database: TttDatabase );
      Procedure DeleteAlias( const Name: String );
      Procedure DeleteDriver( const Name: String );
      Procedure DropConnections;
      Function FindDatabase( const DatabaseName: String ): TttDatabase;
      Procedure GetAliasNames( List: TStrings );
      Procedure GetAliasParams( const AliasName: String; List: TStrings );
      Function GetAliasDriverName( const AliasName: String ): String;
      Procedure GetAliasDatabaseInfo( Const AliasName : String; Var Descript, Path : String );
      Function  GetAliasDatabaseDescription( const AliasName: String ): String;
      Function  GetAliasDatabasePath( const AliasName: String ): String;
      Procedure GetConfigParams( const Path, Section: String; List: TStrings );
      Procedure GetDatabaseNames( List: TStrings );
      Procedure GetDriverNames( List: TStrings );
      Procedure GetDriverParams( const DriverName: String; List: TStrings );
      procedure GetFieldNames(const DatabaseName, TableName: string;
        List: TStrings);
      Function GetPassword: Boolean;
      Procedure GetTableNames( const DatabaseName, Pattern: String;
        Extensions, SystemTables: Boolean; List: TStrings );
      Procedure GetStoredProcNames( const DatabaseName: String; List: TStrings );
      Function IsAlias( const Name: String ): Boolean;
      Procedure ModifyAlias( Name: String; List: TStrings );
      Procedure ModifyDriver( Name: String; List: TStrings );
      Procedure Open;
      Function OpenDatabase( const DatabaseName: String ): TttDatabase;
      Procedure RemoveAllPasswords;
      Procedure RemovePassword( const Password: String );
      Procedure SaveConfigFile;
      property DatabaseCount: Integer read GetDatabaseCount;
      property Databases[Index: Integer]: TttDatabase read GetDatabase;
      property Handle: HDBISES read GetHandle;
    Published
      property Active: Boolean read GetActive write SetActive default FALSE;
      property AutoSessionName: Boolean read FAutoSessionName write SetAutoSessionName default FALSE;
      property KeepConnections: Boolean read FKeepConnections write FKeepConnections default TRUE;
      property NetFileDir: String read GetNetFileDir write SetNetFileDir;
      property PrivateDir: String read GetPrivateDir write SetPrivateDir;
      property SessionName: String read FSessionName write SetSessionName stored SessionNameStored;
      property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default TRUE;
      property OnPassword: TPasswordEvent read FOnPassword write FOnPassword;
      property OnStartup: TNotifyEvent read FOnStartup write FOnStartup;
  end;

  TttTDatabaseLoginEvent = Procedure( Database: TttDatabase; LoginParams: TStrings ) of object;

  TttDatabase =
  Class( TCustomConnection )
    Private
      FTransIsolation: TTransIsolation;
      FKeepConnection: Boolean;
      FTemporary: Boolean;
      FSessionAlias: Boolean;
      FAliased: Boolean;
      FSQLBased: Boolean;
      FAcquiredHandle: Boolean;
      FPseudoIndexes: Boolean;
      FHandleShared: Boolean;
      FExclusive: Boolean;
      FReadOnly: Boolean;
      FRefCount: Integer;
      FHandle: HDBIDB;
      FSession: TttSession;
      FParams: TStrings;
      FStmtList: TList;
      FSessionName: String;
      FDatabaseName: String;
      FDatabaseType: String;
      FOnLogin: TttTDatabaseLoginEvent;
      Procedure CheckActive;
      Procedure CheckInactive;
      Procedure CheckDatabaseName;
      Procedure CheckDatabaseAlias( var Password: String );
      Procedure CheckSessionName( Required: Boolean );
      Procedure ClearStatements;
      Procedure EndTransaction( TransEnd: EXEnd );
      Function GetAliasName: String;
      Function GetDirectory: String;
      Function GetDriverName: String;
      Function GetInTransaction: Boolean;
{$HPPEMIT '#ifdef GetObjectContext'}
{$HPPEMIT '#undef GetObjectContext'}
{$HPPEMIT '#endif'}
      Function GetObjectContext: IUnknown;
      Function GetTraceFlags: TTraceFlags;
      Procedure Login( LoginParams: TStrings );
      Function  OpenFromExistingDB: Boolean;
      Procedure ParamsChanging( Sender: TObject );
      Procedure SetAliasName( const Value: String );
      Procedure SetDatabaseFlags;
      Procedure SetDatabaseName( const Value: String );
      Procedure SetDatabaseType( const Value: String; Aliased: Boolean );
      Procedure SetDirectory( const Value: String );
      Procedure SetDriverName( const Value: String );
      Procedure SetExclusive(Value: Boolean);
      Procedure SetHandle( Value: HDBIDB );
      Procedure SetKeepConnection( Value: Boolean );
      Procedure SetParams( Value: TStrings );
      Procedure SetReadOnly(Value: Boolean);
      Procedure SetTraceFlags( Value: TTraceFlags );
      Procedure SetSessionName( const Value: String );
    Protected
      FDefault : TttSession;
      FSessionList : TttSessionList;
      Function LoginPromptDefault : Boolean; Virtual;
      Procedure DoConnect; override;
      Procedure DoDisconnect; override;
      Function GetConnected: Boolean; override;
      Function GetDataSet(Index: Integer): TttDBDataSet; reintroduce;
      Function  Engine : TVirtEng; Virtual; Abstract;
      Procedure Loaded; Override;
      Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
      Procedure SetSessionList; Virtual;  // Override This!
      Function  DefaultSession : TttSession; Virtual; Abstract;
    Public
      constructor Create( AOwner: TComponent ); Override;
      destructor Destroy; Override;
      Procedure ApplyUpdates( const DataSets: array of TttDBDataset );
      Procedure CloseDataSets;
      Procedure Commit;
      Function Execute(const SQL: string; Params: TParams = NIL;
        Cache: Boolean = FALSE; Cursor: phDBICur = NIL): Integer;
      Procedure FlushSchemaCache( const TableName: String );
      procedure GetFieldNames(const TableName: string; List: TStrings);
      procedure GetTableNames(List: TStrings; SystemTables: Boolean = False);
      Procedure Rollback;
      Procedure StartTransaction;
      Procedure ValidateName( const Name: String );
      property DataSets[Index: Integer]: TttDBDataset read GetDataSet;
      property Directory: String read GetDirectory write SetDirectory;
      property Handle: HDBIDB read FHandle write SetHandle;
      property IsSQLBased: Boolean read FSQLBased;
      property InTransaction: Boolean read GetInTransaction;
      property Session: TttSession read FSession;
      property Temporary: Boolean read FTemporary write FTemporary;
      property SessionAlias: Boolean read FSessionAlias;
      property TraceFlags: TTraceFlags read GetTraceFlags write SetTraceFlags;
    Published
      property AliasName: String read GetAliasName write SetAliasName;
      property Connected;
      property DatabaseName: String read FDatabaseName write SetDatabaseName;
      property Exclusive: Boolean read FExclusive write SetExclusive default FALSE;
      property HandleShared: Boolean read FHandleShared write FHandleShared default FALSE;
      property KeepConnection: Boolean read FKeepConnection write SetKeepConnection default TRUE;
      property LoginPrompt;
      property Params: TStrings read FParams write SetParams;
      property ReadOnly: Boolean read FReadOnly write SetReadOnly default FALSE;
      property SessionName: String read FSessionName write SetSessionName;
      property TransIsolation: TTransIsolation read FTransIsolation write FTransIsolation default tiReadCommitted;
      property AfterConnect;
      property AfterDisconnect;
      property BeforeConnect;
      property BeforeDisconnect;
      property OnLogin: TttTDatabaseLoginEvent read FOnLogin write FOnLogin;
  end;

  { TttBDEDataset }
  TttDataSetUpdateObject =
  Class( TComponent )
    Protected
      Function GetDataSet: TDataSet; virtual; abstract;
      Procedure SetDataSet( ADataSet: TDataSet ); Virtual; Abstract;
      Procedure Apply( UpdateKind: TUpdateKind ); Virtual; Abstract;
      property DataSet: TDataset read GetDataSet write SetDataSet;
  end;

  TttSQLUpdateObject = class( TttDataSetUpdateObject )
  protected
     Function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
  end;

  TttBDEDataset =
  Class( TDataSet )
  Private
    FHandle: HDBICur;
    FRecProps: RecProps;
    FStmtHandle: HDBIStmt;
    FExprFilter: HDBIFilter;
    FFuncFilter: HDBIFilter;
    FFilterBuffer: PChar;
    FIndexFieldMap: DBIKey;
    FExpIndex: Boolean;
    FCaseInsIndex: Boolean;
    FCachedUpdates: Boolean;
    FInUpdateCallback: Boolean;
    FCanModify: Boolean;
    FCacheBlobs: Boolean;
    FKeySize: Word;
    FUpdateCBBuf: PDELAYUPDCbDesc;
    FUpdateCallback: TttBDECallback;
    FKeyBuffers: array[TKeyIndex] of PKeyBuffer;
    FKeyBuffer: PKeyBuffer;
    FRecNoStatus: TRecNoStatus;
    FIndexFieldCount: Integer;
    FConstDisableCount: Integer;
    FRecordSize: Word;
    FBookmarkOfs: Word;
    FRecInfoOfs: Word;
    FBlobCacheOfs: Word;
    FRecBufSize: Word;
    FConstraintLayer: Boolean;
    FBlockBufSize: Integer;
    FBlockBufOfs: Integer;
    FBlockBufCount: Integer;
    FBlockReadCount: Integer;
	FLastParentPos: Integer;
    FBlockReadBuf: PChar;
    FParentDataSet: TttBDEDataSet;
    FUpdateObject: TttDataSetUpdateObject;
    FOnUpdateError: TUpdateErrorEvent;
    FOnUpdateRecord: TUpdateRecordEvent;
    Procedure ClearBlobCache( Buffer: PChar );
    Function GetActiveRecBuf( var RecBuf: PChar ): Boolean;
    Function GetBlobData( Field: TField; Buffer: PChar ): TBlobData;
    Function GetOldRecord: PChar;
    Procedure InitBufferPointers( GetProps: Boolean );
    Function RecordFilter( RecBuf: Pointer; RecNo: Integer ): Smallint; stdcall;
    Procedure SetBlobData( Field: TField; Buffer: PChar; Value: TBlobData );
    Function HasConstraints: Boolean;
  Protected
    FSessionList : TttSessionList;
    Function  Engine : TVirtEng; Virtual; Abstract;
    Procedure SetSessionList; Virtual; Abstract;
    Function  DefaultSession : TttSession; Virtual; Abstract;
    Procedure ActivateFilters;
    Procedure AddFieldDesc(FieldDescs: TFieldDescList; var DescNo: Integer;
      var FieldID: Integer; RequiredFields: TBits; FieldDefs: TFieldDefs);
    Procedure AllocCachedUpdateBuffers( Allocate: Boolean );
    Procedure AllocKeyBuffers;
    Function  AllocRecordBuffer: PChar; Override;
    Function  CachedUpdateCallBack( CBInfo: Pointer ): CBRType;
    Procedure CheckCachedUpdateMode;
    Procedure CheckSetKeyMode;
    Procedure ClearCalcFields( Buffer: PChar ); Override;
    Procedure CloseCursor; Override;
    Procedure CloseBlob( Field: TField ); Override;
    Function  CreateExprFilter( const Expr: String;
      Options: TFilterOptions; Priority: Integer ): HDBIFilter;
    Function  CreateFuncFilter( FilterFunc: Pointer;
      Priority: Integer ): HDBIFilter;
    Function  CreateHandle: HDBICur; Virtual;
    Function  CreateLookupFilter( Fields: TList; const Values: Variant;
      Options: TLocateOptions; Priority: Integer ): HDBIFilter;
    Procedure DataEvent(Event: TDataEvent; Info: Longint); Override;
    Procedure DeactivateFilters;
    Procedure DestroyHandle; Virtual;
    Procedure DestroyLookupCursor; Virtual;
    Function  FindRecord( Restart, GoForward: Boolean ): Boolean; Override;
    Function  ForceUpdateCallback: Boolean;
    Procedure FreeKeyBuffers;
    Procedure FreeRecordBuffer( var Buffer: PChar ); Override;
    Procedure GetBookmarkData( Buffer: PChar; Data: Pointer ); Override;
    Function  GetBookmarkFlag( Buffer: PChar ): TBookmarkFlag; Override;
    Function  GetCanModify: Boolean; Override;
    Function  GetFieldFullName(Field: TField): string; override;
    Function GetHandle : HDBICur;
    Function  GetIndexField( Index: Integer ): TField;
    Function  GetIndexFieldCount: Integer;
    Function  GetIsIndexField( Field: TField ): Boolean; Override;
    Function  GetKeyBuffer( KeyIndex: TKeyIndex ): PKeyBuffer;
    Function  GetKeyExclusive: Boolean;
    Function  GetKeyFieldCount: Integer;
    Function  GetLookupCursor( const KeyFields: String; CaseInsensitive: Boolean ): HDBICur; Virtual;
    Function  GetRecord( Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean ): TGetResult; Override;
    Function  GetRecordCount: Integer; Override;
    Function  GetRecNo: Integer; Override;
    Function  GetRecordSize: Word; Override;
    Function  GetStateFieldValue( State: TDataSetState; Field: TField ): Variant; Override;
    Procedure GetObjectTypeNames(Fields: TFields);
    Function  GetUpdatesPending: Boolean;
    Function  GetUpdateRecordSet: TUpdateRecordTypes;
    Function  InitKeyBuffer( Buffer: PKeyBuffer ): PKeyBuffer;
    Procedure InitRecord( Buffer: PChar ); Override;
    Procedure InternalAddRecord( Buffer: Pointer; Append: Boolean ); Override;
    Procedure InternalCancel; Override;
    Procedure InternalClose; Override;
    Procedure InternalDelete; Override;
    Procedure InternalEdit; Override;
    Procedure InternalFirst; Override;
    Procedure InternalGotoBookmark( Bookmark: TBookmark ); Override;
    Procedure InternalHandleException; Override;
    Procedure InternalInitFieldDefs; Override;
    Procedure InternalInitRecord( Buffer: PChar ); Override;
    Procedure InternalInsert; override;
    Procedure InternalLast; Override;
    Procedure InternalOpen; Override;
    Procedure InternalPost; Override;
    Procedure InternalRefresh; Override;
    Procedure InternalSetToRecord( Buffer: PChar ); Override;
    Function  IsCursorOpen: Boolean; Override;
    Function  LocateRecord( const KeyFields: String; const KeyValues: Variant;
      Options: TLocateOptions; SyncCursor: Boolean ): Boolean;
    Function  MapsToIndex( Fields: TList; CaseInsensitive: Boolean ): Boolean;
    Procedure OpenCursor( InfoQuery: Boolean ); Override;
    Procedure PostKeyBuffer( Commit: Boolean );
    Procedure PrepareCursor; Virtual;
    Function  ProcessUpdates( UpdCmd: DBIDelayedUpdCmd ): DBIResult;
    Function  ResetCursorRange: Boolean;
    Procedure SetBookmarkData( Buffer: PChar; Data: Pointer ); Override;
    Procedure SetBookmarkFlag( Buffer: PChar; Value: TBookmarkFlag ); Override;
    Procedure SetCachedUpdates( Value: Boolean );
    Function  SetCursorRange: Boolean;
    Procedure SetFieldData( Field: TField; Buffer: Pointer ); Override;
    Procedure SetFilterData( const Text: String; Options: TFilterOptions );
    Procedure SetFilterHandle( var Filter: HDBIFilter; Value: HDBIFilter );
    Procedure SetFiltered( Value: Boolean ); Override;
    Procedure SetFilterOptions( Value: TFilterOptions ); Override;
    Procedure SetFilterText( const Value: String ); Override;
    Procedure SetIndexField( Index: Integer; Value: TField );
    Procedure SetKeyBuffer( KeyIndex: TKeyIndex; Clear: Boolean );
    Procedure SetKeyExclusive( Value: Boolean );
    Procedure SetKeyFieldCount( Value: Integer );
    Procedure SetKeyFields( KeyIndex: TKeyIndex; const Values: array of const );
    Procedure SetLinkRanges( MasterFields: TList );
    Procedure SetStateFieldValue( State: TDataSetState; Field: TField; const Value: Variant ); Override;
    Procedure SetOnFilterRecord( const Value: TFilterRecordEvent ); Override;
    Procedure SetOnUpdateError( UpdateEvent: TUpdateErrorEvent );
    Procedure SetRecNo( Value: Integer ); Override;
    Procedure SetupCallBack( Value: Boolean );
    Procedure SetUpdateRecordSet( RecordTypes: TUpdateRecordTypes );
    Procedure SetUpdateObject( Value: TttDataSetUpdateObject );
    Procedure SwitchToIndex( const IndexName, TagName: String );
    Function  UpdateCallbackRequired: Boolean;
    property StmtHandle: HDBIStmt read FStmtHandle write FStmtHandle;
  Public
    constructor Create( AOwner: TComponent ); Override;
    destructor Destroy; Override;
    Procedure BlockReadNext; override;
    Procedure SetBlockReadSize(Value: Integer); override;
    Procedure ApplyUpdates;
    Function  BookmarkValid( Bookmark: TBookmark ): Boolean; Override;
    Procedure Cancel; Override;
    Procedure CancelUpdates;
    property  CacheBlobs: Boolean read FCacheBlobs write FCacheBlobs default TRUE;
    Function  CompareBookmarks( Bookmark1, Bookmark2: TBookmark ): Integer; Override;
    Procedure CommitUpdates;
    Function  ConstraintCallBack( Req: DsInfoReq; var ADataSources: DataSources ): DBIResult; stdcall;
    Function  ConstraintsDisabled: Boolean;
    Procedure DisableConstraints;
    Procedure EnableConstraints;
    Procedure FetchAll;
    Procedure FlushBuffers;
    Function  GetCurrentRecord( Buffer: PChar ): Boolean; Override;
    Function GetBlobFieldData(FieldNo: Integer; var Buffer: TBlobByteData): Integer; override;
    Function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; override;
    Function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
    Procedure GetIndexInfo;
    Function  Locate( const KeyFields: String; const KeyValues: Variant;
      Options: TLocateOptions ): Boolean; Override;
    Function  Lookup( const KeyFields: String; const KeyValues: Variant;
      const ResultFields: String ): Variant; Override;
    Function  IsSequenced: Boolean; Override;
    Procedure Post; Override;
    Procedure RevertRecord;
    Function  UpdateStatus: TUpdateStatus; Override;
    Function  Translate( Src, Dest: PChar; ToOem: Boolean ) : Integer;  Override;

    property ExpIndex: Boolean read FExpIndex;
    property Handle: HDBICur read FHandle;
    property KeySize: Word read FKeySize;
    property UpdateObject: TttDataSetUpdateObject read FUpdateObject write SetUpdateObject;
    property UpdatesPending: Boolean read GetUpdatesPending;
    property UpdateRecordTypes: TUpdateRecordTypes read GetUpdateRecordSet write SetUpdateRecordSet;
  Published
    property Active;
    property AutoCalcFields;
    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates default FALSE;
    property ObjectView default FALSE;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property BeforeRefresh;
    property AfterRefresh;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnNewRecord;
    property OnPostError;
    property OnUpdateError: TUpdateErrorEvent read FOnUpdateError write SetOnUpdateError;
    property OnUpdateRecord: TUpdateRecordEvent read FOnUpdateRecord write FOnUpdateRecord;
  end;

  TttNestedTable = class(TttBDEDataSet)
  protected
    Function  CreateHandle: HDBICur; override;
    Procedure DoAfterPost; override;
    Procedure DoBeforeInsert; override;
    Procedure InternalPost; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property DataSetField;
    property ObjectView default TRUE;
  end;

  TttDBDataset =
  Class( TttBDEDataset )
    Private
      FAutoRefresh: Boolean;
      FDBFlags: TDBFlags;
      FUpdateMode: TUpdateMode;
      FDatabase: TttDatabase;
      FDatabaseName: String;
      FSessionName: String;
      Procedure CheckDBSessionName;
      Function GetDBHandle: HDBIDB;
      Function GetDBSession: TttSession;
      Procedure SetDatabaseName( const Value: String );
      Procedure SetSessionName( const Value: String );
      Procedure SetUpdateMode( const Value: TUpdateMode );
      Procedure SetAutoRefresh(const Value: Boolean);
      Procedure SetupAutoRefresh;
    Protected
      Procedure CloseCursor; Override;
      Function ConstraintsStored: Boolean;
      Procedure Disconnect; Virtual;
      Procedure OpenCursor( InfoQuery: Boolean ); Override;
      Function SetDBFlag( Flag: Integer; Value: Boolean ): Boolean; virtual;
      Procedure SetHandle(Value: HDBICur);
      property DBFlags: TDBFlags read FDBFlags;
      property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
    Public
      constructor Create(AOwner: TComponent); override;
      Function CheckOpen( Status: DBIResult ): Boolean;
      Procedure CloseDatabase( Database: TttDatabase );
      Function OpenDatabase: TttDatabase;
      property Database: TttDatabase read FDatabase;
      property DBHandle: HDBIDB read GetDBHandle;
      property DBSession: TttSession read GetDBSession;
      property Handle: HDBICur read GetHandle write SetHandle;
    Published
      property AutoRefresh: Boolean read FAutoRefresh write SetAutoRefresh default FALSE;
      property DatabaseName: String read FDatabaseName write SetDatabaseName;
      property Filter;
      property Filtered;
      property FilterOptions;
      property SessionName: String read FSessionName write SetSessionName;
      property OnFilterRecord;
  end;

{ TttTable }

  TttBatchMove = Class;
  TttBatchMoveClass = Class of TttBatchMove;

  TttTable =
  Class( TttDBDataset )
  Private
    FStoreDefs: Boolean;
    FIndexDefs: TIndexDefs;
    FMasterLink: TMasterDataLink;
    FDefaultIndex: Boolean;
    FExclusive: Boolean;
    FReadOnly: Boolean;
    FTableType: TTableType;
    FFieldsIndex: Boolean;
    FTableName: TFileName;
    FIndexName: TIndexName;

    FLookupHandle: HDBICur;
    FLookupKeyFields: String;
    FTableLevel: Integer;
    FLookupCaseIns: Boolean;
    FNativeTableName: DBITBLNAME;
    Procedure CheckMasterRange;
    Procedure DecodeIndexDesc(const IndexDesc: IDXDesc;
      var Source, Name, FieldExpression, DescFields: string;
      var Options: TIndexOptions);
    Function FieldDefsStored: Boolean;
    Function GetDriverTypeName( Buffer: PChar ): PChar;
    Function GetExists: Boolean;
    Function GetIndexFieldNames: String;
    Function GetIndexName: String;
    Procedure GetIndexParams( const IndexName: String; FieldsIndex: Boolean;
      var IndexedName, IndexTag: String );
    Function GetMasterFields: String;
    Function GetTableTypeName: PChar;
    Function GetTableLevel: Integer;
    Function IndexDefsStored: Boolean;
    Function IsXBaseTable: Boolean;
    Procedure MasterChanged( Sender: TObject );
    Procedure MasterDisabled( Sender: TObject );
    Procedure SetDataSource( Value: TDataSource );
    Procedure SetExclusive( Value: Boolean );
    Procedure SetIndexDefs(Value: TIndexDefs);
    Procedure SetIndex( const Value: String; FieldsIndex: Boolean );
    Procedure SetIndexFieldNames( const Value: String );
    Procedure SetIndexName( const Value: String );
    Procedure SetMasterFields( const Value: String );
    Procedure SetReadOnly( Value: Boolean );
    Procedure SetTableLock( LockType: TLockType; Lock: Boolean );
    Procedure SetTableName( const Value: TFileName );
    Procedure SetTableType( Value: TTableType );
    Procedure UpdateRange;
  Protected
    Function CreateHandle: HDBICur; Override;
    Procedure DataEvent( Event: TDataEvent; Info: Longint ); Override;
    Procedure DefChanged(Sender: TObject); override;
    Procedure DestroyHandle; Override;
    Procedure DestroyLookupCursor; Override;
    Procedure DoOnNewRecord; Override;
    Procedure EncodeFieldDesc(var FieldDesc: FLDDesc;
      const Name: string; DataType: TFieldType; Size, Precision: Integer);
    Procedure EncodeIndexDesc(var IndexDesc: IDXDesc;
      const Name, FieldExpression: string; Options: TIndexOptions;
      const DescFields: string = '');
    Function GetCanModify: Boolean; Override;
    Function GetDataSource: TDataSource; Override;
    Function GetHandle( const IndexName, IndexTag: String ): HDBICur;
    Function GetLanguageDriverName: String;
    Function GetLookupCursor( const KeyFields: String;
      CaseInsensitive: Boolean ): HDBICur; Override;
    Procedure InitFieldDefs; Override;
    Function GetFileName: string;
    Function GetTableType: TTableType;
    Function IsProductionIndex( const IndexName: String ): Boolean;
    Function NativeTableName: PChar;
    Procedure PrepareCursor; Override;
    Procedure UpdateIndexDefs; Override;
    property MasterLink: TMasterDataLink read FMasterLink;
    Function  GetBatchMoveClass : TttBatchMoveClass; Virtual; Abstract;
  Public
    constructor Create( AOwner: TComponent ); Override;
    destructor Destroy; Override;
    Function BatchMove( ASource: TttBDEDataset; AMode: TBatchMode ): Longint;
    Procedure AddIndex(const Name, Fields: string; Options: TIndexOptions;
      const DescFields: string = '');
    Procedure ApplyRange;
    Procedure CancelRange;
    Procedure CreateTable;
    Procedure DeleteIndex( const Name: String );
    Procedure DeleteTable;
    Procedure EditKey;
    Procedure EditRangeEnd;
    Procedure EditRangeStart;
    Procedure EmptyTable;
    Function FindKey( const KeyValues: array of const ): Boolean;
    Procedure FindNearest( const KeyValues: array of const );
    Procedure GetDetailLinkFields(MasterFields, DetailFields: TList); override;
    Procedure GetIndexNames( List: TStrings );
    Procedure GotoCurrent( Table: TttTable );
    Function GotoKey: Boolean;
    Procedure GotoNearest;
    Procedure LockTable( LockType: TLockType );
    Procedure RenameTable( const NewTableName: String );
    Procedure SetKey;
    Procedure SetRange( const StartValues, EndValues: array of const );
    Procedure SetRangeEnd;
    Procedure SetRangeStart;
    Procedure UnlockTable( LockType: TLockType );
    property Exists: Boolean read GetExists;
    property IndexFieldCount: Integer read GetIndexFieldCount;
    property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
    property KeyExclusive: Boolean read GetKeyExclusive write SetKeyExclusive;
    property KeyFieldCount: Integer read GetKeyFieldCount write SetKeyFieldCount;
    property TableLevel: Integer read GetTableLevel write FTableLevel;
  Published
    property Constraints stored ConstraintsStored;
    property DefaultIndex: Boolean read FDefaultIndex write FDefaultIndex default TRUE;
    property Exclusive: Boolean read FExclusive write SetExclusive default FALSE;
    property FieldDefs stored FieldDefsStored;
    property IndexDefs: TIndexDefs read FIndexDefs write SetIndexDefs stored IndexDefsStored;
    property IndexFieldNames: String read GetIndexFieldNames write SetIndexFieldNames;
    property IndexName: String read GetIndexName write SetIndexName;
    property MasterFields: String read GetMasterFields write SetMasterFields;
    property MasterSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default FALSE;
    property StoreDefs: Boolean read FStoreDefs write FStoreDefs default FALSE;
    property TableName: TFileName read FTableName write SetTableName;
(*
    property TableType: TTableType read FTableType write SetTableType default ttDefault;
*)
    property UpdateMode;
    property UpdateObject;
  end;

{ TttBatchMove }
  TttBatchMove =
  Class( TComponent )
  Private
    FDestination: TttTable;
    FSource: TttBDEDataset;
    FMode: TBatchMode;
    FAbortOnKeyViol: Boolean;
    FAbortOnProblem: Boolean;
    FTransliterate: Boolean;
    FRecordCount: Longint;
    FMovedCount: Longint;
    FKeyViolCount: Longint;
    FProblemCount: Longint;
    FChangedCount: Longint;
    FMappings: TStrings;
    FKeyViolTableName: TFileName;
    FProblemTableName: TFileName;
    FChangedTableName: TFileName;
    FCommitCount: Integer;
    Function ConvertName( const Name: String; Buffer: PChar ): PChar;
    Procedure SetMappings( Value: TStrings );
    Procedure SetSource( Value: TttBDEDataset );
  Protected
    Function Engine : TVirtEng; Virtual; Abstract;
    Procedure Notification( AComponent: TComponent;
      Operation: TOperation ); Override;
  Public
    constructor Create( AOwner: TComponent ); Override;
    destructor Destroy; Override;
    Procedure Execute;
  Public
    property ChangedCount: Longint read FChangedCount;
    property KeyViolCount: Longint read FKeyViolCount;
    property MovedCount: Longint read FMovedCount;
    property ProblemCount: Longint read FProblemCount;
  Published
    property AbortOnKeyViol: Boolean read FAbortOnKeyViol write FAbortOnKeyViol default TRUE;
    property AbortOnProblem: Boolean read FAbortOnProblem write FAbortOnProblem default TRUE;
    property CommitCount: Integer read FCommitCount write FCommitCount default 0;
    property ChangedTableName: TFileName read FChangedTableName write FChangedTableName;
    property Destination: TttTable read FDestination write FDestination;
    property KeyViolTableName: TFileName read FKeyViolTableName write FKeyViolTableName;
    property Mappings: TStrings read FMappings write SetMappings;
    property Mode: TBatchMode read FMode write FMode default batAppend;
    property ProblemTableName: TFileName read FProblemTableName write FProblemTableName;
    property RecordCount: Longint read FRecordCount write FRecordCount default 0;
    property Source: TttBDEDataset read FSource write SetSource;
    property Transliterate: Boolean read FTransliterate write FTransliterate default TRUE;
  end;


  { TttStoredProc }
  TttStoredProc =
  Class( TttDBDataset )
  Private
    FProcName: String;
    FParams: TttParams;
    FParamDescs: TSPParamDescList;
    FServerDescs: TServerDescList;
    FRecordBuffer: array of Char;
    FOverLoad: Word;
    FPrepared: Boolean;
    FQueryMode: Boolean;
    FBindMode: TParamBindMode;
    Procedure BindParams;
    Function CheckServerParams: Boolean;
    Function CreateCursor( GenHandle: Boolean ): HDBICur;
    Procedure CreateParamDesc;
    Procedure FreeStatement;
    Function GetCursor( GenHandle: Boolean ): HDBICur;
    Procedure PrepareProc;
    Procedure ReadParamData(Reader: TReader);
    Procedure SetParamsList( Value: TttParams );
    Procedure SetServerParams;
    Procedure WriteParamData(Writer: TWriter);
  Protected
    Function CreateHandle: HDBICur; Override;
    Procedure DefineProperties(Filer: TFiler); override;
    Procedure Disconnect; Override;
    Function GetParamsCount: Word;
    Function SetDBFlag( Flag: Integer; Value: Boolean ): Boolean; override;
    Procedure SetOverLoad( Value: Word );
    Procedure SetProcName( const Value: String );
    Procedure SetPrepared( Value: Boolean );
    Procedure SetPrepare( Value: Boolean );
  Public
    constructor Create( AOwner: TComponent ); Override;
    destructor Destroy; Override;
    Procedure CopyParams( Value: TttParams );
    Function DescriptionsAvailable: Boolean;
    Procedure ExecProc;
    Function ParamByName( const Value: String ): TttParam;
    Procedure Prepare;
    Procedure GetResults;
    Procedure UnPrepare;
    property ParamCount: Word read GetParamsCount;
    property StmtHandle;
    property Prepared: Boolean read FPrepared write SetPrepare;
  Published
    property StoredProcName: String read FProcName write SetProcName;
    property Overload: Word read FOverload write SetOverload default 0;
    property Params: TttParams read FParams write SetParamsList stored FALSE;
    property ParamBindMode: TParamBindMode read FBindMode write FBindMode default pbByName;
    property UpdateObject;
  end;

  { TttQuery }
  TttQuery =
  Class( TttDBDataset )
    Private
      FSQL: TStrings;
      FPrepared: Boolean;
      FParams: TttParams;
      FText: String;
      FDataLink: TDataLink;
      FLocal: Boolean;
      FRowsAffected: Integer;
      FUniDirectional: Boolean;
      FRequestLive: Boolean;
      FSQLBinary: PChar;
      FConstrained: Boolean;
      FParamCheck: Boolean;
      FExecSQL: Boolean;
      FCheckRowsAffected: Boolean;
      Function CreateCursor( GenHandle: Boolean ): HDBICur;
      Function GetQueryCursor( GenHandle: Boolean ): HDBICur;
      Function GetRowsAffected: Integer;
      Procedure PrepareSQL( Value: PChar );
      Procedure QueryChanged( Sender: TObject );
      Procedure ReadBinaryData( Stream: TStream );
      Procedure ReadParamData(Reader: TReader);
      Procedure RefreshParams;
      Procedure SetDataSource( Value: TDataSource );
      Procedure SetQuery( Value: TStrings );
      Procedure SetParamsList( Value: TttParams );
      Procedure SetParamsFromCursor;
      Procedure SetPrepared( Value: Boolean );
      Procedure SetPrepare( Value: Boolean );
      Procedure WriteBinaryData( Stream: TStream );
      Procedure WriteParamData(Writer: TWriter);
    Protected
      Function CreateHandle: HDBICur; Override;
      Procedure DefineProperties( Filer: TFiler ); Override;
      Procedure Disconnect; Override;
      Procedure FreeStatement; virtual;
      Function GetDataSource: TDataSource; Override;
      Function GetParamsCount: Word;
      Function SetDBFlag( Flag: Integer; Value: Boolean ): Boolean; override;
      Procedure GetStatementHandle(SQLText: PChar); virtual;
      property DataLink: TDataLink read FDataLink;
    Public
      constructor Create( AOwner: TComponent ); Override;
      destructor Destroy; Override;
      Procedure ExecSQL;
      Procedure GetDetailLinkFields(MasterFields, DetailFields: TList); override;
      Function ParamByName( const Value: String ): TttParam;
      Procedure Prepare;
      Procedure UnPrepare;
      property Handle: HDBICur read FHandle;
      property Prepared: Boolean read FPrepared write SetPrepare;
      property ParamCount: Word read GetParamsCount;
      property Local: Boolean read FLocal;
      property StmtHandle;
      property Text: String read FText;
      property RowsAffected: Integer read GetRowsAffected;
      property SQLBinary: PChar read FSQLBinary write FSQLBinary;
    Published
      property Constrained: Boolean read FConstrained write FConstrained default FALSE;
      property Constraints stored ConstraintsStored;
      property DataSource: TDataSource read GetDataSource write SetDataSource;
      property ParamCheck: Boolean read FParamCheck write FParamCheck default TRUE;
      property RequestLive: Boolean read FRequestLive write FRequestLive default FALSE;
      property SQL: TStrings read FSQL write SetQuery;
      { This property must be listed after the SQL property for Delphi 1.0 compatibility }
      property Params: TttParams read FParams write SetParamsList stored FALSE;
      property UniDirectional: Boolean read FUniDirectional write FUniDirectional default FALSE;
      property UpdateMode;
      property UpdateObject;
  end;

  { TttUpdateSQL }
  TttUpdateSQL =
  Class( TttSQLUpdateObject )
  Private
    FDataSet: TDataset;
    FDatabaseName: string;
    FSessionName: string;
    FQueries: array[TUpdateKind] of TttQuery;
    FSQLText: array[TUpdateKind] of TStrings;
    Function GetQuery( UpdateKind: TUpdateKind ): TttQuery;
    Function GetSQLIndex( Index: Integer ): TStrings;
    Procedure SetSQL( UpdateKind: TUpdateKind; Value: TStrings );
    Procedure SetSQLIndex( Index: Integer; Value: TStrings );
  Protected
    Function GetSQL( UpdateKind: TUpdateKind ): TStrings; Override;
    Function  GetQueryClass : TttQueryClass; Virtual; Abstract;
    Function GetDataSet: TDataset; Override;
    Procedure SetDataSet( ADataSet: TDataset ); Override;
    Procedure SQLChanged( Sender: TObject );
  Public
    constructor Create( AOwner: TComponent ); Override;
    destructor Destroy; Override;
    Procedure Apply( UpdateKind: TUpdateKind ); Override;
    Procedure ExecSQL( UpdateKind: TUpdateKind ); virtual;
    Procedure SetParams( UpdateKind: TUpdateKind ); virtual;
    property DatabaseName: string read FDatabaseName write FDatabaseName;
    property DataSet;
    property Query[UpdateKind: TUpdateKind]: TttQuery read GetQuery;
    property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
    property SessionName: string read FSessionName write FSessionName;
  Published
    property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
    property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
    property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
  end;

  { TttBlobStream }
  TttBlobStream =
  Class( TStream )
    Private
      FField: TBlobField;
      FDataSet: TttBDEDataset;
      FBuffer: PChar;
      FMode: TBlobStreamMode;
      FFieldNo: Integer;
      FOpened: Boolean;
      FModified: Boolean;
      FPosition: Longint;
      FBlobData: TBlobData;
      FCached: Boolean;
      FCacheSize: Longint;
      Function GetBlobSize: Longint;
    Protected
      Function Engine : TVirtEng; Virtual; Abstract;
      Function PositionDataset: Boolean; Virtual;
    Public
      constructor Create( Field: TBlobField; Mode: TBlobStreamMode );
      destructor Destroy; Override;
      Function Read( var Buffer; Count: Longint ): Longint; Override;
      Function Write( const Buffer; Count: Longint ): Longint; Override;
      Function Seek( Offset: Longint; Origin: Word ): Longint; Override;
      Procedure Truncate;
  end;

Function GetFieldSource(ADataSet: TDataSet; var ADataSources:  DataSources): Boolean;

Function  IsDirectory( const DatabaseName: String ): Boolean;
Procedure RegisterBDEInitProc( const InitProc: TBDEInitProc );

implementation
uses
  Forms,
  DBPWDlg,
  DBConsts,
  BDEConst,
  ActiveX,
  BseErrs,
  DBLogDlg;


var
  TimerID: Word = 0;
  SQLDelay: DWORD = 50;
  StartTime: DWORD = 0;
  BDEInitProcs: TList;
  CurrentSession : TttSession;
  CurrentSessionList : TttSessionList;
  GetObjectContextProc: Function: IUnknown;

{ TttQueryDataLink }
type
  TttQueryDataLink =
  Class( TDetailDataLink )
    Private
      FQuery: TttQuery;
    Protected
      Procedure ActiveChanged; Override;
      Procedure RecordChanged( Field: TField ); Override;
      Function GetDetailDataSet: TDataSet; Override;
      Procedure CheckBrowseMode; Override;
    Public
      constructor Create( AQuery: TttQuery );
  end;

{ Utility routines }
Procedure TAnsiToNativeBuf( Engine : TVirtEng; Locale: TLocale; Source, Dest: PChar; Len: Integer );
var
  DataLoss: LongBool;
begin
  if ( Len > 0 ) then
    Engine.AnsiToNative( Locale, Dest, Source, Len, DataLoss );
end;


Procedure TNativeToAnsiBuf( Engine : TVirtEng; Locale: TLocale; Source, Dest: PChar; Len: Integer );
var
  DataLoss: LongBool;
begin
  if ( Len > 0 ) then
    Engine.NativeToAnsi( Locale, Dest, Source, Len, DataLoss );
end;


Function TAnsiToNative( Engine : TVirtEng; Locale: TLocale; const AnsiStr: String;
  NativeStr: PChar; MaxLen: Integer ): PChar;
var
  Len: Integer;
begin
  Len := Length( AnsiStr );
  if ( Len > MaxLen ) then
    Len := MaxLen;
  NativeStr[ Len ] := #0;
  if ( Len > 0 ) then
    TAnsiToNativeBuf( Engine, Locale, Pointer( AnsiStr ), NativeStr, Len );
  CharNext( AnsiStrLastChar( NativeStr ) )^ := #0;
  Result := NativeStr;
end;


Procedure TNativeToAnsi( Engine : TVirtEng; Locale: TLocale; NativeStr: PChar; var AnsiStr: String );
var
  Len : Integer;
begin
  Len := StrLen( NativeStr );
  SetString( AnsiStr, NIL, Len );
  if ( Len > 0 ) then
    TNativeToAnsiBuf( Engine, Locale, NativeStr, Pointer( AnsiStr ), Len );
end;


Procedure TDbiError( Engine : TVirtEng; ErrorCode: DBIResult );
begin
  Raise ETDBEngineError.Create( Engine, ErrorCode );
end;


Procedure Check( Engine : TVirtEng; Status: DBIResult );
begin
  if ( Status <> 0 ) then
    TDbiError( Engine, Status );
end;


Procedure RegisterBDEInitProc( const InitProc : TBDEInitProc );
begin
  if not Assigned( BDEInitProcs ) then
    BDEInitProcs := TList.Create;
  BDEInitProcs.Add( @InitProc );
end;




Function GetFieldSource(ADataSet: TDataSet; var ADataSources:  DataSources): Boolean;
var
  Current: PChar;
  Field: TField;
  Values: array[0..4] of string;
  I: Integer;

  Function GetPChar(const S: string): PChar;
  begin
    if S <> '' then 
      Result := PChar(Pointer(S)) 
    else 
      Result := '';
  end;

  Procedure Split(const S: string);
  begin
    Current := PChar(Pointer(S));
  end;

  Function NextItem: string;
  var
    C: PChar;
    I: PChar;
    Terminator: Char;
    Ident: array[0..1023] of Char;
  begin
    Result := '';
    C := Current;
    I := Ident;
    while C^ in ['.',' ',#0] do
      if C^ = #0 then 
        Exit 
      else 
        Inc(C);
    Terminator := '.';
    if C^ = '"' then
    begin
      Terminator := '"';
      Inc(C);
    end;
    while not (C^ in [Terminator, #0]) do
    begin
      if C^ in LeadBytes then
      begin
        I^ := C^;
        Inc(C);
        Inc(I);
      end
      else 
      if C^ = '\' then
      begin
        Inc(C);
        if C^ in LeadBytes then
        begin
          I^ := C^;
          Inc(C);
          Inc(I);
        end;
        if C^ = #0 then 
          Dec(C);
      end;
      I^ := C^;
      Inc(C);
      Inc(I);
    end;
    SetString(Result, Ident, I - Ident);
    if (Terminator = '"') and (C^ <> #0) then 
      Inc(C);
    Current := C;
  end;

  Function PopValue: PChar;
  begin
    if I >= 0 then
    begin
      Result := GetPChar(Values[I]);
      Dec(I);
    end 
    else 
      Result := '';
  end;

begin
  Result := FALSE;
  Field := ADataSet.FindField(ADataSources.szSourceFldName);
  if (Field = NIL) or (Field.Origin = '') then 
    Exit;
  Split(Field.Origin);
  I := -1;
  repeat
    Inc(I);
    Values[I] := NextItem;
  until (Values[I] = '') or (I = High(Values));
  if I = High(Values) then 
    Exit;
  Dec(I);
  StrCopy(ADataSources.szOrigFldName, PopValue);
  StrCopy(ADataSources.szTblName, PopValue);
  StrCopy(ADataSources.szDbName, PopValue);
  Result := (ADataSources.szOrigFldName[0] <> #0) and
    (ADataSources.szTblName[0] <> #0);
end;

{ Parameter binding routines }

Function GetParamDataSize(Param: TParam): Integer;
begin
  with Param do
    if ((DataType in [ftString, ftFixedChar]) and (Length(VarToStr(Value)) > 255)) or
       (DataType in [ftBlob..ftTypedBinary]) then
      Result := SizeOf(BlobParamDesc)
    else
      Result := GetDataSize;
end;

Procedure GetParamData( Engine : TVirtEng; Param: TParam; Buffer: Pointer; const DrvLocale: TLocale);

  Function GetNativeStr: PChar;
  begin
    Param.NativeStr := VarToStr(Param.Value);
    Result := PChar(Param.NativeStr);
    if DrvLocale <> NIL then
      TAnsiToNativeBuf( Engine, DrvLocale, Result, Result, StrLen(Result));
  end;

begin
  with Param do
    if DataType in [ftString, ftFixedChar, ftMemo]  then
    begin
      NativeStr := VarToStr(Value);
      if (Length(NativeStr) > 255) or (DataType = ftMemo) then
      begin
        with BlobParamDesc(Buffer^) do
        begin
          if DrvLocale <> NIL then
            TAnsiToNativeBuf( Engine, DrvLocale, PChar(NativeStr), PChar(NativeStr), Length(NativeStr));
          pBlobBuffer := PChar(NativeStr);
          ulBlobLen := StrLen(pBlobBuffer);
        end;
      end else
      begin
        if (DrvLocale <> NIL) then
          TAnsiToNativeBuf( Engine, DrvLocale, PChar(NativeStr), Buffer, Length(NativeStr) + 1) 
        else
          GetData(Buffer);
      end;
    end
    else if (DataType in [ftBlob..ftTypedBinary]) then
    begin
      with BlobParamDesc(Buffer^) do
      begin
        NativeStr := VarToStr(Value);
        ulBlobLen := Length(NativeStr);
        pBlobBuffer := PChar(NativeStr);
      end;
    end else
      GetData(Buffer);
end;

Function GetStatementLocale(StmtHandle: HDBIStmt): TLocale;
begin
  Result := NIL;
end;

Procedure FreeStatementLocale(var Value: TLocale);
begin
  Value := NIL;
end;

{ Any fixes made to this utility Procedure should also be investigated for the
  TStoredProcedure. }
Procedure SetQueryParams( Engine : TVirtEng; Sender : TComponent; StmtHandle: HDBIStmt; Params : TParams);
var
  I: Integer;
  NumBytes: Word;
  FieldDescs: TFieldDescList;
  RecBuffer: PChar;
  CurPtr, NullPtr: PChar;
  DrvLocale: TLocale;
begin
  SetLength( FieldDescs, Params.Count );
  NumBytes := SizeOf( SmallInt );
  for I := 0 to Params.Count - 1 do
    Inc(NumBytes, GetParamDataSize( Params[ I ] ) );
  RecBuffer := AllocMem( NumBytes );
  NullPtr := RecBuffer + NumBytes - SizeOf( SmallInt );
  Smallint( Pointer( NullPtr )^ ) := -1;
  CurPtr := RecBuffer;
  try
      DrvLocale := NIL;
      for I := 0 to Params.Count - 1 do
        with FieldDescs[I], Params[I] do
        begin
          iFldType := FldTypeMap[DataType];
          if iFldType in [fldBlob, fldZString] then
            iSubType := FldSubTypeMap[DataType]
          else
            if iFldType = fldUNKNOWN then
              DatabaseErrorFmt(SNoParameterValue, [Name], Sender);
          iFldNum := I + 1;
          iLen := GetParamDataSize( Params[ I ] );
          GetParamData( Engine, Params[ i ], CurPtr, DrvLocale );
          iOffset := CurPtr - RecBuffer;
          if IsNull then
            iNullOffset := NullPtr - RecBuffer
          else if iFldType = fldZString then
            iUnits1 := GetDataSize - 1 {Do not include null terminator}
          else if iFldType = fldBYTES then
            iUnits1 := GetDataSize
          else if iFldType = fldVARBYTES then
            iUnits1 := GetDataSize - 2
          else if iFldType = fldBlob then
          begin
            iSubType := FldSubTypeMap[ DataType ];
          end;
          Inc( CurPtr, iLen );
        end;
      Check( Engine, Engine.QSetParams( StmtHandle, High( FieldDescs )+1,
        PFLDDesc( FieldDescs ), RecBuffer ) );
  finally
    FreeMem( RecBuffer );
  end;
end;


{ Timer callback Function }
Procedure FreeTimer( ForceKill : Boolean = FALSE );
begin
  if (TimerID <> 0) and ( ForceKill or ( GetTickCount - StartTime > SQLDelay ) ) then
  begin
    KillTimer( 0, TimerID );
    TimerID   := 0;
    StartTime := 0;
    Screen.Cursor := crDefault;
  end;
end;


Procedure TimerCallBack( hWnd: HWND; Message: Word; TimerID: Word; SysTime: LongInt ); stdcall;
begin
  FreeTimer( TRUE );
end;



Function DLLDetachCallBack( CallType: CBType; Data: Longint;  CBInfo: Pointer ): CBRType; stdcall;
begin
  CurrentSession.FDLLDetach := TRUE;
  CurrentSessionList.CloseAll;
  Result := cbrUSEDEF
end;


constructor TttBDECallback.Create( Engine : TVirtEng; AOwner: TObject; Handle: hDBICur; CBType: CBType;
  CBBuf: Pointer; CBBufSize: Integer; CallbackEvent: TttBDECallbackEvent;
  Chain: Boolean );
begin
  FEngine := Engine;
  FOwner  := AOwner;
  FHandle := Handle;
  FCBType := CBType;
  FCallbackEvent := CallbackEvent;
end;


destructor TttBDECallback.Destroy;
begin
  Inherited Destroy;
end;


Function TttBDECallback.Invoke( CallType: CBType; CBInfo: Pointer ): CBRType;
begin
  if ( CallType = FCBType ) then
    Result := FCallbackEvent( CBInfo )
  else
    Result := cbrUSEDEF;
  if Assigned( FOldCBFunc ) then
    Result := FOldCBFunc( CallType, FOldCBData, CBInfo );
end;


{ Utility routines }
Function StrToOem( const AnsiStr: String ): String;
begin
  SetLength( Result, Length( AnsiStr ) );
  if ( Length( Result ) > 0 ) then
    CharToOem( PChar( AnsiStr ), PChar( Result ) );
end;


Function IsDirectory( const DatabaseName: String ): Boolean;
var
  I: Integer;
begin
  Result := TRUE;
  if ( DatabaseName = '' ) then
    Exit;
  I := 1;
  while ( I <= Length( DatabaseName ) ) do
  begin
    if ( DatabaseName[ I ] in [':','\'] ) then
      Exit;
    if ( DatabaseName[ I ] in LeadBytes ) then
      Inc( I, 2 )
    else
	  Inc( I );
  end;
  Result := FALSE;
end;


Function GetIntProp( Engine : TVirtEng; const Handle: Pointer; PropName: Integer ): Integer;
Var
  Length : Word;
  Value  : Integer;
begin
  Value := 0;
  if ( Engine.GetEngProp( HDBIObj( Handle ), PropName, @Value, SizeOf( Value ), Length ) = DBIERR_NONE ) then
    Result := Value
  else
    Result := 0;
end;


Function SetBoolProp( Engine : TVirtEng; const Handle: Pointer; PropName: Integer; Value: Bool ) : Boolean;
begin
  Result := Engine.SetEngProp( HDBIObj( Handle ), PropName, Abs( Integer( Value ) ) ) = DBIERR_NONE;
end;


Function StringListToParams( List: TStrings ): String;
var
  S: String;
  P, I: Integer;
begin
  for I := 0 to Pred( List.Count ) do
  begin
    S := List[I];
    P := Pos( '=', S );
    if ( P >= 0 ) and ( P < Length( S ) ) then
      Result := Format( '%s%s:"%s";', [Result, Copy( S, 1, P-1 ), Copy( S, P+1, 255 )] );
  end;
  Result := StrToOem( Result );
  SetLength( Result, Pred( Length( Result ) ) );
end;


{ TttError }
constructor TttError.Create( Owner: ETDBEngineError; ErrorCode: DBIResult;
  NativeError: Longint; Message: PChar );
begin
  Owner.FErrors.Add( Self );
  FErrorCode   := ErrorCode;
  FNativeError := NativeError;
  FMessage     := Message;
end;


Function TttError.GetCategory: Byte;
begin
  Result := Hi( FErrorCode );
end;


Function TttError.GetSubCode: Byte;
begin
  Result := Lo( FErrorCode );
end;


{ ETDBEngineError }
constructor ETDBEngineError.Create( Engine : TVirtEng; ErrorCode : DBIResult );
var
  ErrorIndex: Integer;
  EntryCode: DBIResult;
  NativeError: Longint;
  ContextBuf: DBIPATH;
  Messages: TStrings;

  Procedure AddMessage( const Msg: String );
  begin
    if ( Msg <> '' ) and ( Messages.IndexOf( Msg ) = -1 ) then
      Messages.Add( Msg );
  end;

  Function GetErrorString( Code: DBIResult ): String;
  var
    Msg: DBIPATH;
  begin
    Engine.GetErrorString( Code, Msg );
    Result := Msg;
    Trim( Result );
  end;

begin
  FreeTimer( TRUE );
  FErrors := TList.Create;
(* PGB
  if not DefaultSession.Active and ( ErrorCode <> DBIERR_INTERFACEVER ) then
  begin
    Message := Format( SInitError, [ ErrorCode ] );
    TttError.Create( Self, ErrorCode, 0, PChar( Message ) );
  end
  else
*)
  begin
    TttError.Create( Self, ErrorCode, 0, PChar( GetErrorString( ErrorCode ) ) );
    Messages := TStringList.Create;
    try
      if ( ErrorCode <> DBIERR_USERCONSTRERR ) then
        AddMessage( Errors[0].Message );
      ErrorIndex := 1;
      Repeat
        EntryCode := Engine.GetErrorEntry( ErrorIndex, NativeError, ContextBuf );
        if ( EntryCode = DBIERR_NONE ) or ( EntryCode = DBIERR_NOTINITIALIZED ) then
          Break;
        TttError.Create( Self, EntryCode, NativeError, ContextBuf );
        if ( NativeError = 0 ) and ( ErrorCode <> DBIERR_USERCONSTRERR ) then
          AddMessage( GetErrorString( EntryCode ) );
        AddMessage( Trim( ContextBuf ) );
        Inc( ErrorIndex );
      Until FALSE;
      Message := Messages.Text;
      if ( Message <> '' ) then
        Message := Copy( Message, 1, Length( Message ) - 2 )
      else
        Message := Format( 'Titan Interface Error: ( %x )', [ ErrorCode ] );
    finally
      Messages.Free;
    end;
 end;
end;


destructor ETDBEngineError.Destroy;
var
  i : Integer;
begin
  if ( FErrors <> NIL ) then
  begin
    for i := Pred( FErrors.Count ) downto 0 do
      TttError( FErrors[ i ] ).Free;
    FErrors.Free;
  end;
  Inherited Destroy;
end;


Function ETDBEngineError.GetError( Index : Integer ) : TttError;
begin
  Result := FErrors[ Index ];
end;


Function ETDBEngineError.GetErrorCount: Integer;
begin
  Result := FErrors.Count;
end;


{ TttSessionlist }
constructor TttSessionlist.Create;
begin
  Inherited Create;
  FSessions       := TThreadList.Create;
  FSessionNumbers := TBits.Create;
  OpenCriticalSection;
end;


destructor TttSessionlist.Destroy;
begin
  CloseAll;
  CloseCriticalSection;
  FSessionNumbers.Free;
  FSessions.Free;
  Inherited Destroy;
end;


Procedure TttSessionlist.AddSession( ASession : TttSession );
var
  List: TList;
begin
  List := FSessions.LockList;
  try
    if ( List.Count = 0 ) then 
      ASession.FDefault := TRUE;
    List.Add( ASession );
  finally
    FSessions.UnlockList;
  end;
end;


Procedure TttSessionlist.CloseAll;
var
  I: Integer;
  List: TList;
begin
  List := FSessions.LockList;
  try
    for I := List.Count-1 downto 0 do
      TttSession( List[ I ] ).Free;
  finally
    FSessions.UnlockList;
  end;
end;

Function TttSessionlist.GetCount: Integer;
var
  List: TList;
begin
  List := FSessions.LockList;
  try
    Result := List.Count;
  finally
    FSessions.UnlockList;
  end;
end;

Function TttSessionlist.GetCurrentSession : TttSession;
var
  Handle: HDBISes;
  I: Integer;
  List: TList;
begin
  List := FSessions.LockList;
  try
    Check( Engine, Engine.GetCurrSession( Handle ) );
    for I := 0 to List.Count - 1 do
	begin
      Result := TttSession( List[ I ] );
      if ( Result.Handle = Handle ) then
        Exit;
	end;
    Result := NIL;
  finally
    FSessions.UnlockList;
  end;
end;

Function TttSessionlist.GetSession( Index : Integer ) : TttSession;
var
  List: TList;
begin
  List := FSessions.LockList;
  try
    Result := TttSession( List[ Index ] );
  finally
    FSessions.UnlockList;
  end;
end;

Function TttSessionlist.GetSessionByName( const SessionName : String ) : TttSession;
begin
  if ( SessionName = '' ) then
    Result := DefaultSession
  else
    Result := FindSession( SessionName );
  if ( Result = NIL ) then
    DatabaseErrorFmt( SInvalidSessionName, [ SessionName ] );
end;


Function TttSessionlist.FindSession( const SessionName : String ) : TttSession;
var
  I: Integer;
  List: TList;
begin
  if SessionName = '' then
    Result := DefaultSession
  else
  begin
    List := FSessions.LockList;
    try
      for I := 0 to Pred( List.Count ) do
      begin
        Result := List[ I ];
        if ( AnsiCompareText( Result.SessionName, SessionName ) = 0 ) then 
          Exit;
      end;
      Result := NIL;
    finally
      FSessions.UnlockList;
    end;
  end;
end;

Procedure TttSessionlist.GetSessionNames( List : TStrings );
var
  I: Integer;
  SList: TList;
begin
  List.BeginUpdate;
  try
    List.Clear;
    SList := FSessions.LockList;
    try
      for I := 0 to Pred( SList.Count ) do
        with TttSession( SList[ I ] ) do
          List.Add( SessionName );
    finally
      FSessions.UnlockList;
    end;
  finally
    List.EndUpdate;
  end;
end;

Function TttSessionlist.OpenSession( const SessionName : String ) : TttSession;
begin
  Result := FindSession( SessionName );
  if ( Result = NIL ) then
  begin
    Result := GetSessionClass.Create( NIL );
    Result.SessionName := SessionName;
  end;
  Result.SetActive( TRUE );
end;


Procedure TttSessionlist.SetCurrentSession( Value : TttSession );
begin
  Check( Engine, Engine.SetCurrSession( Value.FHandle ) )
end;


{ TttSession }
constructor TttSession.Create( AOwner: TComponent );
begin
  ValidateAutoSession( AOwner, FALSE );
  Inherited Create( AOwner );
  FDatabases := TList.Create;
  FCallbacks := TList.Create;
  FKeepConnections := TRUE;
  FSQLHourGlass    := TRUE;
  SetSessionList;
  AddToSessionList;
  FReserved := 0;
  FHandle := NIL;
end;


destructor TttSession.Destroy;
begin
  SetActive( FALSE );
  RemoveFromSessionList;
  Inherited Destroy;
  FDatabases.Free;
  FCallbacks.Free;
end;


Procedure TttSession.AddtoSessionList;
begin
  FSessionList.AddSession( Self );
end;


Procedure TttSession.RemoveFromSessionList;
begin
  FSessionList.FSessions.Remove( Self );
end;


Procedure TttSession.AddTitanAlias( const Name : String; List : TStrings );
var
  Params: String;
begin
  Params := StringListToParams( List );
  Check( Engine, Engine.AddTitanAlias( PChar( StrToOem( Name ) ), PChar( Params ) ) );
end;


Procedure TttSession.DeleteTitanAlias( const Name : String );
begin
  Check( Engine, Engine.DeleteTitanAlias( PChar( StrToOem( Name ) ) ) );
end;


Procedure TttSession.AddAlias( const Name, Driver: String; List: TStrings );
begin
  InternalAddAlias( Name, Driver, List, ConfigMode, TRUE );
end;


Procedure TttSession.AddDriver( const Name: String; List: TStrings );
var
  Params: String;
  CfgModeSave: TConfigMode;
begin
  Params := StringListToParams( List );
  LockSession;
  Try
    CfgModeSave := ConfigMode;
    Try
      CheckConfigMode( ConfigMode );
      Check( Engine, Engine.AddDriver( NIL, PChar( StrToOem( Name ) ), PChar( Params ), Bool( -1 ) ) );
    Finally
      ConfigMode := cfgModeSave;
    end;
  Finally
    UnlockSession;
  end;
  DBNotification( dbAddDriver, Pointer( Name ) );
end;


Procedure TttSession.AddDatabase( Value : TttDatabase );
begin
  FDatabases.Add( Value );
  DBNotification( dbAdd, Value );
end;


Procedure TttSession.AddStandardAlias( const Name, Path, DefaultDriver : String );
var
  AliasParams: TStringList;
begin
  AliasParams := TStringList.Create;
  try
    AliasParams.Add( Format( '%s=%s', [szCFGDBPATH, Path] ) );
    AliasParams.Add( Format( '%s=%s', [szCFGDBDEFAULTDRIVER, DefaultDriver] ) );
    AddAlias( Name, szCFGDBSTANDARD, AliasParams );
  finally
    AliasParams.Free;
  end;
end;


Procedure TttSession.AddPassword( const Password : String );
var
  Buffer: array[ 0..255 ] of Char;
begin
  if ( Password <> '' ) then
  begin
    LockSession;
    Try
      Check( Engine, Engine.AddPassword( TAnsiToNative( Engine, NIL, Password,
        Buffer, SizeOf( Buffer ) - 1 ) ) );
    Finally
      UnlockSession;
    end;
  end;
end;


Procedure TttSession.CallBDEInitProcs;
(*
var
  I: Integer;
*)
begin
(*
  if Assigned( BDEInitProcs ) then
    for I := 0 to BDEInitProcs.Count - 1 do
      TTBDEInitProc( BDEInitProcs[I] )( Self );
*)
end;


Procedure TttSession.CheckInactive;
begin
  if Active then
    DatabaseError( SSessionActive, Self );
end;


Procedure TttSession.CheckConfigMode( CfgMode: TConfigMode );
begin
  if ( CfgMode = cmAll ) then
    CfgMode := cmPersistent;
  ConfigMode := CfgMode;
end;


Procedure TttSession.Close;
begin
  SetActive( FALSE );
end;


Procedure TttSession.CloseDatabase( Database: TttDatabase );
begin
  with Database do
  begin
    if ( FRefCount <> 0 ) then
      Dec( FRefCount );
    if ( FRefCount = 0 ) and not KeepConnection then
      if not Temporary then
        Close
      else
        if not ( csDestroying in ComponentState ) then
          Free;
  end;
end;


Procedure TttSession.CloseDatabaseHandle( Database : TttDatabase );
var
  i  : integer;
  DB : TttDatabase;
begin
  for i := 0 to Pred( FDatabases.Count ) do
  begin
    DB := FDatabases[ i ];
    if ( DB <> Database ) and ( DB.Handle <> NIL ) and
       ( AnsiCompareText( DB.DatabaseName, Database.DatabaseName ) = 0 ) then
      Exit;
  end;
  Engine.CloseDatabase( Database.FHandle );
end;


Function TttSession.DBLoginCallback( CBInfo: Pointer ): CBRType;
var
  Database: TttDatabase;
  UserName, Password: String;
  AliasParams: TStringList;
begin
  Result := cbrYES;
  with PCBDBLogin( CBInfo )^ do
  try
    if ( hDB = NIL ) then
    begin
      if not FBDEOwnsLoginCbDb then
      begin
        Database := OpenDatabase( szDbName );
        if not Database.HandleShared then
        begin
          hDb := Database.Handle;
          bCallbackToClose := TRUE;
        end
        else
        begin
          CloseDatabase( Database );
          Result := cbrAbort;
        end;
      end
      else
      begin
        AliasParams := TStringList.Create;
        try
          GetAliasParams( szDbName, AliasParams );
          UserName := AliasParams.Values[ szUSERNAME ];
        finally
          AliasParams.Free;
        end;
        Password := '';
        if Assigned(LoginDialogExProc) then
        if LoginDialogEx( szDbName, UserName, Password, TRUE ) then
        begin
          TAnsiToNative( Engine, NIL, Password, szPassword, SizeOf( szPassword ) - 1 );
          bCallbackToClose := FALSE;
        end
        else
          Result :=cbrAbort;
      end
    end
    else
    begin
      Database := FindDatabase( szDbName );
      if Assigned( Database ) and ( hDB = Database.Handle ) then
        CloseDatabase( Database );
    end;
  except
    Result := cbrAbort;
  end;
end;


Procedure TttSession.DBNotification( DBEvent : TDatabaseEvent; const Param );
begin
  if Assigned( FOnDBNotify ) then
    FOnDBNotify( DBEvent, Param );
end;


Procedure TttSession.DeleteAlias( const Name : String );
begin
  InternalDeleteAlias( Name, ConfigMode, TRUE );
end;


Procedure TttSession.DeleteDriver( const Name: String );
begin
  DBNotification( dbDeleteDriver, Pointer( Name ) );
  LockSession;
  Try
    Engine.DeleteDriver( NIL, PChar( StrToOem( Name ) ), FALSE );
  Finally
    UnlockSession;
  end;
end;


Procedure TttSession.DeleteConfigPath( const Path, Node : String );
var
  CfgPath: String;
begin
  CfgPath := Format( Path, [ Node ] );
  Check( Engine, Engine.CfgDropRecord( NIL, PChar( CfgPath ) ) );
end;


Procedure TttSession.DropConnections;
var
  i: Integer;
begin
  for i := Pred( FDatabases.Count ) downto 0 do
    with TttDatabase( FDatabases[ i ] ) do
      if Temporary and ( FRefCount = 0 ) then
        Free;
end;


Function TttSession.FindDatabase( const DatabaseName : String ) : TttDatabase;
var
  i : Integer;
begin
  for i := 0 to Pred( FDatabases.Count ) do
  begin
    Result := FDatabases[ i ];
    if ( ( Result.DatabaseName <> '' ) or Result.Temporary ) and
      ( AnsiCompareText( Result.DatabaseName, DatabaseName ) = 0 ) then
        Exit;
  end;
  Result := NIL;
end;


Function TttSession.DoFindDatabase( const DatabaseName: String;
  AOwner : TComponent ) : TttDatabase;
var
  i : Integer;
begin
  if ( AOwner <> NIL ) then
    for i := 0 to Pred( FDatabases.Count ) do
    begin
      Result := FDatabases[ i ];
      if ( Result.Owner = AOwner ) and ( Result.HandleShared ) and
        ( AnsiCompareText( Result.DatabaseName, DatabaseName ) = 0 ) then
        Exit;
    end;
  Result := FindDatabase( DatabaseName );
end;


Function TttSession.FindDatabaseHandle( const DatabaseName : String ): HDBIDB;
var
  i  : Integer;
  DB : TttDatabase;
begin
  for i := 0 to Pred( FDatabases.Count ) do
  begin
    DB := FDatabases[ i ];
    if ( DB.Handle <> NIL ) and
       ( AnsiCompareText( DB.DatabaseName, DatabaseName ) = 0 ) and
       DB.HandleShared then
    begin
      Result := DB.Handle;
      Exit;
    end;
  end;
  Result := NIL;
end;


Function TttSession.GetActive: Boolean;
begin
  Result := ( FHandle <> NIL );
end;


Function TttSession.GetAliasDriverName( const AliasName : String ) : String;
var
  Desc: DBDesc;
begin
  LockSession;
  try
    if ( Engine.GetDatabaseDesc( PChar( StrToOem( AliasName ) ), @Desc ) <> 0 ) then
      DatabaseErrorFmt( SInvalidAliasName, [ AliasName ] );
  finally
    UnlockSession;
  end;
  if ( Desc.szDBType[sizeOf( Desc.szDBType ) - 1] <> #0 ) then
    Desc.szDBType[sizeOf( Desc.szDBType ) - 1] := #0;
  OemToChar( Desc.szDBType, Desc.szDBType );
  Result := Desc.szDBType;
end;


Procedure TttSession.GetAliasDatabaseInfo( Const AliasName : String; Var Descript, Path : String );
var
  Desc: DBDesc;
begin
  LockSession;
  try
    if ( Engine.GetDatabaseDesc( PChar( StrToOem( AliasName ) ), @Desc ) <> 0 ) then
      DatabaseErrorFmt( SInvalidAliasName, [ AliasName ] );
  finally
    UnlockSession;
  end;
  OemToChar( Desc.szText, Desc.szText );
  Descript := Desc.szText;
  OemToChar( Desc.szPhyName, Desc.szPhyName );
  Path := Desc.szPhyName;
end;


Function TttSession.GetAliasDatabaseDescription( const AliasName: String ) : String;
Var
  Dummy : String;
begin
  GetAliasDatabaseInfo( AliasName, Result, Dummy );
end;


Function TttSession.GetAliasDatabasePath( const AliasName : String ) : String;
Var
  Dummy : String;
begin
  GetAliasDatabaseInfo( AliasName, Dummy, Result );
end;


Procedure TttSession.GetAliasNames( List : TStrings );
var
  Cursor: HDBICur;
  Desc: DBDesc;
begin
  List.BeginUpdate;
  try
    List.Clear;
    LockSession;
    try
      Check( Engine, Engine.OpenDatabaseList( Cursor ) );
    finally
      UnlockSession;
    end;
    try
      while ( Engine.GetNextRecord( Cursor, dbiNOLOCK, @Desc, NIL ) = 0 ) do
      begin
        OemToChar( Desc.szName, Desc.szName );
        List.Add( Desc.szName );
      end;
    finally
      Engine.CloseCursor( Cursor );
    end;
  finally
    List.EndUpdate;
  end;
end;


Procedure TttSession.GetAliasParams( const AliasName: String; List: TStrings );
var
  SAlias: DBIPath;
begin
  List.BeginUpdate;
  try
    List.Clear;
    StrPLCopy( SAlias, AliasName, Pred( SizeOf( SAlias ) ) );
    CharToOEM( SAlias, SAlias );
    GetConfigParams( '\DATABASES\%s\DB OPEN', SAlias, List );
  finally
    List.EndUpdate;
  end;
end;


Procedure TttSession.GetConfigParams( const Path, Section: String; List: TStrings );
var
  ConfigDesc: CFGDesc;
  Cursor    : hDbiCur;
begin
  LockSession;
  try
    Check( Engine, Engine.OpenCfgInfoList( NIL, dbiREADONLY, cfgPERSISTENT, PChar( Format( Path, [Section] ) ), Cursor ) );
  finally
    UnlockSession;
  end;
  try
    while Engine.GetNextRecord( Cursor, dbiNOLOCK, @ConfigDesc, NIL ) = 0 do
      with ConfigDesc do
      begin
        OemToChar( szValue, szValue );
        List.Add( Format( '%s=%s', [szNodeName, szValue] ) );
      end;
  finally
    Engine.CloseCursor( Cursor );
  end;
end;


Function TttSession.GetDatabase( Index : Integer ) : TttDatabase;
begin
  Result := FDatabases[ Index ];
end;


Function TttSession.GetDatabaseCount: Integer;
begin
  Result := FDatabases.Count;
end;


Procedure TttSession.GetDatabaseNames( List : TStrings );
var
  i     : Integer;
  Names : TStringList;
begin
  Names := TStringList.Create;
  try
    Names.Sorted := TRUE;
    GetAliasNames( Names );
    for I := 0 to Pred( FDatabases.Count ) do
      with TttDatabase( FDatabases[ i ] ) do
        if not IsDirectory( DatabaseName ) then
          Names.Add( DatabaseName );
    List.Assign( Names );
  finally
    Names.Free;
  end;
end;


Procedure TttSession.GetDriverNames( List : TStrings );
begin
  List.BeginUpdate;
  try
    List.Clear;
    List.Add( szCFGDBSTANDARD );
  finally
    List.EndUpdate;
  end;
end;


Procedure TttSession.GetDriverParams( const DriverName: String; List: TStrings );
begin
  List.BeginUpdate;
  try
    List.Clear;
    if CompareText( DriverName, szCFGDBSTANDARD ) = 0 then
    begin
      List.Add( Format( '%s=',   [szCFGDBPATH] ) );
    end
    else
      GetConfigParams( '\DRIVERS\%s\DB OPEN', StrToOem( DriverName ), List );
  finally
    List.EndUpdate;
  end;
end;


Function TttSession.GetHandle: HDBISes;
begin
  if ( FHandle <> NIL ) then
    Check( Engine, Engine.SetCurrSession( FHandle ) )
  else
    SetActive( TRUE );
  Result := FHandle;
end;


Function TttSession.GetNetFileDir : String;
var
  Length: Word;
  Buffer: DBIPATH;
begin
  if Active and not ( csWriting in ComponentState ) then
  begin
    LockSession;
    try
      Check( Engine, Engine.GetEngProp( HDBIOBJ( FHandle ), sesNETFILE, @Buffer, SizeOf( Buffer ), Length ) );
    finally
      UnLockSession;
    end;
    TNativeToAnsi( Engine, NIL, Buffer, Result );
  end
  else
    Result := FNetFileDir;
  Result := AnsiUpperCase( Result );
end;


Function TttSession.GetPrivateDir: String;
var
  SessionInfo: SESInfo;
begin
  if Active and not ( csWriting in ComponentState ) then
  begin
    LockSession;
    try
      Check( Engine, Engine.GetSesInfo( SessionInfo ) );
    finally
      UnlockSession;
    end;
    TNativeToAnsi( Engine, NIL, SessionInfo.szPrivDir, Result );
  end
  else
    Result := FPrivateDir;
  Result := AnsiUpperCase( Result );
end;

function TttSession.GetPassword: Boolean;
begin
  if Assigned(FOnPassword) then
  begin
    Result := False;
    FOnPassword(Self, Result)
  end else if Assigned(DB.PasswordDialog) then
    Result := DB.PasswordDialog(Self as IDBSession)
  else
    Result := False;
end;

Procedure TttSession.GetTableNames( const DatabaseName, Pattern: String;
  Extensions, SystemTables: Boolean; List: TStrings );
var
  Database: TttDatabase;
  Cursor: HDBICur;
  WildCard: PChar;
  Name: String;
  SPattern: DBITBLNAME;
  Desc: TBLBaseDesc;
begin
  List.BeginUpdate;
  try
    List.Clear;
    Database := OpenDatabase( DatabaseName );
    try
      WildCard := NIL;
      if ( Pattern <> '' ) then
        WildCard := TAnsiToNative( Engine, NIL, Pattern, SPattern, SizeOf( SPattern ) - 1 );
      Check( Engine, Engine.OpenTableList( Database.Handle, FALSE, SystemTables, WildCard, Cursor ) );
      try
        while ( Engine.GetNextRecord( Cursor, dbiNOLOCK, @Desc, NIL ) = 0 ) do
          with Desc do
          begin
            if Extensions and ( szExt[0] <> #0 ) then
              StrCat( StrCat( szName, '.' ), szExt );
            TNativeToAnsi( Engine, NIL, szName, Name );
            List.Add( Name );
          end;
      finally
        Engine.CloseCursor( Cursor );
      end;
    finally
      CloseDatabase( Database );
    end;
  finally
    List.EndUpdate;
  end;
end;


procedure TttSession.GetFieldNames(const DatabaseName, TableName: string;
  List: TStrings);
var
  Database: TttDatabase;
  Cursor: HDBICur;
  Name: string;
  Desc: FLDDesc;
begin
  List.BeginUpdate;
  try
    List.Clear;
    Database := OpenDatabase(DatabaseName);
    try
      Check( Engine, Engine.OpenFieldList( Database.Handle, PChar( TableName ), '', FALSE, Cursor ) );
      try
        while Engine.GetNextRecord( Cursor, dbiNOLOCK, @Desc, NIL ) = 0 do
          with Desc do
          begin
            TNativeToAnsi( Engine, NIL, szName, Name );
            List.Add( Name );
          end;
      finally
        Engine.CloseCursor( Cursor );
      end;
    finally
      CloseDatabase(Database);
    end;
  finally
    List.EndUpdate;
  end;
end;

Procedure TttSession.GetStoredProcNames( const DatabaseName : String; List : TStrings );
var
  Database: TttDatabase;
  Cursor: HDBICur;
  Name: String;
  Desc: SPDesc;
begin
  List.BeginUpdate;
  try
    List.Clear;
    Database := OpenDatabase( DatabaseName );
    try
      Check( Engine, Engine.OpenSPList( Database.Handle, FALSE, TRUE, NIL, Cursor ) );
      try
        while ( Engine.GetNextRecord( Cursor, dbiNOLOCK, @Desc, NIL ) = 0 ) do
          with Desc do
          begin
            TNativeToAnsi( Engine, NIL, szName, Name );
            List.Add( Name );
          end;
      finally
        Engine.CloseCursor( Cursor );
      end;
    finally
      CloseDatabase( Database );
    end;
  finally
    List.EndUpdate;
  end;
end;


Procedure TttSession.InitializeBDE;
var
  Status       : DBIResult;
  Env          : DbiEnv;
  SetCursor    : Boolean;
  FEngine      : TVirtEng;
begin
  SetCursor := ( GetCurrentThreadID = MainThreadID ) and ( Screen.Cursor = crDefault );
  if SetCursor then
    Screen.Cursor := crHourGlass;
  try
    FillChar( Env, SizeOf( Env ), 0 );
    StrPLCopy( Env.szLang, SIDAPILangID, SizeOf( Env.szLang ) - 1 );
    if ( Engine = NIL ) then
    begin
      Try
        FEngine := TVirtEng.Create( GetEngineClass, NIL, NIL, 400, @Env );
        Status  := FEngine.Status;
        SetEngineObject( FEngine );
      Except
        On E:ETitanEngineError do
          Status := E.DBIError;
      end;
    end
    else
      Status := DBIERR_MULTIPLEINIT;
    if ( Status <> DBIERR_NONE ) and ( Status <> DBIERR_MULTIPLEINIT ) then
      Check( Engine, Status );
    Check( Engine, Engine.GetCurrSession( FHandle ) );
(*
    if ( Engine.GetObjFromName( objCLIENT, NIL, ClientHandle ) = 0 ) then
      if IsLibrary then
        Engine.RegisterCallback( NIL, cbDETACHNOTIFY, 0, 0, NIL, DLLDetachCallBack );
*)
  finally
    if SetCursor and ( Screen.Cursor = crHourGlass ) then
      Screen.Cursor := crDefault;
  end;
end;


Procedure TttSession.InternalAddAlias( const Name, Driver: String; List: TStrings;
  CfgMode: TConfigMode; RestoreMode: Boolean );
var
  Params: String;
  DrvName: String;
  CfgModeSave: TConfigMode;
begin
  Params  := StringListToParams( List );
  DrvName := List.Values[ szCFGDBDEFAULTDRIVER ];
  if ( DrvName = '' ) and ( CompareText( Driver, szCFGDBSTANDARD ) <> 0 ) then
    DrvName := Driver;
  LockSession;
  try
    CfgModeSave := ConfigMode;
    try
      CheckConfigMode( CfgMode );
      Check( Engine, Engine.AddAlias( NIL, PChar( StrToOem( Name ) ), PChar( StrToOem( DrvName ) ), PChar( Params ), Bool( -1 ) ) );
    finally
      if RestoreMode then
        ConfigMode := CfgModeSave;
    end;
  finally
    UnlockSession;
  end;
  DBNotification( dbAddAlias, Pointer( Name ) );
end;


Procedure TttSession.InternalDeleteAlias( const Name: String;
  CfgMode: TConfigMode; RestoreMode: Boolean );
begin
  DBNotification( dbDeleteAlias, Pointer( Name ) );
  LockSession;
  try
    Engine.DeleteAlias( NIL, PChar( Name ) );
  finally
    UnlockSession;
  end;
end;


Function TttSession.IsAlias( const Name: String ): Boolean;
begin
  LockSession;
  try
    Result := (Name <> '') and
      ( Engine.CfgPosition( NIL, PChar(Format('\DATABASES\%s', [StrToOem(Name)]))) = 0);
  finally
    UnlockSession;
  end;
end;

procedure ApplicationHandleException(Sender: TObject);
begin
  if Assigned(Classes.ApplicationHandleException) then
    Classes.ApplicationHandleException(Sender);
end;

Procedure TttSession.Loaded;
begin
  Inherited Loaded;
  try
    if AutoSessionName then
      SetSessionNames;
    if FStreamedActive then
      SetActive( TRUE );
  except
    if ( csDesigning in ComponentState ) then
      ApplicationHandleException( Self )
    else
      raise;
  end;
end;


Procedure TttSession.LockSession;
begin
  if ( FLockCount = 0 ) then
  begin
    CriticalSectionStart;
    Inc( FLockCount );
    MakeCurrent;
  end
  else
    Inc( FLockCount );
end;


Procedure TttSession.UnLockSession;
begin
  Dec( FLockCount );
  if ( FLockCount = 0 ) then
    CriticalSectionEnd;
end;


Procedure TttSession.MakeCurrent;
begin
  if ( FHandle <> NIL ) then
    Check( Engine, Engine.SetCurrSession( FHandle ) )
  else
    SetActive( TRUE );
end;


Procedure TttSession.ModifyAlias( Name : String; List : TStrings );
var
  DriverName: String;
  OemName: String;
  CfgModeSave: TConfigMode;
begin
  LockSession;
  try
    CfgModeSave := ConfigMode;
    try
      CheckConfigMode( ConfigMode );
      DriverName := GetAliasDriverName( Name );
      OemName := StrToOem( Name );
      ModifyConfigParams( '\DATABASES\%s\DB INFO', OemName, List );
      if CompareText( DriverName, szCFGDBSTANDARD ) <> 0 then
        ModifyConfigParams( '\DATABASES\%s\DB OPEN', OemName, List );
    finally
      ConfigMode := CfgModeSave;
    end;
  finally
    UnLockSession;
  end;
end;


Procedure TttSession.ModifyDriver( Name: String; List: TStrings );
var
  CfgModeSave: TConfigMode;
  OemName: String;
begin
  LockSession;
  try
    CfgModeSave := ConfigMode;
    try
      CheckConfigMode( ConfigMode );
      OemName := StrToOem( Name );
      ModifyConfigParams( '\DRIVERS\%s\INIT', OemName, List );
        ModifyConfigParams( '\DRIVERS\%s\DB OPEN', OemName, List );
    finally
      ConfigMode := CfgModeSave;
    end;
  finally
    UnLockSession;
  end;
end;


Procedure TttSession.ModifyConfigParams( const Path, Node: String; List: TStrings );
var
  I, J, C: Integer;
  Params: TStrings;
begin
  Params := TStringList.Create;
  try
    GetConfigParams( Path, Node, Params );
    C := 0;
    for I := 0 to Params.Count - 1 do
    begin
      J := List.IndexOfName( Params.Names[I] );
      if J >= 0 then
      begin
        Params[I] := List[J];
        Inc( C );
      end;
    end;
    if C > 0 then SetConfigParams( Path, Node, Params );
  finally
    Params.Free;
  end;
end;


Procedure TttSession.Notification( AComponent: TComponent; Operation: TOperation );
begin
  Inherited Notification( AComponent, Operation );
  if AutoSessionName and ( Operation = opInsert ) then
    if ( AComponent is TttDBDataset ) then
      TttDBDataset( AComponent ).FSessionName := Self.SessionName
    else 
      if ( AComponent is TttDatabase ) then
        TttDatabase( AComponent ).FSession := Self;
end;


Procedure TttSession.Open;
begin
  SetActive( TRUE );
end;


Function TttSession.DoOpenDatabase( const DatabaseName: String; AOwner: TComponent ): TttDatabase;
var
  TempDatabase: TttDatabase;
begin
  Result := NIL;
  LockSession;
  try
  TempDatabase := NIL;
  try
    Result := DoFindDatabase( DatabaseName, AOwner );
    if ( Result = NIL ) then
    begin
      TempDatabase                := GetDatabaseClass.Create( Self );
      TempDatabase.DatabaseName   := DatabaseName;
      TempDatabase.KeepConnection := FKeepConnections;
      TempDatabase.Temporary      := TRUE;
      Result                      := TempDatabase;
    end;
    Result.Open;
    Inc( Result.FRefCount );
  except
    TempDatabase.Free;
    raise;
  end;
  finally
    UnLockSession;
  end;
end;


Function TttSession.OpenDatabase( const DatabaseName : String ) : TttDatabase;
begin
  Result := DoOpenDatabase( DatabaseName, NIL );
end;


Function TttSession.SessionNameStored: Boolean;
begin
  Result := not FAutoSessionName;
end;


Procedure TttSession.RegisterCallbacks( Value : Boolean );
var
  I: Integer;
begin
  if Value then
  begin
    { Do not register any callbacks if we are not in the MainThread }
    if GetCurrentThreadID <> MainThreadID then 
      Exit;
    if FSQLHourGlass then
      FCallbacks.Add( TttBDECallback.Create( Engine, Self, NIL, cbSERVERCALL,
        @FCBSCType, SizeOf( CBSCType ), ServerCallBack, FALSE ) );
    FCallbacks.Add( TttBDECallback.Create( Engine, Self, NIL, cbDBLOGIN,
      @FCBDBLogin, SizeOf( TCBDBLogin ), DBLoginCallBack, FALSE ) );
  end
  else
  begin
    for I := Pred( FCallbacks.Count ) downto 0 do
      TttBDECallback( FCallbacks[I] ).Free;
    FCallbacks.Clear;
  end;
end;


Procedure TttSession.RemoveDatabase( Value : TttDatabase );
begin
  FDatabases.Remove( Value );
  DBNotification( dbRemove, Value );
end;


Procedure TttSession.RemoveAllPasswords;
begin
  LockSession;
  try
    Engine.DropPassword( NIL );
  finally
    UnlockSession;
  end;
end;


Procedure TttSession.RemovePassword( const Password : String );
var
  Buffer: array[0..255] of Char;
begin
  LockSession;
  try
    if ( Password <> '' ) then
      Engine.DropPassword( TAnsiToNative( Engine, NIL, Password, Buffer,
        SizeOf( Buffer ) - 1 ) );
  finally
    UnlockSession;
  end;
end;


Procedure TttSession.SaveConfigFile;
var
  CfgModeSave: TConfigMode;
begin
  CfgModeSave := ConfigMode;
  try
    ConfigMode := cmPersistent;
    Check( Engine, Engine.CfgSave( NIL, NIL, Bool( -1 ) ) );
  finally
    ConfigMode := CfgModeSave;
  end;
end;


Function TttSession.ServerCallBack( CBInfo: Pointer ): CBRType;
begin
  Result := cbrUSEDEF;
  if ( GetCurrentThreadID <> MainThreadID ) then
    Exit;
  if (FCBSCType = cbscSQL) then
  begin
    if ( TimerID = 0 ) then
      TimerID := SetTimer( 0, 0, SQLDelay, @TimerCallBack );
    if ( Screen.Cursor <> crSQLWait ) then
      Screen.Cursor := crSQLWait;
    StartTime := GetTickCount;
  end;
end;

Procedure TttSession.SetActive( Value : Boolean );
begin
  if ( csReading in ComponentState ) then
    FStreamedActive := Value
  else
    if ( Active <> Value ) then
      StartSession( Value );
end;


Procedure TttSession.SetAutoSessionName( Value : Boolean );
begin
  if ( Value <> FAutoSessionName ) then
  begin
    if Value then
    begin
      CheckInActive;
      ValidateAutoSession( Owner, TRUE );
      FSessionNumber := -1;
      CriticalSectionStart;
      try
        with FSessionList do
        begin
          FSessionNumber := FSessionNumbers.OpenBit;
          FSessionNumbers[FSessionNumber] := TRUE;
        end;
      finally
        CriticalSectionEnd;
      end;
      UpdateAutoSessionName;
    end
    else
    begin
      if ( FSessionNumber > -1 ) then
      begin
        CriticalSectionStart;
        try
          FSessionList.FSessionNumbers[ FSessionNumber ] := FALSE;
        finally
          CriticalSectionEnd;
        end;
      end;
    end;
    FAutoSessionName := Value;
  end;
end;


Function TttSession.GetConfigMode: TConfigMode;
begin
  LockSession;
  try
    Result := TConfigMode( Byte( GetIntProp( Engine, FHandle, sesCFGMODE2 ) ) );
  finally
    UnlockSession;
  end;
end;


Procedure TttSession.SetConfigMode( Value: TConfigMode );
begin
  LockSession;
  try
    Check( Engine, Engine.SetEngProp( hDBIObj( FHandle ), sesCFGMODE2, Longint( Byte( Value ) ) ) );
  finally
    UnlockSession;
  end;
end;


Procedure TttSession.SetConfigParams( const Path, Node: String; List: TStrings );
var
  ParamList: TParamList;
begin
  ParamList := TParamList.Create( List );
  try
    with ParamList do
      Check( Engine, Engine.CfgModifyRecord( NIL, PChar( Format( Path, [Node] ) ), FieldCount,
        PFLDDesc( FieldDescs ), Buffer ) );
  finally
    ParamList.Free;
  end;
end;


Procedure TttSession.SetName( const NewName: TComponentName );
begin
  Inherited SetName( NewName );
  if FAutoSessionName then
    UpdateAutoSessionName;
end;


Procedure TttSession.SetNetFileDir( const Value: String );
var
  Buffer: DBIPATH;
begin
  if Active then
  begin
    LockSession;
    try
      Check( Engine, Engine.SetEngProp( HDBIOBJ( Handle ), sesNETFILE,
        Longint( TAnsiToNative( Engine, NIL, Value, Buffer, SizeOf( Buffer ) - 1 ) ) ) );
    finally
      UnLockSession;
    end;
  end;
  FNetFileDir := Value;
end;


Procedure TttSession.SetPrivateDir( const Value: String );
var
  Buffer: DBIPATH;
begin
  if Active then
  begin
    LockSession;
    try
      Check( Engine, Engine.SetPrivateDir( TAnsiToNative( Engine, NIL, Value,
        Buffer, SizeOf( Buffer ) - 1 ) ) );
    finally
      UnlockSession;
    end;
  end;
  FPrivateDir := Value;
end;


Procedure TttSession.SetSessionName( const Value: String );
var
  Ses: TttSession;
begin
  if FAutoSessionName and not FUpdatingAutoSessionName then
    DatabaseError(SAutoSessionActive, Self);
  CheckInActive;
  if Value <> '' then
  begin
    Ses := FSessionList.FindSession(Value);
    if not ( ( Ses = NIL ) or ( Ses = Self ) ) then
      DatabaseErrorFmt(SDuplicateSessionName, [Value], Self);
  end;
  FSessionName := Value
end;

Procedure TttSession.SetSessionNames;
var
  I: Integer;
  Component: TComponent;
begin
  if ( Owner <> NIL ) then
    for I := 0 to Pred( Owner.ComponentCount ) do
    begin
      Component := Owner.Components[ i ];
      if ( Component is TttDBDataset ) and
        ( AnsiCompareText( TttDBDataset( Component ).SessionName, Self.SessionName ) <> 0 ) then
         TttDBDataset( Component ).SessionName := Self.SessionName
      else 
        if ( Component is TttDatabase ) and ( AnsiCompareText( TttDatabase( Component ).SessionName, Self.SessionName ) <> 0 ) then
          TttDatabase( Component ).SessionName := Self.SessionName
    end;
end;


Procedure TttSession.StartSession( Value : Boolean );
var
  I: Integer;
begin
  CriticalSectionStart;
  try
    if Value then
    begin
      if Assigned( FOnStartup ) then
        FOnStartup( Self );
      if ( FSessionName = '' ) then
        DatabaseError( SSessionNameMissing, Self );
      if ( DefaultSession <> Self ) then
        DefaultSession.Active := TRUE;
      if FDefault then
        InitializeBDE
      else
        Check( Engine, Engine.StartSession( NIL, FHandle, NIL ) );
      try
        RegisterCallbacks( TRUE );
        if ( FNetFileDir <> '' ) then
          SetNetFileDir( FNetFileDir );
        if ( FPrivateDir <> '' ) then
          SetPrivateDir( FPrivateDir );
        ConfigMode := cmAll;
        CallBDEInitProcs;
      except
        StartSession( FALSE );
        raise;
      end;
    end
    else
    begin
      Engine.SetCurrSession( FHandle );
      for I := Pred( FDatabases.Count ) downto 0 do
        with TttDatabase( FDatabases[ i ] ) do
          if Temporary then
            Free
          else
            Close;
      RegisterCallbacks( FALSE );
      if FDefault then
      begin
        if not FDLLDetach then
        begin
          if IsLibrary then
          begin
            CurrentSession     := DefaultSession;
            CurrentSessionList := FSessionList;
            Engine.RegisterCallback( NIL, cbDETACHNOTIFY, 0, 0, @DLLDetachCallBack, NIL );
            DbiDLLExit;
          end;
          If ( Engine <> NIL ) then
            Engine.Free;
          SetEngineObject( NIL );
        end;
      end
      else
      begin
        Check( Engine, Engine.CloseSession( FHandle ) );
        Engine.SetCurrSession( DefaultSession.FHandle );
      end;
      FHandle := NIL;
    end;
  finally
    CriticalSectionEnd;
  end;
end;


Procedure TttSession.UpdateAutoSessionName;
begin
  FUpdatingAutoSessionName := TRUE;
  try
    SessionName := Format( '%s_%d', [Name, FSessionNumber + 1] );
  finally
    FUpdatingAutoSessionName := FALSE;
  end;
  SetSessionNames;
end;


Procedure TttSession.ValidateAutoSession( AOwner: TComponent; AllSessions: Boolean );
var
  I: Integer;
  Component: TComponent;
begin
  if ( AOwner <> NIL ) then
    for I := 0 to Pred( AOwner.ComponentCount ) do
    begin
      Component := AOwner.Components[ i ];
      if ( Component <> Self ) and ( Component is TttSession ) then
        if AllSessions then
          DatabaseError( SAutoSessionExclusive, Self )
        else 
          if TttSession( Component ).AutoSessionName then
            DatabaseErrorFmt( SAutoSessionExists, [Component.Name] );
    end;
end;


{ TttDatabase }
constructor TttDatabase.Create( AOwner : TComponent );
begin
  Inherited Create( AOwner );
  SetSessionList;
  if ( FSession = NIL ) then
    if ( AOwner is TttSession ) then
      FSession := TttSession( AOwner )
    else
      FSession := DefaultSession;
  SessionName := FSession.SessionName;
  FSession.AddDatabase( Self );
  FParams := TStringList.Create;
  TStringList( FParams ).OnChanging := ParamsChanging;
  LoginPrompt := LoginPromptDefault;
  FKeepConnection := TRUE;
  FTransIsolation := tiReadCommitted;
end;


destructor TttDatabase.Destroy;
begin
  Destroying;
  Close;
  if ( FSession <> NIL ) then
    FSession.RemoveDatabase( Self );
  Inherited Destroy;
  FParams.Free;
  FStmtList.Free;
end;

Function TttDatabase.LoginPromptDefault : Boolean;
begin
  Result := TRUE;
end;

Procedure TttDatabase.SetSessionList;
begin
  //Override This!
  Halt;
end;


Procedure TttDatabase.ApplyUpdates( const DataSets: array of TttDBDataset );
var
  I  : Integer;
  DS : TttDBDataset;
begin
  StartTransaction;
  try
    for I := 0 to High( DataSets ) do
    begin
      DS := DataSets[ I ];
      if ( DS.Database <> Self ) then
        DatabaseError( Format( SUpdateWrongDB, [DS.Name, Name] ) );
      DataSets[I].ApplyUpdates;
    end;
    Commit;
  except
    Rollback;
    raise;
  end;
  for I := 0 to High( DataSets ) do
    DataSets[I].CommitUpdates;
end;

type
  PStmtInfo = ^TStmtInfo;
  TStmtInfo =
  packed record
    HashCode: Integer;
    StmtHandle: HDBIStmt;
    SQLText: string;
  end;

Procedure TttDatabase.ClearStatements;
var
  i: Integer;
begin
  if Assigned( FStmtList ) then
  begin
    for i := 0 to FStmtList.Count - 1 do
    begin
      Engine.QFree( PStmtInfo( FStmtList[ i ] ).StmtHandle );
      Dispose( PStmtInfo( FStmtList[ i ] ) );
    end;
    FStmtList.Clear;
  end;
end;

Function TttDatabase.Execute(const SQL: string; Params: TParams = NIL;
  Cache: Boolean = FALSE; Cursor: phDBICur = NIL): Integer;

  Function GetStmtInfo(SQL: PChar): PStmtInfo;

    Function GetHashCode(Str: PChar): Integer;
    var
      Off, Len, Skip, I: Integer;
    begin
      Result := 0;
      Off := 1;
      Len := StrLen(Str);
      if Len < 16 then
        for I := (Len - 1) downto 0 do
        begin
          Result := (Result * 37) + Ord(Str[Off]);
          Inc(Off);
        end
      else
      begin
        { Only sample some characters }
        Skip := Len div 8;
        I := Len - 1;
        while I >= 0 do
        begin
          Result := (Result * 39) + Ord(Str[Off]);
          Dec(I, Skip);
          Inc(Off, Skip);
        end;
      end;
    end;

  var
    HashCode, i: Integer;
    Info: PStmtInfo;
  begin
    if not Assigned(FStmtList) then
      FStmtList := TList.Create;
    Result := NIL;
    HashCode := GetHashCode(SQL);
    for i := 0 to FStmtList.Count - 1 do
    begin
      Info := PStmtInfo(FStmtList[i]);
      if (Info.HashCode = HashCode) and
         (AnsiStrIComp(PChar(Info.SQLText), SQL) = 0) then
      begin
        Result := Info;
        break;
      end;
    end;
    if not Assigned(Result) then
    begin
      New(Result);
      FStmtList.Add(Result);
      FillChar(Result^, SizeOf(Result^), 0);
      Result.HashCode := HashCode;
    end;
  end;

  Function GetStatementHandle: HDBIStmt;
  var
    Info: PStmtInfo;
    Status: DBIResult;
  begin
    Info   := NIL;
    Result := NIL;
    if Cache then
    begin
      Info := GetStmtInfo( PChar( SQL ) );
      Result := Info.StmtHandle;
    end;
    if not Assigned( Result ) then
    begin
      Check( Engine, Engine.QAlloc( Handle, qrylangSQL, Result ) );
      if ( Cursor <> NIL ) then
        Check( Engine, Engine.SetEngProp(hDbiObj( Result ), stmtLIVENESS, Ord( wantCanned ) ) );
      if not IsSQLBased then
      begin
        SetBoolProp( Engine, Result, stmtAUXTBLS,        FALSE );
        SetBoolProp( Engine, Result, stmtCANNEDREADONLY, TRUE  );
      end
      else
        SetBoolProp( Engine, Result, stmtUNIDIRECTIONAL, TRUE  );
      while TRUE do
      begin
        Status := Engine.QPrepare( Result, PChar( SQL ) );
        case Status of
        DBIERR_NONE:
          break;
        DBIERR_NOTSUFFTABLERIGHTS:
          if not FSession.GetPassword then
            TDbiError( Engine, Status );
        else
          TDbiError( Engine, Status );
        end;
      end;
      if Assigned( Info ) then
      begin
        Info.SQLText    := SQL;
        Info.StmtHandle := Result;
      end;
    end;
  end;

var
  StmtHandle : HDBIStmt;
  Len        : Word;
begin
  Open;
  if Assigned(Params) and (Params.Count > 0) then
  begin
    StmtHandle := GetStatementHandle;
    try
      SetQueryParams( Engine, Self, StmtHandle, Params );
      Check( Engine, Engine.QExec( StmtHandle, Cursor ) );
    finally
      if not Cache then
        Engine.QFree( StmtHandle );
    end;
  end
  else
    Check( Engine, Engine.QExecDirect( Handle, qrylangSQL, PChar( SQL ), Cursor ) );
  if (Cursor = NIL ) and ( Engine.GetEngProp( hDBIObj( StmtHandle ), stmtROWCOUNT,
                           @Result, SizeOf( Result ), Len ) <> 0 ) then
    Result := 0;
end;


Procedure TttDatabase.CheckActive;
begin
  if ( FHandle = NIL ) then
    DatabaseError( SDatabaseClosed );
end;


Procedure TttDatabase.CheckInactive;
begin
  if ( FHandle <> NIL ) then
    if ( csDesigning in ComponentState ) then
      Close 
    else
      DatabaseError( SDatabaseOpen, Self);
end;


Procedure TttDatabase.CheckDatabaseName;
begin
  if ( FDatabaseName = '' ) and not Temporary then
    DatabaseError( SDatabaseNameMissing, Self );
end;


Procedure TttDatabase.CheckSessionName( Required: Boolean );
var
  NewSession: TttSession;
begin
  if Required then
    NewSession := FSessionList.List[FSessionName]
  else
    NewSession := FSessionList.FindSession( FSessionName );
  if ( NewSession <> NIL ) and ( NewSession <> FSession ) then
  begin
    if ( FSession <> NIL ) then 
      FSession.RemoveDatabase( Self );
    FSession := NewSession;
    FSession.FreeNotification(Self);
    FSession.AddDatabase( Self );
    try
      ValidateName( FDatabaseName );
    except
      FDatabaseName := '';
      raise;
    end;
  end;
  if Required then 
    FSession.Active := TRUE;
end;

Procedure TttDatabase.DoDisconnect;
begin
  if ( FHandle <> NIL ) then
  begin
    ClearStatements;
    Session.DBNotification( dbClose, Self );
    CloseDataSets;
    if not FAcquiredHandle then
      FSession.CloseDatabaseHandle( Self ) 
    else
      FAcquiredHandle := FALSE;
    FSQLBased := FALSE;
    FHandle := NIL;
    FRefCount := 0;
    if FSessionAlias then
    begin
      FSession.InternalDeleteAlias( FDatabaseName, cmSession, TRUE );
      FSessionAlias := FALSE;
    end;
  end;
end;


Procedure TttDatabase.CloseDataSets;
begin
  while ( DataSetCount <> 0 ) do 
    TttDBDataSet( DataSets[ DataSetCount - 1 ] ).Disconnect;
end;


Procedure TttDatabase.Commit;
begin
  CheckActive;
  EndTransaction( xendCOMMIT );
end;


Procedure TttDatabase.EndTransaction( TransEnd : EXEnd );
begin
  Check( Engine, Engine.EndTran( FHandle, NIL, TransEnd ) );
end;


Function TttDatabase.GetAliasName: String;
begin
  if FAliased then
    Result := FDatabaseType
  else
    Result := '';
end;


Function TttDatabase.GetConnected: Boolean;
begin
  Result := ( FHandle <> NIL );
end;


Function TttDatabase.GetDataSet( Index : Integer ) : TttDBDataset;
begin
  Result := inherited GetDataSet( Index ) as TttDBDataSet;
end;


Function TttDatabase.GetDirectory: String;
var
  SDirectory: DBIPATH;
begin
  if ( Handle <> NIL ) then
  begin
    Check( Engine, Engine.GetDirectory( Handle, FALSE, SDirectory ) );
    SetLength( Result, StrLen( SDirectory ) );
    OemToChar( SDirectory, PChar( Result ) );
  end 
  else
    Result := '';
end;


procedure TttDatabase.GetFieldNames(const TableName: string; List: TStrings);
begin
  if Assigned( FSession ) then
    FSession.GetFieldNames( Self.DatabaseName, TableName, List );
end;


procedure TttDatabase.GetTableNames( List : TStrings; SystemTables : Boolean = FALSE );
begin
  if Assigned( FSession ) then
    FSession.GetTableNames( Self.DatabaseName, '', FALSE, SystemTables, List );
end;


Function TttDatabase.GetDriverName: String;
begin
  if FAliased then 
    Result := '' 
  else 
    Result := FDatabaseType;
end;


Procedure TttDatabase.SetDatabaseFlags;
var
  Length: Word;
  Buffer: DBINAME;
begin
  Check( Engine, Engine.GetEngProp( HDBIOBJ( FHandle ), dbDATABASETYPE, @Buffer, SizeOf( Buffer ), Length ) );
  FSQLBased := StrIComp( Buffer, szCFGDBSTANDARD ) <> 0;
  FPseudoIndexes := FALSE;
end;


Function TttDatabase.GetTraceFlags: TTraceFlags;
begin
  if Connected and IsSQLBased then
    Result := TTraceFlags( Word( GetIntProp( Engine, FHandle, dbTraceMode ) ) )
  else
    Result := [];
end;

Function TttDatabase.GetObjectContext : IUnknown;
begin
  if Assigned( GetObjectContextProc ) then
    Result := GetObjectContextProc
  else
    Result := NIL;
end;

Function TttDatabase.GetInTransaction: Boolean;
var
  X: XInfo;
begin
  Result := ( Handle <> NIL ) and ( Engine.GetTranInfo( Handle, NIL, @X ) = DBIERR_NONE )
    and ( X.exState = xsActive );
end;


Procedure TttDatabase.Loaded;
begin
  Inherited Loaded;
  if not StreamedConnected then 
    CheckSessionName( FALSE );
end;


Procedure TttDatabase.Notification( AComponent : TComponent; Operation : TOperation );
begin
  Inherited Notification( AComponent, Operation );
  if ( Operation = opRemove ) and ( AComponent = FSession ) and ( FSession <> DefaultSession ) then
  begin
    Close;
    SessionName := '';
  end;
end;




Procedure TttDatabase.Login( LoginParams: TStrings );
var
  UserName, Password: String;
begin
  if Assigned( FOnLogin ) then 
    FOnLogin( Self, LoginParams ) 
  else
  begin
    UserName := LoginParams.Values[szUSERNAME];
    if Assigned(LoginDialogExProc) then
    if not LoginDialogEx( DatabaseName, UserName, Password, FALSE ) then
      DatabaseErrorFmt( SLoginError, [DatabaseName] );
    LoginParams.Values[szUSERNAME] := UserName;
    LoginParams.Values[szPASSWORD] := Password;
  end;
end;


Procedure TttDatabase.CheckDatabaseAlias( var Password: String );
var
  Aliased: Boolean;
  DBName: String;
  DriverType: String;
  AliasParams: TStringList;
  LoginParams: TStringList;

  Function NeedsDBAlias: Boolean;
  var
    I: Integer;
    PName: String;
  begin
    Result := not Aliased or ( ( FDatabaseType <> '' ) and
      ( FDatabaseName <> FDatabaseType ) );
    for I := 0 to FParams.Count - 1 do
    begin
      if AliasParams.IndexOf( FParams[I] ) > -1 then
        continue;
      PName := FParams.Names[I];
      if ( CompareText( PName, szPASSWORD ) = 0 ) then
        continue;
      if AliasParams.IndexOfName( PName ) > -1 then
      begin
        Result := TRUE;
        AliasParams.Values[PName] := FParams.Values[PName];
      end;
    end;
  end;

  Procedure LoadDatabaseParameters;
  var
    i           : Integer;
    CurrentName : String;
  begin
    for i := 0 to Pred( AliasParams.Count ) do
    begin
      CurrentName := AliasParams.Names[ i ];
      if ( FParams.IndexOfName( CurrentName ) <> -1 ) then
      begin
        if ( FParams.Values[ CurrentName ] = '' ) then
          FParams.Values[ CurrentName ] := AliasParams.Values[ CurrentName ];
      end
      else
        FParams.Add( AliasParams[ i ] );
    end;
  end;

begin
  Password := '';
  FSessionAlias := FALSE;
  AliasParams := TStringList.Create;
  try
    begin
      if ( FDatabaseType <> '' ) then
      begin
        DBName := FDatabaseType;
        Aliased := FAliased;
      end
      else
      begin
        DBName := FDatabaseName;
        Aliased := TRUE;
      end;
      if Aliased then
      begin
        FSession.GetAliasParams( DBName, AliasParams );
      end
      else
      begin
        FSession.GetDriverParams( DBName, AliasParams );
        DriverType := FDatabaseType;
      end;
      if not ( csDesigning in ComponentState ) then
        LoadDatabaseParameters;
      if AliasParams.IndexOfName( szUSERNAME ) <> -1 then
      begin
        if LoginPrompt then
        begin
          LoginParams := TStringList.Create;
          try
            if FParams.Values[szUSERNAME] = '' then
              FParams.Values[szUSERNAME] := AliasParams.Values[szUSERNAME];
            LoginParams.Values[szUSERNAME] := FParams.Values[szUSERNAME];
            Login( LoginParams );
            Password := LoginParams.Values[szPASSWORD];
            FParams.Values[szUSERNAME] := LoginParams.Values[szUSERNAME];
          finally
            LoginParams.Free;
          end;
        end
        else
          Password := FParams.Values[szPASSWORD];
      end;
    end;
    if NeedsDBAlias then
    begin
      FSession.InternalAddAlias( FDatabaseName, DriverType, AliasParams,
        cmSession, FALSE );
      FSessionAlias := TRUE;
    end;
  finally
    AliasParams.Free;
  end;
end;


Function TttDatabase.OpenFromExistingDB: Boolean;
begin
  Handle := FSession.FindDatabaseHandle( DatabaseName );
  FAcquiredHandle := FALSE;
  Result := ( Handle <> NIL );
end;

Procedure TttDatabase.DoConnect;
const
  OpenModes: array[Boolean] of DbiOpenMode = (dbiReadWrite, dbiReadOnly);
  ShareModes: array[Boolean] of DbiShareMode = (dbiOpenShared, dbiOpenExcl);
var
  DBName: String;
  DBPassword: String;
  CfgModeSave: TConfigMode;
  ParamList: TParamList;
  OpenModeFlag: Word;
begin
  if ( FHandle = NIL ) then
  begin
    CheckDatabaseName;
    CheckSessionName( TRUE );
    if not ( HandleShared and OpenFromExistingDB ) then
    begin
      FSession.LockSession;
      try
        CfgModeSave := FSession.ConfigMode;
        try
          CheckDatabaseAlias( DBPassword );
          try
{ -- Original Code ---------
            if ( FDatabaseType = '' ) and IsDirectory( FDatabaseName ) then
              DBName := ''
            else
              DBName := StrToOem( FDatabaseName );
 -- End of Original Code --}
{ REGGATTA CODE }
            DBName := StrToOem( FDatabaseName );
            OpenModeFlag := 0;
            ParamList := TParamList.Create( FParams );
            Try
            Check( Engine, Engine.OpenDatabase( Pointer( DBName ), NIL,
              DBIOpenMode(Integer(OpenModes[FReadOnly]) or OpenModeFlag),
              ShareModes[FExclusive], Pointer(StrToOem(DBPassword)), ParamList.FieldCount,
              PFLDDesc(ParamList.FieldDescs), ParamList.Buffer, FHandle ) );
            Finally
              ParamList.Free;
            end;

            if DBName = '' then
              SetDirectory( FDatabaseName );
            SetBoolProp( Engine, FHandle, dbUSESCHEMAFILE,        TRUE );
            SetBoolProp( Engine, FHandle, dbPARAMFMTQMARK,        TRUE );
            SetBoolProp( Engine, FHandle, dbCOMPRESSARRAYFLDDESC, TRUE );
            SetDatabaseFlags;
            Session.DBNotification( dbOpen, Self );
          except
            if FSessionAlias then
              FSession.InternalDeleteAlias( FDatabaseName, cmSession, FALSE );
            raise;
          end;
        finally
          FSession.ConfigMode := CfgModeSave;
        end;
      finally
        FSession.UnlockSession;
      end;
    end;
  end;
end;


Procedure TttDatabase.ParamsChanging( Sender: TObject );
begin
  CheckInactive;
end;


Procedure TttDatabase.Rollback;
begin
  CheckActive;
  EndTransaction( xendABORT );
end;


Procedure TttDatabase.SetAliasName( const Value: String );
begin
  SetDatabaseType( Value, TRUE );
end;

Procedure TttDatabase.SetDatabaseName( const Value : String );
begin
  if ( csReading in ComponentState ) then
    FDatabaseName := Value
  else
    if FDatabaseName <> Value then
    begin
      CheckInactive;
      ValidateName( Value );
      FDatabaseName := Value;
    end;
end;


Procedure TttDatabase.SetDatabaseType( const Value: String; Aliased: Boolean );
begin
  CheckInactive;
  FDatabaseType := Value;
  FAliased := Aliased;
end;


Procedure TttDatabase.SetDirectory( const Value : String );
begin
  if ( Handle <> NIL ) then
    Check( Engine, Engine.SetDirectory( Handle, Pointer( StrToOem( Value ) ) ) );
end;


Procedure TttDatabase.SetDriverName( const Value : String );
begin
  SetDatabaseType( Value, FALSE );
end;


Procedure TttDatabase.SetHandle( Value: HDBIDB );
var
  DBSession: HDBISes;
begin
  if Connected then 
    Close;
  if ( Value <> NIL ) then
  begin
    Check( Engine, Engine.GetObjFromObj( HDBIObj( Value ), objSESSION, HDBIObj( DBSession ) ) );
    CheckDatabaseName;
    CheckSessionName( TRUE );
    if ( FSession.Handle <> DBSession ) then 
      DatabaseError( SDatabaseHandleSet, Self );
    FHandle := Value;
    SetDatabaseFlags;
    Session.DBNotification( dbOpen, Self );
    FAcquiredHandle := TRUE;
  end;
end;


Procedure TttDatabase.SetKeepConnection( Value: Boolean );
begin
  if ( FKeepConnection <> Value ) then
  begin
    FKeepConnection := Value;
    if not Value and ( FRefCount = 0 ) then 
      Close;
  end;
end;


Procedure TttDatabase.SetParams( Value : TStrings );
begin
  CheckInactive;
  FParams.Assign( Value );
end;


Procedure TttDatabase.SetSessionName( const Value : String );
begin
  CheckInactive;
  if ( FSessionName <> Value ) then
  begin
    FSessionName := Value;
    CheckSessionName( FALSE );
  end;
end;


Procedure TttDatabase.SetTraceFlags( Value: TTraceFlags );
begin
  if Connected and IsSQLBased then
    Engine.SetEngProp( hDBIObj( FHandle ), dbTraceMode, Integer( Word( Value ) ) );
end;

Procedure TttDatabase.SetExclusive(Value: Boolean);
begin
  CheckInactive;
  FExclusive := Value;
end;

Procedure TttDatabase.SetReadOnly(Value: Boolean);
begin
  CheckInactive;
  FReadOnly := Value;
end;

Procedure TttDatabase.StartTransaction;
var
  TransHandle:  HDBIXAct;
begin
  CheckActive;
  Check( Engine, Engine.BeginTran( FHandle, EXILType( FTransIsolation ), TransHandle ) );
end;


Procedure TttDatabase.ValidateName( const Name: String );
var
  Database: TttDatabase;
begin
  if ( Name <> '' ) and ( FSession <> NIL ) then
  begin
    Database := FSession.FindDatabase( Name );
    if ( Database <> NIL ) and ( Database <> Self ) and
      not ( Database.HandleShared and HandleShared ) then
    begin
      if not Database.Temporary or ( Database.FRefCount <> 0 ) then
        DatabaseErrorFmt( SDuplicateDatabaseName, [Name] );
      Database.Free;
    end;
  end;
end;


Procedure TttDatabase.FlushSchemaCache( const TableName : String );
begin
  if Connected and IsSQLBased then
    Check( Engine, Engine.SchemaCacheFlush( FHandle, PChar( TableName ) ) );
end;


{ TttBDEDataset }
constructor TttBDEDataset.Create( AOwner : TComponent );
begin
  Inherited Create( AOwner );
  FCacheBlobs := TRUE;
  SetSessionList;
  NestedDataSetClass := TNestedTable;
end;


destructor TttBDEDataset.Destroy;
begin
  Inherited Destroy;
  if ( FBlockReadBuf <> NIL ) then
  begin
    FreeMem( FBlockReadBuf );
    FBlockReadBuf := NIL;
  end;
  SetUpdateObject( NIL );
end;




Procedure TttBDEDataset.OpenCursor( InfoQuery: Boolean );
begin
  If ( FHandle = NIL ) then
    FHandle := CreateHandle;
  if FHandle = NIL then
  begin
    FreeTimer( TRUE );
    raise ENoResultSet.Create( SHandleError );
  end;
  Inherited OpenCursor( InfoQuery );
end;


Procedure TttBDEDataset.CloseCursor;
begin
  Inherited CloseCursor;
  if ( FHandle <> NIL ) then
  begin
    DestroyHandle;
    FHandle := NIL;
  end;
  FParentDataSet := NIL;
end;


Function TttBDEDataset.CreateHandle: HDBICur;
begin
  Result := NIL;
end;


Procedure TttBDEDataset.DestroyHandle;
begin
  Engine.RelRecordLock( FHandle, FALSE );
  Engine.CloseCursor( FHandle );
end;

Procedure TttBDEDataset.InternalInitFieldDefs;
var
  I, FieldID: Integer;
  FieldDescs: TFieldDescList;
  ValCheckDesc: VCHKDesc;
  RequiredFields: TBits;
  CursorProps: CurProps;
  FldDescCount,
  MaxFieldID,
  HiddenFieldCount: Integer;
begin
  Engine.GetCursorProps( FHandle, CursorProps);
  FldDescCount := CursorProps.iFields;
  HiddenFieldCount := 0;
  if FieldDefs.HiddenFields then
  begin
    if SetBoolProp( Engine, Handle, curGETHIDDENCOLUMNS, TRUE) then
    begin
      Engine.GetCursorProps(FHandle, CursorProps);
      HiddenFieldCount := CursorProps.iFields - FldDescCount;
      FldDescCount := CursorProps.iFields;
    end;
  end;
  RequiredFields := TBits.Create;
  try
    MaxFieldID := GetIntProp( Engine, Handle, curMAXFIELDID );
    if ( MaxFieldID > 0 ) then
      RequiredFields.Size := MaxFieldID + 1 
    else
      RequiredFields.Size := FldDescCount + 1;
    for I := 1 to CursorProps.iValChecks do
    begin
      Engine.GetVChkDesc(FHandle, I, @ValCheckDesc );
      if ValCheckDesc.bRequired and not ValCheckDesc.bHasDefVal then
        RequiredFields[ValCheckDesc.iFldNum] := TRUE;
    end;
    SetLength( FieldDescs, FldDescCount );
    Engine.GetFieldDescs( FHandle, PFLDDesc( FieldDescs ) );
    FieldID := FieldNoOfs;
    I := FieldID - 1;
    FieldDefs.Clear;
    while ( I < FldDescCount ) do
      AddFieldDesc( FieldDescs, I, FieldID, RequiredFields, FieldDefs);
    if FieldDefs.HiddenFields then
    begin
      SetBoolProp( Engine, Handle, curGETHIDDENCOLUMNS, FALSE );
      if ( HiddenFieldCount > 0 ) then
        for I := FldDescCount - HiddenFieldCount to Pred( FldDescCount ) do
          FieldDefs[ I ].Attributes := FieldDefs[ I ].Attributes + [ faHiddenCol ];
    end;
  finally
    RequiredFields.Free;
  end;
end;

Procedure TttBDEDataSet.GetObjectTypeNames(Fields: TFields);
var
  Len: Word;
  I: Integer;
  TypeDesc: ObjTypeDesc;
  ObjectField: TObjectField;
begin
  for I := 0 to Pred( Fields.Count ) do
    if ( Fields[ I ] is TObjectField ) then
    begin
      ObjectField := TObjectField( Fields[ I ] );
      TypeDesc.iFldNum := ObjectField.FieldNo;
      if ( Engine.GetEngProp( hDBIObj( Handle ), curFIELDTYPENAME, @TypeDesc,
        SizeOf(TypeDesc), Len) = DBIERR_NONE ) and ( Len > 0 ) then
        ObjectField.ObjectType := TypeDesc.szTypeName;
      with ObjectField do
	  begin
        if DataType in [ftADT, ftArray] then
        begin
          if ( DataType = ftArray ) and SparseArrays and ( Fields[ 0 ].DataType = ftADT ) then
            GetObjectTypeNames( TObjectField( Fields[ 0 ] ).Fields)
          else
            GetObjectTypeNames(Fields);
        end;
      end;
    end
end;

Procedure TttBDEDataset.InternalOpen;
var
  CursorProps: CurProps;
begin
  if CachedUpdates then 
    Check( Engine, Engine.BeginDelayedUpdates( FHandle ) );
  Engine.GetCursorProps( FHandle, CursorProps );
  FRecordSize := CursorProps.iRecBufSize;
  BookmarkSize := CursorProps.iBookmarkSize;
  FCanModify := ( CursorProps.eOpenMode = dbiReadWrite )
    and not CursorProps.bTempTable;
  FConstraintLayer := HasConstraints and CanModify;
  if FConstraintLayer then
    Check( Engine, Engine.BeginConstraintLayer( NIL, FHandle, @TttBDEDataSet.ConstraintCallBack,
      Integer( Pointer( Self ) ) ) );
  FRecNoStatus := TRecNoStatus( CursorProps.ISeqNums );
  FieldDefs.Updated := FALSE;
  FieldDefs.Update;
  GetIndexInfo;
  if DefaultFields then 
    CreateFields;
  BindFields( TRUE );
  if ObjectView then 
    GetObjectTypeNames( Fields );
  InitBufferPointers( FALSE );
  if CachedUpdates then
  begin
    AllocCachedUpdateBuffers( TRUE );
    SetupCallBack( UpdateCallBackRequired );
  end;
  AllocKeyBuffers;
  Engine.SetToBegin( FHandle );
  PrepareCursor;
  if Filter <> '' then
    FExprFilter := CreateExprFilter( Filter, FilterOptions, 0 );
  if Assigned( OnFilterRecord ) then
    FFuncFilter := CreateFuncFilter( @TttBDEDataset.RecordFilter, 1 );
  if Filtered then ActivateFilters;
end;


Procedure TttBDEDataset.InternalClose;
begin
  FFuncFilter := NIL;
  FExprFilter := NIL;
  FreeKeyBuffers;
  if CachedUpdates then
  begin
    SetupCallBack( FALSE );
    AllocCachedUpdateBuffers( FALSE );
    if FConstraintLayer then 
      Engine.EndConstraintLayer( FHandle );
    Engine.EndDelayedUpdates( FHandle );
  end;
  BindFields( FALSE );
  if DefaultFields then DestroyFields;
  FIndexFieldCount := 0;
  FKeySize := 0;
  FExpIndex := FALSE;
  FCaseInsIndex := FALSE;
  FCanModify := FALSE;
end;


Procedure TttBDEDataset.PrepareCursor;
begin
end;


Function TttBDEDataset.IsCursorOpen: Boolean;
begin
  Result := ( Handle <> NIL );
end;


Procedure TttBDEDataset.InternalHandleException;
begin
  ApplicationHandleException( Self )
end;



{ Record Functions }

Procedure TttBDEDataset.InitBufferPointers( GetProps: Boolean );
var
  CursorProps: CurProps;
begin
  if GetProps then
  begin
    Check( Engine, Engine.GetCursorProps( FHandle, CursorProps ) );
    BookmarkSize := CursorProps.iBookmarkSize;
    FRecordSize  := CursorProps.iRecBufSize;
  end;
  FBlobCacheOfs := FRecordSize   + CalcFieldsSize;
  FRecInfoOfs   := FBlobCacheOfs + BlobFieldCount * SizeOf( Pointer );
  FBookmarkOfs  := FRecInfoOfs   + SizeOf( TRecInfo );
  FRecBufSize   := FBookmarkOfs  + BookmarkSize;
end;


Function TttBDEDataset.AllocRecordBuffer: PChar;
begin
   Result := AllocMem( FRecBufSize );
end;


Procedure TttBDEDataset.FreeRecordBuffer( var Buffer : PChar );
begin
  ClearBlobCache( Buffer );
  FreeMem( Buffer );
end;


Procedure TttBDEDataset.InternalInitRecord( Buffer : PChar );
begin
  Engine.InitRecord( FHandle, Buffer );
end;


Procedure TttBDEDataset.ClearBlobCache( Buffer : PChar );
var
  I: Integer;
begin
  if FCacheBlobs then
    for I := 0 to Pred( BlobFieldCount ) do
      TBlobDataArray( Buffer + FBlobCacheOfs )[ I ] := '';
end;


Procedure TttBDEDataset.ClearCalcFields( Buffer : PChar );
begin
  FillChar( Buffer[ RecordSize ], CalcFieldsSize, 0 );
end;


Procedure TttBDEDataset.InitRecord( Buffer : PChar );
begin
  Inherited InitRecord( Buffer );
  ClearBlobCache( Buffer );
  with PRecInfo( Buffer + FRecInfoOfs )^ do
  begin
    UpdateStatus := TUpdateStatus( usInserted );
    BookMarkFlag := bfInserted;
    RecordNumber := -1;
  end;
end;


Function TttBDEDataset.GetRecord( Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean ): TGetResult;
var
  Status: DBIResult;
begin
  case GetMode of
    gmCurrent:
      Status := Engine.GetRecord( FHandle, dbiNoLock, Buffer, @FRecProps );
    gmNext:
      Status := Engine.GetNextRecord( FHandle, dbiNoLock, Buffer, @FRecProps );
    gmPrior:
      Status := Engine.GetPriorRecord( FHandle, dbiNoLock, Buffer, @FRecProps );
  else
    Status := DBIERR_NONE;
  end;
  case Status of
    DBIERR_NONE:
      begin
        with PRecInfo( Buffer + FRecInfoOfs )^ do
        begin
          UpdateStatus := TUpdateStatus( FRecProps.iRecStatus );
          BookmarkFlag := bfCurrent;
          RecordNumber := -1;
        end;
        ClearBlobCache( Buffer );
        GetCalcFields( Buffer );
        Check( Engine, Engine.GetBookmark( FHandle, Buffer + FBookmarkOfs ) );
        Result := grOK;
      end;
    DBIERR_BOF:
      Result := grBOF;
    DBIERR_EOF:
      Result := grEOF;
  else
    Result := grError;
    if DoCheck then
      Check( Engine, Status );
  end;
end;


Function TttBDEDataset.GetCurrentRecord( Buffer: PChar ): Boolean;
begin
  if not IsEmpty and ( GetBookmarkFlag( ActiveBuffer ) = bfCurrent ) then
  begin
    UpdateCursorPos;
    Result := ( Engine.GetRecord( FHandle, dbiNoLock, Buffer, NIL ) = DBIERR_NONE );
  end 
  else
    Result := FALSE;
end;


Function TttBDEDataset.GetOldRecord: PChar;
begin
  UpdateCursorPos;
  if SetBoolProp( Engine, Handle, curDELAYUPDGETOLDRECORD, TRUE ) then
  try
    Check( Engine, Engine.GetRecord(FHandle, dbiNoLock, FUpdateCBBuf.pOldRecBuf, NIL ) );
    Result := FUpdateCBBuf.pOldRecBuf;
  finally
    SetBoolProp( Engine, Handle, curDELAYUPDGETOLDRECORD, FALSE );
  end
  else
    Result := NIL;
end;


Procedure TttBDEDataset.FetchAll;
begin
  if not EOF then
  begin
    CheckBrowseMode;
    Check( Engine, Engine.SetToEnd( Handle ) );
    Check( Engine, Engine.GetPriorRecord( FHandle, dbiNoLock, NIL, NIL ) );
	CursorPosChanged;
  end;
end;


Procedure TttBDEDataset.FlushBuffers;
begin
  CheckBrowseMode;
  Check( Engine, Engine.SaveChanges( Handle ) );
end;


Function TttBDEDataset.GetRecordCount: Integer;
begin
  CheckActive;
  if ( Engine.GetExactRecordCount( FHandle, Result ) <> DBIERR_NONE ) and
     ( Engine.GetRecordCount( FHandle, Result ) <> DBIERR_NONE ) then
    Result := -1;
end;


Function TttBDEDataset.GetRecNo: Integer;
var
  BufPtr: PChar;
begin
  CheckActive;
  if ( State = dsCalcFields ) then
    BufPtr := CalcBuffer 
  else
    BufPtr := ActiveBuffer;
  Result := PRecInfo( BufPtr + FRecInfoOfs ).RecordNumber;
end;


Procedure TttBDEDataset.SetRecNo( Value : Integer );
begin
  CheckBrowseMode;
  if ( FRecNoStatus = rnParadox ) and ( Value <> RecNo ) then
  begin
    if ( Engine.SetToSeqNo( Handle, Value ) = DBIERR_NONE ) then
      Resync( [ rmCenter ] );
  end;
end;


Function TttBDEDataset.GetRecordSize: Word;
begin
  Result := FRecordSize;
end;


Function TttBDEDataset.GetActiveRecBuf( var RecBuf: PChar ): Boolean;
begin
  case State of
    dsBlockRead: 
      RecBuf := FBlockReadBuf + ( FBlockBufOfs * FRecordSize );
    dsBrowse:
      if IsEmpty then 
        RecBuf := NIL 
      else 
        RecBuf := ActiveBuffer;
    dsEdit, dsInsert: 
      RecBuf := ActiveBuffer;
    dsSetKey: 
      RecBuf := PChar( FKeyBuffer ) + SizeOf( TKeyBuffer );
    dsCalcFields: 
      RecBuf := CalcBuffer;
    dsFilter: 
      RecBuf := FFilterBuffer;
    dsNewValue: 
      if FInUpdateCallback then
        RecBuf := FUpdateCBBuf.pNewRecBuf 
      else
        RecBuf := ActiveBuffer;
    dsOldValue: 
      if FInUpdateCallback then
        RecBuf := FUpdateCBBuf.pOldRecBuf 
      else
        RecBuf := GetOldRecord;
  else
    RecBuf := NIL;
  end;
  Result := ( RecBuf <> NIL );
end;


Procedure TttBDEDataSet.AddFieldDesc(FieldDescs: TFieldDescList; var DescNo: Integer;
  var FieldID: Integer; RequiredFields: TBits; FieldDefs: TFieldDefs);
var
  FType: TFieldType;
  FSize: Word;
  FRequired: Boolean;
  FPrecision, I: Integer;
  FieldName, FName: string;
  FieldDesc: FLDDesc;
begin
  FieldDesc := FieldDescs[DescNo];
  Inc(DescNo);
  with FieldDesc do
  begin
    TNativeToAnsi( Engine, NIL, szName, FieldName );
    I := 0;
    FName := FieldName;
    while ( FieldDefs.IndexOf(FName) >= 0 ) do
    begin
      Inc( I );
      FName := Format('%s_%d', [FieldName, I]);
    end;
    if ( iFldType < MAXLOGFLDTYPES ) then
      FType := DataTypeMap[iFldType] 
    else
      FType := ftUnknown;
    FSize := 0;
    FPrecision := 0;
    if ( RequiredFields.Size > FieldID ) then
      FRequired := RequiredFields[FieldID] 
    else
      FRequired := FALSE;
    case iFldType of
      fldZSTRING, fldBYTES, fldVARBYTES, fldADT, fldArray, fldRef:
        begin
          if ( iUnits1 = 0 ) then
            FType := ftUnknown 
          else
            FSize := iUnits1;
        end;
      fldINT16, fldUINT16:
        if ( iLen = 1 ) then
          FType := ftSmallInt
        else
          if ( iLen <> 2 ) then
            FType := ftUnknown;
      fldINT32:
        if ( iSubType = fldstAUTOINC ) then
        begin
          FType := ftAutoInc;
          FRequired := FALSE;
        end;
      fldFLOAT:
        if ( iSubType = fldstMONEY ) then 
          FType := ftCurrency;
      fldBCD:
        begin
          FSize := Abs( iUnits2 );
          FPrecision := iUnits1;
        end;
      fldBLOB:
        begin
          FSize := iUnits1;
          if ( iSubType >= fldstMEMO ) and ( iSubType <= fldstBFILE ) then
            FType := BlobTypeMap[iSubType];
        end;
    end;
    with FieldDefs.AddFieldDef do
    begin
      FieldNo := FieldID;
      Inc( FieldID );
      Name := FName;
      DataType := FType;
      Size := FSize;
      Precision := FPrecision;
      if FRequired then
        Attributes := [faRequired];
      if ( efldrRights = fldrREADONLY ) then
        Attributes := Attributes + [faReadonly];
      if iSubType = fldstFIXED then
        Attributes := Attributes + [faFixed];
      InternalCalcField := bCalcField;
      case FType of
        ftADT:
          begin
            if ( iSubType = fldstADTNestedTable ) then
              Attributes := Attributes + [faUnNamed];
            for I := 0 to iUnits1 - 1 do
              AddFieldDesc(FieldDescs, DescNo, FieldID, RequiredFields, ChildDefs);
          end;
        ftArray:
          begin
            I := FieldID;
            StrCat( StrCopy(FieldDescs[DescNo].szName, FieldDesc.szName),'[0]');
            AddFieldDesc(FieldDescs, DescNo, I, RequiredFields, ChildDefs);
            Inc( FieldID, iUnits2 );
          end;
      end;
    end;
  end;
end;

Function TttBDEDataSet.GetBlobFieldData(FieldNo: Integer; var Buffer: TBlobByteData): Integer;
var
  RecBuf: PChar;
  Status: DBIResult;
  DoCheck: Boolean;
begin
  Result := 0;
  DoCheck := ( BlockReadSize = 0 );
  if ( BlockReadSize > 0 ) then
    RecBuf := FBlockReadBuf + (FBlockBufOfs * FRecordSize) 
  else
    if not GetActiveRecBuf( RecBuf ) then 
      Exit;
  Status := Engine.OpenBlob( FHandle, RecBuf, FieldNo, dbiReadOnly );
  if ( Status <> DBIERR_NONE ) then 
    Exit;
  try
    Status := Engine.GetBlobSize( FHandle, RecBuf, FieldNo, Result );
    if ( Status <> DBIERR_NONE ) or ( Result = 0 ) then 
      Exit;
    if ( Length(Buffer) <= Result ) then
      SetLength( Buffer, Trunc( Result + Result div 4 ) );
    Status := Engine.GetBlob( FHandle, RecBuf, FieldNo, 0, Result, Buffer, Result );
  finally
    if ( Status <> DBIERR_NONE ) then 
      Result := 0;
    Engine.FreeBlob( FHandle, RecBuf, FieldNo );
    if DoCheck then 
      Check( Engine, Status )
  end;
end;



Function TttBDEDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean;
var
  IsBlank: LongBool;
  RecBuf: PChar;
  Status: DBIResult;
begin
  if ( BlockReadSize > 0 ) then
  begin
    Status := Engine.GetField(FHandle, FieldNo, FBlockReadBuf +
      (FBlockBufOfs * FRecordSize), Buffer, IsBlank);
    Result := (Status = DBIERR_NONE) and not IsBlank;
  end
  else
  begin
    Result := GetActiveRecBuf(RecBuf);
    if Result then
    begin
      Check( Engine, Engine.GetField( FHandle, FieldNo, RecBuf, Buffer, IsBlank ) );
      Result := not IsBlank;
    end
  end;
end;

Function TttBDEDataSet.GetFieldData( Field: TField; Buffer: Pointer): Boolean;
var
  RecBuf: PChar;
begin
  if ( Field.FieldNo > 0 ) then
    Result := GetFieldData( Field.FieldNo, Buffer )
  else
  begin
    if ( State = dsBlockRead ) then
    begin
      RecBuf := TempBuffer;
      Result := TRUE;
    end
    else
      Result := GetActiveRecBuf( RecBuf );
    if Result and (State in [dsBrowse, dsEdit, dsInsert, dsCalcFields, dsBlockRead]) then
    begin
      Inc( RecBuf, FRecordSize + Field.Offset );
      Result := Boolean( RecBuf[ 0 ] );
      if Result and ( Buffer <> NIL ) then
        Move( RecBuf[1], Buffer^, Field.DataSize );
    end;
  end;
end;


Procedure TttBDEDataset.SetFieldData( Field: TField; Buffer: Pointer );
var
  RecBuf: PChar;
  Blank: LongBool;
begin
  with Field do
  begin
    if not ( State in dsWriteModes ) then
      DatabaseError( SNotEditing, Self );
    if not ( State in dsWriteModes ) then 
      DatabaseError( SNotEditing, Self );

    if ( State = dsSetKey ) and ( ( FieldNo < 0 ) or ( FIndexFieldCount > 0 ) and
      not IsIndexField ) then 
        DatabaseErrorFmt( SNotIndexField, [DisplayName], Self );
    GetActiveRecBuf( RecBuf );
    if ( FieldNo > 0 ) then
    begin
      if ( State = dsCalcFields ) then 
        DatabaseError( SNotEditing );
      if ReadOnly and not ( State in [dsSetKey, dsFilter] ) then
        DatabaseErrorFmt( SFieldReadOnly, [DisplayName] );
      Validate( Buffer );
      if ( FieldKind <> fkInternalCalc ) then
      begin
        if FConstraintLayer and Field.HasConstraints and ( State in [dsEdit, dsInsert] ) then
          Check( Engine, Engine.VerifyField( FHandle, FieldNo, Buffer, Blank ) );
        Check( Engine, Engine.PutField( FHandle, FieldNo, RecBuf, Buffer ) );
      end;
    end 
    else {fkCalculated, fkLookup}
    begin
      Inc( RecBuf, FRecordSize + Offset );
      Boolean( RecBuf[0] ) := LongBool( Buffer );
      if Boolean( RecBuf[ 0 ] ) then 
        Move( Buffer^, RecBuf[ 1 ], DataSize );
    end;
    if not ( State in [dsCalcFields, dsFilter, dsNewValue] ) then
      DataEvent( deFieldChange, Longint( Field ) );
  end;
end;


Function TttBDEDataset.GetBlobData( Field : TField; Buffer : PChar ) : TBlobData;
begin
  Result := TBlobDataArray( Buffer + FBlobCacheOfs )[ Field.Offset ];
end;


Procedure TttBDEDataset.SetBlobData( Field : TField; Buffer : PChar; Value : TBlobData );
begin
  if ( Buffer = ActiveBuffer ) then
    TBlobDataArray( Buffer + FBlobCacheOfs )[ Field.Offset ] := Value;
end;


Procedure TttBDEDataset.CloseBlob( Field: TField );
begin
  Engine.FreeBlob( Handle, ActiveBuffer, Field.FieldNo );
end;




Function TttBDEDataset.GetStateFieldValue( State: TDataSetState; Field: TField ): Variant;
begin
  CheckCachedUpdateMode;
  Result := Inherited GetStateFieldValue( State, Field );
end;


Procedure TttBDEDataset.SetStateFieldValue( State: TDataSetState; Field: TField; Const Value: Variant );
begin
  CheckCachedUpdateMode;
  Inherited SetStateFieldValue( State, Field, Value );
end;


Function TttBDEDataset.Translate( Src, Dest: PChar; ToOem: Boolean ) : Integer;
begin
  Result := StrLen( Src );
  if ToOem then
    TAnsiToNativeBuf( Engine, NIL, Src, Dest, Result )
  else
    TNativeToAnsiBuf( Engine, NIL, Src, Dest, Result );
  if ( Src <> Dest ) then
    Dest[ Result ] := #0;
end;

Function TttBDEDataSet.GetFieldFullName( Field : TField ) : string;
var
  Len: Word;
  AttrDesc: ObjAttrDesc;
  Buffer: array[0..1024] of Char;
begin
  if ( Field.FieldNo > 0 ) then
  begin
    AttrDesc.iFldNum := Field.FieldNo;
    AttrDesc.pszAttributeName := Buffer;
    Check( Engine, Engine.GetEngProp( HDBIOBJ( Handle ), curFIELDFULLNAME, @AttrDesc, SizeOf( Buffer ), Len ) );
    TNativeToAnsi( Engine, NIL, Buffer, Result);
  end
  else
    Result := inherited GetFieldFullName( Field );
end;

Function TttBDEDataset.GetHandle : HDBICur;
begin
  Result := FHandle;
end;

Procedure TttBDEDataset.InternalFirst;
begin
  Check( Engine, Engine.SetToBegin( FHandle ) );
end;


Procedure TttBDEDataset.InternalLast;
begin
  Check( Engine, Engine.SetToEnd( FHandle ) );
end;


Procedure TttBDEDataset.InternalEdit;
begin
  Check( Engine, Engine.GetRecord( FHandle, dbiWriteLock, ActiveBuffer, NIL ) );
  ClearBlobCache( ActiveBuffer );
end;

Procedure TttBDEDataSet.InternalInsert;
begin
  SetBoolProp( Engine, Handle, curMAKECRACK, TRUE );
  CursorPosChanged;
end;

Procedure TttBDEDataset.InternalPost;
begin
  inherited;
  if ( State = dsEdit ) then
    Check( Engine, Engine.ModifyRecord( FHandle, ActiveBuffer, TRUE ) ) 
  else
    Check( Engine, Engine.InsertRecord( FHandle, dbiNoLock, ActiveBuffer ) );
end;


Procedure TttBDEDataset.InternalDelete;
var
  Result: DBIResult;
begin
  Result := Engine.DeleteRecord( FHandle, NIL );
  if ( Result <> DBIERR_NONE ) and ( ErrCat( Result ) <> ERRCAT_NOTFOUND ) then
    Check( Engine, Result );
end;


Function TttBDEDataset.IsSequenced: Boolean;
begin
  Result := ( FRecNoStatus = rnParadox ) and ( not Filtered );
end;


Function TttBDEDataset.GetCanModify: Boolean;
begin
  Result := FCanModify or ForceUpdateCallback;
end;


Procedure TttBDEDataset.InternalRefresh;
begin
  if ( DataSetField <> NIL ) and ( DataSetField.DataType = ftReference ) then
    Check( Engine, Engine.ForceRecordReread( FHandle, ActiveBuffer ) )
  else
    Check( Engine, Engine.ForceReread( FHandle ) );
end;


Procedure TttBDEDataset.Post;
begin
  Inherited Post;
  if ( State = dsSetKey ) then
    PostKeyBuffer( TRUE );
end;


Procedure TttBDEDataset.Cancel;
begin
  Inherited Cancel;
  if ( State = dsSetKey ) then
    PostKeyBuffer( FALSE );
end;


Procedure TttBDEDataset.InternalCancel;
begin
  If ( State = dsEdit ) then
    Engine.RelRecordLock( FHandle, FALSE );
end;


Procedure TttBDEDataset.InternalAddRecord( Buffer: Pointer; Append: Boolean );
begin
  if Append then
    Check( Engine, Engine.AppendRecord( FHandle, Buffer ) ) 
  else
    Check( Engine, Engine.InsertRecord( FHandle, dbiNoLock, Buffer ) );
end;


Procedure TttBDEDataset.InternalGotoBookmark( Bookmark : TBookmark );
begin
  Check( Engine, Engine.SetToBookmark( FHandle, Bookmark ) );
end;


Procedure TttBDEDataset.InternalSetToRecord( Buffer : PChar );
begin
  InternalGotoBookmark( Buffer + FBookmarkOfs );
end;


Function TttBDEDataset.GetBookmarkFlag( Buffer : PChar ) : TBookmarkFlag;
begin
  Result := PRecInfo( Buffer + FRecInfoOfs ).BookmarkFlag;
end;


Procedure TttBDEDataset.SetBookmarkFlag( Buffer : PChar; Value : TBookmarkFlag );
begin
  PRecInfo( Buffer + FRecInfoOfs ).BookmarkFlag := Value;
end;


Procedure TttBDEDataset.GetBookmarkData( Buffer : PChar; Data : Pointer );
begin
  Move( Buffer[ FBookmarkOfs ], Data^, BookmarkSize );
end;


Procedure TttBDEDataset.SetBookmarkData( Buffer : PChar; Data : Pointer );
begin
  Move( Data^, Buffer[ FBookmarkOfs ], BookmarkSize );
end;


Function TttBDEDataset.CompareBookmarks( Bookmark1, Bookmark2 : TBookmark ) : Integer;
const
  RetCodes: array[Boolean, Boolean] of ShortInt = ( ( 2,CMPLess ),( CMPGtr,CMPEql ) );
begin
  { Check for uninitialized bookmarks }
  Result := RetCodes[Bookmark1 = NIL, Bookmark2 = NIL];
  if ( Result = 2 ) then
  begin
    if ( Handle <> NIL ) then
      Check( Engine, Engine.CompareBookmarks( Handle, Bookmark1, Bookmark2, Result ) );
    if ( Result = CMPKeyEql ) then 
      Result := CMPEql;
  end;
end;


Function TttBDEDataset.BookmarkValid( Bookmark: TBookmark ): Boolean;
begin
  Result := ( Handle <> NIL );
  if Result then
  begin
    CursorPosChanged;
    Result := ( Engine.SetToBookmark( FHandle, Bookmark ) = DBIERR_NONE ) and
      ( Engine.GetRecord( FHandle, dbiNOLOCK, NIL, NIL ) = DBIERR_NONE )
  end;
end;


Procedure TttBDEDataSet.SetBlockReadSize(Value: Integer);

  Function CanBlockRead: Boolean;
  var
    i: Integer;
  begin
    Result := (BufferCount <= 1) and (DataSetField = NIL);
    if Result then
      for i := 0 to FieldCount - 1 do
        if (Fields[i].DataType in [ftDataSet, ftReference]) then
        begin
          Result := FALSE;
          break;
        end;
  end;

  Procedure FreeBuffer;
  begin
    if FBlockReadBuf <> NIL then
    begin
      FreeMem(FBlockReadBuf);
      FBlockReadBuf := NIL;
    end;
  end;

const
  DEFBLOCKSIZE  = 64 * 1024;
var
  Size : Integer;
begin
  if ( Value <> BlockReadSize ) then
  begin
    if ( Value > 0 ) then
	begin
      if EOF or not CanBlockRead then 
        Exit;
      FreeBuffer;
      UpdateCursorPos;
      Engine.SetEngProp( HDBIObj( FHandle ), curMAKECRACK, 0 );
      if Value = MaxInt then
        Size := DEFBLOCKSIZE 
      else
        Size := Value * FRecordSize;
      FBlockReadBuf := AllocMem(Size);
      FBlockBufSize := Size div FRecordSize;
      FBlockBufOfs := FBlockBufSize; { Force read of data }
      FBlockBufCount := FBlockBufSize;
      FBlockReadCount := 0;
      inherited;
      BlockReadNext;
    end 
    else
    begin
      inherited;
      FreeBuffer;
    end;
  end;
end;

Procedure TttBDEDataSet.BlockReadNext;
var
  Status: DbiResult;
begin
  if ( FBlockBufOfs >= FBlockBufCount - 1 ) then
  begin
    if ( FBlockBufCount < FBlockBufSize ) then 
      Last 
    else
    begin
      Status := Engine.ReadBlock( FHandle, FBlockBufCount, FBlockReadBuf );
      if (Status <> DBIERR_NONE) and (Status <> DBIERR_EOF) then
        Check( Engine, Status );
      if ( FBlockBufCount = 0 ) and ( Status = DBIERR_EOF ) then 
        Last;
      Inc( FBlockReadCount, FBlockBufCount );
      FBlockBufOfs := 0;
    end
  end 
  else
    Inc( FBlockBufOfs );
  if ( CalcFieldsSize > 0 ) then
    GetCalcFields( TempBuffer );
  DataEvent(deDataSetScroll, -1);
end;

Procedure TttBDEDataset.GetIndexInfo;
var
  IndexDesc: IDXDesc;
begin
  if ( Engine.GetIndexDesc( FHandle, 0, IndexDesc ) = DBIERR_NONE ) then
  begin
    FExpIndex := IndexDesc.bExpIdx;
    FCaseInsIndex := IndexDesc.bCaseInsensitive;
    if not ExpIndex then
    begin
      FIndexFieldCount := IndexDesc.iFldsInKey;
      FIndexFieldMap := IndexDesc.aiKeyFld;
    end;
    FKeySize := IndexDesc.iKeyLen;
  end;
end;


Procedure TttBDEDataset.SwitchToIndex( const IndexName, TagName : String );
var
  Status: DBIResult;
begin
  ResetCursorRange;
  UpdateCursorPos;
  Status := Engine.SwitchToIndex( FHandle, PChar( IndexName ), PChar( TagName ), 0, TRUE );
  if ( Status = DBIERR_NOCURRREC ) then
    Status := Engine.SwitchToIndex( FHandle, PChar( IndexName ), PChar( TagName ), 0, FALSE );
  Check( Engine, Status );
  FKeySize := 0;
  FExpIndex := FALSE;
  FCaseInsIndex := FALSE;
  FIndexFieldCount := 0;
  SetBufListSize( 0 );
  InitBufferPointers( TRUE );
  try
    SetBufListSize( BufferCount + 1 );
  except
    SetState( dsInactive );
    CloseCursor;
    raise;
  end;
  GetIndexInfo;
end;


Function TttBDEDataset.GetIndexField( Index : Integer ): TField;
var
  FieldNo: Integer;
begin
  if ( Index < 0 ) or ( Index >= FIndexFieldCount ) then
    DatabaseError( SFieldIndexError, Self );
  FieldNo := FIndexFieldMap[Index];
  Result := FieldByNumber( FieldNo );
  if ( Result = NIL ) then
    DatabaseErrorFmt( SIndexFieldMissing, [ FieldDefs[FieldNo - 1].Name ], Self );
end;


Procedure TttBDEDataset.SetIndexField( Index : Integer; Value : TField );
begin
  GetIndexField( Index ).Assign( Value );
end;


Function TttBDEDataset.GetIndexFieldCount: Integer;
begin
  Result := FIndexFieldCount;
end;


Procedure TttBDEDataset.AllocKeyBuffers;
var
  KeyIndex: TKeyIndex;
begin
  try
    for KeyIndex := Low( TKeyIndex ) to High( TKeyIndex ) do
      FKeyBuffers[KeyIndex] := InitKeyBuffer( AllocMem( SizeOf( TKeyBuffer ) + FRecordSize ) );
  except
    FreeKeyBuffers;
    raise;
  end;
end;


Procedure TttBDEDataset.FreeKeyBuffers;
var
  KeyIndex: TKeyIndex;
begin
  for KeyIndex := Low( TKeyIndex ) to High( TKeyIndex ) do
    DisposeMem( FKeyBuffers[ KeyIndex ], SizeOf( TKeyBuffer ) + FRecordSize );
end;


Function TttBDEDataset.InitKeyBuffer( Buffer: PKeyBuffer ): PKeyBuffer;
begin
  FillChar( Buffer^, SizeOf( TKeyBuffer ) + FRecordSize, 0 );
  Engine.InitRecord( FHandle, PChar( Buffer ) + SizeOf( TKeyBuffer ) );
  Result := Buffer;
end;


Procedure TttBDEDataset.CheckSetKeyMode;
begin
  if ( State <> dsSetKey ) then 
    DatabaseError( SNotEditing, Self );
end;


Function TttBDEDataset.SetCursorRange: Boolean;
var
  RangeStart, RangeEnd: PKeyBuffer;
  StartKey, EndKey: PChar;
  IndexBuffer: PChar;
  UseStartKey, UseEndKey, UseKey: Boolean;
begin
  Result := FALSE;
  if not (
    BuffersEqual( FKeyBuffers[kiRangeStart], FKeyBuffers[kiCurRangeStart],
    SizeOf( TKeyBuffer ) + FRecordSize ) and
    BuffersEqual( FKeyBuffers[kiRangeEnd], FKeyBuffers[kiCurRangeEnd],
    SizeOf( TKeyBuffer ) + FRecordSize ) ) then
  begin
    IndexBuffer := AllocMem( KeySize * 2 );
    try
      UseStartKey := TRUE;
      UseEndKey := TRUE;
      RangeStart := FKeyBuffers[kiRangeStart];
      if RangeStart.Modified then
      begin
        StartKey := PChar( RangeStart ) + SizeOf( TKeyBuffer );
        UseStartKey := Engine.ExtractKey( Handle, StartKey, IndexBuffer ) = 0;
      end
      else
        StartKey := NIL;
      RangeEnd := FKeyBuffers[kiRangeEnd];
      if RangeEnd.Modified then
      begin
        EndKey := PChar( RangeEnd ) + SizeOf( TKeyBuffer );
        UseEndKey := ( Engine.ExtractKey( Handle, EndKey, IndexBuffer + KeySize ) = 0 );
      end
      else
        EndKey := NIL;
      UseKey := UseStartKey and UseEndKey;
      if UseKey then
      begin
        if ( StartKey <> NIL ) then 
          StartKey := IndexBuffer;
        if ( EndKey <> NIL ) then 
          EndKey := IndexBuffer + KeySize;
      end;
      Check( Engine, Engine.SetRange( FHandle, UseKey,
        RangeStart.FieldCount, 0, StartKey, not RangeStart.Exclusive,
        RangeEnd.FieldCount, 0, EndKey, not RangeEnd.Exclusive ) );
      Move( FKeyBuffers[kiRangeStart]^, FKeyBuffers[kiCurRangeStart]^,
        SizeOf( TKeyBuffer ) + FRecordSize );
      Move( FKeyBuffers[kiRangeEnd]^, FKeyBuffers[kiCurRangeEnd]^,
        SizeOf( TKeyBuffer ) + FRecordSize );
      DestroyLookupCursor;
      Result := TRUE;
    finally
      FreeMem( IndexBuffer, KeySize * 2 );
    end;
  end;
end;


Function TttBDEDataset.ResetCursorRange: Boolean;
begin
  Result := FALSE;
  if FKeyBuffers[kiCurRangeStart].Modified or
    FKeyBuffers[kiCurRangeEnd].Modified then
  begin
    Check( Engine, Engine.ResetRange( FHandle ) );
    InitKeyBuffer( FKeyBuffers[kiCurRangeStart] );
    InitKeyBuffer( FKeyBuffers[kiCurRangeEnd] );
    DestroyLookupCursor;
    Result := TRUE;
  end;
end;


Procedure TttBDEDataset.SetLinkRanges( MasterFields: TList );
var
  I: Integer;
  SaveState: TDataSetState;
begin
  SaveState := SetTempState( dsSetKey );
  try
    FKeyBuffer := InitKeyBuffer( FKeyBuffers[kiRangeStart] );
    FKeyBuffer^.Modified := TRUE;
    for I := 0 to Pred( MasterFields.Count ) do
      GetIndexField( I ).Assign( TField( MasterFields[I] ) );
    FKeyBuffer^.FieldCount := MasterFields.Count;
  finally
    RestoreState( SaveState );
  end;
  Move( FKeyBuffers[kiRangeStart]^, FKeyBuffers[kiRangeEnd]^,
    SizeOf( TKeyBuffer ) + FRecordSize );
end;


Function TttBDEDataset.GetKeyBuffer( KeyIndex: TKeyIndex ): PKeyBuffer;
begin
  Result := FKeyBuffers[KeyIndex];
end;


Procedure TttBDEDataset.SetKeyBuffer( KeyIndex: TKeyIndex; Clear: Boolean );
begin
  CheckBrowseMode;
  FKeyBuffer := FKeyBuffers[KeyIndex];
  Move( FKeyBuffer^, FKeyBuffers[kiSave]^, SizeOf( TKeyBuffer ) + FRecordSize );
  if Clear then 
    InitKeyBuffer( FKeyBuffer );
  SetState( dsSetKey );
  SetModified( FKeyBuffer.Modified );
  DataEvent( deDataSetChange, 0 );
end;


Procedure TttBDEDataset.PostKeyBuffer( Commit: Boolean );
begin
  DataEvent( deCheckBrowseMode, 0 );
  if Commit then
    FKeyBuffer.Modified := Modified 
  else
    Move( FKeyBuffers[kiSave]^, FKeyBuffer^, SizeOf( TKeyBuffer ) + FRecordSize );
  SetState( dsBrowse );
  DataEvent( deDataSetChange, 0 );
end;


Function TttBDEDataset.GetKeyExclusive: Boolean;
begin
  CheckSetKeyMode;
  Result := FKeyBuffer.Exclusive;
end;


Procedure TttBDEDataset.SetKeyExclusive( Value: Boolean );
begin
  CheckSetKeyMode;
  FKeyBuffer.Exclusive := Value;
end;


Function TttBDEDataset.GetKeyFieldCount: Integer;
begin
  CheckSetKeyMode;
  Result := FKeyBuffer.FieldCount;
end;


Procedure TttBDEDataset.SetKeyFieldCount( Value: Integer );
begin
  CheckSetKeyMode;
  FKeyBuffer.FieldCount := Value;
end;


Procedure TttBDEDataset.SetKeyFields( KeyIndex: TKeyIndex;
  const Values: array of const );
var
  I: Integer;
  SaveState: TDataSetState;
begin
  if ExpIndex then 
    DatabaseError( SCompositeIndexError, Self );
  if ( FIndexFieldCount = 0 ) then 
    DatabaseError( SNoFieldIndexes, Self );
  SaveState := SetTempState( dsSetKey );
  try
    FKeyBuffer := InitKeyBuffer( FKeyBuffers[KeyIndex] );
    for I := 0 to High( Values ) do 
      GetIndexField( I ).AssignValue( Values[I] );
    FKeyBuffer^.FieldCount := High( Values ) + 1;
    FKeyBuffer^.Modified := Modified;
  finally
    RestoreState( SaveState );
  end;
end;


Function TttBDEDataset.GetIsIndexField( Field: TField ): Boolean;
var
  I: Integer;
begin
  Result := FALSE;
  with Field do
    if ( FieldNo > 0 ) then
      for I := 0 to Pred( FIndexFieldCount ) do
       if ( FIndexFieldMap[I] = FieldNo ) then
        begin
          Result := TRUE;
          Exit;
        end;
end;


Function TttBDEDataset.MapsToIndex( Fields: TList; CaseInsensitive: Boolean ): Boolean;
var
  I: Integer;
  HasStr : Boolean;
begin
  Result := FALSE;
  HasStr := FALSE;
  For i := 0 to Fields.Count - 1 do
  begin
    HasStr := TField(Fields[I]).DataType in [ftString, ftFixedChar, ftWideString];
    if HasStr then 
      break;
  end;
  if ( CaseInsensitive <> FCaseInsIndex ) and HasStr then 
    Exit;
  if ( Fields.Count > FIndexFieldCount ) then 
    Exit;
  for I := 0 to Pred( Fields.Count ) do
    if TField( Fields[I] ).FieldNo <> Integer( FIndexFieldMap[I] ) then 
      Exit;
  Result := TRUE;
end;



Procedure TttBDEDataset.ActivateFilters;
begin
  if ( FExprFilter <> NIL ) then
  begin
    if ( Engine.ActivateFilter( FHandle, FExprFilter ) <> DBIERR_NONE ) then
    begin
      Engine.DropFilter( FHandle, FExprFilter );
      FExprFilter := CreateExprFilter( Filter, FilterOptions, 0 );
      Check( Engine, Engine.ActivateFilter( FHandle, FExprFilter ) );
    end;
  end;
  if ( FFuncFilter <> NIL ) then
  begin
    if ( Engine.ActivateFilter( FHandle, FFuncFilter ) <> DBIERR_NONE ) then
    begin
      Engine.DropFilter( FHandle, FFuncFilter );
      FFuncFilter := CreateFuncFilter( @TttBDEDataset.RecordFilter, 1 );
      Check( Engine, Engine.ActivateFilter( FHandle, FFuncFilter ) );
    end;
  end;
end;


Procedure TttBDEDataset.DeactivateFilters;
begin
  if ( FFuncFilter <> NIL ) then 
    Check( Engine, Engine.DeactivateFilter( FHandle, FFuncFilter ) );
  if ( FExprFilter <> NIL ) then 
    Check( Engine, Engine.DeactivateFilter( FHandle, FExprFilter ) );
end;


Function TttBDEDataset.CreateExprFilter( const Expr: String;
  Options: TFilterOptions; Priority: Integer ): HDBIFilter;
var
  Parser: TExprParser;
begin
  Parser := TExprParser.Create(Self, Expr, Options, [], '', NIL, FldTypeMap );
  try
    Check( Engine, Engine.AddFilter( FHandle, 0, Priority, FALSE, PCANExpr( Parser.FilterData ), NIL, Result ) );
  finally
    Parser.Free;
  end;
end;


Function TttBDEDataset.CreateFuncFilter( FilterFunc: Pointer;
  Priority: Integer ): HDBIFilter;
begin
  Check( Engine, Engine.AddFilter( FHandle, Integer( Self ), Priority, FALSE, NIL, PFGENFilter( FilterFunc ), Result ) );
end;


{$WARNINGS OFF}
Function TttBDEDataset.CreateLookupFilter( Fields: TList; const Values: Variant;
  Options: TLocateOptions; Priority: Integer ): HDBIFilter;
var
  I: Integer;
  Filter: TFilterExpr;
  Expr, Node: PExprNode;
  FilterOptions: TFilterOptions;
begin
  if loCaseInsensitive in Options then
    FilterOptions := [foNoPartialCompare, foCaseInsensitive] 
  else
    FilterOptions := [foNoPartialCompare];
  Filter := TFilterExpr.Create(Self, FilterOptions, [], '', NIL, FldTypeMap );
  try
    if ( Fields.Count = 1 ) then
    begin
      Node := Filter.NewCompareNode( TField( Fields[0] ), coEQ, Values );
      Expr := Node;
    end 
    else
      for I := 0 to Pred( Fields.Count ) do
      begin
        Node := Filter.NewCompareNode( TField( Fields[I] ), coEQ, Values[I] );
        if ( I = 0 ) then
          Expr := Node 
        else
          Expr := Filter.NewNode( enOperator, coAND, Unassigned, Expr, Node );
      end;
    if loPartialKey in Options then 
      Node^.FPartial := TRUE;
    Check( Engine, Engine.AddFilter( FHandle, 0, Priority, FALSE, PCANExpr( Filter.GetFilterData( Expr ) ), NIL, Result ) );
  finally
    Filter.Free;
  end;
end;
{$WARNINGS ON}


Procedure TttBDEDataset.SetFilterHandle( var Filter: HDBIFilter; Value: HDBIFilter );
begin
  if Filtered then
  begin
    CursorPosChanged;
    DestroyLookupCursor;
    Engine.SetToBegin( FHandle );
    if Filter <> NIL then 
      Engine.DropFilter( FHandle, Filter );
    Filter := Value;
    if Filter <> NIL then 
      Engine.ActivateFilter( FHandle, Filter );
  end 
  else
    Filter := Value;
end;


Procedure TttBDEDataset.SetFilterData( const Text: String; Options: TFilterOptions );
var
  HFilter: HDBIFilter;
begin
  if Active then
  begin
    CheckBrowseMode;
    if ( Filter <> Text ) or ( FilterOptions <> Options ) then
    begin
      if Text <> '' then
        HFilter := CreateExprFilter( Text, Options, 0 ) 
      else
        HFilter := NIL;
      SetFilterHandle( FExprFilter, HFilter );
    end;
  end;
  Inherited SetFilterText( Text );
  Inherited SetFilterOptions( Options );
  if Active and Filtered then 
    First;
end;


Procedure TttBDEDataset.SetFilterText( const Value: String );
begin
  SetFilterData( Value, FilterOptions );
end;


Procedure TttBDEDataset.SetFiltered( Value: Boolean );
begin
  if Active then
  begin
    CheckBrowseMode;
    if Filtered <> Value then
    begin
      DestroyLookupCursor;
      Engine.SetToBegin( FHandle );
      if Value then 
        ActivateFilters 
      else 
        DeactivateFilters;
      Inherited SetFiltered( Value );
    end;
    First;
  end 
  else
    Inherited SetFiltered( Value );
end;


Procedure TttBDEDataset.SetFilterOptions( Value: TFilterOptions );
begin
  SetFilterData( Filter, Value );
end;


Procedure TttBDEDataset.SetOnFilterRecord( const Value: TFilterRecordEvent );
var
  Filter: HDBIFilter;
begin
  if Active then
  begin
    CheckBrowseMode;
    if Assigned( OnFilterRecord ) <> Assigned( Value ) then
    begin
      if Assigned( Value ) then
        Filter := CreateFuncFilter( @TttBDEDataset.RecordFilter, 1 ) 
      else
        Filter := NIL;
      SetFilterHandle( FFuncFilter, Filter );
    end;
    Inherited SetOnFilterRecord( Value );
    if Filtered then 
      First;
  end 
  else
    Inherited SetOnFilterRecord( Value );
end;


Function TttBDEDataset.FindRecord( Restart, GoForward: Boolean ): Boolean;
var
  Status: DBIResult;
begin
  CheckBrowseMode;
  DoBeforeScroll;
  SetFound( FALSE );
  UpdateCursorPos;
  CursorPosChanged;
  if not Filtered then 
    ActivateFilters;
  try
    if GoForward then
    begin
      if Restart then 
        Check( Engine, Engine.SetToBegin( FHandle ) );
      Status := Engine.GetNextRecord( FHandle, dbiNoLock, NIL, NIL );
    end 
    else
    begin
      if Restart then 
        Check( Engine, Engine.SetToEnd( FHandle ) );
      Status := Engine.GetPriorRecord( FHandle, dbiNoLock, NIL, NIL );
    end;
  finally
    if not Filtered then 
      DeactivateFilters;
  end;
  if ( Status = DBIERR_NONE ) then
  begin
    Resync( [rmExact, rmCenter] );
    SetFound( TRUE );
  end;
  Result := Found;
  if Result then 
    DoAfterScroll;
end;


Function TttBDEDataset.RecordFilter( RecBuf: Pointer; RecNo: Integer ): Smallint;
var
  Accept: Boolean;
  SaveState: TDataSetState;
begin
  SaveState := SetTempState( dsFilter );
  FFilterBuffer := RecBuf;
  try
    Accept := TRUE;
    OnFilterRecord( Self, Accept );
  except
    ApplicationHandleException( Self );
  end;
  RestoreState( SaveState );
  Result := Ord( Accept );
end;


Function TttBDEDataset.LocateRecord( const KeyFields: String;
  const KeyValues: Variant; Options: TLocateOptions;
  SyncCursor: Boolean ): Boolean;
var
  I, FieldCount, PartialLength: Integer;
  Buffer: PChar;
  Fields: TList;
  LookupCursor: HDBICur;
  Filter: HDBIFilter;
  Status: DBIResult;
  CaseInsensitive: Boolean;
begin
  CheckBrowseMode;
  CursorPosChanged;
  Buffer := TempBuffer;
  Fields := TList.Create;
  try
    GetFieldList( Fields, KeyFields );
    CaseInsensitive := loCaseInsensitive in Options;
    if CachedUpdates then
      LookupCursor := NIL
    else
      if MapsToIndex( Fields, CaseInsensitive ) then
        LookupCursor := FHandle
      else
        LookupCursor := GetLookupCursor( KeyFields, CaseInsensitive );
    if ( LookupCursor <> NIL ) then
    begin
      SetTempState( dsFilter );
      FFilterBuffer := Buffer;
      try
        Engine.InitRecord( LookupCursor, Buffer );
        FieldCount := Fields.Count;
        if ( FieldCount = 1 ) then
        begin
          If VarIsArray( KeyValues ) then
            TField( Fields.First ).Value := KeyValues[ 0 ]
          else
            TField( Fields.First ).Value := KeyValues;
        end
        else
          for I := 0 to Pred( FieldCount ) do
            TField( Fields[I] ).Value := KeyValues[I];
        PartialLength := 0;
        if ( loPartialKey in Options ) and ( TField( Fields.Last ).DataType = ftString ) then
        begin
          Dec( FieldCount );
          PartialLength := Length( TField( Fields.Last ).AsString );
        end;
        Status := Engine.GetRecordForKey( LookupCursor, FALSE, FieldCount, PartialLength, Buffer, Buffer );
      finally
        RestoreState( dsBrowse );
      end;
      if ( Status = DBIERR_NONE ) and SyncCursor and
        ( LookupCursor <> FHandle ) then
        Status := Engine.SetToCursor( FHandle, LookupCursor );
    end 
    else
    begin
      Check( Engine, Engine.SetToBegin( FHandle ) );
      Filter := CreateLookupFilter( Fields, KeyValues, Options, 2 );
      Engine.ActivateFilter( FHandle, Filter );
      Status := Engine.GetNextRecord( FHandle, dbiNoLock, Buffer, NIL );
      Engine.DropFilter( FHandle, Filter );
    end;
  finally
    Fields.Free;
  end;
  Result := Status = DBIERR_NONE;
end;


Function TttBDEDataset.Lookup( const KeyFields: String; const KeyValues: Variant;
  const ResultFields: String ): Variant;
begin
  Result := Null;
  if LocateRecord( KeyFields, KeyValues, [], FALSE ) then
  begin
    SetTempState( dsCalcFields );
    try
      CalculateFields( TempBuffer );
      Result := FieldValues[ResultFields];
    finally
      RestoreState( dsBrowse );
    end;
  end;
end;


Function TttBDEDataset.Locate( const KeyFields: String;
  const KeyValues: Variant; Options: TLocateOptions ): Boolean;
begin
  DoBeforeScroll;
  Result := LocateRecord( KeyFields, KeyValues, Options, TRUE );
  if Result then
  begin
    Resync( [rmExact, rmCenter] );
    DoAfterScroll;
  end;
end;


Function TttBDEDataset.GetLookupCursor( const KeyFields: String; CaseInsensitive: Boolean ): HDBICur;
begin
  Result := NIL;
end;


Procedure TttBDEDataset.DestroyLookupCursor;
begin
end;


Function TttBDEDataset.HasConstraints: Boolean;
var
  I: Integer;
begin
  Result := TRUE;
  if ( Constraints.Count > 0 ) then 
    Exit;
  for I := 0 to Pred( FieldCount ) do
    if Fields[I].HasConstraints then 
      Exit;
  Result := FALSE;
end;


Function TttBDEDataset.ConstraintsDisabled: Boolean;
begin
  Result := ( FConstDisableCount > 0 );
end;


Procedure TttBDEDataset.DisableConstraints;
begin
  if ( FConstDisableCount = 0 ) then
    SetBoolProp( Engine, Handle, curCONSTSTATE, FALSE);
  Inc( FConstDisableCount );
end;


Procedure TttBDEDataset.EnableConstraints;
begin
  if ( FConstDisableCount <> 0 ) then
  begin
    Dec( FConstDisableCount );
    if ( FConstDisableCount = 0 ) then
      SetBoolProp( Engine, Handle, curCONSTSTATE, TRUE );
  end;
end;


Function TttBDEDataset.ConstraintCallBack( Req: DsInfoReq;
  var ADataSources: DataSources ): DBIResult;

  Function GetPChar( const S: String ): PChar;
  begin
    if S <> '' then 
      Result := PChar( Pointer( S ) ) 
    else 
      Result := '';
  end;


  Function GetFieldConstraint: Boolean;
  var
    Field: TField;
  begin
    Result := FALSE;
    Field := FindField( ADataSources.szSourceFldName );
    if ( Field <> NIL ) and ( Field.Required or ( Field.ImportedConstraint <> '' ) or
      ( Field.CustomConstraint <> '' ) ) then
    begin
      StrCopy( ADataSources.szSQLExprImport, GetPChar( Field.ImportedConstraint ) );
      StrCopy( ADataSources.szSQLExprCustom, GetPChar( Field.CustomConstraint ) );
      StrCopy( ADataSources.szErrStrCustom, GetPChar( Field.ConstraintErrorMessage ) );
      StrCopy( ADataSources.szErrStrImport, GetPChar( Field.ConstraintErrorMessage ) );
      ADataSources.bRequired := Field.Required;
      Result := TRUE;
    end;
  end;


  Procedure GetTableConstraint;
  begin
    with ADataSources, Constraints[iNumElem - 1] do
    begin
      StrCopy( szSQLExprImport, GetPChar( ImportedConstraint ) );
      StrCopy( szSQLExprCustom, GetPChar( CustomConstraint ) );
      StrCopy( szErrStrCustom, GetPChar( ErrorMessage ) );
      StrCopy( szErrStrImport, GetPChar( ErrorMessage ) );
    end;
  end;


  Function GetDefaultExpression: Boolean;
  var
    Field: TField;
  begin
    Result := FALSE;
    Field := FindField( ADataSources.szSourceFldName );
    if ( Field <> NIL ) and ( Field.DefaultExpression <> '' ) then
    begin
      StrCopy( ADataSources.szSQLExprImport, GetPChar( Field.DefaultExpression ) );
      Result := TRUE;
    end;
  end;


begin
  Result := DBIERR_NA;
  try
    case Req of
      dsFieldSource: 
        if GetFieldSource( Self, ADataSources ) then 
          Result := DBIERR_NONE;
      dsFieldDomainExpr: 
        if GetFieldConstraint then 
          Result := DBIERR_NONE;
      dsFieldDefault: 
        if GetDefaultExpression then 
          Result := DBIERR_NONE;
      dsNumTblConstraint:
        begin
          ADataSources.iNumElem := Constraints.Count;
          Result := DBIERR_NONE;
        end;
      dsTblConstraint:
        begin
          GetTableConstraint;
          Result := DBIERR_NONE;
        end;
    end;
  except
  end;
end;


Procedure TttBDEDataset.AllocCachedUpdateBuffers( Allocate: Boolean );
begin
  if Allocate then
  begin
    FUpdateCBBuf := AllocMem( SizeOf( DELAYUPDCbDesc ) );
    FUpdateCBBuf.pNewRecBuf := AllocMem( FRecBufSize );
    FUpdateCBBuf.pOldRecBuf := AllocMem( FRecBufSize );
    FUpdateCBBuf.iRecBufSize := FRecordSize;
  end 
  else
  begin
    if Assigned( FUpdateCBBuf ) then
    begin
      FreeMem( FUpdateCBBuf.pNewRecBuf );
      FreeMem( FUpdateCBBuf.pOldRecBuf );
      DisposeMem( FUpdateCBBuf, SizeOf( DELAYUPDCbDesc ) );
    end;
  end;
end;


Procedure TttBDEDataset.CheckCachedUpdateMode;
begin
  if not CachedUpdates then 
    DatabaseError( SNoCachedUpdates, Self );
end;


Function TttBDEDataset.UpdateCallbackRequired: Boolean;
begin
  Result := FCachedUpdates and ( Assigned( FOnUpdateError ) or
    Assigned( FOnUpdateRecord ) or Assigned( FUpdateObject ) );
end;


Function TttBDEDataset.ForceUpdateCallback: Boolean;
begin
  Result := FCachedUpdates and ( Assigned( FOnUpdateRecord ) or
    Assigned( FUpdateObject ) );
end;


Procedure TttBDEDataset.SetCachedUpdates( Value: Boolean );

  Procedure ReAllocBuffers;
  begin
    FreeFieldBuffers;
    FreeKeyBuffers;
    SetBufListSize( 0 );
    try
      InitBufferPointers( TRUE );
      SetBufListSize( BufferCount + 1 );
      AllocKeyBuffers;
    except
      SetState( dsInactive );
      CloseCursor;
      raise;
    end;
  end;

begin
  if ( State = dsInActive ) or ( csDesigning in ComponentState ) then
    FCachedUpdates := Value
  else 
  if ( FCachedUpdates <> Value ) then
  begin
    CheckBrowseMode;
    UpdateCursorPos;
    if FConstraintLayer then 
      Engine.EndConstraintLayer( FHandle );
    if FCachedUpdates then
      Check( Engine, Engine.EndDelayedUpdates( FHandle ) ) 
    else
      Check( Engine, Engine.BeginDelayedUpdates( FHandle ) );
    if FConstraintLayer then
      Check( Engine, Engine.BeginConstraintLayer( NIL, FHandle,
        @TttBDEDataset.ConstraintCallBack, Integer( Pointer( Self ) ) ) );
    FCachedUpdates := Value;
    ReAllocBuffers;
    AllocCachedUpdateBuffers( Value );
    SetupCallBack( UpdateCallBackRequired );
    Resync( [] );
  end;
end;


Procedure TttBDEDataset.SetupCallBack( Value: Boolean );
begin
  if Value then
  begin
    if ( csDesigning in ComponentState ) then 
      Exit;
    if not Assigned( FUpdateCallback ) then
      FUpdateCallback := TttBDECallback.Create( Engine, Self, Self.Handle, cbDELAYEDUPD,
        FUpdateCBBuf, SizeOf( DELAYUPDCbDesc ), CachedUpdateCallBack, TRUE );
  end
  else
  begin
    if Assigned( FUpdateCallback ) then
    begin
      FUpdateCallback.Free;
      FUpdateCallback := NIL;
    end;
  end;
end;


Function TttBDEDataset.ProcessUpdates( UpdCmd: DBIDelayedUpdCmd ): DBIResult;
begin
  CheckCachedUpdateMode;
  UpdateCursorPos;
  Result := Engine.ApplyDelayedUpdates( Handle, UpdCmd );
  If Active then
    Resync( [] );
end;


Procedure TttBDEDataset.ApplyUpdates;
var
  Status: DBIResult;
begin
  if ( State <> dsBrowse ) then 
    Post;
  Status := ProcessUpdates( dbiDelayedUpdPrepare );
  if ( Status <> DBIERR_NONE ) then
    if ( Status = DBIERR_UPDATEABORT ) then 
      SysUtils.Abort
    else 
      TDbiError( Engine, Status );
end;


Procedure TttBDEDataset.CommitUpdates;
begin
  Check( Engine, ProcessUpdates( dbiDelayedUpdCommit ) );
end;


Procedure TttBDEDataset.CancelUpdates;
begin
  Cancel;
  ProcessUpdates( dbiDelayedUpdCancel );
  if Active then
    Resync([]);
end;


Procedure TttBDEDataset.RevertRecord;
var
  Status: DBIResult;
begin
  if State in dsEditModes then Cancel;
  Status := ProcessUpdates( dbiDelayedUpdCancelCurrent );
  if not ( ( Status = DBIERR_NONE ) or ( Status = DBIERR_NOTSUPPORTED ) ) then
    Check( Engine, Status );
end;


Function TttBDEDataset.UpdateStatus: TUpdateStatus;
var
  BufPtr: PChar;
begin
  if CachedUpdates then
  begin
    if ( State = dsCalcFields ) then
      BufPtr := CalcBuffer 
    else
      BufPtr := ActiveBuffer;
    Result := PRecInfo( BufPtr + FRecInfoOfs ).UpdateStatus;
  end 
  else
    Result := usUnModified;
end;

Function TttBDEDataSet.CachedUpdateCallBack(CBInfo: Pointer): CBRType;
const
  CBRetCode: array[TUpdateAction] of CBRType = (cbrAbort, cbrAbort,
    cbrSkip, cbrRetry, cbrPartialAssist);
var
  UpdateAction: TUpdateAction;
  UpdateKind: TUpdateKind;
begin
  FInUpdateCallBack := TRUE;
  UpdateAction := uaFail;
  UpdateKind := TUpdateKind(ord(FUpdateCBBuf.eDelayUpdOpType)-1);
  try
    if Assigned(FOnUpdateRecord) then
      FOnUpdateRecord(Self, UpdateKind, UpdateAction)
    else
      if Assigned(FUpdateObject) then
      begin
        FUpdateObject.Apply(UpdateKind);
        UpdateAction := uaApplied;
      end
    else
      TDbiError( Engine, FUpdateCBBuf.iErrCode );
  except
    on E: Exception do
    begin
      if E is ETDBEngineError then
        FUpdateCBBuf.iErrCode := ETDBEngineError(E).Errors[0].ErrorCode;
      if (E is EDatabaseError) and Assigned(FOnUpdateError) then
        FOnUpdateError(Self, EDatabaseError(E), UpdateKind, UpdateAction)
      else
      begin
        ApplicationHandleException( Self );
        UpdateAction := uaAbort;
      end;
    end;
  end;
  Result := CBRetCode[UpdateAction];
  if UpdateAction = uaAbort then 
    FUpdateCBBuf.iErrCode := DBIERR_UPDATEABORT;
  FInUpdateCallBack := FALSE;
end;

Function TttBDEDataset.GetUpdateRecordSet: TUpdateRecordTypes;
begin
  if Active then
  begin
    CheckCachedUpdateMode;
    Result := TUpdateRecordTypes( Byte( GetIntProp( Engine, FHandle,
      curDELAYUPDDISPLAYOPT ) ) );
  end
  else
    Result := [];
end;


Procedure TttBDEDataset.SetUpdateRecordSet( RecordTypes: TUpdateRecordTypes );
begin
  CheckCachedUpdateMode;
  CheckBrowseMode;
  UpdateCursorPos;
  Check( Engine, Engine.SetEngProp( hDbiObj( Handle ), curDELAYUPDDISPLAYOPT, Longint( Byte( RecordTypes ) ) ) );
  Resync( [] );
end;


procedure TttBDEDataSet.SetUpdateObject(Value: TttDataSetUpdateObject);
begin
  if ( Value <> FUpdateObject ) then
  begin
    if Assigned( FUpdateObject ) and ( FUpdateObject.DataSet = Self ) then
      FUpdateObject.DataSet := NIL;
    FUpdateObject := Value;
    if Assigned( FUpdateObject ) then
    begin
      { If another dataset already references this updateobject, then
        remove the reference }
      if Assigned( FUpdateObject.DataSet ) and
        ( FUpdateObject.Dataset is TttBDEDataset ) and
        ( FUpdateObject.DataSet <> Self ) then
        TttBDEDataset( FUpdateObject.DataSet ).UpdateObject := NIL;
      FUpdateObject.DataSet := Self;
    end;
  end;
end;


Procedure TttBDEDataset.SetOnUpdateError( UpdateEvent: TUpdateErrorEvent );
begin
  if Active then
    SetupCallback( UpdateCallBackRequired );
  FOnUpdateError := UpdateEvent;
end;


Function TttBDEDataset.GetUpdatesPending: Boolean;
begin
  Result := GetIntProp( Engine, FHandle, curDELAYUPDNUMUPDATES ) > 0;
end;

Procedure TttBDEDataSet.DataEvent(Event: TDataEvent; Info: Integer);


  procedure CheckIfParentScrolled;
  var
    ParentPosition, I: Integer;
  begin
    ParentPosition := 0;
    with FParentDataSet do
     if not IsEmpty then
       for I := 0 to BookmarkSize - 1 do
         ParentPosition := ParentPosition + Byte(ActiveBuffer[FBookmarkOfs+I]);
    if ( FLastParentPos = 0 ) or ( ParentPosition <> FLastParentPos ) then
    begin
      First;
      FLastParentPos := ParentPosition;
    end 
    else
    begin
      UpdateCursorPos;
      Resync([]);
    end;
  end;

begin
  if ( Event = deParentScroll ) then
    CheckIfParentScrolled;
  inherited DataEvent(Event, Info);
end;


{ TttNestedTable }
constructor TttNestedTable.Create( AOwner : TComponent );
begin
  inherited Create( AOwner );
  ObjectView := TRUE;
end;

Function TttNestedTable.CreateHandle: HDBICur;
var
  PHandle: HDBICur;
begin
  if not Assigned(DataSetField) then 
    DatabaseError(SNoDataSetField, Self);
  FParentDataSet := (DataSetField.DataSet as TttBDEDataSet);
  OpenParentDataSet( FParentDataSet );
  PHandle := FParentDataSet.Handle;
  with DataSetField do
    if DataType = ftDataSet then
      Check( Engine, Engine.OpenNestedTable( PHandle, FieldNo, ReadOnly, FALSE, Result ) )
    else
      Check( Engine, Engine.OpenRef( PHandle, FieldNo, ReadOnly, FALSE, Result ) );
  FieldDefs.HiddenFields := FParentDataSet.FieldDefs.HiddenFields;
  if DataSetField.IncludeObjectField then
    FieldNoOfs := 1 
  else
    FieldNoOfs := 2;
end;

Procedure TttNestedTable.DoAfterPost;
var
  DataPtr: Pointer;
  RefData: Variant;
  RefSize: Word;
  RefBuffer: array[0..255] of Byte;
begin
  if ( DataSetField.DataType = ftReference ) then
  begin
    Check( Engine, Engine.GetEngProp( hDBIObj( FHandle ), curGETREF, @RefBuffer, SizeOf(RefBuffer), RefSize));
    if ( RefSize <= DataSetField.DataSize ) then
    begin
      RefData := VarArrayCreate([0, DataSetField.DataSize - 1], varByte);
      DataPtr := VarArrayLock(RefData);
      try
        Move(RefBuffer, DataPtr^, RefSize);
      finally
        VarArrayUnlock(RefData);
      end;
      DataSetField.AsVariant := RefData;
    end;
  end;
  inherited;
end;

Procedure TttNestedTable.DoBeforeInsert;
begin
  inherited DoBeforeInsert;
  if (DataSetField.DataType = ftDataSet) and (FParentDataSet.State = dsInsert) then
    FParentDataSet.Post;
end;

Procedure TttNestedTable.InternalPost;
begin
  inherited;
  if ( DataSetField.DataType = ftReference ) and ( State = dsInsert ) then
  begin
    if TReferenceField( DataSetField ).ReferenceTableName = '' then
      DatabaseErrorFmt( SNoReferenceTableName, [ DataSetField.DisplayName ] );
    Check( Engine, Engine.SetEngProp( hDBIObj( FHandle ), curREFINSERTTABLENAME,
      Integer( PChar( TReferenceField( DataSetField ).ReferenceTableName ) ) ) );
  end;
end;


{ TttDBDataset }
constructor TttDBDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AOwner is TttDatabase then
  begin
    DatabaseName := TttDatabase( AOwner ).DatabaseName;
    SessionName  := TttDatabase( AOwner ).SessionName;
  end;
  FAutoRefresh := FALSE;
end;

Procedure TttDBDataSet.SetHandle(Value: HDBICur);
begin
  Close;
  FHandle := Value;
  if Assigned( Value ) then
  try
    Open;
  except
    FHandle := NIL;
    Raise;
  end;
end;

Procedure TttDBDataset.OpenCursor( InfoQuery: Boolean );
begin
  SetDBFlag( dbfOpened, TRUE );
  Inherited OpenCursor( InfoQuery );
  SetUpdateMode( FUpdateMode );
  if Database.IsSQLBased then
    SetupAutoRefresh;
end;


Procedure TttDBDataset.CloseCursor;
begin
  Inherited CloseCursor;
  SetDBFlag( dbfOpened, FALSE );
end;


Procedure TttDBDataset.CheckDBSessionName;
var
  S: TttSession;
  Database: TttDatabase;
begin
  if ( SessionName <> '' ) and ( DatabaseName <> '' ) then
  begin
    S := FSessionList.FindSession( SessionName );
    if Assigned( S ) and not Assigned( S.DoFindDatabase( DatabaseName, Self ) ) then
    begin
      Database := DefaultSession.DoFindDatabase( DatabaseName, Self );
      if Assigned( Database ) then Database.CheckSessionName( TRUE );
    end;
  end;
end;


Function TttDBDataset.CheckOpen( Status: DBIResult ): Boolean;
begin
  case Status of
    DBIERR_NONE:
      Result := TRUE;
    DBIERR_NOTSUFFTABLERIGHTS:
      begin
        if not DBSession.GetPassword then
          TDbiError( Engine, Status );
        Result := FALSE;
      end;
  else
    TDbiError( Engine, Status );
    Result := FALSE;
  end;
end;


Function TttDBDataset.ConstraintsStored: Boolean;
begin
  Result := ( Constraints.Count > 0 );
end;


Procedure TttDBDataset.Disconnect;
begin
  Close;
end;


Function TttDBDataset.GetDBHandle: HDBIDB;
begin
  if ( FDatabase <> NIL ) then
    Result := FDatabase.Handle
  else
    Result := NIL;
end;




Function TttDBDataset.GetDBSession: TttSession;
begin
  if ( FDatabase <> NIL ) then
    Result := FDatabase.Session
  else
    Result := FSessionList.FindSession( SessionName );
  if ( Result = NIL ) then
    Result := DefaultSession;
end;




Function TttDBDataset.OpenDatabase: TttDatabase;
begin
  with FSessionList.List[FSessionName] do
    Result := DoOpenDatabase( FDatabasename, Self.Owner );
end;


Procedure TttDBDataset.CloseDatabase( Database: TttDatabase );
begin
  if Assigned( Database ) then
    Database.Session.CloseDatabase( Database );
end;



Procedure TttDBDataset.SetDatabaseName( const Value: String );
begin
  if ( csReading in ComponentState ) then
    FDatabaseName := Value
  else 
    if ( FDatabaseName <> Value ) then
    begin
      CheckInactive;
      if ( FDatabase <> NIL ) then 
        DatabaseError( SDatabaseOpen, Self );
    FDatabaseName := Value;
    DataEvent( dePropertyChange, 0);
  end;
end;

Function TttDBDataset.SetDBFlag( Flag: Integer; Value: Boolean ): Boolean;
begin
  Result := Flag in DBFlags;
  if Value then
  begin
    if not Result then
    begin
      if FDBFlags = [] then
      begin
        CheckDBSessionName;
        FDatabase := OpenDatabase;
        FDatabase.RegisterClient( Self );
      end;
      Include(FDBFlags, Flag);
    end;
  end else
  begin
    if Result then
    begin
      Exclude(FDBFlags, Flag);
      if FDBFlags = [] then
      begin
        FDatabase.UnRegisterClient( Self );
        FDatabase.Session.CloseDatabase(FDatabase);
        FDatabase := NIL;
      end;
    end;
  end;
end;


Procedure TttDBDataset.SetSessionName( const Value: String );
begin
  CheckInactive;
  FSessionName := Value;
  DataEvent( depropertyChange, 0 );
end;


Procedure TttDBDataset.SetUpdateMode( const Value: TUpdateMode );
begin
  if ( FHandle <> NIL ) and Database.IsSQLBased and CanModify then
    Check( Engine, Engine.SetEngProp( hDbiObj( FHandle ), curUPDLOCKMODE, Longint( Value ) ) );
  FUpdateMode := Value;
end;

{ AutoRefresh }
Procedure TttDBDataSet.SetAutoRefresh(const Value: Boolean);
begin
  CheckInactive;
  FAutoRefresh := Value;
end;

Procedure TttDBDataSet.SetupAutoRefresh;
const
  PropFlags : array[TAutoRefreshFlag] of LongInt = ( 0, curFIELDISAUTOINCR, curFIELDISDEFAULT );
var
  I       : Integer;
  ColDesc : ServerColDesc;
begin
  If AutoRefresh then
    Check( Engine, Engine.SetEngProp( hDbiObj( FHandle ), curAUTOREFETCH, LongInt( TRUE ) ) );
  for I := 0 to Fields.Count - 1 do
    with Fields[I] do
      if ( AutoGenerateValue <> arNone ) then
      begin
        ColDesc.iFldNum    := I + 1;
        ColDesc.bServerCol := TRUE;
        Check( Engine, Engine.SetEngProp( hDbiObj( FHandle ), PropFlags[ AutoGenerateValue ], LongInt( @ColDesc ) ) );
      end;
end;

{ TttDBDataSet.IProviderSupport }

{ TttBatchMove }
constructor TttBatchMove.Create( AOwner: TComponent );
begin
  Inherited Create( AOwner );
  FAbortOnKeyViol := TRUE;
  FAbortOnProblem := TRUE;
  FTransliterate := TRUE;
  FMappings := TStringList.Create;
end;


destructor TttBatchMove.Destroy;
begin
  FMappings.Free;
  Inherited Destroy;
end;


Function TttBatchMove.ConvertName( const Name: String; Buffer: PChar ): PChar;
begin
  if ( Name <> '' ) then
    Result := TAnsiToNative( Engine, NIL, Name, Buffer, DBIMAXTBLNAMELEN ) 
  else
    Result := NIL;
end;


Procedure TttBatchMove.Execute;
type
  TFieldMap = array of Word;
var
  SourceActive, DestinationActive: Boolean;
  BatchMode: TBatchMode;
  I: Integer;
  FieldCount: Word;
  FieldMap: TFieldMap;
  DestName, SourceName: String;
  SKeyViolName, SProblemName, SChangedName: DBITBLNAME;

  Procedure GetMappingNames;
  var
    P: Integer;
    Mapping: String;
  begin
    Mapping := FMappings[I];
    P := Pos( '=', Mapping );
    if P > 0 then
    begin
      DestName := Copy( Mapping, 1, P - 1 );
      SourceName := Copy( Mapping, P + 1, 255 );
    end else
    begin
      DestName := Mapping;
      SourceName := Mapping;
    end;
  end;

begin
  if ( Destination = NIL ) or ( Source = NIL ) or ( Destination = Source ) then
    DatabaseError( SInvalidBatchMove, Self );
  SourceActive := Source.Active;
  DestinationActive := Destination.Active;
  FieldCount := 0;
  FieldMap := NIL;
  try
    Source.DisableControls;
    Destination.DisableControls;
    Source.Open;
    Source.CheckBrowseMode;
    Source.UpdateCursorPos;
    BatchMode := FMode;
    if BatchMode = batCopy then
    begin
      Destination.Close;
      if FMappings.Count = 0 then
        Destination.FieldDefs := Source.FieldDefs
      else
      begin
        Destination.FieldDefs.Clear;
        for I := 0 to FMappings.Count - 1 do
        begin
          GetMappingNames;
          with Source.FieldDefs.Find( SourceName ) do
            Destination.FieldDefs.Add( DestName, DataType, Size, Required );
        end;
      end;
      Destination.IndexDefs.Clear;
      Destination.CreateTable;
      BatchMode := batAppend;
    end;
    Destination.Open;
    Destination.CheckBrowseMode;
    if FMappings.Count <> 0 then
    begin
      FieldCount := Destination.FieldDefs.Count;
      SetLength(FieldMap, FieldCount);
      for I := 0 to FMappings.Count - 1 do
      begin
        GetMappingNames;
        FieldMap[Destination.FieldDefs.Find( DestName ).FieldNo] :=
          Source.FieldDefs.Find( SourceName ).FieldNo;
      end;
    end;
    if FRecordCount > 0 then
    begin
      Source.UpdateCursorPos;
      FMovedCount := FRecordCount;
    end else
    begin
      Check( Engine, Engine.SetToBegin( Source.Handle ) );
      FMovedCount := MaxLongint;
    end;
    Source.CursorPosChanged;
    try
      if CommitCount > 0 then
        Check( Engine, Engine.SetEngProp( hDBIObj( Destination.DBHandle ), dbBATCHCOUNT, CommitCount ) );
      Check( Engine, Engine.BatchMove( NIL, Source.Handle, NIL, Destination.Handle,
        EBATMode( BatchMode ), FieldCount, PWord( FieldMap ), NIL, NIL, 0,
        ConvertName( FKeyViolTableName, SKeyViolName ),
        ConvertName( FProblemTableName, SProblemName ),
        ConvertName( FChangedTableName, SChangedName ),
        @FProblemCount, @FKeyViolCount, @FChangedCount,
        FAbortOnProblem, FAbortOnKeyViol, FMovedCount, FTransliterate ) );
    finally
      if DestinationActive then Destination.First;
    end;
  finally
    if not DestinationActive then 
      Destination.Close;
    if not SourceActive then 
      Source.Close;
    Destination.EnableControls;
    Source.EnableControls;
  end;
end;


Procedure TttBatchMove.Notification( AComponent: TComponent;
  Operation: TOperation );
begin
  Inherited Notification( AComponent, Operation );
  if Operation = opRemove then
  begin
    if Destination = AComponent then
      Destination := NIL;
    if Source = AComponent then
      Source := NIL;
  end;
end;


Procedure TttBatchMove.SetMappings( Value: TStrings );
begin
  FMappings.Assign( Value );
end;


Procedure TttBatchMove.SetSource( Value: TttBDEDataset );
begin
  FSource := Value;
  if Value <> NIL then 
    Value.FreeNotification( Self );
end;



{ TttTable }
constructor TttTable.Create( AOwner: TComponent );
begin
  Inherited Create( AOwner );
  FIndexDefs := TIndexDefs.Create( Self );
  FMasterLink := TMasterDataLink.Create( Self );
  FMasterLink.OnMasterChange := MasterChanged;
  FMasterLink.OnMasterDisable := MasterDisabled;
  FDefaultIndex := TRUE;
end;

destructor TttTable.Destroy;
begin
  Inherited Destroy;
  FMasterLink.Free;
  FIndexDefs.Free;
end;

Function TttTable.GetHandle( const IndexName, IndexTag: String ): HDBICur;
const
  OpenModes: array[Boolean] of DbiOpenMode = ( dbiReadWrite, dbiReadOnly );
  ShareModes: array[Boolean] of DbiShareMode = ( dbiOpenShared, dbiOpenExcl );
var
  IndexID: Word;
  OpenMode: DbiOpenMode;
  RetCode: DbiResult;
begin
  Result := NIL;
  OpenMode := OpenModes[FReadOnly or ForceUpdateCallback];
  if DefaultIndex then
    IndexID := 0
  else
    IndexID := NODEFAULTINDEX;
  while TRUE do
  begin
    RetCode := Engine.OpenTable( DBHandle, NativeTableName, GetTableTypeName,
      PChar(IndexName), PChar(IndexTag), IndexID, OpenMode, ShareModes[FExclusive],
      xltField, FALSE, NIL, Result);
    if RetCode = DBIERR_TABLEREADONLY then
      OpenMode := dbiReadOnly
    else
      if CheckOpen( RetCode ) then
        Break;
  end;
end;


Function TttTable.CreateHandle: HDBICur;
var
  IndexName, IndexTag: String;
begin
  if FTableName = '' then
    DatabaseError( SNoTableName, Self );
  IndexDefs.Updated := FALSE;
  If Database.IsSQLbased then
  begin
    GetIndexParams( FIndexName, FFieldsIndex, IndexName, IndexTag );
    Result := GetHandle( IndexName, IndexTag );
  end
  else
  begin
    Result := GetHandle( '', '' );
    FHandle := Result;
    GetIndexParams(FIndexName, FFieldsIndex, IndexName, IndexTag);
    if ( IndexName <> '' ) and IsProductionIndex( IndexName ) then
       Check( Engine, Engine.SwitchToIndex( Result, PChar( IndexName ), PChar( IndexTag ), 0, FALSE ) );
  end;     
end;

Function TttTable.GetLanguageDriverName: string;
begin
  Result := '';
end;



Procedure TttTable.PrepareCursor;
begin
(* Titan tables would not be XBaseTables
  if IsXBaseTable then
  begin
    GetIndexParams( FIndexName, FFieldsIndex, IndexName, IndexTag );
    if not IsProductionIndex( IndexName ) then
      SwitchToIndex(IndexName, IndexTag);
  end;
*)
  CheckMasterRange;
end;

Procedure TttTable.DefChanged(Sender: TObject);
begin
  StoreDefs := TRUE;
end;

Procedure TttTable.InitFieldDefs;
var
  I, FieldID, FldDescCount: Integer;
  FieldDescs: TFieldDescList;
  FCursor, VCursor: HDBICur;
  RequiredFields: TBits;
  ValCheckDesc: VCHKDesc;
begin
  if ( FHandle <> NIL ) then
    InternalInitFieldDefs
  else
  begin
    SetDBFlag( dbfFieldList, TRUE );
    try
      if ( FTableName = '' ) then
        DatabaseError(SNoTableName, Self);
        while not CheckOpen( Engine.OpenFieldList(DBHandle, NativeTableName,
          GetTableTypeName, FALSE, FCursor)) do {Retry};
        try
          Check( Engine, Engine.GetRecordCount(FCursor, FldDescCount));
          SetLength(FieldDescs, FldDescCount);
          { Create an array of field descriptors }
          for I := 0 to FldDescCount - 1 do
            Check( Engine, Engine.GetNextRecord(FCursor, dbiNoLock, @FieldDescs[I], NIL));
          { Initialize list of required fields }
          RequiredFields := TBits.Create;
          try
            if FieldDescs[FldDescCount-1].iFldNum > FldDescCount then
              RequiredFields.Size := FieldDescs[FldDescCount-1].iFldNum + 1 
            else
              RequiredFields.Size := FldDescCount + 1;
            if Engine.OpenVChkList(DBHandle, NativeTableName, GetTableTypeName, VCursor) = 0 then
            try
              while Engine.GetNextRecord(VCursor, dbiNoLock, @ValCheckDesc, NIL) = 0 do
                if ValCheckDesc.bRequired and not ValCheckDesc.bHasDefVal then
                begin
                  { Grow the RequiredFields bits if needed for array fields }
                  if ValCheckDesc.iFldNum > (RequiredFields.Size - 1) then
                    RequiredFields.Size := RequiredFields.Size + 100;
                  RequiredFields[ValCheckDesc.iFldNum] := TRUE;
                end;
            finally
              Engine.CloseCursor(VCursor);
            end;
            { Initialize the FieldDefs }
            FieldDefs.BeginUpdate;
            try
              FieldDefs.Clear;
              I := 0;
              FieldID := 1;
              while I < FldDescCount do
                AddFieldDesc(FieldDescs, I, FieldID, RequiredFields, FieldDefs);
            finally
              FieldDefs.EndUpdate;
            end;
          finally
            RequiredFields.Free;
          end;
        finally
          Engine.CloseCursor(FCursor);
        end;
    finally
      SetDBFlag(dbfFieldList, FALSE);
    end;
  end;
end;


Procedure TttTable.DestroyHandle;
begin
  DestroyLookupCursor;
  Inherited DestroyHandle;
end;

Procedure TttTable.DecodeIndexDesc(const IndexDesc: IDXDesc;
  var Source, Name, FieldExpression, DescFields: string;
  var Options: TIndexOptions);

  Procedure ConcatField(var FieldList: string; const FieldName: string);
  begin
    if FieldList = '' then
      FieldList := FieldName else
      FieldList := Format('%s;%s', [FieldList, FieldName]);
  end;

var
  IndexOptions: TIndexOptions;
  I: Integer;
  SSource, SName: PChar;
  FieldName: String;
begin
  with IndexDesc do
  begin
    if szTagName[0] = #0 then
    begin
      SName := szName;
      Source := '';
    end
    else begin
      SSource := szName;
      SName := szTagName;
      TNativeToAnsi( Engine, NIL, SSource, Source );
    end;
    TNativeToAnsi( Engine, NIL, SName, Name );
    Name := ExtractFileName( Name );
    Source := ExtractFileName( Source );
    IndexOptions := [];
    if bPrimary then
      Include( IndexOptions, ixPrimary );
    if bUnique then
      Include( IndexOptions, ixUnique );
    if bDescending then
      Include( IndexOptions, ixDescending );
    if bCaseInsensitive then
      Include( IndexOptions, ixCaseInsensitive );
    if not bMaintained then 
      Include( IndexOptions, ixNonMaintained );
    if bExpIdx then
    begin
      TNativeToAnsi( Engine, NIL, szKeyExp, FieldExpression );
      Include( IndexOptions, ixExpression );
    end else
    begin
      FieldExpression := '';
      DescFields := '';
      for I := 0 to iFldsInKey - 1 do
      begin
        FieldName := FieldDefList[aiKeyFld[I] - 1].Name;
        ConcatField(FieldExpression, FieldName);
        if abDescending[I] then
          ConcatField(DescFields, FieldName);
      end;
      if bDescending and (DescFields = FieldExpression) then
        DescFields := '';
    end;
    Options := IndexOptions;
  end;
end;


Procedure TttTable.EncodeIndexDesc(var IndexDesc: IDXDesc;
  const Name, FieldExpression: string; Options: TIndexOptions;
  const DescFields: string);

  Function IndexFieldOfs(const FieldName: string): Integer;
  var
    FieldNo: Integer;
  begin
    FieldNo := FieldDefs.Find(FieldName).FieldNo;
    for Result := 0 to IndexDesc.iFldsInKey - 1 do
      if IndexDesc.aiKeyFld[Result] = FieldNo then
        Exit;
    DatabaseErrorFmt( SIndexFieldMissing, [FieldName], Self );
    Result := -1;
  end;

var
  Pos: Integer;
begin
  FillChar( IndexDesc, SizeOf( IndexDesc ), 0 );
  with IndexDesc do
  begin
    if IsXBaseTable then
      TAnsiToNative( Engine, NIL, Name, szTagName, SizeOf( szTagName ) - 1 )
    else
      TAnsiToNative( Engine, NIL, Name, szName, SizeOf( szName ) - 1 );
    bPrimary    := ixPrimary in Options;
    bUnique     := ixUnique in Options;
    bDescending := (ixDescending in Options) and (DescFields = '');
    bMaintained := not (ixNonMaintained in Options);
    Word(bCaseInsensitive) := Word(ixCaseInsensitive in Options);
    if ixExpression in Options then
    begin
      bExpIdx := TRUE;
      TAnsiToNative( Engine, NIL, FieldExpression, szKeyExp, SizeOf( szKeyExp ) - 1 );
    end 
    else
    begin
      Pos := 1;
      while ( Pos <= Length( FieldExpression ) ) and ( iFldsInKey < DBIMAXFLDSINKEY ) do
      begin
        aiKeyFld[iFldsInKey] :=
          FieldDefs.Find( ExtractFieldName( FieldExpression, Pos ) ).FieldNo;
        Inc( iFldsInKey );
      end;
      if (DescFields <> '') then
      begin
        bDescending := TRUE;
        Pos := 1;
        while Pos <= Length(DescFields) do
          abDescending[IndexFieldOfs(ExtractFieldName(DescFields, Pos))] := TRUE;
      end;
    end;
  end;
end;


Procedure TttTable.AddIndex(const Name, Fields: string; Options: TIndexOptions;
  const DescFields: string);
var
  IndexDesc: IDXDesc;
begin
  FieldDefs.Update;
  if Active then
  begin
    EncodeIndexDesc(IndexDesc, Name, Fields, Options, DescFields);
    CheckBrowseMode;
    CursorPosChanged;
    Check( Engine, Engine.AddIndex( DBHandle, Handle, NIL, NIL, IndexDesc, NIL ) );
  end 
  else
  begin
      EncodeIndexDesc(IndexDesc, Name, Fields, Options, DescFields);
    SetDBFlag( dbfTable, TRUE );
    try
      Check( Engine, Engine.AddIndex( DBHandle, NIL, NativeTableName, GetTableTypeName, IndexDesc, NIL ) );
    finally
      SetDBFlag( dbfTable, FALSE );
    end;
  end;
  IndexDefs.Updated := FALSE;
end;


Procedure TttTable.DeleteIndex( const Name: String );
var
  IndexName, IndexTag: String;
begin
  if Active then
  begin
    GetIndexParams( Name, FALSE, IndexName, IndexTag );
    CheckBrowseMode;
    Check( Engine, Engine.DeleteIndex( DBHandle, Handle, NIL, NIL, PChar( IndexName ), PChar( IndexTag ), 0 ) );
  end
  else
  begin
    GetIndexParams( Name, FALSE, IndexName, IndexTag );
    SetDBFlag( dbfTable, TRUE );
    try
      Check( Engine, Engine.DeleteIndex( DBHandle, NIL, NativeTableName, GetTableTypeName,
        PChar( IndexName ), PChar( IndexTag ), 0 ) );
    finally
      SetDBFlag( dbfTable, FALSE );
    end;
  end;
  FIndexDefs.Updated := FALSE;
end;


Function TttTable.GetIndexFieldNames: String;
begin
  if FFieldsIndex then
    Result := FIndexName
  else
    Result := '';
end;


Function TttTable.GetIndexName: String;
begin
  if FFieldsIndex then
    Result := ''
  else
    Result := FIndexName;
end;


Procedure TttTable.GetIndexNames( List: TStrings );
begin
  IndexDefs.Update;
  IndexDefs.GetItemNames( List );
end;


Procedure TttTable.GetIndexParams( const IndexName: String;
  FieldsIndex: Boolean; var IndexedName, IndexTag: String );
var
  I: Integer;
  IndexStr: TIndexName;
  SIndexName: DBIMSG; 
  SIndexTag: DBIPATH;
begin
  SIndexName[0] := #0;
  SIndexTag[0] := #0;
  if IndexName <> '' then
  begin
    IndexDefs.Update;
    IndexStr := IndexName;
      if FieldsIndex then
        if Database.FPseudoIndexes then
        begin
          for I := 1 to Length( IndexStr ) do
            if IndexStr[I] = ';' then IndexStr[I] := '@';
          IndexStr := '@' + IndexStr;
        end else
          IndexStr := IndexDefs.FindIndexForFields( IndexName ).Name;
      if IsXBaseTable and ( UpperCase( ExtractFileExt( IndexStr ) ) <> '.NDX' ) then
      begin
        TAnsiToNative( Engine, NIL, IndexStr, SIndexTag, SizeOf( SIndexTag ) - 1 );
        with IndexDefs do
        begin
          I := IndexOf( IndexStr );
          if I <> -1 then
            IndexStr := Items[I].Source
          else
            DatabaseErrorFmt( SIndexDoesNotExist, [IndexName], Self );
          TAnsiToNative( Engine, NIL, IndexStr, SIndexName, SizeOf( SIndexName ) - 1 );
        end;
      end else
        TAnsiToNative( Engine, NIL, IndexStr, SIndexName, SizeOf( SIndexName ) - 1 );
  end;
  IndexedName := SIndexName;
  IndexTag := SIndexTag;
end;

Procedure TttTable.SetIndexDefs(Value: TIndexDefs);
begin
  IndexDefs.Assign(Value);
end;

Procedure TttTable.SetIndex( const Value: String; FieldsIndex: Boolean );
var
  IndexName, IndexTag: String;
begin
  if Active then CheckBrowseMode;
  if ( FIndexName <> Value ) or ( FFieldsIndex <> FieldsIndex ) then
  begin
    if Active then
    begin
      GetIndexParams( Value, FieldsIndex, IndexName, IndexTag );
      SwitchToIndex( IndexName, IndexTag );
      CheckMasterRange;
    end;
    FIndexName := Value;
    FFieldsIndex := FieldsIndex;
    if Active then
      Resync( [] );
  end;
end;


Procedure TttTable.SetIndexFieldNames( const Value: String );
begin
  SetIndex( Value, Value <> '' );
end;


Procedure TttTable.SetIndexName( const Value: String );
begin
  SetIndex( Value, FALSE );
end;



Procedure TttTable.UpdateIndexDefs;
var
  Opts: TIndexOptions;
  IdxName, Src, Flds, DescFlds: string;

  Procedure UpdateFromCursor;
  var
    I: Integer;
    Cursor: HDBICur;
    CursorProps: CurProps;
    IndexDescs: TIndexDescList;
  begin
    if Handle = NIL then
    begin
      Cursor := GetHandle('', '');
    end 
    else
      Cursor := Handle;
    try
      Engine.GetCursorProps(Cursor, CursorProps);
      if CursorProps.iIndexes > 0 then
      begin
        SetLength(IndexDescs, CursorProps.iIndexes);
        Engine.GetIndexDescs(Cursor, PIDXDesc(IndexDescs));
        for I := 0 to CursorProps.iIndexes - 1 do
        begin
          DecodeIndexDesc(IndexDescs[I], Src, IdxName, Flds, DescFlds, Opts);
          with IndexDefs.AddIndexDef do
          begin
            Name := IdxName;
            Fields := Flds;
            DescFields := DescFlds;
            Options := Opts;
            if Src <> '' then
              Source := Src;
          end;
        end;
      end;
    finally
      if (Cursor <> NIL) and (Cursor <> Handle) then 
        Engine.CloseCursor(Cursor);
    end;
  end;

  Procedure UpdateFromIndexList;
  var
    FCursor: HDBICur;
    IndexDesc: IDXDesc;
  begin
    while not CheckOpen( Engine.OpenIndexList(DBHandle, NativeTableName,
      GetTableTypeName, FCursor)) do {Retry};
    try
      while Engine.GetNextRecord(FCursor, dbiNoLock, @IndexDesc, NIL) = 0 do
        if IndexDesc.bMaintained then
        begin
          DecodeIndexDesc(IndexDesc, Src, IdxName, Flds, DescFlds, Opts);
          with IndexDefs.AddIndexDef do
          begin
            Name := IdxName;
            Fields := Flds;
            DescFields := DescFlds;
            Options := Opts;
          end;
        end;
    finally
      Engine.CloseCursor(FCursor);
    end;
  end;

begin
  SetDBFlag(dbfIndexList, TRUE);
  try
    FieldDefs.Update;
    IndexDefs.Clear;
    if IsCursorOpen or not Database.IsSQLBased then
      UpdateFromCursor 
    else
      UpdateFromIndexList;
  finally
    SetDBFlag(dbfIndexList, FALSE);
  end;
end;

Function TttTable.IsProductionIndex( const IndexName: String ): Boolean;
begin
  Result := TRUE;
end;

Function TttTable.GetExists: Boolean;
var
  H: HDBICur;
  E: DBIResult;
begin
  Result := Active;
  if Result or (TableName = '') then 
    Exit;
  SetDBFlag(dbfTable, TRUE);
  try
    if Database.IsSQLBased then
    begin
      E := Engine.OpenFieldList(DBHandle, NativeTableName, NIL, FALSE, H);
      Result := ( E = DBIERR_NONE );
      if Result then 
        Engine.CloseCursor( H )
      else 
        if (E <> DBIERR_NOSUCHTABLE) and (E <> DBIERR_OBJNOTFOUND) then 
          DbiError( E );
    end 
    else 
      Result := FileExists(GetFileName);
  finally
    SetDBFlag(dbfTable, FALSE);
  end;
end;

Function TttTable.FindKey( const KeyValues: array of const ): Boolean;
begin
  CheckBrowseMode;
  SetKeyFields( kiLookup, KeyValues );
  Result := GotoKey;
end;


Procedure TttTable.FindNearest( const KeyValues: array of const );
begin
  CheckBrowseMode;
  SetKeyFields( kiLookup, KeyValues );
  GotoNearest;
end;


Function TttTable.GotoKey: Boolean;
var
  KeyBuffer: PKeyBuffer;
  IndexBuffer, RecBuffer: PChar;
  UseKey: Boolean;
begin
  Result := FALSE;
  CheckBrowseMode;
  DoBeforeScroll;
  CursorPosChanged;
  KeyBuffer := GetKeyBuffer( kiLookup );
  IndexBuffer := AllocMem( KeySize );
  try
    RecBuffer := PChar( KeyBuffer ) + SizeOf( TKeyBuffer );
    UseKey := Engine.ExtractKey( Handle, RecBuffer, IndexBuffer ) = 0;
    if UseKey then
      RecBuffer := IndexBuffer;
    Result := ( Engine.GetRecordForKey( Handle, UseKey, KeyBuffer^.FieldCount, 0, RecBuffer, NIL ) = 0 );
    if Result then
    begin
      Try
        Resync( [rmExact, rmCenter] );
        DoAfterScroll;
      Except
        begin
          Result := FALSE;
          Resync([]);
        end;
      end;
    end
    else
      Resync([]);
  finally
    FreeMem( IndexBuffer, KeySize );
  end;
end;


Procedure TttTable.GotoNearest;
var
  SearchCond: DBISearchCond;
  KeyBuffer: PKeyBuffer;
  IndexBuffer, RecBuffer: PChar;
  UseKey: Boolean;
  Status: DBIResult;
begin
  CheckBrowseMode;
  CursorPosChanged;
  KeyBuffer := GetKeyBuffer( kiLookup );
  if KeyBuffer^.Exclusive then
    SearchCond := keySEARCHGT
  else
    SearchCond := keySEARCHGEQ;
  IndexBuffer := AllocMem( KeySize );
  try
    RecBuffer := PChar( KeyBuffer ) + SizeOf( TKeyBuffer );
    UseKey := Engine.ExtractKey( Handle, RecBuffer, IndexBuffer ) = 0;
    if UseKey then
      RecBuffer := IndexBuffer;
    Status := Engine.SetToKey( Handle, SearchCond, UseKey, KeyBuffer^.FieldCount, 0, RecBuffer );
    If ( Status = DBIERR_EOF ) then
      Resync( [] )
    else
    begin
      Check( Engine, Status );
      Resync( [rmCenter] );
    end;
  finally
    FreeMem( IndexBuffer, KeySize );
  end;
end;


Procedure TttTable.SetKey;
begin
  SetKeyBuffer( kiLookup, TRUE );
end;


Procedure TttTable.EditKey;
begin
  SetKeyBuffer( kiLookup, FALSE );
end;


Procedure TttTable.ApplyRange;
begin
  CheckBrowseMode;
  if SetCursorRange then
    First;
end;


Procedure TttTable.CancelRange;
begin
  CheckBrowseMode;
  UpdateCursorPos;
  if ResetCursorRange then
    Resync( [] );
end;


Procedure TttTable.SetRange( const StartValues, EndValues: array of const );
begin
  CheckBrowseMode;
  SetKeyFields( kiRangeStart, StartValues );
  SetKeyFields( kiRangeEnd, EndValues );
  ApplyRange;
end;


Procedure TttTable.SetRangeEnd;
begin
  SetKeyBuffer( kiRangeEnd, TRUE );
end;


Procedure TttTable.SetRangeStart;
begin
  SetKeyBuffer( kiRangeStart, TRUE );
end;


Procedure TttTable.EditRangeEnd;
begin
  SetKeyBuffer( kiRangeEnd, FALSE );
end;


Procedure TttTable.EditRangeStart;
begin
  SetKeyBuffer( kiRangeStart, FALSE );
end;


Procedure TttTable.UpdateRange;
begin
  SetLinkRanges( FMasterLink.Fields );
end;


Function TttTable.GetLookupCursor( const KeyFields: String;
  CaseInsensitive: Boolean ): HDBICur;
var
  IndexFound, FieldsIndex: Boolean;
  KeyIndexName, IndexName, IndexTag: String;
  KeyIndex: TIndexDef;
begin
  if ( KeyFields <> FLookupKeyFields ) or
     ( CaseInsensitive <> FLookupCaseIns ) then
  begin
    DestroyLookupCursor;
    IndexFound := FALSE;
    FieldsIndex := FALSE;
    { If a range is active, don't use a lookup cursor }
    if not FKeyBuffers[kiCurRangeStart].Modified and
       not FKeyBuffers[kiCurRangeEnd].Modified then
    begin
      if Database.FPseudoIndexes then
      begin
        if not CaseInsensitive then
        begin
          KeyIndexName := KeyFields;
          FieldsIndex := TRUE;
          IndexFound := TRUE;
        end;
      end
      else
      begin
        KeyIndex := IndexDefs.GetIndexForFields( KeyFields, CaseInsensitive );
        if ( KeyIndex <> NIL ) and
           ( CaseInsensitive = (ixCaseInsensitive in KeyIndex.Options ) ) then
        begin
          KeyIndexName := KeyIndex.Name;
          FieldsIndex := FALSE;
          IndexFound := TRUE;
        end;
      end;
      if IndexFound and ( Length( KeyFields ) < DBIMAXMSGLEN ) then
      begin
        Check( Engine, Engine.CloneCursor( Handle, TRUE, FALSE, FLookupHandle ) );
        GetIndexParams( KeyIndexName, FieldsIndex, IndexName, IndexTag );
        Check( Engine, Engine.SwitchToIndex( FLookupHandle, PChar( IndexName ), PChar( IndexTag ), 0, FALSE ) );
      end;
      FLookupKeyFields := KeyFields;
      FLookupCaseIns := CaseInsensitive;
    end;
  end;
  Result := FLookupHandle;
end;


Procedure TttTable.DestroyLookupCursor;
begin
  if FLookupHandle <> NIL then
  begin
    Engine.CloseCursor( FLookupHandle );
    FLookupHandle := NIL;
    FLookupKeyFields := '';
  end;
end;


Procedure TttTable.GotoCurrent( Table: TttTable );
begin
  CheckBrowseMode;
  Table.CheckBrowseMode;
  if ( AnsiCompareText( DatabaseName, Table.DatabaseName ) <> 0 ) or
    ( AnsiCompareText( TableName, Table.TableName ) <> 0 ) then
    DatabaseError( STableMismatch, Self );
  Table.UpdateCursorPos;
  Check( Engine, Engine.SetToCursor( Handle, Table.Handle ) );
  DoBeforeScroll;
  Resync( [rmExact, rmCenter] );
  DoAfterScroll;
end;


Procedure TttTable.GetDetailLinkFields(MasterFields, DetailFields: TList);
var
  i: Integer;
  Idx: TIndexDef;
begin
  MasterFields.Clear;
  DetailFields.Clear;
  if (MasterSource <> NIL) and (MasterSource.DataSet <> NIL) and
     (Self.MasterFields <> '') then
  begin
    Idx := NIL;
    MasterSource.DataSet.GetFieldList(MasterFields, Self.MasterFields);
    UpdateIndexDefs;
    if IndexName <> '' then
      Idx := IndexDefs.Find(IndexName)
    else
      if IndexFieldNames <> '' then
        Idx := IndexDefs.GetIndexForFields(IndexFieldNames, FALSE)
      else
        for i := 0 to IndexDefs.Count - 1 do
          if ixPrimary in IndexDefs[i].Options then
          begin
            Idx := IndexDefs[i];
            break;
          end;
    if Idx <> NIL then
      GetFieldList(DetailFields, Idx.Fields);
  end;
end;

Procedure TttTable.CheckMasterRange;
begin
  if FMasterLink.Active and ( FMasterLink.Fields.Count > 0 ) then
  begin
    SetLinkRanges( FMasterLink.Fields );
    SetCursorRange;
  end;
end;


Procedure TttTable.MasterChanged( Sender: TObject );
begin
  CheckBrowseMode;
  UpdateRange;
  ApplyRange;
end;


Procedure TttTable.MasterDisabled( Sender: TObject );
begin
  CancelRange;
end;


Function TttTable.GetDataSource: TDataSource;
begin
  Result := FMasterLink.DataSource;
end;


Procedure TttTable.SetDataSource( Value: TDataSource );
begin
  if IsLinkedTo( Value ) then
    DatabaseError( SCircularDataLink, Self );
  FMasterLink.DataSource := Value;
end;


Function TttTable.GetMasterFields: String;
begin
  Result := FMasterLink.FieldNames;
end;


Procedure TttTable.SetMasterFields( const Value: String );
begin
  FMasterLink.FieldNames := Value;
end;


Procedure TttTable.DoOnNewRecord;
var
  I: Integer;
begin
  if FMasterLink.Active and ( FMasterLink.Fields.Count > 0 ) then
    for I := 0 to Pred( FMasterLink.Fields.Count ) do
      IndexFields[I] := TField( FMasterLink.Fields[I] );
  Inherited DoOnNewRecord;
end;


Function TttTable.BatchMove( ASource: TttBDEDataset; AMode: TBatchMode ): Longint;
begin
  with GetBatchMoveClass.Create( NIL ) do
  try
    Destination := Self;
    Source := ASource;
    Mode := AMode;
    Execute;
    Result := MovedCount;
  finally
    Free;
  end;
end;

Procedure TttTable.CreateTable;
var
  TableDesc: CRTblDesc;
  IndexDescs: TIndexDescList;
  FieldDescs: TFieldDescList;
  ValChecks: TValCheckList;
  DriverTypeName: DBINAME;
  SQLLName: DBINAME;
  PSQLLName: PChar;
  LvlFldDesc: FLDDesc;
  Level: DBINAME;


  Procedure InitTableSettings;
  var
    PTblType: PChar;
  begin
    FillChar(TableDesc, SizeOf(TableDesc), 0);
    with TableDesc do
    begin
      TAnsiToNative( Engine, NIL, TableName, szTblName, SizeOf( szTblName ) - 1 );
      PTblType := GetTableTypeName;
      if Assigned(PTblType) then
        StrCopy(szTblType, PTblType);
      if FTableLevel > 0 then
      begin
        iOptParams := 1;
        StrCopy(@Level, PChar(IntToStr(FTableLevel)));
        pOptData := @Level;
        StrCopy(LvlFldDesc.szName, szCFGDRVLEVEL);
        LvlFldDesc.iLen := StrLen(Level) + 1;
        LvlFldDesc.iOffset := 0;
        pfldOptParams :=  @LvlFldDesc;
      end;
    end;
  end;

  Procedure InitFieldDescriptors;
  var
    I: Integer;
    TempFieldDescs: TFieldDescList;
  begin
    with TableDesc do
    begin
      InitFieldDefsFromFields;
      iFldCount := FieldDefs.Count;
      SetLength(TempFieldDescs, iFldCount);
      for I := 0 to FieldDefs.Count - 1 do
      with FieldDefs[I] do
      begin
        EncodeFieldDesc(TempFieldDescs[I], Name, DataType, Size, Precision);
        if Required then
          Inc(iValChkCount);
      end;
      SetLength(FieldDescs, iFldCount);
      pFldDesc := BDE.PFLDDesc(FieldDescs);
      PSQLLName := NIL;
      if Database.IsSQLBased then
        if Engine.GetLdNameFromDB(DBHandle, NIL, SQLLName) = 0 then
          PSQLLName := SQLLName;
      Check( Engine, Engine.TranslateRecordStructure(NIL, iFldCount, BDE.PFLDDesc(TempFieldDescs),
        GetDriverTypeName(DriverTypeName), PSQLLName, pFLDDesc, FALSE));
    end;
  end;

  Procedure InitIndexDescriptors;
  var
    I: Integer;
  begin
    TableDesc.iIdxCount := IndexDefs.Count;
    SetLength(IndexDescs, TableDesc.iIdxCount);
    TableDesc.pIdxDesc := PIDXDesc(IndexDescs);
    for I := 0 to IndexDefs.Count - 1 do
    with IndexDefs[I] do
      EncodeIndexDesc(IndexDescs[I], Name, FieldExpression, Options, DescFields);
  end;

  Procedure InitValChecks;
  var
    I, ValCheckNo: Integer;
  begin
    with TableDesc do
    if iValChkCount > 0 then
    begin
      SetLength(ValChecks, iValChkCount);
      ValCheckNo := 0;
      for I := 0 to FieldDefs.Count - 1 do
        if FieldDefs[I].Required then
        begin
          ValChecks[ValCheckNo].iFldNum := I + 1;
          ValChecks[ValCheckNo].bRequired := TRUE;
          Inc(ValCheckNo);
        end;
      pvchkDesc := BDE.pVCHKDesc(ValChecks);
    end;
  end;

begin
  CheckInactive;
  SetDBFlag(dbfTable, TRUE);
  try
    InitTableSettings;
        InitFieldDescriptors;
        InitIndexDescriptors;
        InitValChecks;
        Check( Engine, Engine.CreateTable(DBHandle, TRUE, TableDesc));
  finally
    SetDBFlag(dbfTable, FALSE);
  end;
end;

Procedure TttTable.DeleteTable;
begin
  CheckInactive;
  SetDBFlag( dbfTable, TRUE );
  try
    Check( Engine, Engine.DeleteTable(DBHandle, NativeTableName, GetTableTypeName));
  finally
    SetDBFlag( dbfTable, FALSE );
  end;
end;


Procedure TttTable.EmptyTable;
begin
  if Active then
  begin
    CheckBrowseMode;
    Check( Engine, Engine.EmptyTable( DBHandle, Handle, NIL, NIL ) );
    ClearBuffers;
    DataEvent( deDataSetChange, 0 );
  end else
  begin
    SetDBFlag( dbfTable, TRUE );
    try
      Check( Engine, Engine.EmptyTable(DBHandle, NIL, NativeTableName, GetTableTypeName));
    finally
      SetDBFlag( dbfTable, FALSE );
    end;
  end;
end;


Procedure TttTable.LockTable( LockType: TLockType );
begin
  SetTableLock( LockType, TRUE );
end;


Procedure TttTable.SetTableLock( LockType: TLockType; Lock: Boolean );
var
  L: DBILockType;
begin
  CheckActive;
  if LockType = ltReadLock then
    L := dbiREADLOCK
  else
    L := dbiWRITELOCK;
  if Lock then
    Check( Engine, Engine.AcqTableLock( Handle, L ) )
  else
    Check( Engine, Engine.RelTableLock( Handle, FALSE, L ) );
end;


Procedure TttTable.UnlockTable( LockType: TLockType );
begin
  SetTableLock( LockType, FALSE );
end;


Procedure TttTable.RenameTable( const NewTableName: String );
var
  SNewTableName: DBITBLNAME;
begin
  CheckInactive;
  SetDBFlag( dbfTable, TRUE );
  try
    Check( Engine, Engine.RenameTable( DBHandle, NativeTableName, GetTableTypeName,
      TAnsiToNative( Engine, NIL, NewTableName, SNewTableName, SizeOf(SNewTableName) - 1)));
  finally
    SetDBFlag( dbfTable, FALSE );
  end;
  TableName := NewTableName;
end;

Procedure TttTable.EncodeFieldDesc(var FieldDesc: FLDDesc;
  const Name: string; DataType: TFieldType; Size, Precision: Integer);
begin
  with FieldDesc do
  begin
    TAnsiToNative( Engine, NIL, Name, szName, SizeOf( szName ) - 1 );
    iFldType := FldTypeMap[DataType];
    iSubType := FldSubTypeMap[DataType];
    case DataType of
      ftString, ftFixedChar, ftBytes, ftVarBytes, ftBlob..ftTypedBinary:
        iUnits1 := Size;
      ftBCD:
        begin
          { Default precision is 32, Size = Scale }
          if ( Precision > 0 ) and ( Precision <= 32 ) then
            iUnits1 := Precision 
          else
            iUnits1 := 32;
          iUnits2 := Size;
        end;
    end;
  end;
end;


Procedure TttTable.DataEvent( Event: TDataEvent; Info: Longint );
begin
  if ( Event = depropertyChange ) and Assigned( IndexDefs ) then
    IndexDefs.Updated := FALSE;
  Inherited DataEvent( Event, Info );
end;


Function TttTable.GetCanModify: Boolean;
begin
  Result := Inherited GetCanModify and not ReadOnly;
end;


Function TttTable.GetDriverTypeName( Buffer: PChar ): PChar;
var
  Length: Word;
begin
  Result := Buffer;
  Check( Engine, Engine.GetEngProp( HDBIOBJ( DBHandle ), dbDATABASETYPE, Buffer, SizeOf( DBINAME ), Length ) );
  if StrIComp( Buffer, szCFGDBSTANDARD ) = 0 then
  begin
    Result := GetTableTypeName;
    if Result <> NIL then Result := StrCopy( Buffer, Result );
  end;
end;

Function TttTable.GetTableTypeName: PChar;
begin
  Result := NIL;
end;

Function TttTable.GetTableLevel: Integer;
begin
  if ( Handle <> NIL ) then
    Result := GetIntProp( Engine, Handle, curTABLELEVEL )
  else
    Result := FTableLevel;
end;

Function TttTable.FieldDefsStored: Boolean;
begin
  Result := StoreDefs and (FieldDefs.Count > 0);
end;

Function TttTable.IndexDefsStored: Boolean;
begin
  Result := StoreDefs and (IndexDefs.Count > 0);
end;

Function TttTable.IsXBaseTable: Boolean;
begin
  Result := FALSE;
end;

Function TttTable.GetFileName: string;
(*
const
  Exts: array [TTableType] of string = ('.DB', '.DB', '.DBF', '.DBF', '.TXT');
*)
var
  FDb: Boolean;
begin
  FDb := SetDBFlag(dbfDatabase, TRUE);
  try
    Result := Database.Directory;
    if (Result <> '') and (not IsPathDelimiter(Result, Length(Result))) then
      Result := Result + '\';
(*
    if ExtractFileExt(TableName) = '' then
      Result := Result + ChangeFileExt(TableName, Exts[TableType]) 
    else
*)
      Result := Result + TableName;
  finally
    SetDBFlag(dbfDatabase, FDb);
  end;
end;

Function TttTable.GetTableType: TTableType;
begin
  Result := ttDefault;
end;


Function TttTable.NativeTableName: PChar;
begin
  Result := PChar( FTableName );
end;

Procedure TttTable.SetExclusive( Value: Boolean );
begin
  CheckInactive;
  FExclusive := Value;
end;


Procedure TttTable.SetReadOnly( Value: Boolean );
begin
  CheckInactive;
  FReadOnly := Value;
end;

Procedure TttTable.SetTableName( const Value: TFileName );
begin
  if ( csReading in ComponentState ) then
    FTableName := Value
  else
    if (FTableName <> Value) then
    begin
      CheckInactive;
      FTableName := Value;
      FNativeTableName[0] := #0;
      DataEvent(dePropertyChange, 0);
    end;
end;


Procedure TttTable.SetTableType( Value: TTableType );
begin
  CheckInactive;
  FTableType := Value;
end;

{ TTable.IProviderSupport }


{ TttQueryDataLink }
constructor TttQueryDataLink.Create( AQuery : TttQuery );
begin
  Inherited Create;
  FQuery := AQuery;
end;


Procedure TttQueryDataLink.ActiveChanged;
begin
  if FQuery.Active then
    FQuery.RefreshParams;
end;

Function TttQueryDataLink.GetDetailDataSet: TDataSet;
begin
  Result := FQuery;
end;

Procedure TttQueryDataLink.RecordChanged( Field : TField );
begin
  if ( Field = NIL ) then
    ActiveChanged;
end;


Procedure TttQueryDataLink.CheckBrowseMode;
begin
  if FQuery.Active then
    FQuery.CheckBrowseMode;
end;


{ TttStoredProc }
constructor TttStoredProc.Create( AOwner: TComponent );
begin
  Inherited Create( AOwner );
  FParams       := TttParams.Create( Self );
end;


destructor TttStoredProc.Destroy;
begin
  Destroying;
  Disconnect;
  FParams.Free;
  Inherited Destroy;
end;

Procedure TttStoredProc.DefineProperties(Filer: TFiler);

  Function WriteData: Boolean;
  begin
    if ( Filer.Ancestor <> NIL ) then
      Result := not FParams.IsEqual(TttStoredProc(Filer.Ancestor).FParams) 
    else
      Result := ( FParams.Count > 0 );
  end;

begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData );
end;

Procedure TttStoredProc.WriteParamData(Writer: TWriter);
begin
  Writer.WriteCollection(Params);
end;

Procedure TttStoredProc.ReadParamData(Reader: TReader);
begin
  Reader.ReadValue;
  Reader.ReadCollection(Params);
end;

Procedure TttStoredProc.Disconnect;
begin
  Close;
  UnPrepare;
end;


Function TttStoredProc.CreateCursor( GenHandle: Boolean ): HDBICur;
begin
  if StoredProcName <> '' then
  begin
    SetPrepared( TRUE );
    Result := GetCursor( GenHandle );
  end
  else
    Result := NIL;
end;


Function TttStoredProc.CreateHandle: HDBICur;
begin
  Result := CreateCursor( TRUE );
end;


Function TttStoredProc.GetCursor( GenHandle: Boolean ): HDBICur;
var
  PCursor: phDBICur;
begin
  Result := NIL;
  if GenHandle then
    PCursor := @Result
  else
    PCursor := NIL;
  BindParams;
  Check( Engine, Engine.QExec( StmtHandle, PCursor ) );
  GetResults;
end;


Procedure TttStoredProc.ExecProc;
begin
  CheckInActive;
  SetDBFlag( dbfExecProc, TRUE );
  try
    CreateCursor( FALSE );
  finally
    SetDBFlag( dbfExecProc, FALSE );
  end;
end;


Procedure TttStoredProc.SetProcName( const Value: String );
begin
  if not ( csReading in ComponentState ) then
  begin
    CheckInactive;
    if Value <> FProcName then
    begin
      FProcName := Value;
      FreeStatement;
      FParams.Clear;
    end;
  end
  else
    FProcName := Value;
end;


Procedure TttStoredProc.SetOverLoad( Value: Word );
begin
  if not ( csReading in ComponentState ) then
  begin
    CheckInactive;
    if Value <> OverLoad then
    begin
      FOverLoad := Value;
      FreeStatement;
      FParams.Clear;
    end
  end
  else
    FOverLoad := Value;
end;


Function TttStoredProc.GetParamsCount: Word;
begin
  Result := FParams.Count;
end;


Procedure TttStoredProc.CreateParamDesc;
var
  Desc: SPParamDesc;
  Cursor: HDBICur;
  Buffer: DBISPNAME;
  ParamName: string;
  ParamDataType: TFieldType;
begin
  TAnsiToNative( Engine, NIL, StoredProcName, Buffer, SizeOf( Buffer ) - 1 );
  if Engine.OpenSPParamList( DBHandle, Buffer, FALSE, OverLoad, Cursor ) = 0 then
  try
    while Engine.GetNextRecord( Cursor, dbiNOLOCK, @Desc, NIL ) = 0 do
      with Desc do
      begin
        TNativeToAnsi( Engine, NIL, szName, ParamName );
        if (TParamType(eParamType) = ptResult) and (ParamName = '') then
          ParamName := SResultName;
        if uFldType < MAXLOGFLDTYPES then 
          ParamDataType := DataTypeMap[uFldType]
        else 
          ParamDataType := ftUnknown;
        case uFldtype of
          fldFloat:
             if uSubType = fldstMONEY then 
               ParamDataType := ftCurrency;
          fldBlob:
             if (uSubType >= fldstMEMO) and (uSubType <= fldstBFILE) then
               ParamDataType := BlobTypeMap[uSubType];
        end;
        with TParam(FParams.Add) do
        begin
          ParamType := TParamType(eParamType);
          DataType := ParamDataType;
          Name := ParamName;
        end;
      end;
    SetServerParams;
  finally
    Engine.CloseCursor( Cursor );
  end;
end;

Procedure TttStoredProc.SetServerParams;
var
  I: Integer;
begin
  SetLength( FServerDescs, Params.Count );
  for I := 0 to Pred( Params.Count ) do
    with TParam( Params[ I ] ), FServerDescs[ I ] do
    begin
      ParamName := Name;
      BindType  := DataType;
    end;
end;

Function TttStoredProc.CheckServerParams: Boolean;
var
  Low, I, J: Integer;
begin
  if FServerDescs = NIL then
  begin
    SetServerParams;
    Result := FALSE;
  end
  else
  begin
    Low := 0;
    for I := 0 to High(FServerDescs) do
    begin
      for J := Low to Params.Count - 1 do
        with TParam(Params[J]), FServerDescs[I] do
          if Name = ParamName then
            if (DataType <> BindType) then
            begin
              Result := FALSE;
              Exit;
            end 
            else
            begin
              if J = Low then 
                inc(Low);
              Break;
            end;
    end;
    Result := TRUE;
  end;
end;


Function TttStoredProc.DescriptionsAvailable: Boolean;
var
  Cursor: HDBICur;
  Buffer: DBISPNAME;
begin
  SetDBFlag( dbfProcDesc, TRUE );
  try
    TAnsiToNative( Engine, NIL, StoredProcName, Buffer, SizeOf( Buffer ) - 1 );
    Result := Engine.OpenSPParamList( DBHandle, Buffer, FALSE, OverLoad, Cursor ) = 0;
    if Result then
      Engine.CloseCursor( Cursor );
  finally
    SetDBFlag( dbfProcDesc, FALSE );
  end;
end;


Procedure TttStoredProc.PrepareProc;
var
  I: Integer;
  NumBytes, Offset: Word;
  Buffer: DBISPNAME;
begin
  SetLength(FParamDescs, FParams.Count);
  NumBytes := 0;
  for I := 0 to FParams.Count - 1 do
    with Params[I] do
      if DataType in [ftString, ftFixedChar] then
        Inc(NumBytes, 255 + 2)
      else
        Inc(NumBytes, GetParamDataSize(Params[I]) + 2);
  SetLength( FRecordBuffer, NumBytes );
  Offset := 0;
  for I := 0 to FParams.Count - 1 do
  begin
    with Params[I], FParamDescs[I] do
    begin
      if DataType = ftUnknown then
        DatabaseErrorFmt(SNoParameterValue, [Name], Self);
      if ParamType = ptUnknown then
        DatabaseErrorFmt(SNoParameterType, [Name], Self);
      if FBindMode = pbByName then
        TAnsiToNative( Engine, NIL, Name, szName, SizeOf(szName) - 1)
      else
        uParamNum := I + 1;
      eParamType := STMTParamType(ParamType);
      uFldType := FldTypeMap[DataType];
      uSubType := FldSubTypeMap[DataType];
      if uFldType = fldZString then
      begin
        uLen := 255;
        iUnits1 := 255;
      end
      else
      if uFldType = fldADT then
      begin
        iUnits1 := Value;
        iUnits2 := Value;
        TAnsiToNative( Engine, NIL, Name, szName, SizeOf(szName) - 1)
      end
      else
        uLen := GetParamDataSize(Params[I]);
      uOffset := Offset;
      Inc(Offset, uLen);
      uNullOffset := NumBytes - 2 * (I + 1);
      if ParamType in [ptInput, ptInputOutput] then
        PSmallint(@FRecordBuffer[NumBytes - 2 * (I + 1)])^ := IndNull;
    end;
  end;
  TAnsiToNative( Engine, NIL, StoredProcName, Buffer, Pred( SizeOf( Buffer ) ) );
  Check( Engine, Engine.QPrepareProc(DBHandle, Buffer, High(FParamDescs)+1,
    PSPParamDesc(FParamDescs), NIL, FStmtHandle));
end;

Procedure TttStoredProc.GetResults;
var
  I: Integer;
  CurPtr: PChar;
  IntPtr: ^SmallInt;
  NumBytes: Word;
begin
  if FRecordBuffer <> NIL then
  begin
    CurPtr   := PChar(FRecordBuffer);
    NumBytes := High(FRecordBuffer) + 1;
    for I := 0 to FParams.Count - 1 do
      with Params[I] do
      begin
        if ParamType in [ptOutput, ptInputOutput, ptResult] then
        begin
          if DataType = ftString then
            TNativeToAnsiBuf( Engine, NIL, CurPtr, CurPtr, StrLen( CurPtr ) );
          IntPtr := @FRecordBuffer[NumBytes - 2 * (I + 1)];
          if IntPtr^ = IndNull then
            Value := NULL
          else
            if IntPtr^ = IndTrunc then
              DatabaseErrorFmt( STruncationError, [Name] )
            else
              SetData( CurPtr );
        end;
        if DataType = ftString then
          Inc( CurPtr, 255 )
        else
          Inc( CurPtr, GetParamDataSize( Params[ I] ) );
      end;
  end;
end;


Procedure TttStoredProc.BindParams;
var
  I: Integer;
  CurPtr: PChar;
  NumBytes: Word;
  IntPtr: ^SmallInt;
begin
  if FRecordBuffer = NIL then
    Exit;
  if not CheckServerParams then
  begin
    SetPrepared(FALSE);
    SetPrepared(TRUE);
  end;
  NumBytes := High(FRecordBuffer) + 1;
  CurPtr := PChar(FRecordBuffer);
    for I := 0 to FParams.Count - 1 do
    begin
      with Params[I] do
      begin
        if ParamType in [ptInput, ptInputOutput] then
        begin
          GetParamData( Engine, Params[i], CurPtr, NIL );
          IntPtr := @FRecordBuffer[NumBytes - 2 * (I + 1)];
          if IsNull then
            IntPtr^ := IndNull
          else
            IntPtr^ := 0;
        end;
        if (DataType = ftString) then
        begin
          Inc(CurPtr, 255);
          { Adjust param descriptor for string pseudo blobs }
          if ParamType = ptInput then
            with FParamDescs[I] do
            begin
              uLen := GetParamDataSize(Params[I]);
              if ( uFldType = fldZString ) then
                iUnits1 := GetDataSize - 1 
              else
                iUnits1 := GetDataSize;
            end
        end
        else
          Inc(CurPtr, GetParamDataSize(Params[I]));
      end;
    end;
    Check( Engine, Engine.QSetProcParams(StmtHandle, High(FParamDescs)+1,
      PSPParamDesc(FParamDescs), FRecordBuffer));
end;


Procedure TttStoredProc.SetPrepared( Value: Boolean );
begin
  if Handle <> NIL then
    DatabaseError( SDataSetOpen, Self );
  if Prepared <> Value then
  begin
    if Value then
      try
        if FParams.Count = 0 then
          CreateParamDesc
        else
          SetServerParams;
        if not FQueryMode then
          PrepareProc;
        FPrepared := TRUE;
      except
        FreeStatement;
        raise;
      end
    else
      FreeStatement;
  end;
end;


Procedure TttStoredProc.Prepare;
begin
  SetDBFlag( dbfStoredProc, TRUE );
  SetPrepared( TRUE );
end;


Procedure TttStoredProc.UnPrepare;
begin
  SetPrepared( FALSE );
  SetDBFlag( dbfStoredProc, FALSE );
end;


Procedure TttStoredProc.FreeStatement;
begin
  if StmtHandle <> NIL then
    Engine.QFree( FStmtHandle );
  FParamDescs := NIL;
  FRecordBuffer := NIL;
  FPrepared := FALSE;
end;


Procedure TttStoredProc.SetPrepare( Value: Boolean );
begin
  if Value then
    Prepare
  else
    UnPrepare;
end;

Function TttStoredProc.SetDBFlag( Flag: Integer; Value: Boolean ): Boolean;
begin
  if not Value and ( DBFlags - [Flag] = [] ) then
    SetPrepared( FALSE );
  Result := Inherited SetDBFlag( Flag, Value );
end;


Procedure TttStoredProc.CopyParams( Value: TttParams );
begin
  if not Prepared and ( FParams.Count = 0 ) then
    try
      FQueryMode := TRUE;
      Prepare;
      Value.Assign( FParams );
    finally
      UnPrepare;
      FQueryMode := FALSE;
    end
  else
    Value.Assign( FParams );
end;


Procedure TttStoredProc.SetParamsList( Value: TttParams );
begin
  CheckInactive;
  if Prepared then
  begin
    SetPrepared( FALSE );
    FParams.Assign( Value );
    SetPrepared( TRUE );
  end
  else
    FParams.Assign( Value );
end;


Function TttStoredProc.ParamByName( const Value: String ): TttParam;
begin
  Result := FParams.ParamByName( Value );
end;

{ TttQuery }
constructor TttQuery.Create( AOwner: TComponent );
begin
  Inherited Create( AOwner );
  FSQL := TStringList.Create;
  TStringList( SQL ).OnChange := QueryChanged;
  FParams := TttParams.Create( Self );
  FDataLink := TttQueryDataLink.Create( Self );
  RequestLive := FALSE;
  ParamCheck := TRUE;
  FRowsAffected := -1;
end;


destructor TttQuery.Destroy;
begin
  Destroying;
  Disconnect;
  SQL.Free;
  FParams.Free;
  FDataLink.Free;
  StrDispose( SQLBinary );
  Inherited Destroy;
end;


Procedure TttQuery.Disconnect;
begin
  Close;
  UnPrepare;
end;


Procedure TttQuery.SetPrepare( Value: Boolean );
begin
  if Value then 
    Prepare
  else 
    UnPrepare;
end;


Procedure TttQuery.Prepare;
begin
  SetDBFlag( dbfPrepared, TRUE );
  SetPrepared( TRUE );
end;


Procedure TttQuery.UnPrepare;
begin
  SetPrepared( FALSE );
  SetDBFlag( dbfPrepared, FALSE );
end;


Procedure TttQuery.SetDataSource( Value: TDataSource );
begin
  if IsLinkedTo( Value ) then 
    DatabaseError( SCircularDataLink, Self );
  FDataLink.DataSource := Value;
end;


Function TttQuery.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

Procedure TttQuery.SetQuery( Value: TStrings );
begin
  if SQL.Text <> Value.Text then
  begin
    Disconnect;
    SQL.BeginUpdate;
    try
      SQL.Assign( Value );
    finally
      SQL.EndUpdate;
    end;
  end;
end;


Procedure TttQuery.QueryChanged( Sender: TObject );
var
  List: TttParams;
begin
  FText := SQL.Text;
  if not ( csReading in ComponentState ) then
  begin
    Disconnect;
    StrDispose( SQLBinary );
    SQLBinary := NIL;
    if ParamCheck or ( csDesigning in ComponentState ) then
    begin
      List := TttParams.Create( Self );
      try
        FText := List.ParseSQL(SQL.Text, TRUE);
        List.AssignValues(FParams);
        FParams.Clear;
        FParams.Assign(List);
	  finally
        List.Free;
      end;
	end
	else
	  FText := SQL.Text;
    DataEvent( depropertyChange, 0 );
  end 
  else
    FText := FParams.ParseSQL( SQL.Text, FALSE );
end;


Procedure TttQuery.SetParamsList( Value: TttParams );
begin
  FParams.AssignValues( Value );
end;


Function TttQuery.GetParamsCount: Word;
begin
  Result := FParams.Count;
end;


Procedure TttQuery.DefineProperties( Filer: TFiler );

  Function WriteData: Boolean;
  begin
    if ( Filer.Ancestor <> NIL ) then
      Result := not FParams.IsEqual(TttQuery( Filer.Ancestor ).FParams )
    else
      Result := ( FParams.Count > 0 );
  end;

begin
  Inherited DefineProperties( Filer );
  Filer.DefineBinaryproperty( 'Data', ReadBinaryData, WriteBinaryData, SQLBinary <> NIL );
  Filer.DefineProperty( 'ParamData', ReadParamData, WriteParamData, WriteData );
end;

Procedure TttQuery.ReadParamData(Reader: TReader);
begin
  Reader.ReadValue;
  Reader.ReadCollection(FParams);
end;

Procedure TttQuery.WriteParamData(Writer: TWriter);
begin
  Writer.WriteCollection(Params);
end;

Procedure TttQuery.ReadBinaryData( Stream: TStream );
begin
  SQLBinary := StrAlloc( Stream.Size );
  Stream.ReadBuffer( SQLBinary^, Stream.Size );
end;


Procedure TttQuery.WriteBinaryData( Stream: TStream );
begin
  Stream.WriteBuffer( SQLBinary^, StrBufSize( SQLBinary ) );
end;


Procedure TttQuery.SetPrepared( Value: Boolean );
begin
  if Handle <> NIL then 
    DatabaseError( SDataSetOpen, Self );
  if Value <> Prepared then
  begin
    if Value then
    begin
      FRowsAffected := -1;
      FCheckRowsAffected := TRUE;
      if Length( Text ) > 1 then 
        PrepareSQL( PChar( Text ) )
      else 
        DatabaseError( SEmptySQLStatement, Self );
    end
    else
    begin
      if FCheckRowsAffected then
        FRowsAffected := RowsAffected;
      FreeStatement;
    end;
    FPrepared := Value;
  end;
end;


Procedure TttQuery.FreeStatement;
var
  Result: DbiResult;
begin
  if StmtHandle <> NIL then
  begin
    Result := Engine.QFree( FStmtHandle );
    if not ( csDestroying in ComponentState ) then
      Check( Engine, Result );
  end;
end;


Procedure TttQuery.SetParamsFromCursor;
var
  I: Integer;
  DataSet: TDataSet;
  FActive: Boolean;
begin
  if FDataLink.DataSource <> NIL then
  begin
    DataSet := FDataLink.DataSource.DataSet;
    if DataSet <> NIL then
    begin
      FActive := DataSet.Active;
      if not FActive then
        DataSet.Active := TRUE;
      DataSet.FieldDefs.Update;
      for I := 0 to FParams.Count - 1 do
        with FParams[I] do
          if not Bound then
          begin
            AssignField( DataSet.FieldByName( Name ) );
            Bound := FALSE;
          end;
      if not FActive then
        DataSet.Active := FActive;
    end;
  end;
end;


Procedure TttQuery.RefreshParams;
var
  DataSet: TDataSet;
begin
  DisableControls;
  try
    if FDataLink.DataSource <> NIL then
    begin
      DataSet := FDataLink.DataSource.DataSet;
      if DataSet <> NIL then
        if DataSet.Active and ( DataSet.State <> dsSetKey ) then
        begin
          Close;
          Open;
        end;
    end;
  finally
    EnableControls;
  end;
end;


Function TttQuery.ParamByName( const Value: String ): TttParam;
begin
  Result := FParams.ParamByName( Value );
end;



Function TttQuery.CreateCursor( GenHandle: Boolean ): HDBICur;
begin
  if SQL.Count > 0 then
  begin
    FExecSQL := not GenHandle;
	Try
      SetPrepared( TRUE );
	Finally
	  FExecSQL := FALSE;
	end;
    if FDataLink.DataSource <> NIL then 
      SetParamsFromCursor;
    Result := GetQueryCursor( GenHandle );
  end 
  else
  begin
    DatabaseError( SEmptySQLStatement, Self );
    Result := NIL;
  end;
  FCheckRowsAffected := ( Result = NIL );
end;


Function TttQuery.CreateHandle: HDBICur;
begin
  Result := CreateCursor( TRUE )
end;


Procedure TttQuery.ExecSQL;
begin
  CheckInActive;
  SetDBFlag( dbfExecSQL, TRUE );
  try
    CreateCursor( FALSE );
  finally
    SetDBFlag( dbfExecSQL, FALSE );
  end;
end;


Function TttQuery.GetQueryCursor( GenHandle: Boolean ): HDBICur;
var
  PCursor: phDBICur;
begin
  Result := NIL;
  if GenHandle then
    PCursor := @Result
  else
    PCursor := NIL;
  if ( FParams.Count > 0 ) then
    SetQueryParams( Engine, Self, StmtHandle, Params );
  Check( Engine, Engine.QExec( StmtHandle, PCursor ) );
end;


Function TttQuery.SetDBFlag( Flag: Integer; Value: Boolean ): Boolean;
var
  NewConnection: Boolean;
begin
  if Value then
  begin
    NewConnection := DBFlags = [];
    Result := Inherited SetDBFlag( Flag, Value );
    if not ( csReading in ComponentState ) and NewConnection then
      FLocal := not Database.IsSQLBased;
  end
  else begin
    if DBFlags - [Flag] = [] then
      SetPrepared( FALSE );
    Result := Inherited SetDBFlag( Flag, Value );
  end;
end;

Procedure TttQuery.PrepareSQL( Value: PChar );
begin
  GetStatementHandle( Value );
  if not Local then
    SetBoolProp( Engine, StmtHandle, stmtUNIDIRECTIONAL, FUniDirectional );
end;

Procedure TttQuery.GetStatementHandle( SQLText: PChar );
const
  DataType: array[Boolean] of LongInt = ( Ord( wantCanned ), Ord( wantLive ) );
begin
  Check( Engine, Engine.QAlloc( DBHandle, qrylangSQL, FStmtHandle ) );
  try
    If not FExecSQL then
      Check( Engine, Engine.SetEngProp( hDbiObj( StmtHandle ), stmtLIVENESS,
        DataType[RequestLive and not ForceUpdateCallback] ) );
    if Local then
    begin
      SetBoolProp( Engine, StmtHandle, stmtAUXTBLS, FALSE );
      if RequestLive and Constrained then
        SetBoolProp( Engine, StmtHandle, stmtCONSTRAINED, TRUE );
      SetBoolProp( Engine, StmtHandle, stmtCANNEDREADONLY, TRUE );
    end;
    while not CheckOpen( Engine.QPrepare( FStmtHandle, SQLText ) ) do
      {Retry};
  except
    Engine.QFree( FStmtHandle );
    FStmtHandle := NIL;
    raise;
  end;
end;


Function TttQuery.GetRowsAffected: Integer;
var
  Length: Word;
begin
  if Prepared then
    if Engine.GetEngProp( hDBIObj( StmtHandle ), stmtROWCOUNT, @Result, SizeOf( Result ),
      Length ) <> 0 then
      Result := -1
    else
  else
    Result := FRowsAffected;
end;


Procedure TttQuery.GetDetailLinkFields(MasterFields, DetailFields: TList);

  Function AddFieldToList(const FieldName: string; DataSet: TDataSet;
    List: TList): Boolean;
  var
    Field: TField;
  begin
    Field := DataSet.FindField(FieldName);
    if (Field <> NIL) then
      List.Add(Field);
    Result := Field <> NIL;
  end;

var
  i: Integer;
begin
  MasterFields.Clear;
  DetailFields.Clear;
  if (DataSource <> NIL) and (DataSource.DataSet <> NIL) then
    for i := 0 to Params.Count - 1 do
      if AddFieldToList(Params[i].Name, DataSource.DataSet, MasterFields) then
        AddFieldToList(Params[i].Name, Self, DetailFields);
end;

{ TttUpdateSQL }
constructor TttUpdateSQL.Create( AOwner: TComponent );
var
  UpdateKind: TUpdateKind;
begin
  Inherited Create( AOwner );
  for UpdateKind := Low( TUpdateKind ) to High( TUpdateKind ) do
  begin
    FSQLText[UpdateKind] := TStringList.Create;
    TStringList( FSQLText[UpdateKind] ).OnChange := SQLChanged;
  end;
end;


destructor TttUpdateSQL.Destroy;
var
  UpdateKind: TUpdateKind;
begin
  if Assigned( FDataSet ) and ( FDataset is TttBDEDataset ) and
    ( ttTBDEDataset( FDataSet ).UpdateObject = Self ) then
    TttBDEDataset( FDataSet ).UpdateObject := NIL;
  for UpdateKind := Low( TUpdateKind ) to High( TUpdateKind ) do
    FSQLText[UpdateKind].Free;
  Inherited Destroy;
end;


Procedure TttUpdateSQL.ExecSQL( UpdateKind: TUpdateKind );
begin
  with Query[UpdateKind] do
  begin
    Prepare;
    ExecSQL;
    if RowsAffected <> 1 then 
      DatabaseError( SUpdateFailed );
  end;
end;


Function TttUpdateSQL.GetQuery( UpdateKind: TUpdateKind ): TttQuery;
begin
  if not Assigned( FQueries[UpdateKind] ) then
  begin
    FQueries[UpdateKind] := GetQueryClass.Create( Self );
    FQueries[UpdateKind].SQL.Assign( FSQLText[UpdateKind] );
    if ( FDataSet is TttDBDataset ) then
    begin
      FQueries[UpdateKind].SessionName := TttDBDataset( FDataSet ).SessionName;
      FQueries[UpdateKind].DatabaseName := TttDBDataset( FDataSet ).DataBaseName;
    end
    else
    begin
      FQueries[UpdateKind].SessionName := Self.SessionName;
      FQueries[UpdateKind].DatabaseName := Self.DataBaseName;
    end;
  end;
  Result := FQueries[UpdateKind];
end;


Function TttUpdateSQL.GetSQL( UpdateKind: TUpdateKind ): TStrings;
begin
  Result := FSQLText[UpdateKind];
end;


Function TttUpdateSQL.GetSQLIndex( Index: Integer ): TStrings;
begin
  Result := FSQLText[TUpdateKind( Index )];
end;

Function TttUpdateSQL.GetDataSet: TDataset;
begin
  Result := FDataSet;
end;


Procedure TttUpdateSQL.SetDataSet( ADataSet: TDataset );
begin
  FDataSet := ADataSet;
end;


Procedure TttUpdateSQL.SetSQL( UpdateKind: TUpdateKind; Value: TStrings );
begin
  FSQLText[UpdateKind].Assign( Value );
end;


Procedure TttUpdateSQL.SetSQLIndex( Index: Integer; Value: TStrings );
begin
  SetSQL( TUpdateKind( Index ), Value );
end;


Procedure TttUpdateSQL.SQLChanged( Sender: TObject );
var
  UpdateKind: TUpdateKind;
begin
  for UpdateKind := Low( TUpdateKind ) to High( TUpdateKind ) do
    if Sender = FSQLText[UpdateKind] then
    begin
      if Assigned( FQueries[UpdateKind] ) then
      begin
        FQueries[UpdateKind].Params.Clear;
        FQueries[UpdateKind].SQL.Assign( FSQLText[UpdateKind] );
      end;
      Break;
    end;
end;


Procedure TttUpdateSQL.SetParams( UpdateKind: TUpdateKind );
var
  I: Integer;
  Old: Boolean;
  Param: TttParam;
  PName: String;
  Field: TField;
begin
  if not Assigned( FDataSet ) then Exit;
  with Query[UpdateKind] do
  begin
    for I := 0 to Params.Count - 1 do
    begin
      Param := Params[I];
      PName := Param.Name;
      Old := CompareText( Copy( PName, 1, 4 ), 'OLD_' ) = 0;
      if Old then
        System.Delete( PName, 1, 4 );
      Field := FDataSet.FindField( PName );
      if not Assigned( Field ) then
        Continue;
      if Old then
        Param.AssignFieldValue( Field, Field.OldValue )
      else
        Param.AssignFieldValue( Field, Field.NewValue );
    end;
  end;
end;


Procedure TttUpdateSQL.Apply( UpdateKind: TUpdateKind );
begin
  SetParams( UpdateKind );
  ExecSQL( UpdateKind );
end;


constructor TttBlobStream.Create( Field: TBlobField; Mode: TBlobStreamMode );
var
  OpenMode: DbiOpenMode;
begin
  FMode := Mode;
  FField := Field;
  FDataSet := FField.DataSet as TttBDEDataset;
  FFieldNo := FField.FieldNo;
  if not FDataSet.GetActiveRecBuf( FBuffer ) then
    Exit;
  if FDataSet.State = dsFilter then
    DatabaseErrorFmt( SNoFieldAccess, [FField.DisplayName], FDataSet );
  if not FField.Modified then
  begin
    if Mode = bmRead then
    begin
      FCached := FDataSet.FCacheBlobs and ( FBuffer = FDataSet.ActiveBuffer ) and
        ( FField.IsNull or ( FDataSet.GetBlobData( FField, FBuffer ) <> '' ) );
      OpenMode := dbiReadOnly;
      if PositionDataset then
         if not FDataSet.GetCurrentRecord(FBuffer) then Exit;
    end
    else
    begin
      FDataSet.SetBlobData( FField, FBuffer, '' );
      if FField.ReadOnly then
        DatabaseErrorFmt( SFieldReadOnly, [FField.DisplayName], FDataSet );
      if not ( FDataSet.State in [dsEdit, dsInsert] ) then
        DatabaseError( SNotEditing, FDataSet );
      OpenMode := dbiReadWrite;
    end;
    if not FCached then
	begin
      if FDataSet.State = dsBrowse then
        FDataSet.GetCurrentRecord(FDataSet.ActiveBuffer);
      Check( Engine, Engine.OpenBlob( FDataSet.Handle, FBuffer, FFieldNo, OpenMode ) );
	end;
  end;
  FOpened := TRUE;
  if Mode = bmWrite then
    Truncate;
end;


destructor TttBlobStream.Destroy;
begin
  if FOpened then
  begin
    if FModified then
      FField.Modified := TRUE;
    if not FField.Modified and not FCached then
      Engine.FreeBlob( FDataSet.Handle, FBuffer, FFieldNo );
  end;
  if FModified then
  try
    FDataSet.DataEvent( deFieldChange, Longint( FField ) );
  except
    ApplicationHandleException( Self );
  end;
end;

Function TttBlobStream.PositionDataset : Boolean;
begin
   Result := FALSE;
end;

Function TttBlobStream.Read( var Buffer; Count: Longint ): Longint;
var
  Status: DBIResult;
begin
  Result := 0;
  if FOpened then
  begin
    if FCached then
    begin
      if Count > Size - FPosition then
        Result := Size - FPosition else
        Result := Count;
      if Result > 0 then
      begin
        Move( PChar( FDataSet.GetBlobData( FField, FBuffer ) )[FPosition], Buffer, Result );
        Inc( FPosition, Result );
      end;
    end else
    begin
      Status := Engine.GetBlob( FDataSet.Handle, FBuffer, FFieldNo, FPosition,
        Count, @Buffer, Result );
      case Status of
        DBIERR_NONE, DBIERR_ENDOFBLOB:
          begin
            if FField.Transliterate then
              TNativeToAnsiBuf( Engine, NIL, @Buffer, @Buffer, Result );
            if FDataset.FCacheBlobs and ( FBuffer = FDataSet.ActiveBuffer ) and
              ( FMode = bmRead ) and not FField.Modified and ( FPosition = FCacheSize ) then
            begin
              FCacheSize := FPosition + Result;
              SetLength( FBlobData, FCacheSize );
              Move( Buffer, PChar( FBlobData )[FPosition], Result );
              if FCacheSize = Size then
              begin
                FDataSet.SetBlobData( FField, FBuffer, FBlobData );
                FBlobData := '';
                FCached := TRUE;
                Engine.FreeBlob( FDataSet.Handle, FBuffer, FFieldNo );
              end;
            end;
            Inc( FPosition, Result );
          end;
        DBIERR_INVALIDBLOBOFFSET:
          {Nothing};
      else
        TDbiError( Engine, Status );
      end;
    end;
  end;
end;


Function TttBlobStream.Write( const Buffer; Count: Longint ): Longint;
var
  Temp: Pointer;
begin
  Result := 0;
  if FOpened then
  begin
    if FField.Transliterate then
    begin
      GetMem( Temp, Count );
      try
        TAnsiToNativeBuf( Engine, NIL, @Buffer, Temp, Count );
        Check( Engine, Engine.PutBlob( FDataSet.Handle, FBuffer, FFieldNo, FPosition, Count, Temp ) );
      finally
        FreeMem( Temp, Count );
      end;
    end else
      Check( Engine, Engine.PutBlob( FDataSet.Handle, FBuffer, FFieldNo, FPosition, Count, @Buffer ) );
    Inc( FPosition, Count );
    Result := Count;
    FModified := TRUE;
    FDataSet.SetBlobData( FField, FBuffer, '' );
  end;
end;


Function TttBlobStream.Seek( Offset: Longint; Origin: Word ): Longint;
begin
  case Origin of
    0: FPosition := Offset;
    1: Inc( FPosition, Offset );
    2: FPosition := GetBlobSize + Offset;
  end;
  Result := FPosition;
end;


Procedure TttBlobStream.Truncate;
begin
  if FOpened then
  begin
    Check( Engine, Engine.TruncateBlob( FDataSet.Handle, FBuffer, FFieldNo, FPosition ) );
    FModified := TRUE;
    FDataSet.SetBlobData( FField, FBuffer, '' );
  end;
end;


Function TttBlobStream.GetBlobSize: Longint;
begin
  Result := 0;
  if FOpened then
    if FCached then
      Result := Length( FDataSet.GetBlobData( FField, FBuffer ) )
    else
      Check( Engine, Engine.GetBlobSize( FDataSet.Handle, FBuffer, FFieldNo, Result ) );
end;

var
  SaveInitProc: Pointer;
  NeedToUninitialize: Boolean;

Procedure InitDBTables;
begin
  if ( SaveInitProc <> NIL ) then
    TProcedure( SaveInitProc );
  NeedToUninitialize := Succeeded( CoInitialize( NIL ) );
end;

initialization
  if not IsLibrary then
  begin
    SaveInitProc := InitProc;
    InitProc := @InitDBTables;
  end;
finalization
  FreeAndNil( BDEInitProcs );
  FreeTimer( TRUE );
  if NeedToUninitialize then
    CoUninitialize;
end.


