{*************************************************************}
{                                                             }
{       Borland Delphi Visual Component Library               }
{       InterBase Express core components                     }
{                                                             }
{       Copyright (c) 1998-2003 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.                }
{                                                             }
{    Additional code created by Jeff Overcash and used        }
{    with permission.                                         }
{*************************************************************}

unit Borland.Vcl.IBCustomDataSet;

{$A8,R-}

interface

uses
  SysUtils, Classes, Variants, Windows, IBExternals, IB, IBHeader, IBDatabase,
  IBSQL, Db, IBUtils, IBBlob, IBIntf, System.Runtime.InteropServices;

const
  BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
  UniCache           =  2;     { Uni-directional cache is 2 records big }

type
  TIBCustomDataSet = class;
  TIBDataSet = class;

  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;
  published
    property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
  end;

  TBlobDataArray = array of TIBBlobStream;

  { TIBCustomDataSet }
  [StructLayout(LayoutKind.Sequential)]
  TFieldData = record
    fdDataType: Short;
    fdDataScale: Short;
    fdNullable: Boolean;
    fdIsNull: Boolean;
    fdDataSize: Short;
    fdDataLength: Short;
    fdDataOfs: Integer;
  end;

  TCachedUpdateStatus = (cusUnmodified, cusModified, cusInserted,
                         cusDeleted, cusUninserted);

  [StructLayout(LayoutKind.Sequential)]
  TIBDBKey = record
     [MarshalAs(UnmanagedType.ByValArray, SizeConst = 8)]
    DBKey: array[0..7] of Byte;
  end;

  [StructLayout(LayoutKind.Sequential)]
  TRecordData = record
    rdBookmarkFlag: TBookmarkFlag;
    rdFieldCount: Short;
    rdRecordNumber: Long;
    rdCachedUpdateStatus: TCachedUpdateStatus;
    rdUpdateStatus: TUpdateStatus;
    rdSavedOffset: DWORD;
    rdDBKey: TIBDBKey;
    rdFields  : IntPtr; {array[1..1] of TFieldData;}
  end;

  { TIBStringField allows us to have strings longer than 8196 }

  TIBStringField = class(TStringField)
  private
    buffer : IntPtr;
  protected
    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;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; 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 }
  TIBCustomDataSet = class(TDataset)
  private
    FNeedsRefresh: Boolean;
    FForcedRefresh: Boolean;
    FIBLoaded: Boolean;
    FBase: TIBBase;
    FBlobCacheOffset: Integer;
    FBlobStreamList: TBlobDataArray;
    FBufferChunks: Integer;
    FBufferCache,
    FOldBufferCache: IntPtr;
    FBufferChunkSize,
    FCacheSize,
    FOldCacheSize: Integer;
    FFilterBuffer: IntPtr;
    FBPos,
    FOBPos,
    FBEnd,
    FOBEnd: DWord;
    FCachedUpdates: Boolean;
    FCalcFieldsOffset: Integer;
    FCurrentRecord: Long;
    FDeletedRecords: Long;
    FModelBuffer,
    FOldBuffer, FTempBuffer: IntPtr;
    FOpen: Boolean;
    FInternalPrepared: Boolean;
    FQDelete,
    FQInsert,
    FQRefresh,
    FQSelect,
    FQModify: TIBSQL;
    FRecordBufferSize: Int64;
    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;
    FGDSLibrary : IGDSLibrary;

    function GetSelectStmtHandle: TISC_STMT_HANDLE;
    procedure SetUpdateMode(const Value: TUpdateMode);
    procedure SetUpdateObject(Value: TIBDataSetUpdateObject);

    function AdjustCurrentRecord(Buffer: IntPtr; GetMode: TGetMode): TGetResult;
    procedure AdjustRecordOnInsert(Buffer: TRecordBuffer);
    function CanEdit: Boolean;
    function CanInsert: Boolean;
    function CanDelete: Boolean;
    function CanRefresh: Boolean;
    procedure CheckEditState;
    procedure ClearBlobCache;
    procedure CopyRecordBuffer(Source, Dest: TRecordBuffer);
    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: TRecordBuffer);
    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; Buffer: TRecordBuffer);
    function InternalLocate(const KeyFields: string; const KeyValues: Variant;
                            Options: TLocateOptions): Boolean;
    procedure InternalPostRecord(Qry: TIBSQL; Buff: TRecordBuffer);
    procedure InternalRevertRecord(RecordNumber: Integer);
    function IsVisible(Buffer: IntPtr): Boolean;
    procedure SaveOldBuffer(Buffer: IntPtr);
    procedure SetBufferChunks(Value: Integer);
    procedure SetDatabase(Value: TIBDatabase);
    procedure SetDeleteSQL(Value: TStrings);
    procedure SetInsertSQL(Value: TStrings);
    procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: TRecordBuffer);
    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: IntPtr; Offset: DWORD;
                            Origin: Integer): Integer;
    procedure ReadCache(FCache: IntPtr; Offset: DWORD; Origin: Integer;
                       Buffer: IntPtr);
    procedure ReadRecordCache(RecordNumber: Integer; Buffer: IntPtr;
                              ReadOldBuffer: Boolean);
    procedure WriteCache(FCache: IntPtr; Offset: DWORD; Origin: Integer;
                        Buffer: IntPtr);
    procedure WriteRecordCache(RecordNumber: Long; Buffer: TRecordBuffer);
    function InternalGetRecord(Buffer: IntPtr; GetMode: TGetMode;
                       DoCheck: Boolean): TGetResult;
    procedure SetGeneratorField(const Value: TIBGeneratorField);
    function InternalGetFieldData(Field: TField; Buffer: IntPtr): Boolean;
    procedure InternalSetFieldData(Field: TField; Buffer: IntPtr); virtual;
    function GetPlan: String;

  protected
    function BufferAsRecordData(Buffer : TRecordBuffer) : TRecordData;
    procedure ActivateConnection;
    function ActivateTransaction: Boolean;
    procedure DeactivateTransaction;
    procedure CheckDatasetClosed;
    procedure CheckDatasetOpen;
    function GetActiveBuf: IntPtr;
    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;
    procedure PSExecute; override;
    function PSExecuteStatement(const ASQL: string; AParams: TParams;
      var ResultSet: TObject): 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: TRecordBuffer); override;
    procedure Disconnect; virtual;
    function ConstraintsStored: Boolean;
    procedure ClearCalcFields(Buffer: TRecordBuffer); override;
    procedure CreateFields; override;
    function AllocRecordBuffer: IntPtr; override;
    procedure DoBeforeDelete; override;
    procedure DoBeforeEdit; override;
    procedure DoBeforeInsert; override;
    procedure FreeRecordBuffer(var Buffer: IntPtr); override;
    procedure GetBookmarkData(Buffer: TRecordBuffer; var Data: TBookmark); override;
    function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
    function GetCanModify: Boolean; override;
    function GetDataSource: TDataSource; override;
    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
    function GetRecNo: Integer; override;
    function GetRecord(Buffer: IntPtr; GetMode: TGetMode;
                       DoCheck: Boolean): TGetResult; override;
    function GetRecordCount: Integer; override;
    function GetRecordSize: Word; override;
    procedure InternalAddRecord(Buffer: TRecordBuffer; Append: Boolean); override;
    procedure InternalCancel; override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark(const Bookmark: TBookmark); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: IntPtr); override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalRefresh; override;
    procedure InternalSetToRecord(Buffer: IntPtr); override;
    function IsCursorOpen: Boolean; override;
    procedure ReQuery;
    procedure SetBookmarkFlag(Buffer: IntPtr; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: TRecordBuffer; const Data: TBookmark); override;
    procedure SetCachedUpdates(Value: Boolean);
    procedure SetDataSource(Value: TDataSource);
    procedure SetFieldData(Field : TField; Buffer : IntPtr); override;
    procedure SetFieldData(Field : TField; Buffer : IntPtr;
      NativeFormat : Boolean); overload; override;
    procedure SetRecNo(Value: Integer); override;
    procedure DoOnNewRecord; override;
    procedure Loaded; override;

  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 default 1000;
    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates default false;
    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;

    procedure DataEvent(Event: TDataEvent; Info: TObject); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  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;

    { TDataSet support methods }
    function BookmarkValid(const Bookmark: TBookmark): Boolean; override;
    function CompareBookmarks(const Bookmark1, Bookmark2: TBookmark): Integer; override;
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
    function GetCurrentRecord(Buffer: IntPtr): Boolean; override;
    function GetFieldData(Field : TField; Buffer : IntPtr) : Boolean; overload; override;
    function GetFieldData(Field: TField; Buffer: IntPtr; 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;
    procedure OutputXML(OutputObject: TIBOutputXML);

    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;

  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;
  end;

  TIBDataSet = class(TIBCustomDataSet)
  private
    FPSParams: TParams; // Temporary needed for DataSnap
    function GetPrepared: Boolean;
    procedure CreateParams;

  protected
    function PSGetParams: TParams; override;
    procedure PSSetParams(AParams: TParams); override;
    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
    destructor Destroy; override;
    function ParamByName(Idx : String) : TIBXSQLVAR;
    property Params;
    property Prepared : Boolean read GetPrepared;
    property StatementType;
    property SelectStmtHandle;
    property LiveMode;

  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;

    { 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;
    FDataset : TIBCustomDataset;
    FBlobStream: TIBBlobStream;
    FModified : Boolean;
    procedure SetSize(NewSize: Int64); override;
  public
    constructor Create(AField: TField; ABlobStream: TIBBlobStream;
                       Mode: TBlobStreamMode);
    destructor Destroy; override;
    function Read(var Buffer: array of Byte; Offset, Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    function Write(const Buffer: array of Byte; Offset, Count: Longint): Longint; override;
  end;

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 }
    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 }
    TMemoField,         { ftOraClob }
    nil,      { ftVariant }
    nil,    { ftInterface }
    nil,     { ftIDispatch }
    TGuidField,        { ftGuid }
    TSQLTimeStampField, { ftTimeStamp }
    TFMTBcdField);   { ftFMTBcd }

var
  CreateProviderProc: function(DataSet: TIBCustomDataSet): IProviderSupport = nil;

implementation

uses FmtBcd, DBCommon, DBConsts, Contnrs;

var
  FieldDataSize : Integer;

{ TIBStringField}

constructor TIBStringField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Size := 20;
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
  Len: Integer;
begin
  if Buffer = nil then
    Buffer := Marshal.AllocHGlobal(Size + 1);
  Result := GetData(Buffer);
  if Result then
  begin
      Value := Marshal.PtrToStringAnsi(Buffer);
      Len := Pos(#0, Value);
      if Len > 0 then
        SetLength(Value, Len - 1);
    // All Translate does is return the StrLen which we don't use.  This
    // Is just a waste of time.
//      if Transliterate and (Value <> '') then
//        DataSet.Translate(Value, Value, False);
  end
end;

procedure TIBStringField.SetAsString(const Value: string);
var
  Temp: TValueBuffer;
begin
  Temp := Marshal.StringToHGlobalAnsi(Value);
  try
    SetData(Temp);
  finally
    Marshal.FreeHGlobal(Temp);
  end;
end;

destructor TIBStringField.Destroy;
begin
  if Assigned(Buffer) then
    Marshal.FreeHGlobal(Buffer);
  inherited;
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: Borland.Delphi.System.Currency;
begin
  if GetValue(C) then
    Result := CurrToStr(C)
  else
    Result := '';
end;

function TIBBCDField.GetAsVariant: Variant;
var
  C: Borland.Delphi.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);
  FGDSLibrary := GetGDSLibrary;
  FIBLoaded := False;
  FGDSLibrary.CheckIBLoaded;
  FIBLoaded := True;
  FBase := TIBBase.Create(Self);
  FCurrentRecord := -1;
  FDeletedRecords := 0;
  FUniDirectional := False;
  FBufferChunks := BufferCacheSize;
  SetLength(FBlobStreamList, 0);
  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;
  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);
    ClearBlobCache;
    Marshal.FreeHGlobal(FBufferCache);
    FBufferCache := nil;
    Marshal.FreeHGlobal(FOldBufferCache);
    FreeAndNil(FGeneratorField);
    FOldBufferCache := nil;
    FCacheSize := 0;
    FOldCacheSize := 0;
    FMappedFieldPosition := nil;
  end;
  FGDSLibrary := nil;
  inherited Destroy;
end;

function TIBCustomDataSet.AdjustCurrentRecord(Buffer: IntPtr; 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
          result := grEOF;
          exit;
        end;
      end
      else
        ReadRecordCache(FCurrentRecord, Buffer, False);
    end;
  end;
  result := grOK;
end;

procedure TIBCustomDataSet.ApplyUpdates;
var
  CurBookmark: String;
  I1 : IntPtr;
  Buffer: TRecordBuffer;
  CurUpdateTypes: TIBUpdateRecordTypes;
  UpdateAction: TIBUpdateAction;
  UpdateKind: TUpdateKind;
  bRecordsSkipped: Boolean;

  procedure GetUpdateKind;
  begin
    case TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData))).rdCachedUpdateStatus of
      cusModified:
        UpdateKind := ukModify;
      cusInserted:
        UpdateKind := ukInsert;
      else
        UpdateKind := ukDelete;
    end;
  end;

  procedure ResetBufferUpdateStatus;
  var
    Buf : TRecordData;
  begin
     Buf := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
    case Buf.rdCachedUpdateStatus of
      cusModified:
      begin
        Buf.rdUpdateStatus := usUnmodified;
        Buf.rdCachedUpdateStatus := cusUnmodified;
      end;
      cusInserted:
      begin
        Buf.rdUpdateStatus := usUnmodified;
        Buf.rdCachedUpdateStatus := cusUnmodified;
      end;
      cusDeleted:
      begin
        Buf.rdUpdateStatus := usDeleted;
        Buf.rdCachedUpdateStatus := cusUnmodified;
      end;
    end;
    Marshal.StructureToPtr(TObject(Buf), Buffer, false);
    WriteRecordCache(Buf.rdRecordNumber, 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;
  var
    Buf : TRecordData;
  begin
     Buf := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
    try
      case Buf.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 not FCachedUpdates then
    IBError(ibxeNotCachedUpdates, [nil]);
  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 := 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;
    I1 := Marshal.StringToHGlobalAnsi(CurBookmark);
    try
      if BookmarkValid(I1) then
        Bookmark := CurBookmark
      else
        First;
    finally
      Marshal.FreeHGlobal(I1);
    end;
    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
          RevertRecord
        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.AutoStartTransaction;
  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: TRecordBuffer);
