/Gedemin/IBX/IBCustomDataSet.2

{************************************************************************}

{                                                                        }

{       Borland Delphi Visual Component Library                          }

{       InterBase Express core components                                }

{                                                                        }

{       Copyright (c) 1998-2001 Borland Software Corporation             }

{                                                                        }

{    InterBase Express is based in part on the product                   }

{    Free IB Components, written by Gregory H. Deatz for                 }

{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }

{    Free IB Components is used under license.                           }

{                                                                        }

{    The contents of this file are subject to the InterBase              }

{    Public License Version 1.0 (the "License"); you may not             }

{    use this file except in compliance with the License. You may obtain }

{    a copy of the License at http://www.borland.com/interbase/IPL.html  }

{    Software distributed under the License is distributed on            }

{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }

{    express or implied. See the License for the specific language       }

{    governing rights and limitations under the License.                 }

{    The Original Code was created by InterBase Software Corporation     }

{       and its successors.                                              }

{    Portions created by Borland Software Corporation are Copyright      }

{       (C) Borland Software Corporation. All Rights Reserved.           }

{    Contributor(s): Jeff Overcash                                       }

{                                                                        }

{************************************************************************}



unit IBCustomDataSet;



interface



// ?????????? ???? ??????, ????? ??????? ?????? ???????????

// ? ?????? ???????????, ? ?? ? ?????? ??????

{_$_DEFINE HEAP_STRING_FIELD}



uses

  Windows, SysUtils, Classes, Controls, IBExternals, IB, IBHeader, StdVcl,

  IBDatabase, IBSQL, Db, IBUtils, IBBlob

  //!!!b

  , DBGrids

  //!!!e

  ;



const

  BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}

  UniCache           =  2;     { Uni-directional cache is 2 records big }