begin
  if (State = dsInsert) and (not Modified) then
  begin
    Marshal.WriteInt32(Buffer, Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdRecordNumber')), FRecordCount);
    FCurrentRecord := FRecordCount;
  end;
end;

function TIBCustomDataSet.CanEdit: Boolean;
var
  Buff: TRecordData;
begin
  Buff := TRecordData(Marshal.PtrToStructure(GetActiveBuf, TypeOf(TRecordData)));
  result := ((FQModify.SQL.Text <> '') and (lmModify in FLiveMode)) or
    (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or
    ((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 := Low(FBlobStreamList) to High(FBlobStreamList) do
  begin
    FBlobStreamList[i].Free;
    FBlobStreamList[i] := nil;
  end;
  SetLength(FBlobStreamList, 0);
end;

procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: IntPtr);
var
  b : TBytes;
begin
  SetLength(b, FRecordBufferSize);
  Marshal.Copy(Source, b, 0, FRecordBufferSize);
  Marshal.Copy(b, 0, Dest, FRecordBufferSize);
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
    FQDelete.FreeHandle;
  if FQInsert <> nil then
    FQInsert.FreeHandle;
  if FQModify <> nil then
    FQModify.FreeHandle;
  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: IntPtr);
var
  p: TRecordData;
  pbd: IntPtr;
  i, j : Integer;
  LocalData : IntPtr;
  LocalDate : Int64;
  LocalDouble : Double;
  LocalInt : Integer;
  LocalInt64 : Int64;
  LocalCurrency : Currency;
  LocalBCD : TBytes;
  FieldsLoaded : Integer;
  rdField : TFieldData;
  b : TBytes;

begin
  p := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
  { Make sure blob cache is empty }
  pbd := (IntPtr(Integer(Buffer) + FBlobCacheOffset));
  if RecordNumber > -1 then
    for i := 0 to BlobFieldCount - 1 do
      Marshal.WriteInt32(pbd, i * Marshal.SizeOf(TypeOf(IntPtr)), -1);
  { Get record information }
  p.rdBookmarkFlag := bfCurrent;
  p.rdFieldCount := Qry.Current.Count;
  p.rdRecordNumber := RecordNumber;
  p.rdUpdateStatus := usUnmodified;
  p.rdCachedUpdateStatus := cusUnmodified;
  p.rdSavedOffset := $FFFFFFFF;
  Marshal.StructureToPtr(TObject(p), Buffer, false);

  { Load up the fields }
  FieldsLoaded := FQSelect.Current.Count;
  j := 0;
  for i := 0 to Qry.Current.Count - 1 do
  begin
    if (Qry = FQSelect) then
      j := i
    else
    begin
      if FieldsLoaded = 0 then
        break;
      j := FQSelect.FieldIndex[Qry.Current[i].Name];
      if j < 1 then
        continue
      else
        Dec(FieldsLoaded);
    end;
    with FQSelect.Current[j].Data do
      if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
      begin
        if sqllen <= 8 then          
        begin
          p := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
          SetLength(b, sqllen);
          Marshal.Copy(Qry.Current[i].AsIntPtr, b, 0, sqllen);
          p.rdDBKey.DBKey := b;
          Marshal.StructureToPtr(TObject(p), Buffer, false);
        end;
        continue;
      end;
    if j >= 0 then
    with p do
    begin
      rdField := TFieldData(Marshal.PtrToStructure(IntPtr(Integer(Buffer) +
          Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) + (j * FieldDataSize)),
          TypeOf(TFieldData)));
      rdField.fdDataType := Qry.Current[i].Data.SqlDef;
      rdField.fdDataScale := Qry.Current[i].Data.sqlscale;
      rdField.fdNullable := (Qry.Current[i].Data.sqltype and 1 = 1);
      rdField.fdIsNull :=
        (rdField.fdNullable and (Marshal.ReadInt16(Qry.Current[i].Data.sqlind) = -1));
      LocalData := Qry.Current[i].Data.sqldata;
      case rdField.fdDataType of
        SQL_TIMESTAMP:
        begin
          rdField.fdDataSize := SizeOf(TDateTime);
          if RecordNumber >= 0 then
          begin
            LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
            LocalData := Marshal.AllocHGlobal(SizeOf(Double));
            Marshal.WriteInt64(LocalData, BitConverter.DoubleToInt64Bits(LocalDate));
          end;
        end;
        SQL_TYPE_DATE:
        begin
          rdField.fdDataSize := SizeOf(TDateTime);
          if RecordNumber >= 0 then
          begin
            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
            LocalData := Marshal.AllocHGlobal(SizeOf(LocalInt));
            Marshal.WriteInt32(LocalData, LocalInt);
          end;
        end;
        SQL_TYPE_TIME:
        begin
          rdField.fdDataSize := SizeOf(TDateTime);
          if RecordNumber >= 0 then
          begin
            LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
            LocalData := Marshal.AllocHGlobal(SizeOf(LocalInt));
            Marshal.WriteInt32(LocalData, LocalInt);
          end;
        end;
        SQL_SHORT, SQL_LONG:
        begin
          if (rdField.fdDataScale = 0) then
          begin
            rdField.fdDataSize := SizeOf(Integer);
            if RecordNumber >= 0 then
            begin
              LocalInt := Qry.Current[i].AsLong;
              LocalData := Marshal.AllocHGlobal(SizeOf(LocalInt));
              Marshal.WriteInt32(LocalData, LocalInt);
            end;
          end
          else
            if (rdField.fdDataScale >= (-4)) then
            begin
              rdField.fdDataSize := SizeOf(Currency);
              if RecordNumber >= 0 then
              begin
                LocalCurrency := Qry.Current[i].AsCurrency;
                LocalData := Marshal.AllocHGlobal(SizeOf(Borland.Delphi.System.Currency));
                Marshal.WriteInt64(LocalData, LocalCurrency.ToOACurrency);
              end;
            end
            else
            begin
              if Fields[j].DataType = ftFloat then
              begin
                rdField.fdDataSize := SizeOf(Double);
                if RecordNumber >= 0 then
                begin
                  LocalDouble := Qry.Current[i].AsDouble;
                  LocalData := Marshal.AllocHGlobal(SizeOf(LocalDouble));
                  Marshal.WriteInt64(LocalData, BitConverter.DoubleToInt64Bits(LocalDouble));
                end;
              end
              else
              begin
                rdField.fdDataSize := SizeOf(tBcd);
                if RecordNumber >= 0 then
                begin
                  LocalBCD := TBcd.ToBytes(Qry.Current[i].AsBcd);
                  LocalData := Marshal.AllocHGlobal(SizeOfTBcd);
                  Marshal.Copy(LocalBCD, 0, LocalData, Length(LocalBCD));
                end;
              end
            end;
        end;
        SQL_INT64:
        begin
          if (rdField.fdDataScale = 0) then
          begin
            rdField.fdDataSize := SizeOf(Int64);
            if RecordNumber >= 0 then
            begin
              LocalInt64 := Qry.Current[i].AsInt64;
              LocalData := Marshal.AllocHGlobal(SizeOf(LocalInt64));
              Marshal.WriteInt64(LocalData, LocalInt64);
            end;
          end
          else
            if (rdField.fdDataScale >= (-4)) then
            begin
              rdField.fdDataSize := SizeOf(Currency);
              if RecordNumber >= 0 then
              begin
                LocalCurrency := Qry.Current[i].AsCurrency;
                LocalData := Marshal.AllocHGlobal(SizeOf(Borland.Delphi.System.Currency));
                Marshal.WriteInt64(LocalData, LocalCurrency.ToOACurrency);
              end;
            end
            else
            begin
              if Fields[j].DataType = ftFloat then
              begin
                rdField.fdDataSize := SizeOf(Double);
                if RecordNumber >= 0 then
                begin
                  LocalDouble := Qry.Current[i].AsDouble;
                  LocalData := Marshal.AllocHGlobal(SizeOf(LocalDouble));
                  Marshal.WriteInt64(LocalData, BitConverter.DoubleToInt64Bits(LocalDouble));
                end;
              end
              else
              begin
                rdField.fdDataSize := SizeOf(tBcd);
                if RecordNumber >= 0 then
                begin
                  LocalBCD := TBcd.ToBytes(Qry.Current[i].AsBcd);
                  LocalData := Marshal.AllocHGlobal(SizeOfTBcd);
                  Marshal.Copy(LocalBCD, 0, LocalData, Length(LocalBCD));
                end;
              end
            end
        end;
        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
        begin
          rdField.fdDataSize := SizeOf(Double);
          if RecordNumber >= 0 then
          begin
            LocalDouble := Qry.Current[i].AsDouble;
            LocalData := Marshal.AllocHGlobal(SizeOf(LocalDouble));
            Marshal.WriteInt64(LocalData, BitConverter.DoubleToInt64Bits(LocalDouble));
          end;
        end;
        SQL_VARYING:
        begin
          rdField.fdDataSize := Qry.Current[i].Data.sqllen;
          if RecordNumber >= 0 then
          begin
            rdField.fdDataLength := Marshal.ReadInt16(Qry.Current[i].Data.sqldata);
            if (rdField.fdDataLength = 0) then
              LocalData := nil
            else
              LocalData := IntPtr(Integer(Qry.Current[i].Data.sqldata) + 2);
          end;
        end;
        else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
        begin
          rdField.fdDataSize := Qry.Current[i].Data.sqllen;
          if (rdField.fdDataType = SQL_TEXT) then
          begin
            rdField.fdDataLength := rdField.fdDataSize;
            LocalData := Qry.Current[i].Data.sqldata;
          end;
        end;
      end;
      if RecordNumber < 0 then
      begin
        rdField.fdIsNull := True;
        rdField.fdDataOfs := FRecordSize;
        Inc(FRecordSize, rdField.fdDataSize);
      end
      else
      begin
        if rdField.fdDataType = SQL_VARYING then
        begin
          if LocalData <> nil then
            Marshal.Copy(BytesOf(Qry.Current[i].AsString), 0,
              IntPtr(Integer(Buffer) + rdField.fdDataOfs), Length(BytesOf(Qry.Current[i].AsString)))
          else
            Marshal.Copy(BytesOf(''), 0, IntPtr(Integer(Buffer) + rdField.fdDataOfs), 0);
        end
        else
        begin
          SetLength(b, rdField.fdDataSize);
          Marshal.Copy(LocalData, b, 0, rdField.fdDataSize);
          Marshal.Copy(b, 0, IntPtr(Integer(Buffer) + rdField.fdDataOfs), rdField.fdDataSize);
          if not ((rdField.fdDataType = SQL_TEXT) or
                  (rdField.fdDataType = SQL_BLOB) or
                  (rdField.fdDataType = SQL_ARRAY) or
                  (rdField.fdDataType = SQL_QUAD)) then
            Marshal.FreeHGlobal(LocalData);
        end;
      end;
      Marshal.StructureToPtr(TObject(rdField), IntPtr(Integer(Buffer) +
         Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) + (j * FieldDataSize)),
         false);
      LocalData := nil;
    end;
  end;
  WriteRecordCache(RecordNumber, Buffer);
end;

function TIBCustomDataSet.BufferAsRecordData(Buffer : TRecordBuffer) : TRecordData;
begin
  Result := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
end;

function TIBCustomDataSet.GetActiveBuf: IntPtr;
var
  Buf, OldBuf : TRecordData;
begin
  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:
    begin
      Buf := TRecordData(Marshal.PtrToStructure(ActiveBuffer, TypeOf(TRecordData)));
      OldBuf := TRecordData(Marshal.PtrToStructure(FOldBuffer, TypeOf(TRecordData)));
      if (Buf.rdSavedOffset <> $FFFFFFFF) then
      begin
        ReadCache(FOldBufferCache, Buf.rdSavedOffset, FILE_BEGIN,
                       FTempBuffer);
        result := FTempBuffer;
      end
      else
        if (Buf.rdRecordNumber = OldBuf.rdRecordNumber) then
          result := FOldBuffer
        else
          result := ActiveBuffer;
    end;
  else
    if not FOpen then
      result := nil
    else
      result := ActiveBuffer;
  end;
end;

function TIBCustomDataSet.CachedUpdateStatus: TCachedUpdateStatus;
begin
  if Active then
    result := TRecordData(Marshal.PtrToStructure(GetActiveBuf, TypeOf(TRecordData))).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; Buffer: TRecordBuffer);
var
  Buff : TRecordData;
begin
  Buff := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
  if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
    FUpdateObject.Apply(ukDelete)
  else
  begin
    SetInternalSQLParams(FQDelete, Buffer);
    FQDelete.ExecQuery;
    FRowsAffected := FQDelete.RowsAffected;
  end;
  Buff.rdUpdateStatus := usDeleted;
  Buff.rdCachedUpdateStatus := cusUnmodified;
  Marshal.StructureToPtr(TObject(Buff), Buffer, false);
  WriteRecordCache(Buff.rdRecordNumber, Buffer);
end;

function TIBCustomDataSet.InternalLocate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
var
  fl: TObjectList;
  CurBookmark: String;
  fld : Variant;
  val : Array of Variant;
  i, fld_cnt: Integer;
  fld_str : String;
begin
  fl := TObjectList.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 := WideUpperCase(fld_str);
              if (loPartialKey in Options) then
                result := result and (AnsiPos(val[i], fld_str) = 1)
              else
                result := result and (fld_str = val[i]);
            end
            else
              if TField(fl[i]).DataType in [ftDate, ftTime, ftDateTime] then
                Result := Result and (DateTimeToStr(val[i]) = DateTimeToStr(fld))
              else
              result := result and (val[i] = fld);
          end;
        end;
        Inc(i);
      end;
      if not result then
        Next;
    end;
    if not result then
      Bookmark := CurBookmark
    else
      CursorPosChanged;
  finally
    fl.Free;
    val := nil;
  end;
end;

procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: TRecordBuffer);
var
  i, j, k : Integer;
  pbd: IntPtr;
  rdField : TFieldData;
  Buffer : TRecordData;
begin
  pbd := (IntPtr(Integer(Buff) + FBlobCacheOffset));
  Buffer := TRecordData(Marshal.PtrToStructure(Buff, TypeOf(TRecordData)));
  j := 0;
  for i := 0 to FieldCount - 1 do
  begin
    if Fields[i].IsBlob then
    begin
      k := Marshal.ReadInt32(pbd, j * Marshal.SizeOf(TypeOf(IntPtr)));
      rdField := TFieldData(Marshal.PtrToStructure(IntPtr(Integer(Buff) +
            Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) +
            (FMappedFieldPosition[Fields[i].FieldNo -1] * FieldDataSize)), TypeOf(TFieldData)));
      if k <> -1 then
      begin
        FBlobStreamList[k].FinalizeBlob;
        Marshal.WriteInt32(Buff, rdField.fdDataOfs,FBlobStreamList[k].DBBlobID.gds_quad_high);
        Marshal.WriteInt32(Buff, rdField.fdDataOfs + 4, FBlobStreamList[k].DBBlobID.gds_quad_low);
        rdField.fdIsNull := FBlobStreamList[k].Size = 0;
      end;
      Marshal.StructureToPtr(TObject(rdField), IntPtr(Integer(Buff) +
            Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) +
            (FMappedFieldPosition[Fields[i].FieldNo -1] * FieldDataSize)), false);
      Inc(j);
    end;
  end;
  if Assigned(FUpdateObject) then
  begin
    if (Qry = FQDelete) then
      FUpdateObject.Apply(ukDelete)
    else
      if (Qry = FQInsert) then
        FUpdateObject.Apply(ukInsert)
      else
        FUpdateObject.Apply(ukModify);
  end
  else
  begin
    SetInternalSQLParams(Qry, Buff);
    Qry.ExecQuery;
    FRowsAffected := Qry.RowsAffected;
  end;
  Buffer.rdUpdateStatus := usUnmodified;
  Buffer.rdCachedUpdateStatus := cusUnmodified;
  Marshal.StructureToPtr(TObject(Buffer), Buff, false);
  SetModified(False);
  WriteRecordCache(Buffer.rdRecordNumber, Buff);
  if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
    InternalRefreshRow;
end;

procedure TIBCustomDataSet.InternalRefreshRow;
var
  Buff: IntPtr;
  Buffer : TRecordData;
  ofs: DWORD;
  Qry: TIBSQL;
begin
  Qry := nil;
  Buff := GetActiveBuf;
  Buffer := TRecordData(Marshal.PtrToStructure(Buff, TypeOf(TRecordData)));
  if CanRefresh then
  begin
    if Buff <> nil then
    begin
      if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then
      begin
        Qry := TIBSQL.Create(self);
        Qry.Database := Database;
        Qry.Transaction := Transaction;
        Qry.GoToFirstRecordOnExecute := False;
        Qry.SQL.Text := FUpdateObject.RefreshSQL.Text;
      end
      else
        Qry := FQRefresh;
      SetInternalSQLParams(Qry, Buff);
      Qry.ExecQuery;
      try
        if (Qry.SQLType = SQLExecProcedure) or
           (Qry.Next <> nil) then
        begin
          ofs := Buffer.rdSavedOffset;
          FetchCurrentRecordToBuffer(Qry, Buffer.rdRecordNumber, Buff);
          if FCachedUpdates and (ofs <> $FFFFFFFF) then
          begin
            Buffer.rdSavedOffset := ofs;
            Marshal.StructureToPtr(TObject(Buffer), Buff, false);
            WriteRecordCache(Buffer.rdRecordNumber, Buff);
            SaveOldBuffer(Buff);
          end;
        end;
      finally
        Qry.Close;
      end;
    end;
    if Qry <> FQRefresh then
      Qry.Free;
  end
  else
    IBError(ibxeCannotRefresh, [nil]);
end;

procedure TIBCustomDataSet.InternalRevertRecord(RecordNumber: Integer);
var
  NewBuffer, OldBuffer: IntPtr;
  NewBuf : TRecordData;
begin
  NewBuffer := nil;
  OldBuffer := nil;
  NewBuffer := AllocRecordBuffer;
  OldBuffer := AllocRecordBuffer;
  try
    ReadRecordCache(RecordNumber, NewBuffer, False);
    ReadRecordCache(RecordNumber, OldBuffer, True);
    NewBuf := TRecordData(Marshal.PtrToStructure(NewBuffer, TypeOf(TRecordData)));
    case NewBuf.rdCachedUpdateStatus of
      cusInserted:
      begin
        NewBuf.rdCachedUpdateStatus := cusUninserted;
        Marshal.StructureToPtr(TObject(NewBuf), NewBuffer, false);
        Inc(FDeletedRecords);
      end;
      cusModified,
      cusDeleted:
      begin
        if (NewBuf.rdCachedUpdateStatus = cusDeleted) then
          Dec(FDeletedRecords);
        CopyRecordBuffer(OldBuffer, NewBuffer);
      end;
    end;

    if State in dsEditModes then
      Cancel;

    WriteRecordCache(RecordNumber, NewBuffer);

    if (NewBuf.rdCachedUpdateStatus = cusUninserted) then
      ReSync([]);
  finally
    FreeRecordBuffer(NewBuffer);
    FreeRecordBuffer(OldBuffer);
  end;
end;

{ A visible record is one that is not truly deleted,
  and it is also listed in the FUpdateRecordTypes set }

function TIBCustomDataSet.IsVisible(Buffer: IntPtr): Boolean;
var
  Buff : TRecordData;
begin
  result := True;
  Buff := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
  if not (State = dsOldValue) then
    if Buff.rdRecordNumber >= 0 then
    result := (Buff.rdCachedUpdateStatus in FUpdateRecordTypes) and
              (not ((Buff.rdCachedUpdateStatus = cusUnmodified) and
              (Buff.rdUpdateStatus = usDeleted)))
    else
      Result := false;
end;


function TIBCustomDataSet.LocateNext(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
var
  b : TBookmark;
begin
  DisableControls;
  b := GetBookmark;
  try
    Next;
    Result := InternalLocate(KeyFields, KeyValues, Options);
    if not Result then
      GotoBookmark(b);  // Get back on the record we started with on failure
  finally
    FreeBookmark(b);
    EnableControls;
  end;
end;

procedure TIBCustomDataSet.InternalPrepare;
var
  DidActivate: Boolean;

  procedure PrepareSQL(iSQL : TIBSQL; SQLText : TStrings; lm : TLiveMode);
  begin
    try
      if Trim(SQLText.Text) <> '' then
      begin
        if not iSQL.Prepared then
          iSQL.Prepare;
        Include(FLiveMode, lm);
      end;
    except
     on E: Exception do
       if not (E is EIBInterbaseRoleError) then
         Raise;
    end;
  end;

begin
  if FInternalPrepared then
    Exit;
  if Trim(FQSelect.SQL.Text) = '' then
    IBError(ibxeEmptySQLStatement, []);
  DidActivate := False;
  try
    ActivateConnection;
    DidActivate := ActivateTransaction;
    FBase.CheckDatabase;
    FBase.CheckTransaction;
    if Trim(FQSelect.SQL.Text) <> '' then
    begin
      if not FQSelect.Prepared then
      begin
        FQSelect.ParamCheck := ParamCheck;
        FQSelect.Prepare;
      end;
      FLiveMode := [];
      PrepareSQL(FQDelete, FQDelete.SQL, lmDelete);
      PrepareSQL(FQInsert, FQInsert.SQL, lmInsert);
      PrepareSQL(FQModify, FQModify.SQL, lmModify);
      PrepareSQL(FQRefresh, FQRefresh.SQL, lmRefresh);

      FInternalPrepared := True;
      InternalInitFieldDefs;
    end
    else
      IBError(ibxeEmptyQuery, [nil]);
  finally
    if DidActivate then
      DeactivateTransaction;
  end;
end;

procedure TIBCustomDataSet.RecordModified(Value: Boolean);
begin
  SetModified(Value);
end;

procedure TIBCustomDataSet.RevertRecord;
var
  Buff: TRecordData;
begin
  if FCachedUpdates and FUpdatesPending then
  begin
    Buff := TRecordData(Marshal.PtrToStructure(GetActiveBuf, TypeOf(TRecordData)));
    InternalRevertRecord(Buff.rdRecordNumber);
    ReadRecordCache(Buff.rdRecordNumber, GetActiveBuf, False);
    DataEvent(deRecordChange, nil);
  end;
end;

procedure TIBCustomDataSet.SaveOldBuffer(Buffer: IntPtr);
var
  OldBuffer: IntPtr;
  Buff : TRecordData;

  procedure CopyOldBuffer;
  var
    Dest : IntPtr;
    i : Integer;
  begin
    CopyRecordBuffer(Buffer, OldBuffer);
    Dest := IntPtr(Integer(OldBuffer) + FBlobCacheOffset);
    for i := 0 to BlobFieldCount * SizeOf(TIBBlobStream) - 1 do
      Marshal.WriteByte(Dest, i, 0);
  end;

begin
  Buff := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
  if (Buffer <> nil) and (Buff.rdRecordNumber >= 0) then
  begin
    OldBuffer := AllocRecordBuffer;
    try
      if (Buff.rdSavedOffset = $FFFFFFFF) then
      begin
        Buff.rdSavedOffset := AdjustPosition(FOldBufferCache, 0, FILE_END);
        CopyOldBuffer;
        WriteCache(FOldBufferCache, 0, FILE_CURRENT, OldBuffer);
        WriteCache(FBufferCache, Buff.rdRecordNumber * FRecordBufferSize,
                     FILE_BEGIN, Buffer);
      end
      else begin
        CopyOldBuffer;
        WriteCache(FOldBufferCache, Buff.rdSavedOffset, FILE_BEGIN,
                   OldBuffer);
      end;
    finally
      FreeRecordBuffer(OldBuffer);
    end;
  end;
  Marshal.StructureToPtr(TObject(Buff), Buffer, false);
end;

procedure TIBCustomDataSet.SetBufferChunks(Value: Integer);
begin
  if (Value <= 0) then
    FBufferChunks := BufferCacheSize
  else
    FBufferChunks := Value;
end;

procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
begin
  if (FBase.Database <> Value) then
  begin
    CheckDatasetClosed;
    FBase.Database := Value;
    FQDelete.Database := Value;
    FQInsert.Database := Value;
    FQRefresh.Database := Value;
    FQSelect.Database := Value;
    FQModify.Database := Value;
  end;
end;

procedure TIBCustomDataSet.SetDeleteSQL(Value: TStrings);
begin
  if FQDelete.SQL.Text <> Value.Text then
  begin
    Disconnect;
    FQDelete.SQL.Assign(Value);
  end;
end;

procedure TIBCustomDataSet.SetInsertSQL(Value: TStrings);
begin
  if FQInsert.SQL.Text <> Value.Text then
  begin
    Disconnect;
    FQInsert.SQL.Assign(Value);
  end;
end;

procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: TRecordBuffer);
var
  i, j, k : Integer;
  data: TValueBuffer;
  fn: string;
  tBuff, OldBuffer: IntPtr;
  ts: TTimeStamp;
  cr, Buff : TRecordData;
  b : TBytes;
  quad : TISC_QUAD;
  rdField : TFieldData;

begin
  if (Buffer = nil) then
    IBError(ibxeBufferNotSet, [nil]);
  Buff := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
  if (not FInternalPrepared) then
    InternalPrepare;
  OldBuffer := AllocRecordBuffer;
  try
    for i := 0 to Qry.Params.Count - 1 do
    begin
      fn := Qry.Params[i].Name;
      if (Pos('OLD_', fn) = 1) then {mbcs ok}
      begin
        fn := Copy(fn, 5, Length(fn));
        ReadRecordCache(Buff.rdRecordNumber, OldBuffer, True);
        tBuff := OldBuffer;
      end
      else
      if (Pos('NEW_', fn) = 1) then {mbcs ok}
      begin
        fn := Copy(fn, 5, Length(fn));
        tBuff := Buffer;
      end
      else
        tBuff := Buffer;
      j := FQSelect.FieldIndex[fn];
      cr := TRecordData(Marshal.PtrToStructure(tBuff, TypeOf(TRecordData)));
      if (j >= 0) then
        with cr do
        begin
          rdField := TFieldData(Marshal.PtrToStructure(IntPtr(Integer(tBuff) +
            Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) +
            (j * FieldDataSize)), TypeOf(TFieldData)));
          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
          begin
            for k := 0 to 7 do
              Marshal.WriteByte(Qry.Params[i].AsIntPtr, k , rdDBKey.DBKey[k]);
            continue;
          end;
          if rdField.fdIsNull then
            Qry.Params[i].IsNull := True
          else
          begin
            Qry.Params[i].IsNull := False;
            data := TValueBuffer(Integer(tBuff) + rdField.fdDataOfs);
            case rdField.fdDataType of
              SQL_TEXT, SQL_VARYING:
              begin
                Qry.Params[i].AsString := Marshal.PtrToStringAnsi(data, rdField.fdDataLength);
              end;
            SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
              Qry.Params[i].AsDouble := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(data));
            SQL_SHORT, SQL_LONG:
            begin
              if rdField.fdDataScale = 0 then
                Qry.Params[i].AsLong := Marshal.ReadInt32(data)
              else
                if rdField.fdDataScale >= (-4) then
                  Qry.Params[i].AsCurrency :=
                    BitConverter.Int64BitsToDouble(Marshal.ReadInt64(data))
                else
                  if Fields[j].DataType = ftFloat then
                    Qry.Params[i].AsDouble := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(data))
                  else
                  begin
                    SetLength(B, SizeOfTBcd);
                    Marshal.Copy(Data, B, 0, Length(B));
                    Qry.Params[i].AsBcd := TBcd.FromBytes(B);
                  end;
            end;
            SQL_INT64:
            begin
              if rdField.fdDataScale = 0 then
                Qry.Params[i].AsInt64 := Marshal.ReadInt64(data)
              else
                if rdField.fdDataScale >= (-4) then
                  Qry.Params[i].AsCurrency :=
                     BitConverter.Int64BitsToDouble(Marshal.ReadInt64(data))
                else
                  if Fields[j].DataType = ftFloat then
                    Qry.Params[i].AsDouble := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(data))
                  else
                  begin
                    SetLength(B, SizeOfTBcd);
                    Marshal.Copy(Data, B, 0, Length(B));
                    Qry.Params[i].AsBcd := TBcd.FromBytes(B);
                  end;
            end;
            SQL_BLOB, SQL_ARRAY, SQL_QUAD:
            begin
              Quad.gds_quad_high := Marshal.ReadInt32(data);
              Quad.gds_quad_low := Marshal.ReadInt32(data, 4);
              Qry.Params[i].AsQuad := Quad;
            end;
            SQL_TYPE_DATE:
            begin
              ts.Date := Marshal.ReadInt32(data);
              ts.Time := 0;
              Qry.Params[i].AsDate := TimeStampToDateTime(ts);
            end;
            SQL_TYPE_TIME:
            begin
              ts.Date := DateDelta;
              ts.Time := Marshal.ReadInt32(data);
              Qry.Params[i].AsTime := TimeStampToDateTime(ts);
            end;
            SQL_TIMESTAMP:
            begin
              Qry.Params[i].AsDateTime :=
                TimeStampToDateTime(
                  MSecsToTimeStamp(trunc(BitConverter.Int64BitsToDouble(Marshal.ReadInt64(data)))));
            end;
            SQL_BOOLEAN:
               Qry.Params[i].AsBoolean := (Marshal.ReadInt32(data) = ISC_TRUE);
          end;
        end;
      end;
    end;
  finally
    if (OldBuffer <> nil) then
      FreeRecordBuffer(OldBuffer);
  end;