type

  TIBCustomDataSet = class;

  TIBDataSet = class;



  //!!!b

  //////////////////////////////////////////////////////////

  // ????????? -- ????????, ??????????? ?? ?????? ???????

  //

  TgdcAggregate = class;

  TgdcAggregates = class;

  TgdcAggUpdateEvent = procedure(Agg: TgdcAggregate) of object;



  TgdcAggregate = class(TCollectionItem)

  private

    FVisible: Boolean;

    FActive: Boolean;

    FInUse: Boolean;

    FDataSize: Integer;

    FIndexName: String;

    FAggregateName: String;

    FExpression: String;

    FDataType: TFieldType;

    FOnUpdate: TgdcAggUpdateEvent;

    FDataSet: TIBCustomDataSet;

    FValue: Variant;



    procedure SetActive(const Value: Boolean);

    procedure SetExpression(const Value: String);

    procedure SetIndexName(const Value: String);

    procedure SetVisible(const Value: Boolean);



  public

    constructor Create(AnAggregates: TgdcAggregates; ADataSet: TIBCustomDataSet); reintroduce;



    function Value: Variant;

    function GetDisplayName: String; override;

    procedure SetValue(AValue: Variant);



    property Active: Boolean read FActive write SetActive;

    property AggregateName: String read FAggregateName write FAggregateName;

    property DataSet: TIBCustomDataSet read FDataSet;

    property DataSize: Integer read FDataSize;

    property DataType: TFieldType read FDataType write FDataType;

    property Expression: String read FExpression write SetExpression;

    property IndexName: String read FIndexName write SetIndexName;

    property InUse: Boolean read FInUse;

    property OnUpdate: TgdcAggUpdateEvent read FOnUpdate write FOnUpdate;

    property Visible: Boolean read FVisible write SetVisible;

  end;



  TgdcAggregates = class(TCollection)

  private

    FOwner: TPersistent;



    function GetItem(Index: Integer): TgdcAggregate;

    procedure SetItem(Index: Integer; const Value: TgdcAggregate);



  protected

    function GetOwner: TPersistent; override;



  public

    constructor Create(Owner: TPersistent);



    function Add: TgdcAggregate;

    procedure Clear;

    function Find(const DisplayName: string): TgdcAggregate;

    function IndexOf(const DisplayName: string): Integer;

    property Items[Index: Integer]: TgdcAggregate read GetItem write SetItem; default;

  end;





  //!!!e



  TIBDataSetUpdateObject = class(TComponent)

  private

    FRefreshSQL: TStrings;

    procedure SetRefreshSQL(value: TStrings);

  protected

    function GetDataSet: TIBCustomDataSet; virtual; abstract;

    procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;

    {

    procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;

    function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;

    }

    property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    //!!!!

    //?????????? Andreik

    procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;

    function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;

    //!!!!

  published

    property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;

  end;



  PDateTime = ^TDateTime;

  TBlobDataArray = array[0..0] of TIBBlobStream;

  PBlobDataArray = ^TBlobDataArray;



  { TIBCustomDataSet }

  TFieldData = record

    fdDataType: Short;

    fdDataScale: Short;

    fdNullable: Boolean;

    fdIsNull: Boolean;

    fdDataSize: Short;

    fdDataLength: Short;

    fdDataOfs: Integer;

  end;

  PFieldData = ^TFieldData;



  TCachedUpdateStatus = (

                         cusUnmodified, cusModified, cusInserted,

                         cusDeleted, cusUninserted

                        );

  TIBDBKey = record

    DBKey: array[0..7] of Byte;

  end;

  PIBDBKey = ^TIBDBKey;



  TRecordData = record

    rdBookmarkFlag: TBookmarkFlag;

    rdFieldCount: Short;

    rdRecordNumber: Long;

    rdCachedUpdateStatus: TCachedUpdateStatus;

    rdUpdateStatus: TUpdateStatus;

    rdSavedOffset: DWORD;

    rdDBKey: TIBDBKey;

    rdFields: array[1..1] of TFieldData;

  end;

  PRecordData = ^TRecordData;



  { TIBStringField allows us to have strings longer than 8196 }



  TIBStringField = class(TStringField)

  public

    constructor create(AOwner: TComponent); override;

    class procedure CheckTypeSize(Value: Integer); override;

    function GetAsString: string; override;

    function GetAsVariant: Variant; override;

    function GetValue(var Value: string): Boolean;

    procedure SetAsString(const Value: string); override;

  end;



  { TIBBCDField }

  {  Actually, there is no BCD involved in this type,

     instead it deals with currency types.

     In IB, this is an encapsulation of Numeric (x, y)

     where x < 18 and y <= 4.

     Note: y > 4 will default to Floats

  }

  TIBBCDField = class(TBCDField)

  protected

    class procedure CheckTypeSize(Value: Integer); override;

    function GetAsCurrency: Currency; override;

    function GetAsString: string; override;

    function GetAsVariant: Variant; override;

    function GetDataSize: Integer; override;

  public

    constructor Create(AOwner: TComponent); override;

  published

    property Size default 8;

  end;



  TIBDataLink = class(TDetailDataLink)

  private

    FDataSet: TIBCustomDataSet;

  protected

    procedure ActiveChanged; override;

    procedure RecordChanged(Field: TField); override;

    function GetDetailDataSet: TDataSet; override;

    procedure CheckBrowseMode; override;

  public

    constructor Create(ADataSet: TIBCustomDataSet);

    destructor Destroy; override;

  end;



  TIBGeneratorApplyEvent = (gamOnNewRecord, gamOnPost, gamOnServer);



  TIBGeneratorField = class(TPersistent)

  private

    FField: string;

    FGenerator: string;

    FIncrementBy: Integer;

    DataSet: TIBCustomDataSet;

    

    FApplyEvent: TIBGeneratorApplyEvent;

    function  IsComplete: Boolean;

  public

    constructor Create(ADataSet: TIBCustomDataSet);

    function  ValueName: string;

    procedure Apply;

    procedure Assign(Source: TPersistent); override;

  published

    property Field : string read FField write FField;

    property Generator : string read FGenerator write FGenerator;

    property IncrementBy : Integer read FIncrementBy write FIncrementBy default 1;

    property ApplyEvent : TIBGeneratorApplyEvent read FApplyEvent write FApplyEvent default  gamOnNewRecord;

  end;



  { TIBCustomDataSet }

  TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);



  TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;

                                 UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)

                                 of object;

  TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;

                                   var UpdateAction: TIBUpdateAction) of object;



  TIBUpdateRecordTypes = set of TCachedUpdateStatus;



  TLiveMode = (lmInsert, lmModify, lmDelete, lmRefresh);

  TLiveModes = Set of TLiveMode;



  TIBCustomDataSet = class(TDataset)

  private

    //FNeedsRefresh: Boolean;

    FForcedRefresh: Boolean;

    FIBLoaded: Boolean;

    FBase: TIBBase;

    //!!!b

    FAggregatesActive: Boolean;

    FAggregates: TgdcAggregates;

    FReadBase: TIBBase;

    FBeforeInternalPostRecord: TDataSetNotifyEvent;

    FAfterInternalPostRecord: TDataSetNotifyEvent;

    FBeforeInternalDeleteRecord: TDataSetNotifyEvent;

    FAfterInternalDeleteRecord: TDataSetNotifyEvent;

    //!!!e

    //FBlobCacheOffset: Integer;

    FBlobStreamList: TList;

    FBufferChunks: Integer;

    //FBufferCache,

    FOldBufferCache: PChar;

    FBufferChunkSize,

    FCacheSize,

    FOldCacheSize: Integer;

    //FFilterBuffer: PChar;

    FBPos,

    FOBPos,

    FBEnd,

    FOBEnd: DWord;

    FCachedUpdates: Boolean;

    FCalcFieldsOffset: Integer;

    FCurrentRecord: Long;

    FDeletedRecords: Long;

    //FModelBuffer,

    FOldBuffer: PChar;

    FOpen: Boolean;

    FInternalPrepared: Boolean;

    //FQDelete,

    FQInsert,

    FQRefresh,

    //FQSelect,

    FQModify: TIBSQL;

    FRecordBufferSize: Integer;

    //FRecordCount: Integer;

    FRecordSize: Integer;

    FUniDirectional: Boolean;

    FUpdateMode: TUpdateMode;

    //FUpdateObject: TIBDataSetUpdateObject;

    FParamCheck: Boolean;

    FUpdatesPending: Boolean;

    FUpdateRecordTypes: TIBUpdateRecordTypes;

    //FMappedFieldPosition: array of Integer;

    FDataLink: TIBDataLink;

    FStreamedActive : Boolean;

    FLiveMode: TLiveModes;

    FGeneratorField: TIBGeneratorField;

    //FRowsAffected: Integer;



    FBeforeDatabaseDisconnect,

    FAfterDatabaseDisconnect,

    FDatabaseFree: TNotifyEvent;

    FOnUpdateError: TIBUpdateErrorEvent;

    FOnUpdateRecord: TIBUpdateRecordEvent;

    FBeforeTransactionEnd,

    FAfterTransactionEnd,

    FTransactionFree: TNotifyEvent;

    //!!!

    FReadTransactionSet: Boolean;

    FInsertedAt: Integer;

    FAllowStreamedActive: Boolean;

    FSavedRecordCount: Integer;

    //!!!



    function GetSelectStmtHandle: TISC_STMT_HANDLE;

    procedure SetUpdateMode(const Value: TUpdateMode);

    procedure SetUpdateObject(Value: TIBDataSetUpdateObject);



    function AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): TGetResult;

    procedure AdjustRecordOnInsert(Buffer: Pointer);

    function CanEdit: Boolean;

    function CanInsert: Boolean;

    function CanDelete: Boolean;

    //function CanRefresh: Boolean;

    procedure CheckEditState;

    procedure ClearBlobCache;

    //b!!!

    //procedure CopyRecordBuffer(Source, Dest: Pointer);

    //e!!!

    procedure DoBeforeDatabaseDisconnect(Sender: TObject);

    procedure DoAfterDatabaseDisconnect(Sender: TObject);

    procedure DoDatabaseFree(Sender: TObject);

    procedure DoBeforeTransactionEnd(Sender: TObject);

    //procedure DoAfterTransactionEnd(Sender: TObject);

    procedure DoTransactionFree(Sender: TObject);

    procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;

                                         Buffer: PChar);

    function GetDatabase: TIBDatabase;

    function GetDBHandle: PISC_DB_HANDLE;

    function GetDeleteSQL: TStrings;

    function GetInsertSQL: TStrings;

    function GetSQLParams: TIBXSQLDA;

    function GetRefreshSQL: TStrings;

    function GetSelectSQL: TStrings;

    function GetStatementType: TIBSQLTypes;

    function GetModifySQL: TStrings;

    function GetTransaction: TIBTransaction;

    function GetTRHandle: PISC_TR_HANDLE;

    //procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);

    function InternalLocate(const KeyFields: string; const KeyValues: Variant;

                            Options: TLocateOptions): Boolean;

    //procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);

    procedure InternalRevertRecord(RecordNumber: Integer);

    function IsVisible(Buffer: PChar): Boolean;

    procedure SaveOldBuffer(Buffer: PChar);

    procedure SetBufferChunks(Value: Integer);

    procedure SetDatabase(Value: TIBDatabase);

    procedure SetDeleteSQL(Value: TStrings);

    procedure SetInsertSQL(Value: TStrings);

    //procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);

    procedure SetRefreshSQL(Value: TStrings);

    procedure SetSelectSQL(Value: TStrings);

    procedure SetModifySQL(Value: TStrings);

    //procedure SetTransaction(Value: TIBTransaction);

    procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);

    procedure SetUniDirectional(Value: Boolean);

    procedure RefreshParams;

    procedure SQLChanging(Sender: TObject);

    function AdjustPosition(FCache: PChar; Offset: DWORD;

                            Origin: Integer): Integer;

    procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;

                       Buffer: PChar);

    //procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;

    //                          ReadOldBuffer: Boolean);

    procedure WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;

                        Buffer: PChar);

    //procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);

    function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;

                       DoCheck: Boolean): TGetResult;

    procedure SetGeneratorField(const Value: TIBGeneratorField);

    {!!!}

    {

    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;

    procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;

    }

    {!!!}

    function GetPlan: String;



    //!!!

    function GetReadTransaction: TIBTransaction;



    procedure SetAggregatesActive(const Value: Boolean);



    {$IFDEF HEAP_STRING_FIELD}



    // ?? ????? ????????? ??? ???? ? ???? ??? ???????????

    // ??????????? ???????

    function IsHeapField(FD: TFieldData): Boolean;



    // ???? ???? ????, ??????????? ? ????, ?? ??????? ??? ???

    // ?????? ? ???????? ?? ?????????? ?? ?????????

    // ?.?. ???????? ????? ???????????? ?????

    // ????? ????????????? ????? ???? ???? ???????????

    // ??????????????!

    procedure InitializeRecordBuffer(Source, Dest: Pointer);



    // ??? ???????? ????????? ??????? ???????

    // ?????????????? ??? ???????? ???????? ?? ???? ?

    // ??? ???? ???????, ??? ??????? ? ?????? ?????????? ????????????

    // ?????? ?????????? ??????

    procedure FinalizeCacheBuffer(Buffer: PChar; const Size: Integer);



    {$ENDIF}

    //!!!





  protected

    {andreik}

    //!!!

    // ?????????? ?? ??????

    FRowsAffected: Integer;

    FUpdateObject: TIBDataSetUpdateObject;

    FQSelect, FQDelete: TIBSQL;

    FBlobCacheOffset: Integer;

    FMappedFieldPosition: array of Integer;

    FNeedsRefresh: Boolean;

    FFilterBuffer: PChar;

    FBufferCache: PChar;

    FRecordCount: Integer;

    FDataTransfer: Boolean; // ?????????!

    FAggregatesObsolete: Boolean; // !!!

    FPeekBuffer: PChar; // !!!

    FOpenCounter: Integer; //!!!

    FModelBuffer: PChar; //!!!

    FOnCalcAggregates: TFilterRecordEvent; //?????????

    function CanRefresh: Boolean;

    procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;

    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);

    procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;

    procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;

                              ReadOldBuffer: Boolean);

    procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);

    procedure DoAfterTransactionEnd(Sender: TObject); virtual;

    function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;

    procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;

    procedure SetTransaction(Value: TIBTransaction); virtual;

    procedure SetFiltered(Value: Boolean); override;



    //b!!!

    procedure CopyRecordBuffer(Source, Dest: Pointer);

    //e!!!



    //!!!

    // ???? ???? ????, ??????????? ? ????, ????????? ??????

    // ??????? ??? ?? ?????????, ??? ??? ????????? ?????

    // ?? ???????? ? ????????? ????????????

    procedure FinalizeRecordBuffer(Buffer: Pointer);

    //!!!



    // ?????????

    procedure DoBeforeReadDatabaseDisconnect(Sender: TObject);

    procedure DoAfterReadDatabaseDisconnect(Sender: TObject);

    procedure DoReadDatabaseFree(Sender: TObject);

    procedure DoBeforeReadTransactionEnd(Sender: TObject);

    procedure DoAfterReadTransactionEnd(Sender: TObject);

    procedure DoReadTransactionFree(Sender: TObject);



    function AllowCloseTransaction: Boolean;



    procedure CheckOperation(Operation: TDataOperation;

      ErrorEvent: TDataSetErrorEvent);



    procedure SetReadTransaction(const Value: TIBTransaction); virtual;

    //!!!



    procedure ActivateConnection;

    function ActivateTransaction: Boolean;

    function ActivateReadTransaction: Boolean;

    procedure DeactivateTransaction;

    procedure DeactivateReadTransaction;

    procedure CheckDatasetClosed;

    procedure CheckDatasetOpen;

    function GetActiveBuf: PChar;

    procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;

    procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;

    procedure InternalPrepare; virtual;

    procedure InternalUnPrepare; virtual;

    procedure InternalExecQuery; virtual;

    procedure InternalRefreshRow; virtual;

    procedure InternalSetParamsFromCursor; virtual;

    procedure CheckNotUniDirectional;

    procedure SetActive(Value: Boolean); override;



    { IProviderSupport }

    procedure PSEndTransaction(Commit: Boolean); override;

    function PSExecuteStatement(const ASQL: string; AParams: TParams;

      ResultSet: Pointer = nil): Integer; override;

    function PsGetTableName: string; override;

    function PSGetQuoteChar: string; override;

    function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;

    function PSInTransaction: Boolean; override;

    function PSIsSQLBased: Boolean; override;

    function PSIsSQLSupported: Boolean; override;

    procedure PSStartTransaction; override;

    procedure PSReset; override;

    function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;



    { TDataSet support }

    procedure InternalInsert; override;

    procedure InitRecord(Buffer: PChar); override;

    procedure Disconnect; virtual;

    function ConstraintsStored: Boolean;

    procedure ClearCalcFields(Buffer: PChar); override;

    procedure CreateFields; override;

    function AllocRecordBuffer: PChar; override;

    procedure DoBeforeDelete; override;

    procedure DoBeforeEdit; override;

    procedure DoBeforeInsert; override;

    procedure FreeRecordBuffer(var Buffer: PChar); override;

    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;

    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;

    function GetCanModify: Boolean; override;

    function GetDataSource: TDataSource; override;

    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;

    function GetRecNo: Integer; override;

    function GetRecord(Buffer: PChar; GetMode: TGetMode;

                       DoCheck: Boolean): TGetResult; override;

    function GetRecordCount: Integer; override;

    function GetRecordSize: Word; override;

    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;

    procedure InternalCancel; override;

    procedure InternalClose; override;

    procedure InternalDelete; override;

    procedure InternalFirst; override;

    procedure InternalGotoBookmark(Bookmark: Pointer); override;

    procedure InternalHandleException; override;

    procedure InternalInitFieldDefs; override;

    procedure InternalInitRecord(Buffer: PChar); override;

    procedure InternalLast; override;

    procedure InternalOpen; override;

    procedure InternalPost; override;

    procedure InternalRefresh; override;

    procedure InternalSetToRecord(Buffer: PChar); override;

    function IsCursorOpen: Boolean; override;

    procedure ReQuery;

    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;

    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;

    procedure SetCachedUpdates(Value: Boolean);

    procedure SetDataSource(Value: TDataSource);

    procedure SetFieldData(Field : TField; Buffer : Pointer); override;

    procedure SetFieldData(Field : TField; Buffer : Pointer;

      NativeFormat : Boolean); overload; override;

    procedure SetRecNo(Value: Integer); override;

    procedure DoOnNewRecord; override;

    procedure Loaded; override;



    //!!!b

    procedure DoAfterDelete; override;

    procedure DoAfterPost; override;

    procedure DoAfterRefresh; override;

    //!!!e



  protected

    {Likely to be made public by descendant classes}

    property SQLParams: TIBXSQLDA read GetSQLParams;

    property Params: TIBXSQLDA read GetSQLParams;

    property InternalPrepared: Boolean read FInternalPrepared;

    property QDelete: TIBSQL read FQDelete;

    property QInsert: TIBSQL read FQInsert;

    property QRefresh: TIBSQL read FQRefresh;

    //property QSelect: TIBSQL read FQSelect;

    property QModify: TIBSQL read FQModify;

    property StatementType: TIBSQLTypes read GetStatementType;

    property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;

    property LiveMode : TLiveModes read FLiveMode;



    {Likely to be made published by descendant classes}

    property BufferChunks: Integer read FBufferChunks write SetBufferChunks;

    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;

    property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;

    property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;

    property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;

    property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;

    property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL;

    property ModifySQL: TStrings read GetModifySQL write SetModifySQL;

    property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;

    property ParamCheck: Boolean read FParamCheck write FParamCheck default True;

    property GeneratorField : TIBGeneratorField read FGeneratorField write SetGeneratorField;



    property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect

                                                 write FBeforeDatabaseDisconnect;

    property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect

                                                write FAfterDatabaseDisconnect;

    property DatabaseFree: TNotifyEvent read FDatabaseFree

                                        write FDatabaseFree;

    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd

                                             write FBeforeTransactionEnd;

    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd

                                            write FAfterTransactionEnd;

    property TransactionFree: TNotifyEvent read FTransactionFree

                                           write FTransactionFree;



    //

    property _RecordBufferSize: Integer read FRecordBufferSize;

    property _CurrentRecord: Integer read FCurrentRecord;

    //



  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    procedure ApplyUpdates;

    function CachedUpdateStatus: TCachedUpdateStatus;

    procedure CancelUpdates;

    procedure FetchAll;

    function LocateNext(const KeyFields: string; const KeyValues: Variant;

                        Options: TLocateOptions): Boolean;

    procedure RecordModified(Value: Boolean);

    procedure RevertRecord;

    procedure Undelete;

    procedure Post; override;

    function Current : TIBXSQLDA;

    function SQLType : TIBSQLTypes;



    //!!!b

    procedure Cancel; override;

    procedure CheckRequiredFields;

    //!!!e



    //!!!b

    procedure Sort(F: TField; const Ascending: Boolean = True);

    //!!!e



    //!!!b

    //

    procedure ResetAllAggs(AnActive: Boolean; BL: TBookmarkList);

    //!!!e



    { TDataSet support methods }

    function BookmarkValid(Bookmark: TBookmark): Boolean; override;

    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;

    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;

    function GetCurrentRecord(Buffer: PChar): Boolean; override;

    function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;

    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;

    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 UpdateStatus: TUpdateStatus; override;

    function IsSequenced: Boolean; override;

    property DBHandle: PISC_DB_HANDLE read GetDBHandle;

    property TRHandle: PISC_TR_HANDLE read GetTRHandle;

    property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;

    property UpdatesPending: Boolean read FUpdatesPending;

    property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes

                                                      write SetUpdateRecordTypes;

    property RowsAffected : Integer read FRowsAffected;

    property Plan: String read GetPlan;



    //!!!b

    property QSelect: TIBSQL read FQSelect;



    property ReadTransaction: TIBTransaction read GetReadTransaction write SetReadTransaction;

    property CacheSize: Integer read FCacheSize;



    //

    property AggregatesActive: Boolean read FAggregatesActive write SetAggregatesActive;

    property Aggregates: TgdcAggregates read FAggregates;

    property AggregatesObsolete: Boolean read FAggregatesObsolete;



    property OpenCounter: Integer read FOpenCounter;



    property OnCalcAggregates: TFilterRecordEvent read FOnCalcAggregates write FOnCalcAggregates;

    //!!!e



  published

    property Database: TIBDatabase read GetDatabase write SetDatabase;

    property Transaction: TIBTransaction read GetTransaction

                                          write SetTransaction;

    property ForcedRefresh: Boolean read FForcedRefresh

                                    write FForcedRefresh default False;

    property AutoCalcFields;

    property ObjectView default False;



    property AfterCancel;

    property AfterClose;

    property AfterDelete;

    property AfterEdit;

    property AfterInsert;

    property AfterOpen;

    property AfterPost;

    property AfterRefresh;

    property AfterScroll;

    property BeforeCancel;

    property BeforeClose;

    property BeforeDelete;

    property BeforeEdit;

    property BeforeInsert;

    property BeforeOpen;

    property BeforePost;

    property BeforeRefresh;

    property BeforeScroll;

    property OnCalcFields;

    property OnDeleteError;

    property OnEditError;

    property OnNewRecord;

    property OnPostError;

    property OnUpdateError: TIBUpdateErrorEvent read FOnUpdateError

                                                 write FOnUpdateError;

    property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord

                                                   write FOnUpdateRecord;



    //!!!

    property BeforeInternalPostRecord: TDataSetNotifyEvent read FBeforeInternalPostRecord

      write FBeforeInternalPostRecord;

    property AfterInternalPostRecord: TDataSetNotifyEvent read FAfterInternalPostRecord

      write FAfterInternalPostRecord;

    property BeforeInternalDeleteRecord: TDataSetNotifyEvent read FBeforeInternalDeleteRecord

      write FBeforeInternalDeleteRecord;

    property AfterInternalDeleteRecord: TDataSetNotifyEvent read FAfterInternalDeleteRecord

      write FAfterInternalDeleteRecord;

    //!!!



    //!!!

    property AllowStreamedActive: Boolean read FAllowStreamedActive write FAllowStreamedActive

      default False;

    //!!!

  end;



  TIBDataSet = class(TIBCustomDataSet)

  private

    function GetPrepared: Boolean;



  protected

    procedure PSSetCommandText(const CommandText: string); override;

    procedure SetFiltered(Value: Boolean); override;

    procedure InternalOpen; override;



  public

    procedure Prepare;

    procedure UnPrepare;

    procedure BatchInput(InputObject: TIBBatchInput);

    procedure BatchOutput(OutputObject: TIBBatchOutput);

    procedure ExecSQL;



  public

    function ParamByName(Idx : String) : TIBXSQLVAR;

    property Params;

    property Prepared : Boolean read GetPrepared;

    property StatementType;

    property SelectStmtHandle;

    property LiveMode;



  { by andreik!!! }  

  public

    property QDelete;

    property QInsert;

    property QRefresh;

    property QSelect;

    property QModify;



  published

    { TIBCustomDataSet }

    property BufferChunks;

    property CachedUpdates;

    property DeleteSQL;

    property InsertSQL;

    property RefreshSQL;

    property SelectSQL;

    property ModifySQL;

    property ParamCheck;

    property UniDirectional;

    property Filtered;

    property GeneratorField;

    property BeforeDatabaseDisconnect;

    property AfterDatabaseDisconnect;

    property DatabaseFree;

    property BeforeTransactionEnd;

    property AfterTransactionEnd;

    property TransactionFree;

    property UpdateObject;

    ///!!!!b

    property OnCalcAggregates;

    //!!!!e

    { TIBDataSet }

    property Active;

    property AutoCalcFields;

    property DataSource read GetDataSource write SetDataSource;



    property AfterCancel;

    property AfterClose;

    property AfterDelete;

    property AfterEdit;

    property AfterInsert;

    property AfterOpen;

    property AfterPost;

    property AfterScroll;

    property BeforeCancel;

    property BeforeClose;

    property BeforeDelete;

    property BeforeEdit;

    property BeforeInsert;

    property BeforeOpen;

    property BeforePost;

    property BeforeScroll;

    property OnCalcFields;

    property OnDeleteError;

    property OnEditError;

    property OnFilterRecord;

    property OnNewRecord;

    property OnPostError;

  end;



  { TIBDSBlobStream }

  TIBDSBlobStream = class(TStream)

  protected

    FField: TField;

    FBlobStream: TIBBlobStream;

    FModified : Boolean;

  public

    constructor Create(AField: TField; ABlobStream: TIBBlobStream;

                       Mode: TBlobStreamMode);

    destructor Destroy; override;

    function Read(var Buffer; Count: Longint): Longint; override;

    function Seek(Offset: Longint; Origin: Word): Longint; override;

    procedure SetSize(NewSize: Longint); override;

    function Write(const Buffer; Count: Longint): Longint; override;

  end;



  //!!!b



{ TgsMemoField }



  TgsMemoField = class(TMemoField)

  private

    //??????????? ?????????? OnSetText

    procedure InsideSetText(Sender: TField; const Text: string);



  protected

    procedure SetText(const Value: string); override;

  public

    constructor Create(AOwner: TComponent); override;

  end;



  //!!!e



const

DefaultFieldClasses: array[TFieldType] of TFieldClass = (

    nil,                { ftUnknown }

    TIBStringField,     { ftString }

    TSmallintField,     { ftSmallint }

    TIntegerField,      { ftInteger }

    TWordField,         { ftWord }

    TBooleanField,      { ftBoolean }

    TFloatField,        { ftFloat }

    TCurrencyField,     { ftCurrency }

    TIBBCDField,        { ftBCD }

    TDateField,         { ftDate }

    TTimeField,         { ftTime }

    TDateTimeField,     { ftDateTime }

    TBytesField,        { ftBytes }

    TVarBytesField,     { ftVarBytes }

    TAutoIncField,      { ftAutoInc }

    TBlobField,         { ftBlob }

    TgsMemoField,         { ftMemo }

    //TMemoField,         { ftMemo }

    TGraphicField,      { ftGraphic }

    TBlobField,         { ftFmtMemo }

    TBlobField,         { ftParadoxOle }

    TBlobField,         { ftDBaseOle }

    TBlobField,         { ftTypedBinary }

    nil,                { ftCursor }

    TStringField,       { ftFixedChar }

    nil, {TWideStringField } { ftWideString }

    TLargeIntField,     { ftLargeInt }

    TADTField,          { ftADT }

    TArrayField,        { ftArray }

    TReferenceField,    { ftReference }

    TDataSetField,     { ftDataSet }

    TBlobField,         { ftOraBlob }

    TgsMemoField,         { ftOraClob }

    //TMemoField,         { ftOraClob }

    TVariantField,      { ftVariant }

    TInterfaceField,    { ftInterface }

    TIDispatchField,     { ftIDispatch }

    TGuidField);        { ftGuid }