end;

procedure TIBCustomDataSet.SetRefreshSQL(Value: TStrings);
begin
  if FQRefresh.SQL.Text <> Value.Text then
  begin
    Disconnect;
    FQRefresh.SQL.Assign(Value);
  end;
end;

procedure TIBCustomDataSet.SetSelectSQL(Value: TStrings);
begin
  if FQSelect.SQL.Text <> Value.Text then
  begin
    Disconnect;
    FQSelect.SQL.Assign(Value);
  end;
end;

procedure TIBCustomDataSet.SetModifySQL(Value: TStrings);
begin
  if FQModify.SQL.Text <> Value.Text then
  begin
    Disconnect;
    FQModify.SQL.Assign(Value);
  end;
end;

procedure TIBCustomDataSet.SetTransaction(Value: TIBTransaction);
begin
  if (FBase.Transaction <> Value) then
  begin
    CheckDatasetClosed;
    if FInternalPrepared then
      InternalUnPrepare;
    FBase.Transaction := Value;
    FQDelete.Transaction := Value;
    FQInsert.Transaction := Value;
    FQRefresh.Transaction := Value;
    FQSelect.Transaction := Value;
    FQModify.Transaction := Value;
  end;
end;

procedure TIBCustomDataSet.SetUniDirectional(Value: Boolean);
begin
  CheckDatasetClosed;
  FUniDirectional := Value;
end;

procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
begin
  FUpdateRecordTypes := Value;
  if Active then
    First;
end;

procedure TIBCustomDataSet.RefreshParams;
var
  DataSet: TDataSet;

  function NeedsRefreshing : Boolean;
  var
    i : Integer;
    cur_param: TIBXSQLVAR;
    cur_field: TField;

  begin
    Result := true;
    i := 0;
    while (i < SQLParams.Count) and (Result) do
    begin
      cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
      cur_param := SQLParams[i];
      if (cur_field <> nil) then
      begin
        if (cur_field.IsNull) then
          Result := Result and cur_param.IsNull
        else
        case cur_field.DataType of
          ftString:
            Result := Result and (cur_param.AsString = cur_field.AsString);
          ftBoolean, ftSmallint, ftWord:
            Result := Result and (cur_param.AsShort = cur_field.AsInteger);
          ftInteger:
            Result := Result and (cur_param.AsLong = cur_field.AsInteger);
          ftLargeInt:
            Result := Result and (cur_param.AsInt64 = TLargeIntField(cur_field).AsLargeInt);
          ftFloat, ftCurrency:
            Result := Result and (cur_param.AsDouble = cur_field.AsFloat);
          ftBCD:
            Result := Result and (cur_param.AsCurrency = cur_field.AsCurrency);
          ftFMTBCD:
            Result := Result and (TBcd.Compare(cur_param.AsBcd, cur_field.AsBCD) = 0);
          ftDate:
            Result := Result and (cur_param.AsDate = cur_field.AsDateTime);
          ftTime:
            Result := Result and (cur_param.AsTime = cur_field.AsDateTime);
          ftDateTime:
            Result := Result and (cur_param.AsDateTime = cur_field.AsDateTime);
          else
            Result := false;
        end;
      end;
      Inc(i);
    end;
    Result := not Result;
  end;

begin
  DisableControls;
  try
    if FDataLink.DataSource <> nil then
    begin
      DataSet := FDataLink.DataSource.DataSet;
      if DataSet <> nil then
        if DataSet.Active and (DataSet.State <> dsSetKey) and NeedsRefreshing then
        begin
          Close;
          Open;
        end;
    end;
  finally
    EnableControls;
  end;
end;


procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
begin
  if FOpen then
    Close;
  if FInternalPrepared then
    InternalUnPrepare;
  if Sender = FQSelect then
    FieldDefs.Clear;
end;

{ I can "undelete" uninserted records (make them "inserted" again).
  I can "undelete" cached deleted (the deletion hasn't yet occurred) }
procedure TIBCustomDataSet.Undelete;
var
  Buff: TRecordData;
begin
  CheckActive;
  Buff := TRecordData(Marshal.PtrToStructure(GetActiveBuf, TypeOf(TRecordData)));
  with Buff do
  begin
    if rdCachedUpdateStatus = cusUninserted then
    begin
      rdCachedUpdateStatus := cusInserted;
      Dec(FDeletedRecords);
    end
    else if (rdUpdateStatus = usDeleted) and
            (rdCachedUpdateStatus = cusDeleted) then
    begin
      rdCachedUpdateStatus := cusUnmodified;
      rdUpdateStatus := usUnmodified;
      Dec(FDeletedRecords);
    end;
    Marshal.StructureToPtr(TObject(Buff), GetActiveBuf, false);
    WriteRecordCache(rdRecordNumber, GetActiveBuf);
  end;
end;

function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
begin
  if Active then
    if GetActiveBuf <> nil then
      result := TRecordData(Marshal.PtrToStructure(GetActiveBuf, TypeOf(TRecordData))).rdUpdateStatus
    else
      result := usUnmodified
  else
    result := usUnmodified;
end;

function TIBCustomDataSet.IsSequenced: Boolean;
begin
  Result := Assigned( FQSelect ) and FQSelect.EOF;
end;

function TIBCustomDataSet.AdjustPosition(FCache: IntPtr; Offset: DWORD;
                                        Origin: Integer): Integer;
var
  OldCacheSize: Integer;
begin
  if (FCache = FBufferCache) then
  begin
    case Origin of
      FILE_BEGIN:    FBPos := Offset;
      FILE_CURRENT:  FBPos := FBPos + Offset;
      FILE_END:      FBPos := DWORD(FBEnd) + Offset;
    end;
    OldCacheSize := FCacheSize;
    while (FBPos >= DWORD(FCacheSize)) do
      Inc(FCacheSize, FBufferChunkSize);
    if FCacheSize > OldCacheSize then
      IBAlloc(FBufferCache, OldCacheSize, FCacheSize);
    result := FBPos;
  end
  else begin
    case Origin of
      FILE_BEGIN:    FOBPos := Offset;
      FILE_CURRENT:  FOBPos := FOBPos + Offset;
      FILE_END:      FOBPos := DWORD(FOBEnd) + Offset;
    end;
    OldCacheSize := FOldCacheSize;
    while (FBPos >= DWORD(FOldCacheSize)) do
      Inc(FOldCacheSize, FBufferChunkSize);
    if FOldCacheSize > OldCacheSize then
      IBAlloc(FOldBufferCache, FOldCacheSize, FOldCacheSize);
    result := FOBPos;
  end;
end;

procedure TIBCustomDataSet.ReadCache(FCache: IntPtr; Offset: DWORD; Origin: Integer;
                                    Buffer: IntPtr);
var
  pCache: IntPtr;
  bOld: Boolean;
  Buff : TRecordData;
begin
  bOld := (FCache = FOldBufferCache);
  pCache := IntPtr(AdjustPosition(FCache, Offset, Origin));
  if not bOld then
    pCache := IntPtr(Integer(FBufferCache) + Integer(pCache))
  else
    pCache := IntPtr(Integer(FOldBufferCache) + Integer(pCache));
  CopyRecordBuffer(pCache, Buffer);
  AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
end;

procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: IntPtr;
                                          ReadOldBuffer: Boolean);
var
  Buff : TRecordData;
begin
  if FUniDirectional then
    RecordNumber := RecordNumber mod UniCache;
  if (ReadOldBuffer) then
  begin
    ReadRecordCache(RecordNumber, Buffer, False);
    Buff := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
    if FCachedUpdates and
      (Buff.rdSavedOffset <> $FFFFFFFF) then
      ReadCache(FOldBufferCache, Buff.rdSavedOffset, FILE_BEGIN,
                Buffer)
    else
    begin
      Buff := TRecordData(Marshal.PtrToStructure(FOldBuffer, TypeOf(TRecordData)));
      if ReadOldBuffer and
         (Buff.rdRecordNumber = RecordNumber) then
         CopyRecordBuffer( FOldBuffer, Buffer );
    end
  end
  else
    ReadCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
end;

procedure TIBCustomDataSet.WriteCache(FCache: IntPtr; Offset: DWORD; Origin: Integer;
                                     Buffer: IntPtr);
var
  pCache: IntPtr;
  bOld: Boolean;
  dwEnd: DWORD;
begin
  bOld := (FCache = FOldBufferCache);
  pCache := IntPtr(AdjustPosition(FCache, Offset, Origin));
  if not bOld then
    pCache := IntPtr(Integer(FBufferCache) + Integer(pCache))
  else
    pCache := IntPtr(Integer(FOldBufferCache) + Integer(pCache));
  CopyRecordBuffer(Buffer, pCache);

  dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
  if not bOld then
  begin
    if (dwEnd > FBEnd) then
      FBEnd := dwEnd;
  end
  else
  begin
    if (dwEnd > FOBEnd) then
      FOBEnd := dwEnd;
  end;
end;

procedure TIBCustomDataSet.WriteRecordCache(RecordNumber: Long; Buffer: TRecordBuffer);
begin
  if RecordNumber >= 0 then
  begin
    if FUniDirectional then
      RecordNumber := RecordNumber mod UniCache;
    WriteCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
  end;
end;

function TIBCustomDataSet.AllocRecordBuffer: IntPtr;
begin
  result := nil;
  IBAlloc(result, 0, FRecordBufferSize);
  CopyRecordBuffer(FModelBuffer, Result);
end;

function TIBCustomDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
var
  pbd: IntPtr;
  fs: TIBBlobStream;
  Buff: IntPtr;
  Buffer : TRecordData;
  bTr, bDB: Boolean;
  Quad : TISC_QUAD;
  rdField : TFieldData;
  NewLength : Integer;
begin
  Buff := GetActiveBuf;
  NewLength := Length(FBlobStreamList) + 1;
  if Buff = nil then
  begin
    fs := TIBBlobStream.Create;
    fs.Mode := bmReadWrite;
    SetLength(FBlobStreamList, NewLength);
    FBlobStreamList[High(FBlobStreamList)] := fs;
    result := TIBDSBlobStream.Create(Field, fs, Mode);
    exit;
  end;
  pbd := IntPtr(Integer(Buff) + FBlobCacheOffset);
  if Marshal.ReadInt32(pbd, Field.Offset * SizeOf(Integer)) = -1 then
  begin
    AdjustRecordOnInsert(Buff);
    Buffer := TRecordData(Marshal.PtrToStructure(Buff, TypeOf(TRecordData)));
    fs := TIBBlobStream.Create;
    SetLength(FBlobStreamList, NewLength);
    Dec(NewLength);
    FBlobStreamList[NewLength] := fs;
    fs.Mode := bmReadWrite;
    fs.Database := Database;
    fs.Transaction := Transaction;
    rdField := TFieldData(Marshal.PtrToStructure(IntPtr(Integer(Buff) +
                 Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) +
                   (FMappedFieldPosition[Field.FieldNo - 1] * FieldDataSize)), TypeOf(TFieldData)));
    Quad.gds_quad_high :=  Marshal.ReadInt32(Buff, rdField.fdDataOfs);
    Quad.gds_quad_low := Marshal.ReadInt32(Buff, rdField.fdDataOfs + 4);
    fs.DBBlobID := QUAD;
    Marshal.WriteInt32(IntPtr(Integer(pbd) + Field.Offset * SizeOf(Integer)), NewLength);
    if (CachedUpdates) then
    begin
      bTr := not Transaction.InTransaction;
      bDB := not Database.Connected;
      if bDB then
        Database.Open;
      if bTr then
        Transaction.StartTransaction;
      fs.Seek(0, soBeginning);
      if bTr then
        Transaction.Commit;
      if bDB then
        Database.Close;
    end;
    WriteRecordCache(Buffer.rdRecordNumber, Buff);
  end
  else
    fs := FBlobStreamList[Marshal.ReadInt32(IntPtr(Integer(pbd) + Field.Offset * SizeOf(Integer)))];
  result := TIBDSBlobStream.Create(Field, fs, Mode);
end;

function TIBCustomDataSet.CompareBookmarks(const Bookmark1, Bookmark2: TBookmark): Integer;
const
  CMPLess = -1;
  CMPEql  =  0;
  CMPGtr  =  1;
  RetCodes: array[Boolean, Boolean] of ShortInt = ((2, CMPLess),
                                                   (CMPGtr, CMPEql));
begin
  result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];

  if Result = 2 then
  begin
    if Marshal.ReadInt32(Bookmark1) < Marshal.ReadInt32(Bookmark2) then
      Result := CMPLess
    else
    if Marshal.ReadInt32(Bookmark1) > Marshal.ReadInt32(Bookmark2) then
      Result := CMPGtr
    else
      Result := CMPEql;
  end;
end;

procedure TIBCustomDataSet.DoBeforeDelete;
var
  Buff: TRecordData;
begin
  if not CanDelete then
    IBError(ibxeCannotDelete, [nil]);
  Buff := TRecordData(Marshal.PtrToStructure(GetActiveBuf, TypeOf(TRecordData)));
  if FCachedUpdates and
    (Buff.rdCachedUpdateStatus in [cusUnmodified]) then
    SaveOldBuffer(GetActiveBuf);
  inherited DoBeforeDelete;
end;

procedure TIBCustomDataSet.DoBeforeEdit;
var
  Buff: TRecordData;