var

  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;



implementation



uses

  IBIntf, DBConsts,

  dlgRecordFetch_unit, Forms, flt_sql_parser; //!!! added by Andreik





{ TIBStringField}



constructor TIBStringField.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

end;



class procedure TIBStringField.CheckTypeSize(Value: Integer);

begin

  { don't check string size. all sizes valid }

end;



function TIBStringField.GetAsString: string;

begin

  if not GetValue(Result) then Result := '';

end;



function TIBStringField.GetAsVariant: Variant;

var

  S: string;

begin

  if GetValue(S) then Result := S else Result := Null;

end;



function TIBStringField.GetValue(var Value: string): Boolean;

var

  Buffer: PChar;

begin

  Buffer := nil;

  IBAlloc(Buffer, 0, Size + 1);

  try

    Result := GetData(Buffer);

    if Result then

    begin

      Value := string(Buffer);

      if Transliterate and (Value <> '') then

        DataSet.Translate(PChar(Value), PChar(Value), False);

    end

  finally

    FreeMem(Buffer);

  end;

end;



procedure TIBStringField.SetAsString(const Value: string);

var

  Buffer: PChar;

begin

  Buffer := nil;

  IBAlloc(Buffer, 0, Size + 1);

  try

    StrLCopy(Buffer, PChar(Value), Size);

    if Transliterate then

      DataSet.Translate(Buffer, Buffer, True);

    SetData(Buffer);

  finally

    FreeMem(Buffer);

  end;

end;



{ TIBBCDField }



constructor TIBBCDField.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  SetDataType(ftBCD);

  Size := 8;

end;



class procedure TIBBCDField.CheckTypeSize(Value: Integer);

begin

{ No need to check as the base type is currency, not BCD }

end;



function TIBBCDField.GetAsCurrency: Currency;

begin

  if not GetValue(Result) then

    Result := 0;

end;



function TIBBCDField.GetAsString: string;

var

  C: System.Currency;

begin

  if GetValue(C) then

    Result := CurrToStr(C)

  else

    Result := '';

end;



function TIBBCDField.GetAsVariant: Variant;

var

  C: System.Currency;

begin

  if GetValue(C) then

    Result := C

  else

    Result := Null;

end;



function TIBBCDField.GetDataSize: Integer;

begin

  Result := 8;

end;



{ TIBDataLink }



constructor TIBDataLink.Create(ADataSet: TIBCustomDataSet);

begin

  inherited Create;

  FDataSet := ADataSet;

end;



destructor TIBDataLink.Destroy;

begin

  FDataSet.FDataLink := nil;

  inherited Destroy;

end;





procedure TIBDataLink.ActiveChanged;

begin

  if FDataSet.Active then

    FDataSet.RefreshParams;

end;





function TIBDataLink.GetDetailDataSet: TDataSet;

begin

  Result := FDataSet;

end;



procedure TIBDataLink.RecordChanged(Field: TField);

begin

  if (Field = nil) and FDataSet.Active then

    FDataSet.RefreshParams;

end;



procedure TIBDataLink.CheckBrowseMode;

begin

  if FDataSet.Active then

    FDataSet.CheckBrowseMode;

end;



{ TIBCustomDataSet }



constructor TIBCustomDataSet.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  FIBLoaded := False;

  CheckIBLoaded;

  FIBLoaded := True;

  FBase := TIBBase.Create(Self);

  //!!!

  FReadBase := TIBBase.Create(Self);

  FReadTransactionSet := False;

  FDataTransfer := False;

  FAggregatesObsolete := True;

  FAllowStreamedActive := False;

  FSavedRecordCount := -1;

  //!!!

  FCurrentRecord := -1;

  FDeletedRecords := 0;

  FUniDirectional := False;

  FBufferChunks := BufferCacheSize;

  FBlobStreamList := TList.Create;

  FDataLink := TIBDataLink.Create(Self);

  FQDelete := TIBSQL.Create(Self);

  FQDelete.OnSQLChanging := SQLChanging;

  FQDelete.GoToFirstRecordOnExecute := False;

  FQInsert := TIBSQL.Create(Self);

  FQInsert.OnSQLChanging := SQLChanging;

  FQInsert.GoToFirstRecordOnExecute := False;

  FQRefresh := TIBSQL.Create(Self);

  FQRefresh.OnSQLChanging := SQLChanging;

  FQRefresh.GoToFirstRecordOnExecute := False;

  FQSelect := TIBSQL.Create(Self);

  FQSelect.OnSQLChanging := SQLChanging;

  FQSelect.GoToFirstRecordOnExecute := False;

  FQModify := TIBSQL.Create(Self);

  FQModify.OnSQLChanging := SQLChanging;

  FQModify.GoToFirstRecordOnExecute := False;

  FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];

  FParamCheck := True;

  FForcedRefresh := False;

  FGeneratorField := TIBGeneratorField.Create(Self);

  {Bookmark Size is Integer for IBX}

  BookmarkSize := SizeOf(Integer);

  FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;

  FBase.AfterDatabaseDisconnect := DoAfterDatabaseDisconnect;

  FBase.OnDatabaseFree := DoDatabaseFree;

  FBase.BeforeTransactionEnd := DoBeforeTransactionEnd;

  FBase.AfterTransactionEnd := DoAfterTransactionEnd;

  FBase.OnTransactionFree := DoTransactionFree;

  //!!!b

  FReadBase.BeforeDatabaseDisconnect := DoBeforeReadDatabaseDisconnect;

  FReadBase.AfterDatabaseDisconnect := DoAfterReadDatabaseDisconnect;

  FReadBase.OnDatabaseFree := DoReadDatabaseFree;

  FReadBase.BeforeTransactionEnd := DoBeforeReadTransactionEnd;

  FReadBase.AfterTransactionEnd := DoAfterReadTransactionEnd;

  FReadBase.OnTransactionFree := DoReadTransactionFree;



  FAggregates := TgdcAggregates.Create(Self);

  FAggregatesActive := False;



  FOpenCounter := 0;

  //!!!e

  FLiveMode := [];

  FRowsAffected := 0;

  FStreamedActive := false;

  if AOwner is TIBDatabase then

    Database := TIBDatabase(AOwner)

  else

    if AOwner is TIBTransaction then

      Transaction := TIBTransaction(AOwner);

end;



destructor TIBCustomDataSet.Destroy;

begin

  if FIBLoaded then

  begin

    Close;

    FreeAndNil(FDataLink);

    FreeAndNil(FBase);

    //!!!b

    FreeAndNil(FReadBase);

    FreeAndNil(FAggregates);

    //!!!e

    ClearBlobCache;

    FreeAndNil(FBlobStreamList);

    {$IFDEF HEAP_STRING_FIELD}

    FinalizeCacheBuffer(FBufferCache, FCacheSize);

    {$ENDIF}

    FreeMem(FBufferCache, 0);

    FBufferCache := nil;

    {$IFDEF HEAP_STRING_FIELD}

    FinalizeCacheBuffer(FOldBufferCache, FOldCacheSize);

    {$ENDIF}

    FreeMem(FOldBufferCache, 0);

    FreeAndNil(FGeneratorField);

    FOldBufferCache := nil;

    FCacheSize := 0;

    FOldCacheSize := 0;

    FMappedFieldPosition := nil;

  end;

  inherited Destroy;

end;



function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):

                                             TGetResult;

begin

  while not IsVisible(Buffer) do

  begin

    if GetMode = gmPrior then

    begin

      Dec(FCurrentRecord);

      if FCurrentRecord = -1 then

      begin

        result := grBOF;

        exit;

      end;

      ReadRecordCache(FCurrentRecord, Buffer, False);

    end

    else

    begin

      Inc(FCurrentRecord);

      if (FCurrentRecord = FRecordCount) then

      begin

        if (not FQSelect.EOF) and (FQSelect.Next <> nil) then

        begin

          FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);

          Inc(FRecordCount);

        end

        else

        begin

          //!!!

          //FAggregatesObsolete := True;

          //!!!

          result := grEOF;

          exit;

        end;

      end

      else

        ReadRecordCache(FCurrentRecord, Buffer, False);

    end;

  end;

  result := grOK;