begin
  inherited DoBeforeEdit;
  Buff := TRecordData(Marshal.PtrToStructure(GetActiveBuf, TypeOf(TRecordData)));
  if not(CanEdit or
    (FCachedUpdates and Assigned(FOnUpdateRecord))) then
    IBError(ibxeCannotUpdate, [nil]);
  if FCachedUpdates and (Buff.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
    SaveOldBuffer(GetActiveBuf);
  CopyRecordBuffer(GetActiveBuf, FOldBuffer);
end;

procedure TIBCustomDataSet.DoBeforeInsert;
begin
  if not CanInsert then
    IBError(ibxeCannotInsert, [nil]);
  inherited DoBeforeInsert;
end;

procedure TIBCustomDataSet.FetchAll;
var
  CurBookmark: String;
begin
  if FQSelect.EOF or not FQSelect.Open then
    exit;
  DisableControls;
  try
    CurBookmark := Bookmark;
    Last;
    Bookmark := CurBookmark;
  finally
    EnableControls;
  end;
end;

procedure TIBCustomDataSet.FreeRecordBuffer(var Buffer: IntPtr);
begin
  Marshal.FreeHGlobal(Buffer);
  Buffer := nil;
end;

procedure TIBCustomDataSet.GetBookmarkData(Buffer: TRecordBuffer; var Data: TBookmark);
begin
  if not IsEmpty then
    Marshal.WriteInt32(Data,
      TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData))).rdRecordNumber);
end;

function TIBCustomDataSet.GetBookmarkFlag(Buffer: IntPtr): TBookmarkFlag;
begin
  result := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData))).rdBookmarkFlag;
end;

function TIBCustomDataSet.GetCanModify: Boolean;
begin
  result := ([lmInsert, lmModify, lmDelete] * FLiveMode <> []) or
            (Assigned(FUpdateObject));
end;

function TIBCustomDataSet.GetCurrentRecord(Buffer: IntPtr): Boolean;
begin
  if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
  begin
    UpdateCursorPos;
    ReadRecordCache(
      TRecordData(Marshal.PtrToStructure(ActiveBuffer, TypeOf(TRecordData))).rdRecordNumber,
      Buffer, False);
    result := True;
  end
  else
    result := False;
end;

function TIBCustomDataSet.GetDataSource: TDataSource;
begin
  if FDataLink = nil then
    result := nil
  else
    result := FDataLink.DataSource;
end;

function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
begin
  Result := DefaultFieldClasses[FieldType];
end;

function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: IntPtr): Boolean;
var
  Buff, Data: IntPtr;
  CurrentRecord: TRecordData;
  I: Integer;
  rdField : TFieldData;
  b : TBytes;
begin
  result := False;
  Buff := GetActiveBuf;
  if (Buff = nil) or (not IsVisible(Buff)) then
    exit;
  { The intention here is to stuff the buffer with the data for the
   referenced field for the current record }
  CurrentRecord := TRecordData(Marshal.PtrToStructure(Buff, TypeOf(TRecordData)));
  if (Field.FieldNo < 0) then
  begin
    Buff := IntPtr(Integer(Buff) + FRecordSize + Field.Offset);
    result := Boolean(Marshal.ReadByte(Buff));
    if result and (Buffer <> nil) then
    begin
      SetLength(b, Field.DataSize);
      Marshal.Copy(IntPtr(Integer(Buff) + 1), b, 0, Field.DataSize);
      Marshal.Copy(b, 0, Buffer, Field.DataSize);
    end;
  end
  else
  if (FMappedFieldPosition[Field.FieldNo - 1] >= 0) and
     (FMappedFieldPosition[Field.FieldNo - 1] < CurrentRecord.rdFieldCount) then
  begin
    rdField := TFieldData(Marshal.PtrToStructure(IntPtr(Integer(Buff) +
                 Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) +
                   (FMappedFieldPosition[Field.FieldNo - 1] * FieldDataSize)), TypeOf(TFieldData)));
    result := not rdField.fdIsNull;
    if result and (Buffer <> nil) then
      with rdField do
      begin
        Data := IntPtr(Integer(Buff) + fdDataOfs);
        if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
        begin
          if fdDataLength <= Field.Size then
          begin
            if (Field is TStringfield) and TStringField(Field).FixedChar then
              for I := 0 to Field.Size - 1  do
                Marshal.WriteByte(Buffer, I, Byte(' '));
            SetLength(b, fdDataLength);
            Marshal.Copy(Data, b, 0, fdDataLength);
            Marshal.Copy(b, 0, Buffer, fdDataLength);
            if (Field is TStringfield) and TStringField(Field).FixedChar then
              Marshal.WriteByte(Buffer, Field.Size, 0)
            else
              Marshal.WriteByte(Buffer, fdDataLength, 0);
            if (fdDataType = SQL_TEXT) and (not TStringField(Field).FixedChar) then
              Marshal.WriteByte(Buffer, Length(TrimRight(Marshal.PtrToStringAnsi(Buffer))), 0);
          end
          else
            IBError(ibxeFieldSizeMismatch, [Field.FieldName]);
        end
        else
        begin
          SetLength(b, Field.DataSize);
          Marshal.Copy(Data, b, 0, Field.DataSize);
          Marshal.Copy(b, 0, Buffer, Field.DataSize);
        end;
      end;
  end;
end;

function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: IntPtr): Boolean;
var
  lTempCurr : Borland.Delphi.System.Currency;
  ip : IntPtr;
  b : TBcd;
begin
  if (Field.DataType = ftBCD) and (Buffer <> nil) then
  begin
    Marshal.StructureToPtr(TObject(lTempCurr), ip, false);
    Result := InternalGetFieldData(Field, ip);
    if Result then
      b := TBcd(Marshal.PtrToStructure(Buffer, TypeOf(TBCD)));
  end
  else
    Result := InternalGetFieldData(Field, Buffer);
end;

function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: IntPtr; NativeFormat: Boolean): Boolean;
begin
  if (Field.DataType = ftBCD) and not NativeFormat then
    Result := InternalGetFieldData(Field, Buffer)
  else
    Result := inherited GetFieldData(Field, Buffer, NativeFormat);
end;

{ GetRecNo and SetRecNo both operate off of 1-based indexes as
 opposed to 0-based indexes.
 This is because we want LastRecordNumber/RecordCount = 1 }

function TIBCustomDataSet.GetRecNo: Integer;
begin
  if GetActiveBuf = nil then
    result := 0
  else
    result := TRecordData(Marshal.PtrToStructure(GetActiveBuf, TypeOf(TRecordData))).rdRecordNumber + 1;
end;