end;



procedure TIBCustomDataSet.ApplyUpdates;

var

  CurBookmark: string;

  Buffer: PRecordData;

  CurUpdateTypes: TIBUpdateRecordTypes;

  UpdateAction: TIBUpdateAction;

  UpdateKind: TUpdateKind;

  bRecordsSkipped: Boolean;

  R: Boolean;

  //TempCurrent: Integer;

  Buff: PChar;



  procedure GetUpdateKind;

  begin

    case Buffer^.rdCachedUpdateStatus of

      cusModified:

        UpdateKind := ukModify;

      cusInserted:

        UpdateKind := ukInsert;

      else

        UpdateKind := ukDelete;

    end;

  end;



  procedure ResetBufferUpdateStatus;

  begin

    case Buffer^.rdCachedUpdateStatus of

      cusModified:

      begin

        PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;

        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;

      end;

      cusInserted:

      begin

        PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;

        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;

      end;

      cusDeleted:

      begin

        PRecordData(Buffer)^.rdUpdateStatus := usDeleted;

        PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;

      end;

    end;

    WriteRecordCache(PRecordData(Buffer)^.rdRecordNumber, Pointer(Buffer));

  end;



  procedure UpdateUsingOnUpdateRecord;

  begin

    UpdateAction := uaFail;

    try

      FOnUpdateRecord(Self, UpdateKind, UpdateAction);

    except

      on E: Exception do

      begin

        if (E is EDatabaseError) and Assigned(FOnUpdateError) then

          FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);

        if UpdateAction = uaFail then

          raise;

      end;

    end;

  end;



  procedure UpdateUsingUpdateObject;

  begin

    UpdateAction := uaApply;

    try

      FUpdateObject.Apply(UpdateKind);

      ResetBufferUpdateStatus;

    except

      on E: Exception do

      begin

        UpdateAction := uaFail;

        if (E is EDatabaseError) and Assigned(FOnUpdateError) then

          FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);

        if UpdateAction = uaFail then

          raise;

      end;

    end;

  end;



  procedure UpdateUsingInternalquery;

  begin

    try

      case Buffer^.rdCachedUpdateStatus of

        cusModified:

          InternalPostRecord(FQModify, Buffer);

        cusInserted:

          InternalPostRecord(FQInsert, Buffer);

        cusDeleted:

          InternalDeleteRecord(FQDelete, Buffer);

      end;

    except

      on E: EIBError do begin

        UpdateAction := uaFail;

        if Assigned(FOnUpdateError) then

          FOnUpdateError(Self, E, UpdateKind, UpdateAction);

        case UpdateAction of

          uaFail: raise;

          uaAbort: SysUtils.Abort;

          uaSkip: bRecordsSkipped := True;

        end;

      end;

    end;

  end;



begin

  if State in [dsEdit, dsInsert] then

    Post;

  FBase.CheckDatabase;

  //!!!

  //FBase.CheckTransaction;

  //!!!

  DisableControls;

  CurBookmark := Bookmark;

  CurUpdateTypes := FUpdateRecordTypes;

  FUpdateRecordTypes := [cusModified, cusInserted, cusDeleted];

  try

    First;

    bRecordsSkipped := False;

    while not EOF do

    begin

      Buffer := PRecordData(GetActiveBuf);

      GetUpdateKind;

      UpdateAction := uaApply;

      if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then

      begin

        if (Assigned(FOnUpdateRecord)) then

          UpdateUsingOnUpdateRecord

        else

          if Assigned(FUpdateObject) then

            UpdateUsingUpdateObject;

        case UpdateAction of

          uaFail:

            IBError(ibxeUserAbort, [nil]);

          uaAbort:

            SysUtils.Abort;

          uaApplied:

            ResetBufferUpdateStatus;

          uaSkip:

            bRecordsSkipped := True;

          uaRetry:

            Continue;

        end;

      end;

      if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then

      begin

        UpdateUsingInternalquery;

        UpdateAction := uaApplied;

      end;

      Next;

    end;

    FUpdatesPending := bRecordsSkipped;

  finally

    FUpdateRecordTypes := CurUpdateTypes;



    if BookmarkValid(Pointer(CurBookmark)) then

    begin

      {TempCurrent := FCurrentRecord;

      FCurrentRecord := PInteger(CurBookmark)^;

      Buff := ActiveBuffer;}

      Buff := FBufferCache + _RecordBufferSize * PInteger(CurBookmark)^;

      R := PRecordData(Buff)^.rdCachedUpdateStatus <> cusDeleted;

      {FCurrentRecord := TempCurrent;}



      if R then

        Bookmark := CurBookmark

      else

        First;

    end else

      First;

      

    EnableControls;

  end;

end;



procedure TIBCustomDataSet.InternalBatchInput(InputObject: TIBBatchInput);

begin

  FQSelect.BatchInput(InputObject);

end;



procedure TIBCustomDataSet.InternalBatchOutput(OutputObject: TIBBatchOutput);

var

  Qry: TIBSQL;

begin

  Qry := TIBSQL.Create(Self);

  try

    Qry.Database := FBase.Database;

    Qry.Transaction := FBase.Transaction;

    Qry.SQL.Assign(FQSelect.SQL);

    Qry.BatchOutput(OutputObject);

  finally

    Qry.Free;

  end;

end;



procedure TIBCustomDataSet.CancelUpdates;

var

  CurUpdateTypes: TIBUpdateRecordTypes;

begin

  if State in [dsEdit, dsInsert] then

    Cancel;

  if FCachedUpdates and FUpdatesPending then

  begin

    DisableControls;

    CurUpdateTypes := UpdateRecordTypes;

    UpdateRecordTypes := [cusModified, cusInserted, cusDeleted];

    try

      First;

      while not EOF do

      begin

        if UpdateStatus = usInserted then

        //!!!

          begin

        //!!!

            RevertRecord;

        //!!!    

            First;

          end

        //!!!

        else

        begin

          RevertRecord;

          Next;

        end;

      end;

    finally

      UpdateRecordTypes := CurUpdateTypes;

      First;

      FUpdatesPending := False;

      EnableControls;

    end;

  end;

end;



procedure TIBCustomDataSet.ActivateConnection;

begin

  if not Assigned(Database) then

    IBError(ibxeDatabaseNotAssigned, [nil]);

  if not Assigned(Transaction) then

    IBError(ibxeTransactionNotAssigned, [nil]);

  if not Database.Connected then Database.Open;

end;



function TIBCustomDataSet.ActivateTransaction: Boolean;

begin

  Result := False;

  if not Assigned(Transaction) then

    IBError(ibxeTransactionNotAssigned, [nil]);

  if not Transaction.Active then

  begin

    Result := True;

    Transaction.StartTransaction;

  end;

end;



procedure TIBCustomDataSet.DeactivateTransaction;

begin

  if not Assigned(Transaction) then

    IBError(ibxeTransactionNotAssigned, [nil]);

  Transaction.CheckAutoStop;

end;



procedure TIBCustomDataSet.CheckDatasetClosed;

begin

  if FOpen then

    IBError(ibxeDatasetOpen, [nil]);

end;



procedure TIBCustomDataSet.CheckDatasetOpen;

begin

  if not FOpen then

    IBError(ibxeDatasetClosed, [nil]);

end;



procedure TIBCustomDataSet.CheckNotUniDirectional;

begin

  if UniDirectional then

    IBError(ibxeDataSetUniDirectional, [nil]);

end;



procedure TIBCustomDataSet.AdjustRecordOnInsert(Buffer: Pointer);

begin

  with PRecordData(Buffer)^ do

    if (State = dsInsert) and (not Modified) then

    begin

      rdRecordNumber := FRecordCount;

      FCurrentRecord := FRecordCount;

    end;

end;



function TIBCustomDataSet.CanEdit: Boolean;

var

  Buff: PRecordData;