function TIBCustomDataSet.GetRecord(Buffer: IntPtr; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
var
  Accept: Boolean;
  SaveState: TDataSetState;
begin
  Result := grOK;
  if Filtered and Assigned(OnFilterRecord) then
  begin
    Accept := False;
    SaveState := SetTempState(dsFilter);
    while not Accept do
    begin
      Result := InternalGetRecord(Buffer, GetMode, DoCheck);
      if Result <> grOK then
        break;
      FFilterBuffer := Buffer;
      Accept := True;
      OnFilterRecord(Self, Accept);
      if not Accept and (GetMode = gmCurrent) then
        GetMode := gmPrior;
    end;
    RestoreState(SaveState);
  end
  else
    Result := InternalGetRecord(Buffer, GetMode, DoCheck);
end;

function TIBCustomDataSet.InternalGetRecord(Buffer: IntPtr; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
begin
  result := grError;
  case GetMode of
    gmCurrent:
    begin
      if (FCurrentRecord >= 0) then
      begin
        if FCurrentRecord < FRecordCount then
          ReadRecordCache(FCurrentRecord, Buffer, False)
        else
        begin
          while (not FQSelect.EOF) and
                (FCurrentRecord >= FRecordCount) do
          begin
            if FQSelect.Next = nil then
              break;
            FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
            Inc(FRecordCount);
          end;
          FCurrentRecord := FRecordCount - 1;
          if (FCurrentRecord >= 0) then
            ReadRecordCache(FCurrentRecord, Buffer, False);
        end;
        result := grOk;
      end
      else
        result := grBOF;
    end;
    gmNext:
    begin
      result := grOk;
      if FCurrentRecord = FRecordCount then
        result := grEOF
      else
      if FCurrentRecord = FRecordCount - 1 then
      begin
        if (not FQSelect.EOF) then
        begin
          FQSelect.Next;
          Inc(FCurrentRecord);
        end;
        if (FQSelect.EOF) then
        begin
          result := grEOF;
        end
        else
        begin
          Inc(FRecordCount);
          FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
        end;
      end
      else
        if (FCurrentRecord < FRecordCount) then
        begin
          Inc(FCurrentRecord);
          ReadRecordCache(FCurrentRecord, Buffer, False);
        end;
    end;
    else { gmPrior }
    begin
      if (FCurrentRecord = 0) then
      begin
        Dec(FCurrentRecord);
        result := grBOF;
      end
      else
        if (FCurrentRecord > 0) and
                    (FCurrentRecord <= FRecordCount) then
        begin
          Dec(FCurrentRecord);
          ReadRecordCache(FCurrentRecord, Buffer, False);
          result := grOk;
        end
        else
          if (FCurrentRecord = -1) then
            result := grBOF;
    end;
  end;
  if result = grOk then
    result := AdjustCurrentRecord(Buffer, GetMode);
  if result = grOk then
  begin
    Marshal.WriteInt16(buffer, Ord(bfCurrent));
    GetCalcFields(Buffer);
  end
  else
    if (result = grEOF) then
    begin
      CopyRecordBuffer(FModelBuffer, Buffer);
      Marshal.WriteInt16(buffer, Ord(bfEOF));
    end
    else
      if (result = grBOF) then
      begin
        CopyRecordBuffer(FModelBuffer, Buffer);
        Marshal.WriteInt16(buffer, Ord(bfBOF));
      end
      else
        if (result = grError) then
        begin
          CopyRecordBuffer(FModelBuffer, Buffer);
          Marshal.WriteInt16(buffer, Ord(bfEOF));
        end;
end;

function TIBCustomDataSet.GetRecordCount: Integer;
begin
  result := FRecordCount - FDeletedRecords;
end;

function TIBCustomDataSet.GetRecordSize: Word;
begin
  result := FRecordBufferSize;
end;

procedure TIBCustomDataSet.InternalAddRecord(Buffer: IntPtr; Append: Boolean);
var
  Buff : TRecordData;
begin
  CheckEditState;
  begin
     { When adding records, we *always* append.
       Insertion is just too costly }
    Buff := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
    AdjustRecordOnInsert(Buffer);
    with Buff do
    begin
      rdUpdateStatus := usInserted;
      rdCachedUpdateStatus := cusInserted;
    end;
    if not CachedUpdates then
      InternalPostRecord(FQInsert, Buffer)
    else
    begin
      Marshal.StructureToPtr(TObject(Buff), Buffer, false);
      WriteRecordCache(FCurrentRecord, Buffer);
      FUpdatesPending := True;
    end;
    Inc(FRecordCount);
    Marshal.StructureToPtr(TObject(Buff), Buffer, false);
    InternalSetToRecord(Buffer);
  end
end;

procedure TIBCustomDataSet.InternalCancel;
var
  Buff: IntPtr;
  Buffer : TRecordData;
  CurRec, i, j, k : Integer;
  pbd: IntPtr;
begin
  inherited InternalCancel;
  Buff := GetActiveBuf;
  if Buff <> nil then
  begin
    CurRec := FCurrentRecord;
    AdjustRecordOnInsert(Buff);
    if (State = dsEdit) then
    begin
      CopyRecordBuffer(FOldBuffer, Buff);
      Buffer := TRecordData(Marshal.PtrToStructure(Buff, TypeOf(TRecordData)));
      WriteRecordCache(Buffer.rdRecordNumber, Buff);
    end
    else
    begin
      CopyRecordBuffer(FModelBuffer, Buff);
      Buffer := TRecordData(Marshal.PtrToStructure(Buff, TypeOf(TRecordData)));
      Buffer.rdUpdateStatus := usDeleted;
      Buffer.rdCachedUpdateStatus := cusUnmodified;
      Buffer.rdBookmarkFlag := bfEOF;
      FCurrentRecord := CurRec;
      Marshal.StructureToPtr(TObject(Buffer), Buff, false);
    end;

    pbd := (IntPtr(Integer(Buff) + FBlobCacheOffset));
    j := 0;
    for i := 0 to FieldCount - 1 do
      if Fields[i].IsBlob then
      begin
        k := Marshal.ReadInt32(pbd, j * Marshal.SizeOf(TypeOf(IntPtr)));
        if k > 0 then
          FBlobStreamList[k].Cancel;
        inc(j);
      end;
  end;
end;

procedure TIBCustomDataSet.InternalClose;
begin
  if Assigned(Transaction) then
    Transaction.CheckAutoStop;
  FQSelect.Close;
  ClearBlobCache;
  FreeRecordBuffer(FModelBuffer);
  FreeRecordBuffer(FOldBuffer);
  FreeRecordBuffer(FTempBuffer);
  FCurrentRecord := -1;
  FOpen := False;
  FRecordCount := 0;
  FDeletedRecords := 0;
  FRecordSize := 0;
  FBPos := 0;
  FOBPos := 0;
  FCacheSize := 0;
  FOldCacheSize := 0;
  FBEnd := 0;
  FOBEnd := 0;
  Marshal.FreeHGlobal(FBufferCache);
  FBufferCache := nil;
  Marshal.FreeHGlobal(FOldBufferCache);
  FOldBufferCache := nil;
  BindFields(False);
  FUpdatesPending := false;
  if DefaultFields then
    DestroyFields;
end;

procedure TIBCustomDataSet.InternalDelete;
var
  Buff: IntPtr;
  Buffer : TRecordData;
begin
  Buff := GetActiveBuf;
  if CanDelete then
  begin
    if not CachedUpdates then
      InternalDeleteRecord(FQDelete, Buff)
    else
    begin
      Buffer := TRecordData(Marshal.PtrToStructure(Buff, TypeOf(TRecordData)));
      with Buffer do
      begin
        if rdCachedUpdateStatus = cusInserted then
          rdCachedUpdateStatus := cusUninserted
        else
        begin
          rdUpdateStatus := usDeleted;
          rdCachedUpdateStatus := cusDeleted;
        end;
      end;
      Marshal.StructureToPtr(TObject(Buffer), Buff, false);
      WriteRecordCache(Buffer.rdRecordNumber, Buff);
    end;
    Inc(FDeletedRecords);
    FUpdatesPending := True;
  end
  else
    IBError(ibxeCannotDelete, [nil]);
end;

procedure TIBCustomDataSet.InternalFirst;
begin
  FCurrentRecord := -1;
end;

procedure TIBCustomDataSet.InternalGotoBookmark(const Bookmark: TBookmark);
begin
  FCurrentRecord := Marshal.ReadInt32(Bookmark);
end;

procedure TIBCustomDataSet.InternalHandleException;
begin
end;

procedure TIBCustomDataSet.InternalInitFieldDefs;
var
  FieldType: TFieldType;
  FieldSize: Word;
  FieldNullable : Boolean;
  i, FieldPosition, FieldPrecision, FieldIndex: Integer;
  FieldAliasName: string;
  RelationName, FieldName: string;

begin
  if not InternalPrepared then
  begin
    InternalPrepare;
    exit;
  end;
  FNeedsRefresh := False;
  try
    FieldDefs.BeginUpdate;
    FieldDefs.Clear;
    FieldIndex := 0;
    if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
      SetLength(FMappedFieldPosition, FQSelect.Current.Count);
    for i := 0 to FQSelect.Current.Count - 1 do
      with FQSelect.Current[i].Data do
      begin
        { Get the field name }
        FieldAliasName := aliasname;
        RelationName := relname;
        FieldName := sqlname;
        FieldSize := 0;
        FieldPrecision := 0;
        FieldNullable := FQSelect.Current[i].IsNullable;
        case sqltype and not 1 of
          { All VARCHAR's must be converted to strings before recording
           their values }
          SQL_VARYING, SQL_TEXT:
          begin
            FieldSize := sqllen;
            FieldType := ftString;
          end;
          { All Doubles/Floats should be cast to doubles }
          SQL_DOUBLE, SQL_FLOAT:
            FieldType := ftFloat;
          SQL_SHORT:
          begin
            if (sqlscale = 0) then
              FieldType := ftSmallInt
            else
            begin
              FieldType := ftBCD;
              FieldPrecision := SqlPrecision;
              FieldSize := -sqlscale;
              if FieldPrecision = FieldSize then
                Inc(FieldPrecision);
            end;
          end;
          SQL_LONG:
          begin
            if (sqlscale = 0) then
              FieldType := ftInteger
            else
              if (sqlscale >= (-4)) then
              begin
                FieldType := ftBCD;
                FieldPrecision := SqlPrecision;
                FieldSize := -sqlscale;
                if FieldPrecision = FieldSize then
                  Inc(FieldPrecision);
              end
              else
                if Database.SQLDialect = 1 then
                  FieldType := ftFloat
                else
                  if (FieldCount > i) and (Fields[i] is TFloatField) then
                    FieldType := ftFloat
                  else
                  begin
                    FieldType := ftFMTBCD;
                    FieldPrecision := SqlPrecision;
                    FieldSize := -sqlscale;
                    if FieldPrecision = FieldSize then
                      Inc(FieldPrecision);
                  end;
              end;
          SQL_INT64:
          begin
            if (sqlscale = 0) then
              FieldType := ftLargeInt
            else
              if (sqlscale >= (-4)) then
              begin
                FieldType := ftBCD;
                FieldPrecision := SqlPrecision;
                FieldSize := -sqlscale;
              end
              else
              begin
                if (FieldCount > i) and (Fields[i] is TFloatField) then
                  FieldType := ftFloat
                else
                begin
                  FieldType := ftFMTBCD;
                  FieldPrecision := SqlPrecision;
                  FieldSize := -sqlscale;
                  if FieldPrecision = FieldSize then
                    Inc(FieldPrecision);
                end;
              end;
          end;
          SQL_TIMESTAMP: FieldType := ftDateTime;
          SQL_TYPE_TIME: FieldType := ftTime;
          SQL_TYPE_DATE: FieldType := ftDate;
          SQL_BLOB:
          begin
            FieldSize := Marshal.SizeOf(TypeOf(TISC_QUAD));
            if (sqlsubtype = 1) then
              FieldType := ftmemo
            else
              FieldType := ftBlob;
          end;
          SQL_ARRAY:
          begin
            FieldSize := sizeof (TISC_QUAD);
            FieldType := ftUnknown;
          end;
          SQL_BOOLEAN:
            FieldType := ftBoolean;
          else
            FieldType := ftUnknown;
        end;
        FieldPosition := i;
        if (FieldType <> ftUnknown) and (FieldAliasName <> 'IBX_INTERNAL_DBKEY') then {do not localize}
        begin
          FMappedFieldPosition[FieldIndex] := FieldPosition;
          Inc(FieldIndex);
          with FieldDefs.AddFieldDef do
          begin
            Name := FieldAliasName;
            FieldNo := FieldPosition + 1;
            DataType := FieldType;
            Size := FieldSize;
            Precision := FieldPrecision;
            Required := (not FieldNullable) and (Trim(RelationName) <> '');
            InternalCalcField := False;
            if (FieldName <> '') and (RelationName <> '') then
            begin
              if Database.Has_COMPUTED_BLR(RelationName, FieldName) then
              begin
                Attributes := [faReadOnly];
                InternalCalcField := True;
                FNeedsRefresh := True;
              end
              else
              begin
                if Database.Has_DEFAULT_VALUE(RelationName, FieldName) then
                begin
                  Attributes := Attributes - [faRequired];
                  FNeedsRefresh := True;
                end;
              end;
            end;
            if ((SQLType and not 1) = SQL_TEXT) then
              Attributes := Attributes + [faFixed];
          end;
        end;
      end;
  finally
    FieldDefs.EndUpdate;
  end;
end;

procedure TIBCustomDataSet.InternalInitRecord(Buffer: IntPtr);
begin
  CopyRecordBuffer(FModelBuffer, Buffer);
end;

procedure TIBCustomDataSet.InternalLast;
var
  Buffer: IntPtr;
begin
  if (FQSelect.EOF) then
    FCurrentRecord := FRecordCount
  else
  begin
    Buffer := AllocRecordBuffer;
    try
      while FQSelect.Next <> nil do
      begin
        FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
        Inc(FRecordCount);
      end;
      FCurrentRecord := FRecordCount;
    finally
      FreeRecordBuffer(Buffer);
    end;
  end;
end;

procedure TIBCustomDataSet.InternalSetParamsFromCursor;
var
  i: Integer;
  cur_param: TIBXSQLVAR;
  cur_field: TField;
  s: TStream;
begin
  if FQSelect.SQL.Text = '' then
    IBError(ibxeEmptyQuery, [nil]);
  if not FInternalPrepared then
    InternalPrepare;
  if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
  begin
    for i := 0 to SQLParams.Count - 1 do
    begin
      cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
      cur_param := SQLParams[i];
      if (cur_field <> nil) then
      begin
        if (cur_field.IsNull) then
          cur_param.IsNull := True
        else case cur_field.DataType of
          ftString:
            cur_param.AsString := cur_field.AsString;
          ftBoolean, ftSmallint, ftWord:
            cur_param.AsShort := cur_field.AsInteger;
          ftInteger:
            cur_param.AsLong := cur_field.AsInteger;
          ftLargeInt:
            cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
          ftFloat, ftCurrency:
           cur_param.AsDouble := cur_field.AsFloat;
          ftBCD:
            cur_param.AsCurrency := cur_field.AsCurrency;
          ftFMTBcd :
            cur_param.AsBcd := cur_field.AsBCD;
          ftDate:
            cur_param.AsDate := cur_field.AsDateTime;
          ftTime:
            cur_param.AsTime := cur_field.AsDateTime;
          ftDateTime:
            cur_param.AsDateTime := cur_field.AsDateTime;
          ftBlob, ftMemo:
          begin
            s := nil;
            try
              s := DataSource.DataSet.
                     CreateBlobStream(cur_field, bmRead);
              cur_param.LoadFromStream(s);
            finally
              s.free;
            end;
          end;
          else
            IBError(ibxeNotSupported, [nil]);
        end;
      end;
    end;
  end;
end;

procedure TIBCustomDataSet.ReQuery;
begin
  FQSelect.Close;
  ClearBlobCache;
  FCurrentRecord := -1;
  FRecordCount := 0;
  FDeletedRecords := 0;
  FBPos := 0;
  FOBPos := 0;
  FBEnd := 0;
  FOBEnd := 0;
  FQSelect.Close;
  FQSelect.ExecQuery;
  FOpen := FQSelect.Open;
  FRowsAffected := FQSelect.RowsAffected;
  First;
end;

procedure TIBCustomDataSet.InternalOpen;

  function RecordDataLength(n: Integer): Long;
  begin
    result := Marshal.SizeOf(TypeOf(TRecordData)) - SizeOf(IntPtr) +
                   (n * Marshal.SizeOf(TypeOf(TFieldData)));
  end;

begin
  ActivateConnection;
  ActivateTransaction;
  if FQSelect.SQL.Text = '' then
    IBError(ibxeEmptyQuery, [nil]);
  if not FInternalPrepared then
    InternalPrepare;
  if FQSelect.SQLType = SQLSelect then
  begin
    if DefaultFields then
      CreateFields;
    BindFields(True);
    FCurrentRecord := -1;
    FQSelect.ExecQuery;
    FOpen := FQSelect.Open;

    { Initialize offsets, buffer sizes, etc...
      1. Initially FRecordSize is just the "RecordDataLength".
      2. Allocate a "model" buffer and do a dummy fetch
      3. After the dummy fetch, FRecordSize will be appropriately
         adjusted to reflect the additional "weight" of the field
         data.
      4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
      5. Now, with the BufferSize available, allocate memory for chunks of records
      6. Re-allocate the model buffer, accounting for the new
         FRecordBufferSize.
      7. Finally, calls to AllocRecordBuffer will work!.
     }
    {Step 1}
    FRecordSize := RecordDataLength(FQSelect.Current.Count);
    {Step 2, 3}
    IBAlloc(FModelBuffer, 0, FRecordSize);
    FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
    {Step 4}
    FCalcFieldsOffset := FRecordSize;
    FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
    FRecordBufferSize := (FBlobCacheOffset +
                (BlobFieldCount * SizeOf(Integer)));
    {Step 5}
    if UniDirectional then
      FBufferChunkSize := FRecordBufferSize * UniCache
    else
      FBufferChunkSize := FRecordBufferSize * BufferChunks;
    IBAlloc(FBufferCache, FBufferChunkSize, FBufferChunkSize);
    if FCachedUpdates or (csReading in ComponentState) then
      IBAlloc(FOldBufferCache, FBufferChunkSize, FBufferChunkSize);
    FBPos := 0;
    FOBPos := 0;
    FBEnd := 0;
    FOBEnd := 0;
    FCacheSize := FBufferChunkSize;
    FOldCacheSize := FBufferChunkSize;
    {Step 6}
    IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
                           FRecordBufferSize);
    {Step 7}
    FOldBuffer := AllocRecordBuffer;
    FTempBuffer := AllocRecordBuffer;
  end
  else
    FQSelect.ExecQuery;
  FRowsAffected := FQSelect.RowsAffected;
end;

procedure TIBCustomDataSet.InternalPost;
var
  Qry: TIBSQL;
  Buff: IntPtr;
  Buffer : TRecordData;
  bInserting: Boolean;
begin
  inherited InternalPost;
  Buff := GetActiveBuf;
  CheckEditState;
  AdjustRecordOnInsert(Buff);
  Buffer := TRecordData(Marshal.PtrToStructure(Buff, TypeOf(TRecordData)));
  bInserting := False;
  Qry := nil;
  case State of
    dsInsert :
    begin
      bInserting := True;
      Qry := FQInsert;
      Buffer.rdUpdateStatus := usInserted;
      Buffer.rdCachedUpdateStatus := cusInserted;
      Buffer.rdRecordNumber := FRecordCount;
      Marshal.StructureToPtr(TObject(Buffer), Buff, false);
      WriteRecordCache(FRecordCount, Buff);
      FCurrentRecord := FRecordCount;
    end;
    dsEdit :
    begin
      Qry := FQModify;
      if Buffer.rdCachedUpdateStatus = cusUnmodified then
      begin
        Buffer.rdUpdateStatus := usModified;
        Buffer.rdCachedUpdateStatus := cusModified;
      end
      else
        if Buffer.rdCachedUpdateStatus = cusUninserted then
        begin
          Buffer.rdCachedUpdateStatus := cusInserted;
          Dec(FDeletedRecords);
        end;
      Marshal.StructureToPtr(TObject(Buffer), Buff, false);
    end;
  end;
  if (not CachedUpdates) then
    InternalPostRecord(Qry, Buff)
  else
  begin
    WriteRecordCache(Buffer.rdRecordNumber, Buff);
    FUpdatesPending := True;
  end;
  if bInserting then
    Inc(FRecordCount);
end;

procedure TIBCustomDataSet.InternalRefresh;
begin
  inherited InternalRefresh;
  InternalRefreshRow;
end;

procedure TIBCustomDataSet.InternalSetToRecord(Buffer: IntPtr);
var
  b : TBookmark;
  Buff : TRecordData;
begin
  b := Marshal.AllocHGlobal(sizeof(TBookmark));
  Buff := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
  Marshal.WriteInt32(b, Buff.rdRecordNumber);
  InternalGotoBookmark(b);
  Marshal.FreeHGlobal(b);
end;

function TIBCustomDataSet.IsCursorOpen: Boolean;
begin
  result := FOpen;
end;

function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
                                 Options: TLocateOptions): Boolean;
var
  CurBookmark: TBookmarkStr;
begin
  DisableControls;
  try
    CurBookmark := Bookmark;
    First;
    result := InternalLocate(KeyFields, KeyValues, Options);
    if not result then
      Bookmark := CurBookmark;
  finally
    EnableControls;
  end;
end;

function TIBCustomDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
                                 const ResultFields: string): Variant;
var
  fl: TList;
  CurBookmark: TBookmarkStr;
begin
  DisableControls;
  fl := TList.Create;
  CurBookmark := Bookmark;
  try
    First;
    if InternalLocate(KeyFields, KeyValues, []) then
    begin
      if (ResultFields <> '') then
        result := FieldValues[ResultFields]
      else
        result := NULL;
    end
    else
      result := Null;
  finally
    Bookmark := CurBookmark;
    fl.Free;
    EnableControls;
  end;
end;

procedure TIBCustomDataSet.SetBookmarkData(Buffer: IntPtr; const Data: IntPtr);
begin
  Marshal.WriteInt32(IntPtr(Integer(Buffer) +
                Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdRecordNumber'))),
                Marshal.ReadInt32(Data));
end;

procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: IntPtr; Value: TBookmarkFlag);
var
  Buff : TRecordData;