begin

  Buff := PRecordData(GetActiveBuf);

  result := ((FQModify.SQL.Text <> '') and (lmModify in FLiveMode)) or

    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or

    ((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and

      (FCachedUpdates));

end;



function TIBCustomDataSet.CanInsert: Boolean;

begin

  result := ((FQInsert.SQL.Text <> '') and (lmInsert in FLiveMode)) or

    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukInsert).Text <> ''));

end;



function TIBCustomDataSet.CanDelete: Boolean;

begin

  if ((FQDelete.SQL.Text <> '') and (lmDelete in FLiveMode)) or

    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then

    result := True

  else

    result := False;

end;



function TIBCustomDataSet.CanRefresh: Boolean;

begin

  result := ((FQRefresh.SQL.Text <> '') and (lmRefresh in FLiveMode)) or

    (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> ''));

end;



procedure TIBCustomDataSet.CheckEditState;

begin

  case State of

    { Check all the wsEditMode types }

    dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter,

    dsNewValue, dsInternalCalc :

    begin

      if (State in [dsEdit]) and (not CanEdit) then

        IBError(ibxeCannotUpdate, [nil]);

      if (State in [dsInsert]) and (not CanInsert) then

        IBError(ibxeCannotInsert, [nil]);

    end;

  else

    IBError(ibxeNotEditing, [])

  end;

end;



procedure TIBCustomDataSet.ClearBlobCache;

var

  i: Integer;

begin

  for i := 0 to FBlobStreamList.Count - 1 do

  begin

    TIBBlobStream(FBlobStreamList[i]).Free;

    FBlobStreamList[i] := nil;

  end;

  FBlobStreamList.Pack;

end;



procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);

begin

  {$IFDEF HEAP_STRING_FIELD}

  if Source <> Dest then

    FinalizeRecordBuffer(Dest);

  {$ENDIF}



  Move(Source^, Dest^, FRecordBufferSize);



  {$IFDEF HEAP_STRING_FIELD}

  InitializeRecordBuffer(Source, Dest);

  {$ENDIF}

end;



procedure TIBCustomDataSet.DoBeforeDatabaseDisconnect(Sender: TObject);

begin

  if Active then

    Active := False;

  FInternalPrepared := False;

  if Assigned(FBeforeDatabaseDisconnect) then

    FBeforeDatabaseDisconnect(Sender);

end;



procedure TIBCustomDataSet.DoAfterDatabaseDisconnect(Sender: TObject);

begin

  if Assigned(FAfterDatabaseDisconnect) then

    FAfterDatabaseDisconnect(Sender);

end;



procedure TIBCustomDataSet.DoDatabaseFree(Sender: TObject);

begin

  if Assigned(FDatabaseFree) then

    FDatabaseFree(Sender);

end;



procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);

begin

  {if Active then

    Active := False;}

  {if FQSelect <> nil then

    FQSelect.FreeHandle;}

  if FQDelete <> nil then

  try

    FQDelete.FreeHandle;

  except

  end;

  if FQInsert <> nil then

  try

    FQInsert.FreeHandle;

  except

  end;

  if FQModify <> nil then

  try

    FQModify.FreeHandle;

  except

  end;

  {if FQRefresh <> nil then

    FQRefresh.FreeHandle;}

  {FInternalPrepared := false;}

  if Assigned(FBeforeTransactionEnd) then

    FBeforeTransactionEnd(Sender);

end;



procedure TIBCustomDataSet.DoAfterTransactionEnd(Sender: TObject);

begin

  if Assigned(FAfterTransactionEnd) then

    FAfterTransactionEnd(Sender);

end;



procedure TIBCustomDataSet.DoTransactionFree(Sender: TObject);

begin

  if Assigned(FTransactionFree) then

    FTransactionFree(Sender);

end;



{ Read the record from FQSelect.Current into the record buffer

  Then write the buffer to in memory cache }

procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;

  RecordNumber: Integer; Buffer: PChar);

var

  p: PRecordData;

  pbd: PBlobDataArray;

  i, j: Integer;

  LocalData: Pointer;

  LocalDate, LocalDouble: Double;

  LocalInt: Integer;

  LocalInt64: Int64;

  LocalCurrency: Currency;

  FieldsLoaded: Integer;

begin

  {$IFDEF HEAP_STRING_FIELD}

  FinalizeRecordBuffer(Buffer);

  {$ENDIF}



  p := PRecordData(Buffer);

  { Make sure blob cache is empty }

  pbd := PBlobDataArray(Buffer + FBlobCacheOffset);

  if RecordNumber > -1 then

    for i := 0 to BlobFieldCount - 1 do

      pbd^[i] := nil;

  { Get record information }

  p^.rdBookmarkFlag := bfCurrent;

  p^.rdFieldCount := Qry.Current.Count;

  p^.rdRecordNumber := RecordNumber;

  p^.rdUpdateStatus := usUnmodified;

  p^.rdCachedUpdateStatus := cusUnmodified;

  p^.rdSavedOffset := $FFFFFFFF;



  { Load up the fields }

  FieldsLoaded := FQSelect.Current.Count;

  j := 1;

  for i := 0 to Qry.Current.Count - 1 do

  begin

    if (Qry = FQSelect) then

      j := i + 1

    else begin

      if FieldsLoaded = 0 then

        break;

      j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;

      if j < 1 then

        continue

      else

        Dec(FieldsLoaded);

    end;

    with FQSelect.Current[j - 1].Data^ do

      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}

      begin

        if sqllen <= 8 then

          p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;

        continue;

      end;

    if j > 0 then with p^ do

    begin

      rdFields[j].fdDataType :=

        Qry.Current[i].Data^.sqltype and (not 1);

      rdFields[j].fdDataScale :=

        Qry.Current[i].Data^.sqlscale;

      rdFields[j].fdNullable :=

        (Qry.Current[i].Data^.sqltype and 1 = 1);

      rdFields[j].fdIsNull :=

        (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));

      LocalData := Qry.Current[i].Data^.sqldata;

      case rdFields[j].fdDataType of

        SQL_TIMESTAMP:

        begin

          rdFields[j].fdDataSize := SizeOf(TDateTime);

          if RecordNumber >= 0 then

            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));

          LocalData := PChar(@LocalDate);

        end;

        SQL_TYPE_DATE:

        begin

          rdFields[j].fdDataSize := SizeOf(TDateTime);

          if RecordNumber >= 0 then

            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;

          LocalData := PChar(@LocalInt);

        end;

        SQL_TYPE_TIME:

        begin

          rdFields[j].fdDataSize := SizeOf(TDateTime);

          if RecordNumber >= 0 then

            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;

          LocalData := PChar(@LocalInt);

        end;

        SQL_SHORT, SQL_LONG:

        begin

          if (rdFields[j].fdDataScale = 0) then

          begin

            rdFields[j].fdDataSize := SizeOf(Integer);

            if RecordNumber >= 0 then

              LocalInt := Qry.Current[i].AsLong;

            LocalData := PChar(@LocalInt);

          end

          else if (rdFields[j].fdDataScale >= (-4)) then

               begin

                 rdFields[j].fdDataSize := SizeOf(Currency);

                 if RecordNumber >= 0 then

                   LocalCurrency := Qry.Current[i].AsCurrency;

                 LocalData := PChar(@LocalCurrency);

               end

               else begin

                 rdFields[j].fdDataSize := SizeOf(Double);

                 if RecordNumber >= 0 then

                   LocalDouble := Qry.Current[i].AsDouble;

                LocalData := PChar(@LocalDouble);

              end;

        end;

        SQL_INT64:

        begin

          if (rdFields[j].fdDataScale = 0) then

          begin

            rdFields[j].fdDataSize := SizeOf(Int64);

            if RecordNumber >= 0 then

              LocalInt64 := Qry.Current[i].AsInt64;

            LocalData := PChar(@LocalInt64);

          end

          else if (rdFields[j].fdDataScale >= (-4)) then

               begin

                 rdFields[j].fdDataSize := SizeOf(Currency);

                 if RecordNumber >= 0 then

                   LocalCurrency := Qry.Current[i].AsCurrency;

                   LocalData := PChar(@LocalCurrency);

               end

               else begin

                  rdFields[j].fdDataSize := SizeOf(Double);

                  if RecordNumber >= 0 then

                    LocalDouble := Qry.Current[i].AsDouble;

                  LocalData := PChar(@LocalDouble);

               end

        end;

        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:

        begin

          rdFields[j].fdDataSize := SizeOf(Double);

          if RecordNumber >= 0 then

            LocalDouble := Qry.Current[i].AsDouble;

          LocalData := PChar(@LocalDouble);

        end;

        SQL_VARYING:

        begin

          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;

          rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);

          if RecordNumber >= 0 then

          begin

            if (rdFields[j].fdDataLength = 0) then

              LocalData := nil

            else

              LocalData := @Qry.Current[i].Data^.sqldata[2];

          end;

        end;

        else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }

        begin

          rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;

          if (rdFields[j].fdDataType = SQL_TEXT) then

            rdFields[j].fdDataLength := rdFields[j].fdDataSize;

        end;

      end;

      if RecordNumber < 0 then

      begin

        {$IFDEF HEAP_STRING_FIELD}

        rdFields[j].fdIsNull := True;

        if IsHeapField(rdFields[j]) then

        begin

          rdFields[j].fdDataOfs := 0;

          rdFields[j].fdDataLength := 0;

        end else begin

          rdFields[j].fdDataOfs := FRecordSize;

          Inc(FRecordSize, rdFields[j].fdDataSize);

        end;

        {$ELSE}

        rdFields[j].fdIsNull := True;

        rdFields[j].fdDataOfs := FRecordSize;

        Inc(FRecordSize, rdFields[j].fdDataSize);

        {$ENDIF}

      end

      else begin

        if rdFields[j].fdDataType = SQL_VARYING then

        begin

          {$IFDEF HEAP_STRING_FIELD}

          if IsHeapField(rdFields[j]) then

          begin

            if LocalData <> nil then

            begin

              GetMem(Pointer(rdFields[j].fdDataOfs), rdFields[j].fdDataLength);

              Move(LocalData^, Pointer(rdFields[j].fdDataOfs)^, rdFields[j].fdDataLength);

            end else

              rdFields[j].fdDataOfs := 0;

          end else

          {$ENDIF}

          if LocalData <> nil then

            Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)

        end

        else

          Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)

      end;

    end;

  end;

  WriteRecordCache(RecordNumber, PChar(p));

end;



function TIBCustomDataSet.GetActiveBuf: PChar;

begin

  //!!!

  if FPeekBuffer <> nil then

    Result := FPeekBuffer

  else

  //!!!

    case State of

      dsBrowse:

        if IsEmpty then

          result := nil

        else

          result := ActiveBuffer;

      dsEdit, dsInsert:

        result := ActiveBuffer;

      dsCalcFields:

        result := CalcBuffer;

      dsFilter:

        result := FFilterBuffer;

      dsNewValue:

        result := ActiveBuffer;

      dsOldValue:

        if (PRecordData(ActiveBuffer)^.rdRecordNumber =

          PRecordData(FOldBuffer)^.rdRecordNumber) then

          result := FOldBuffer

        else

          result := ActiveBuffer;

    else if not FOpen then

      result := nil

    else

      result := ActiveBuffer;

    end;

end;



function TIBCustomDataSet.CachedUpdateStatus: TCachedUpdateStatus;

begin

  if Active then

    result := PRecordData(GetActiveBuf)^.rdCachedUpdateStatus

  else

    result := cusUnmodified;

end;



function TIBCustomDataSet.GetDatabase: TIBDatabase;

begin

  result := FBase.Database;

end;



function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;

begin

  result := FBase.DBHandle;

end;



function TIBCustomDataSet.GetDeleteSQL: TStrings;

begin

  result := FQDelete.SQL;

end;



function TIBCustomDataSet.GetInsertSQL: TStrings;

begin

  result := FQInsert.SQL;

end;



function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;

begin

  if not FInternalPrepared then

    InternalPrepare;

  result := FQSelect.Params;

end;



function TIBCustomDataSet.GetRefreshSQL: TStrings;

begin

  result := FQRefresh.SQL;

end;



function TIBCustomDataSet.GetSelectSQL: TStrings;

begin

  result := FQSelect.SQL;

end;



function TIBCustomDataSet.GetStatementType: TIBSQLTypes;

begin

  result := FQSelect.SQLType;

end;



function TIBCustomDataSet.GetModifySQL: TStrings;

begin

  result := FQModify.SQL;

end;



function TIBCustomDataSet.GetTransaction: TIBTransaction;

begin

  result := FBase.Transaction;

end;



function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;

begin

  result := FBase.TRHandle;

end;



procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);

//!!!

var

  DidActivate: Boolean;

//!!!

begin

  //!!!

  if not FDataTransfer then

  begin

  //!!!

  if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then

    FUpdateObject.Apply(ukDelete)

  else

  begin

    //!!!

    DidActivate := False;

    try

      DidActivate := ActivateTransaction;

      try

        if Assigned(FBeforeInternalDeleteRecord) then

          FBeforeInternalDeleteRecord(Self);

    //!!!

        SetInternalSQLParams(FQDelete, Buff);

        FQDelete.ExecQuery;

        FRowsAffected := FQDelete.RowsAffected;

    //!!!

        if Assigned(FAfterInternalDeleteRecord) then

          FAfterInternalDeleteRecord(Self);

      except

        if DidActivate and AllowCloseTransaction then

          Transaction.Rollback;

        raise;

      end;

    finally

      if DidActivate and AllowCloseTransaction then

        Transaction.Commit;

    end;

    //!!!

  end;

  //!!!

  end;

  //!!!

  with PRecordData(Buff)^ do

  begin

    rdUpdateStatus := usDeleted;

    rdCachedUpdateStatus := cusUnmodified;

  end;

  WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);

end;



function TIBCustomDataSet.InternalLocate(const KeyFields: string;

  const KeyValues: Variant; Options: TLocateOptions): Boolean;

var

  fl: TList;

  CurBookmark: string;

  fld : Variant;

  val : Array of Variant;

  i, fld_cnt: Integer;

  fld_str : String;

begin

  fl := TList.Create;

  try

    GetFieldList(fl, KeyFields);

    fld_cnt := fl.Count;

    CurBookmark := Bookmark;

    result := False;

    SetLength(val, fld_cnt);

    if not Eof then

      for i := 0 to fld_cnt - 1 do

      begin

        if VarIsArray(KeyValues) then

          val[i] := KeyValues[i]

        else

          val[i] := KeyValues;

        if (TField(fl[i]).DataType = ftString) and

           not VarIsNull(val[i]) then

        begin

          if (loCaseInsensitive in Options) then

            val[i] := AnsiUpperCase(val[i]);

        end;

      end;

    while ((not result) and (not Eof)) do

    begin

      i := 0;

      result := True;

      while (result and (i < fld_cnt)) do

      begin

        fld := TField(fl[i]).Value;

        if VarIsNull(fld) then

          result := result and VarIsNull(val[i])

        else

        begin

          // We know the Field is not null so if the passed value is null we are

          //   done with this record

          result := result and not VarIsNull(val[i]);

          if result then

          begin

            try

              fld := VarAsType(fld, VarType(val[i]));

            except

              on E: EVariantError do result := False;

            end;

            if TField(fl[i]).DataType = ftString then

            begin

              fld_str := TField(fl[i]).AsString;

              if (loCaseInsensitive in Options) then

                fld_str := AnsiUpperCase(fld_str);

              if (loPartialKey in Options) then

                result := result and (AnsiPos(val[i], fld_str) = 1)

              else

                result := result and (f