begin
  Buff := TRecordData(Marshal.PtrToStructure(Buffer, TypeOf(TRecordData)));
  Buff.rdBookmarkFlag := Value;
  Marshal.StructureToPtr(TObject(Buff), Buffer, false);
end;

procedure TIBCustomDataSet.SetCachedUpdates(Value: Boolean);
begin
  if not Value and FCachedUpdates then
    CancelUpdates;
  if (not (csReading in ComponentState)) and Value then
    CheckDatasetClosed;
  FCachedUpdates := Value;
end;

procedure TIBCustomDataSet.SetDataSource(Value: TDataSource);
begin
  if IsLinkedTo(Value) then
    IBError(ibxeCircularReference, [nil]);
  if FDataLink <> nil then
    FDataLink.DataSource := Value;
end;

procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: IntPtr);
var
  Buff, TmpBuff: IntPtr;
  rdField : TFieldData;
  RD : TRecordData;
  b : TBytes;
begin
  Buff := GetActiveBuf;
  if Field.FieldNo < 0 then
  begin
    TmpBuff := IntPtr(Integer(Buff) + FRecordSize + Field.Offset);
    Marshal.WriteByte(TmpBuff, Byte(Buffer <> nil));
    if Buffer <> nil then
    begin
      SetLength(b, Field.DataSize);
      Marshal.Copy(Buffer, b, 0, Field.DataSize);
      Marshal.Copy(b, 0, IntPtr(Integer(TmpBuff) + 1), Field.DataSize);
    end;
    WriteRecordCache(Marshal.ReadInt32(Buff,
            Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdRecordNumber'))), Buff);
  end
  else
  begin
    CheckEditState;

    { If inserting, Adjust record position }
    AdjustRecordOnInsert(Buff);
    RD := BufferAsRecordData(Buff);
    if (FMappedFieldPosition[Field.FieldNo - 1] >= 0) and
       (FMappedFieldPosition[Field.FieldNo - 1] < Marshal.ReadInt32(Buff,
            Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFieldCount')))) then
    begin
      Field.Validate(Buffer);
      rdField := TFieldData(Marshal.PtrToStructure(IntPtr(Integer(Buff) +
          Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) +
         (FMappedFieldPosition[Field.FieldNo - 1] * FieldDataSize)), TypeOf(TFieldData)));
      if (Buffer = nil) or
         ((Field is TIBStringField) and (Marshal.ReadByte(Buffer) = 0)) then
      begin
        rdField.fdIsNull := True;
        Marshal.StructureToPtr(TObject(rdField), IntPtr(Integer(Buff) +
          Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) +
         (FMappedFieldPosition[Field.FieldNo - 1] * FieldDataSize)), false);
      end
      else
      begin
        SetLength(b, rdField.fdDataSize);
        Marshal.Copy(Buffer, b, 0, min(rdField.fdDataSize, Field.DataSize));
        Marshal.Copy(b, 0, IntPtr(Integer(Buff) + rdField.fdDataOfs), rdField.fdDataSize);
        if (rdField.fdDataType = SQL_TEXT) or
           (rdField.fdDataType = SQL_VARYING) then
          rdField.fdDataLength := Length(BytesOf(Marshal.PtrToStringAnsi(Buffer)));
        rdField.fdIsNull := False;
        if RD.rdUpdateStatus = usUnmodified then
        begin
          if CachedUpdates then
          begin
            FUpdatesPending := True;
            if State = dsInsert then
              RD.rdCachedUpdateStatus := cusInserted
            else if State = dsEdit then
              RD.rdCachedUpdateStatus := cusModified;
          end;

          if State = dsInsert then
            RD.rdUpdateStatus := usInserted
          else
            RD.rdUpdateStatus := usModified;
        end;
        Marshal.StructureToPtr(TObject(rdField), IntPtr(Integer(Buff) +
          Integer(Marshal.OffsetOf(TypeOf(TRecordData), 'rdFields')) +
         (FMappedFieldPosition[Field.FieldNo - 1] * FieldDataSize)), false);
        Marshal.StructureToPtr(TObject(RD), Buff, false);
        WriteRecordCache(RD.rdRecordNumber, Buff);
        SetModified(True);
      end;
    end;
  end;
  if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
      DataEvent(deFieldChange, Field);
end;

procedure TIBCustomDataSet.SetRecNo(Value: Integer);
begin
  CheckBrowseMode;
  if (Value < 1) then
    Value := 1
  else if Value > FRecordCount then
  begin
    InternalLast;
    Value := Min(FRecordCount, Value);
  end;
  if (Value <> RecNo) then
  begin
    DoBeforeScroll;
    FCurrentRecord := Value - 1;
    Resync([]);
    DoAfterScroll;
  end;
end;

procedure TIBCustomDataSet.Disconnect;
begin
  Close;
  InternalUnPrepare;
end;

procedure TIBCustomDataSet.SetUpdateMode(const Value: TUpdateMode);
begin
  if not CanModify then
    IBError(ibxeCannotUpdate, [nil])
  else
    FUpdateMode := Value;
end;


procedure TIBCustomDataSet.SetUpdateObject(Value: TIBDataSetUpdateObject);
begin
  if Value <> FUpdateObject then
  begin
    if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then
    begin
      FUpdateObject.RemoveFreeNotification(Self);
      FUpdateObject.DataSet := nil;
    end;
    FUpdateObject := Value;
    if Assigned(FUpdateObject) then
    begin
      FUpdateObject.FreeNotification(Self);
      if Assigned(FUpdateObject.DataSet) and
        (FUpdateObject.DataSet <> Self) then
        FUpdateObject.DataSet.UpdateObject := nil;
      FUpdateObject.DataSet := Self;
    end;
  end;
end;

function TIBCustomDataSet.ConstraintsStored: Boolean;
begin
  Result := Constraints.Count > 0;
end;

procedure TIBCustomDataSet.ClearCalcFields(Buffer: IntPtr);
var
  i : Integer;
  CalcBuff : IntPtr;
begin
  CalcBuff := IntPtr(Integer(Buffer) + FRecordSize);
 for i := 0 to CalcFieldsSize - 1 do
   Marshal.WriteByte(CalcBuff, i, 0);
end;


procedure TIBCustomDataSet.InternalUnPrepare;
begin
  if FInternalPrepared then
  begin
    CheckDatasetClosed;
    FieldDefs.Clear;
    FInternalPrepared := False;
    FLiveMode := [];
  end;
end;

procedure TIBCustomDataSet.InternalExecQuery;
var
  DidActivate: Boolean;
begin
  DidActivate := False;
  try
    ActivateConnection;
    DidActivate := ActivateTransaction;
    if FQSelect.SQL.Text = '' then
      IBError(ibxeEmptyQuery, [nil]);
    if not FInternalPrepared then
      InternalPrepare;
    if FQSelect.SQLType = SQLSelect then
    begin
      IBError(ibxeIsASelectStatement, [nil]);
    end
    else
      FQSelect.ExecQuery;
  finally
    if DidActivate then
      DeactivateTransaction;
  end;
end;

function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
begin
  Result := FQSelect.Handle;
end;

procedure TIBCustomDataSet.InitRecord(Buffer: IntPtr);
var
  Buff : TRecordData;
  pbd : IntPtr;
  i : Integer;
begin
  inherited InitRecord(Buffer);
  Buff := BufferAsRecordData(Buffer);
  with Buff do
  begin
    rdUpdateStatus := usInserted;
    rdBookMarkFlag := bfInserted;
    rdRecordNumber := -1;
  end;
  pbd := (IntPtr(Integer(Buffer) + FBlobCacheOffset));
  for i := 0 to BlobFieldCount - 1 do
    Marshal.WriteInt32(pbd, i * Marshal.SizeOf(TypeOf(Integer)), -1);
  Marshal.StructureToPtr(TObject(Buff), Buffer, false);
end;

procedure TIBCustomDataSet.InternalInsert;
begin
  CursorPosChanged;
end;

{ TIBDataSet IProviderSupport }

procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
begin
  if Transaction.InTransaction then
  begin
    if Commit then
      Transaction.Commit
    else
      Transaction.Rollback;
  end;
end;

function TIBCustomDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams;
      var ResultSet: TObject) : Integer;
var
  FQuery: TIBDataSet;
  i : Integer;
begin
  if Assigned(ResultSet) then
  begin
    ResultSet := TIBDataSet.Create(nil);
    with ResultSet as TIBDataSet do
    begin
      Database := self.Database;
      Transaction := self.Transaction;
      if not Transaction.InTransaction then
        Transaction.StartTransaction;
      QSelect.GenerateParamNames := true;
      SelectSQL.Text := ASQL;
      for i := 0 to AParams.Count - 1 do
        Params[i].Value := AParams[i].Value;
      Open;
      if SQLType = SQLSelect then
      begin
        FetchAll;
        Result := RecordCount;
      end
      else
        Result := RowsAffected;
    end;
  end
  else
  begin
    FQuery := TIBDataSet.Create(nil);
    try
      FQuery.Database := Database;
      FQuery.Transaction := Transaction;
      if not Transaction.InTransaction then
        Transaction.StartTransaction;
      FQuery.QSelect.GenerateParamNames := True;
      FQuery.SelectSQL.Text := ASQL;
      for i := 0 to AParams.Count - 1 do
        FQuery.Params[i].Value := AParams[i].Value;
      FQuery.ExecSQL;
      if FQuery.SQLType = SQLSelect then
      begin
        FQuery.FetchAll;
        Result := FQuery.RecordCount;
      end
      else
        Result := FQuery.RowsAffected;
    finally
      FQuery.Free;
    end;
  end;
end;

function TIBCustomDataSet.PSGetQuoteChar: string;
begin
  Result := '';
  if Assigned(Database) and (Database.SQLDialect = 3) then
    Result := '"'
end;

function TIBCustomDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
var
  PrevErr: Integer;
begin
  if Prev <> nil then
    PrevErr := Prev.ErrorCode else
    PrevErr := 0;
  if E is EIBError then
    with EIBError(E) do
      Result := EUpdateError.Create(E.Message, '', SQLCode, PrevErr, E) else
      Result := inherited PSGetUpdateException(E, Prev);
end;

function TIBCustomDataSet.PSInTransaction: Boolean;
begin
  Result := Transaction.InTransaction;
end;

function TIBCustomDataSet.PSIsSQLBased: Boolean;
begin
  Result := True;
end;

function TIBCustomDataSet.PSIsSQLSupported: Boolean;
begin
  Result := True;
end;

procedure TIBCustomDataSet.PSReset;
begin
  inherited PSReset;
  if Active then
  begin
    Close;
    Open;
  end;
end;

function TIBCustomDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean;
var
  UpdateAction: TIBUpdateAction;
  SQL: string;
  Params: TParams;
  Temp : TObject;

  procedure AssignParams(DataSet: TDataSet; Params: TParams);
  var
    I: Integer;
    Old: Boolean;
    Param: TParam;
    PName: string;
    Field: TField;
    Value: Variant;
  begin
    for I := 0 to Params.Count - 1 do
    begin
      Param := Params[I];
      PName := Param.Name;
      Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
      if Old then
        Borland.Delphi.System.Delete(PName, 1, 4);
      Field := DataSet.FindField(PName);
      if not Assigned(Field) then
        Continue;
      if Old then
        Param.AssignFieldValue(Field, Field.OldValue)
      else
      begin
        Value := Field.NewValue;
        if VarIsEmpty(Value) then Value := Field.OldValue;
        Param.AssignFieldValue(Field, Value);
      end;
    end;
  end;

begin
  Result := False;
  if Assigned(OnUpdateRecord) then
  begin
    UpdateAction := uaFail;
    if Assigned(FOnUpdateRecord) then
    begin
      FOnUpdateRecord(Delta, UpdateKind, UpdateAction);
      Result := UpdateAction = uaApplied;
    end;
  end
  else if Assigned(FUpdateObject) then
  begin
    SQL := FUpdateObject.GetSQL(UpdateKind).Text;
    if SQL <> '' then
    begin
      Params := TParams.Create;
      try
        Params.ParseSQL(SQL, True);
        AssignParams(Delta, Params);
        Temp := nil;
        if PSExecuteStatement(SQL, Params, temp) = 0 then
          IBError(ibxeNoRecordsAffected, [nil]);
        Result := True;
      finally
        Params.Free;
      end;
    end;
  end;
end;

procedure TIBCustomDataSet.PSStartTransaction;
begin
  ActivateConnection;
  Transaction.StartTransaction;
end;

function TIBCustomDataSet.PSGetTableName: string;
var
  i : Integer;
begin
//  if not FInternalPrepared then
//    InternalPrepare;
  { It is possible for the FQSelectSQL to be unprepared
    with FInternalPreprepared being true (see DoBeforeTransactionEnd).
    So check the Prepared of the SelectSQL instead }
  if not FQSelect.Prepared then
    FQSelect.Prepare;
  Result := FQSelect.UniqueRelationName;
  If Result = '' then
  begin
    i := 0;
    while (i < FQSelect.FieldCount) and (Result = '') do
    begin
      Result := Trim(FQSelect.Current.Vars[i].SqlVar.RelName);
      Inc(i);
    end;
  end;
end;

procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
begin
  InternalBatchInput(InputObject);
end;

procedure TIBDataSet.BatchOutput(OutputObject: TIBBatchOutput);
begin
  InternalBatchOutput(OutputObject);
end;

procedure TIBDataSet.ExecSQL;
begin
  InternalExecQuery;
  FRowsAffected := FQSelect.RowsAffected;
end;

procedure TIBDataSet.Prepare;
begin
  InternalPrepare;
end;

procedure TIBDataSet.UnPrepare;
begin
  InternalUnPrepare;
end;

function TIBDataSet.GetPrepared: Boolean;
begin
  Result := InternalPrepared;
end;

procedure TIBDataSet.InternalOpen;
begin
  ActivateConnection;
  ActivateTransaction;
  InternalSetParamsFromCursor;
  Inherited InternalOpen;
end;

procedure TIBDataSet.SetFiltered(Value: Boolean);
begin
  if (Filtered <> Value) then
  begin
    inherited SetFiltered(value);
    if Active then
    begin
      Close;
      Open;
    end;
  end
  else
    inherited SetFiltered(value);
end;

function TIBCustomDataSet.BookmarkValid(const Bookmark: TBookmark): Boolean;
var
  TempCurrent : long;
  Buff: TRecordData;
begin
  Result := false;
  if not Assigned(Bookmark) then
    exit;
  Result := Marshal.ReadInt32(Bookmark) < FRecordCount;
  // check that this is not a fully deleted record slot
  if Result then
  begin
    TempCurrent := FCurrentRecord;
    FCurrentRecord := Marshal.ReadInt32(Bookmark);
    Buff := BufferAsRecordData(ActiveBuffer);
    if (Buff.rdUpdateStatus = usDeleted) and
       (Buff.rdCachedUpdateStatus = cusUnmodified) then
      Result := false;
    FCurrentRecord := TempCurrent;
  end;
end;

procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: IntPtr);
var
  lTempCurr : Borland.Delphi.System.Currency;
  B : TBytes;
  ip : IntPtr;
begin
  if (Field.DataType = ftBCD) and (Buffer <> nil) then
  begin
    SetLength(B, SizeOfTBcd);
    Marshal.Copy(Buffer, B, 0, Length(B));
    lTempCurr := TBcd.FromBytes(B);
    Marshal.StructureToPtr(TObject(lTempCurr), ip, false);
    InternalSetFieldData(Field, ip);
  end
  else
    InternalSetFieldData(Field, Buffer);
end;

procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: IntPtr;
  NativeFormat: Boolean);
begin
  if (not NativeFormat) and (Field.DataType = ftBCD) then
    InternalSetfieldData(Field, Buffer)
  else
    inherited SetFieldData(Field, buffer, NativeFormat);
end;

procedure TIBCustomDataSet.DoOnNewRecord;

  procedure SetFieldsFromParams;
  var
    i : Integer;
    master_field, cur_field: TField;
  begin
    if (SQLParams.Count > 0) then
      for i := 0 to SQLParams.Count - 1 do
      begin
        master_field := FDataLink.DataSource.DataSet.FindField(SQLParams[i].Name);
        cur_field :=  FindField(SQLParams[i].Name);
        if (master_field <> nil) and (cur_field <> nil) and cur_field.IsNull then
        begin
          if (master_field.IsNull) then
            cur_field.Clear
          else
          case cur_field.DataType of
            ftBoolean, ftSmallint, ftWord, ftInteger, ftString, ftFloat, ftCurrency,
            ftBCD, ftFMTBCD, ftDate, ftTime, ftDateTime:
              cur_field.Value := master_field.Value;
            ftLargeInt:
              TLargeIntField(cur_field).AsLargeInt := TLargeIntField(master_field).AsLargeInt;
          end;
        end;
      end;
  end;

begin
  if FGeneratorField.ApplyEvent = gamOnNewRecord then
    FGeneratorField.Apply;
  if CopyMasterFieldToDetail then
  begin
    if FDataLink.DataSource <> nil then
      if FDataLink.DataSource.DataSet <> nil then
        SetFieldsFromParams;
  end;
  inherited DoOnNewRecord;
end;

procedure TIBCustomDataSet.Post;
var
  i : Integer;
begin
  if (FGeneratorField.ApplyEvent = gamOnServer) and
      FGeneratorField.IsComplete then
    FieldByName(FGeneratorField.Field).Required := false;

  UpdateRecord;
  if State = dsInsert then
  begin
    for i := 0 to Fields.Count - 1 do
    begin
      if (Fields[i].IsNull) and (Fields[i].DefaultExpression <> '') then
        Fields[i].Value := Fields[i].DefaultExpression;
    end;

    if FGeneratorField.ApplyEvent = gamOnPost then
      FGeneratorField.Apply;
  end;
  inherited Post;
end;

procedure TIBCustomDataSet.SetGeneratorField(
  const Value: TIBGeneratorField);
begin
  FGeneratorField.Assign(Value);
end;

procedure TIBCustomDataSet.SetActive(Value: Boolean);
begin
  if (csReading in ComponentState) and
     (not (csDesigning in ComponentState)) then
    FStreamedActive := Value
  else
    inherited SetActive(Value);
end;

procedure TIBCustomDataSet.Loaded;
begin
  if Assigned(FBase.Database) and
      (not FBase.Database.AllowStreamedConnected) and
      (not FBase.Database.Connected) and
       FStreamedActive then
    Active := false
  else
    if FStreamedActive then
      Active := true;
  inherited Loaded;
end;

function TIBCustomDataSet.Current: TIBXSQLDA;
begin
  if not FInternalPrepared then
    InternalPrepare;
  Result := FQSelect.Current;
end;

function TIBCustomDataSet.SQLType: TIBSQLTypes;
begin
  Result := FQSelect.SQLType;
end;

function TIBCustomDataSet.GetPlan: String;
begin
  Result := FQSelect.Plan;
end;

procedure TIBCustomDataSet.CreateFields;
var
  FieldAliasName, RelationName, FieldName : String;
  i : Integer;
  f : TField;
begin
  inherited;
  for i := 0 to FQSelect.Current.Count - 1 do
    with FQSelect.Current[i].Data do
    begin
      { Get the field name }
      FieldAliasName := aliasname;
      RelationName := relname;
      FieldName := sqlname;
      f := FindField(FieldAliasname);
      if Assigned(f) then
      begin
        if (RelationName <> '') and (FieldName <> '') then
          f.Origin := QuoteIdentifier(FBase.Database.SQLDialect, RelationName) + '.' +
                      QuoteIdentifier(FBase.Database.SQLDialect, FieldName);
        if Database.In_Key(RelationName, FieldName) then
          f.ProviderFlags := f.ProviderFlags + [pfInKey]
        else
          if Database.Has_COMPUTED_BLR(RelationName, FieldName) or (Trim(RelationName) = '') then
            f.ProviderFlags := [];
        if f.IsBlob then
          f.ProviderFlags := f.ProviderFlags - [pfInWhere];
      end;
    end;
end;

procedure TIBCustomDataSet.OutputXML(OutputObject: TIBOutputXML);
begin
  QSelect.OutputXML(OutputObject);
end;

{ Needed workaround for TIBDSBlobStream needing to call this protected member
  at the TDataset level }
procedure TIBCustomDataSet.DataEvent(Event: TDataEvent; Info: TObject);
begin
  inherited DataEvent(Event, Info);
end;

procedure TIBCustomDataSet.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FUpdateObject) then
    FUpdateObject := nil;
end;

procedure TIBCustomDataSet.PSExecute;
begin
  FQSelect.ExecQuery;
end;

{ TIBDataSetUpdateObject }

constructor TIBDataSetUpdateObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRefreshSQL := TStringList.Create;
end;

destructor TIBDataSetUpdateObject.Destroy;
begin
  FRefreshSQL.Free;
  inherited Destroy;
end;

procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
begin
  FRefreshSQL.Assign(Value);
end;

{ TIBDSBlobStream }

constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
                                    Mode: TBlobStreamMode);
begin
  inherited Create;
  FModified := false;
  FField := AField;
  FBlobStream := ABlobStream;
  FBlobStream.Seek(0, soBeginning);
  FDataset := FField.Dataset as TIBCustomDataset;
  if (Mode = bmWrite) then
    FBlobStream.Truncate;
end;

destructor TIBDSBlobStream.Destroy;
begin
  if FModified then
  begin
    FModified := false;
    if not TBlobField(FField).Modified then
      TBlobField(FField).Modified := True;
    FDataSet.DataEvent(deFieldChange, FField);
  end;
  inherited Destroy;
end;

function TIBDSBlobStream.Read(var Buffer: array of Byte; Offset, Count: Longint): Longint;
begin
  result := FBlobStream.Read(Buffer, Count);
end;

function TIBDSBlobStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  result := FBlobStream.Seek(Offset, Origin);
end;

procedure TIBDSBlobStream.SetSize(NewSize: Int64);
begin
  FBlobStream.Size := NewSize;
end;

function TIBDSBlobStream.Write(const Buffer: array of Byte; Offset, Count: Longint): Longint;
begin
  FModified := true;
  if not (FField.DataSet.State in [dsEdit, dsInsert]) then
    IBError(ibxeNotEditing, [nil]);
  TIBCustomDataSet(FField.DataSet).RecordModified(True);
  result := FBlobStream.Write(Buffer, Count);
end;

procedure TIBDataSet.PSSetCommandText(const CommandText: string);
begin
  if CommandText <> '' then
    SelectSQL.Text := CommandText;
end;

function TIBDataSet.ParamByName(Idx: String): TIBXSQLVAR;
begin
  if not FInternalPrepared then
    InternalPrepare;
  result := FQSelect.ParamByName(Idx);
end;

{ TGeneratorField }

procedure TIBGeneratorField.Apply;
const
  SGENSQL = 'SELECT GEN_ID(%s, %d) FROM RDB$DATABASE';  {do not localize}
var
  sqlGen : TIBSQL;
begin
  if IsComplete and (DataSet.FieldByName(Field).Value = Null) then
  begin
    sqlGen := TIBSQL.Create(Dataset.Database);
    sqlGen.Transaction := DataSet.Transaction;
    try
      sqlGen.SQL.Text := Format(SGENSQL, [QuoteIdentifier(DataSet.Database.SQLDialect, FGenerator), FIncrementBy]);
      sqlGen.ExecQuery;
      if DataSet.FieldByName(Self.Field).ClassType <> TLargeIntField then
        DataSet.FieldByName(Self.Field).AsInteger := sqlGen.Current.Vars[0].AsInt64
      else
        TLargeIntField(DataSet.FieldByName(Self.Field)).AsLargeInt := sqlGen.Current.Vars[0].AsInt64;
      sqlGen.Close;
    finally
      sqlGen.Free;
    end;
  end;
end;

procedure TIBGeneratorField.Assign(Source: TPersistent);
var
  STemp : TIBGeneratorField;
begin
  if Source is TIBGeneratorField then
  begin
    STemp := Source as TIBGeneratorField;
    FField := STemp.Field;
    FGenerator := STemp.Generator;
    FIncrementBy := STemp.IncrementBy;
    FApplyEvent := STemp.ApplyEvent;
  end
  else
    inherited Assign(Source);
end;

constructor TIBGeneratorField.Create(ADataSet: TIBCustomDataSet);
begin
  inherited Create;
  FField := '';
  FGenerator := '';
  FIncrementBy := 1;
  FApplyEvent := gamOnNewRecord;
  DataSet := ADataSet;
end;

function TIBGeneratorField.IsComplete: Boolean;
begin
  Result := (FGenerator <> '') and (FField <> '');
end;

function TIBGeneratorField.ValueName: string;
begin
  if IsComplete then
    Result := FGenerator + ' -> ' + FField + ' By ' + IntToStr(FIncrementBy) {do not localize}
  else
    Result := '';
end;

destructor TIBDataSet.Destroy;
begin
  FreeAndNil(FPSParams);
  inherited;
end;

function TIBDataSet.PSGetParams: TParams;
begin
  CreateParams;
  Result := FPSParams;
end;

procedure TIBDataSet.PSSetParams(AParams: TParams);
var
  i : Integer;
  Param : TIBXSQLVar;
  Buffer: IntPtr;
begin
  CreateParams;
  for i := 0 to AParams.Count - 1 do
  begin
    Param := Params.ByName(AParams[i].Name);
    if AParams[i].IsNull then
      Param.IsNull := True
    else
    begin
      Param.IsNull := False;
      case AParams[i].DataType of
        ftBytes:
        begin
          Buffer := Marshal.AllocHGlobal(AParams[i].GetDataSize);
          try
            AParams[i].GetData(Buffer);
            Param.AsIntPtr := Buffer;
          finally
            Marshal.FreeHGlobal(Buffer);
          end;
        end;
        ftString, ftFixedChar:
          Param.AsString := AParams[i].AsString;
        ftBoolean, ftSmallint, ftWord:
          Param.AsShort := AParams[i].AsSmallInt;
        ftInteger:
          Param.AsLong := AParams[i].AsInteger;
        ftLargeInt:
          Param.AsInt64 := AParams[i].Value;
        ftFloat:
         Param.AsDouble := AParams[i].AsFloat;
        ftBCD, ftCurrency:
          Param.AsCurrency := AParams[i].AsCurrency;
        ftFMTBCD :
          Param.AsBcd := AParams[i].AsFMTBCD;
        ftDate:
          Param.AsDate := AParams[i].AsDateTime;
        ftTime:
          Param.AsTime := AParams[i].AsDateTime;
        ftDateTime:
          Param.AsDateTime := AParams[i].AsDateTime;
        ftBlob, ftMemo:
          Param.AsString := AParams[i].AsString;
        else
          IBError(ibxeNotSupported, [nil]);
      end;
    end;
  end;
  FPSParams.Assign(AParams);
end;

procedure TIBDataSet.CreateParams;
var
  i : Integer;
  Param: TParam;
  DataType: TFieldType;
begin
  if not Assigned(FPSParams) then
    FPSParams := TParams.Create(Self);
  FPSParams.Clear;
  DataType := ftUnknown;
  if (Trim(SelectSQL.Text) = '') then
    exit;
  for i := 0 to Params.Count - 1 do
  begin
    case Params[i].SQLtype of
      SQL_TYPE_DATE: DataType := ftDate;
      SQL_TYPE_TIME: DataType := ftTime;
      SQL_TIMESTAMP: DataType := ftDateTime;
      SQL_SHORT:
        if (Params[i].SQLVar.sqlscale = 0) then
          DataType := ftSmallInt
        else
          DataType := ftBCD;
      SQL_LONG:
        if (Params[i].SQLVar.sqlscale = 0) then
          DataType := ftInteger
        else if (Params[i].SQLVar.sqlscale >= (-4)) then
          DataType := ftBCD
        else
          if Database.SQLDialect = 1 then
            DataType := ftFloat
          else
            DataType := ftFMTBCD;
      SQL_INT64:
        if (Params[i].SQLVar.sqlscale = 0) then
          DataType := ftLargeInt
        else if (Params[i].SQLVar.sqlscale >= (-4)) then
          DataType := ftBCD
        else DataType := ftFMTBCD;
      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: DataType := ftFloat;
      SQL_TEXT: DataType := ftString;
      SQL_VARYING:
        if (Params[i].SQLVar.sqllen < 1024) then
          DataType := ftString
        else DataType := ftBlob;
      SQL_BLOB, SQL_ARRAY, SQL_QUAD: DataType := ftBlob;
    end;
    Param := FPSParams.CreateParam(DataType, Trim(Params[i].Name), ptInput);
    if DataType <> ftBlob then
      Param.Value := Params[i].Value;
  end;
end;

initialization
  FieldDataSize := Marshal.SizeOf(TypeOf(TFieldData));
finalization
end.