home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Vcl / ibcustomdataset.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  105KB  |  3,572 lines
  1. {********************************************************}
  2. {                                                        }
  3. {       Borland Delphi Visual Component Library          }
  4. {       InterBase Express core components                }
  5. {                                                        }
  6. {       Copyright (c) 1998-1999 Inprise Corporation      }
  7. {                                                        }
  8. {    InterBase Express is based in part on the product   }
  9. {    Free IB Components, written by Gregory H. Deatz for }
  10. {    Hoagland, Longo, Moran, Dunst & Doukas Company.     }
  11. {    Free IB Components is used under license.           }
  12. {                                                        }
  13. {********************************************************}
  14.  
  15. unit IBCustomDataSet;
  16.  
  17. interface
  18.  
  19. uses
  20.   Windows, SysUtils, Classes, Forms, Controls, StdVCL,
  21.   IBExternals, IB, IBHeader, IBDatabase, IBSQL, Db,
  22.   IBUtils, IBBlob;
  23.  
  24. const
  25.   BufferCacheSize    =  32;  { Allocate cache in this many record chunks}
  26.   UniCache           =  2;   { Uni-directional cache is 2 records big }
  27.  
  28. type
  29.   TIBCustomDataSet = class;
  30.   TIBDataSet = class;
  31.  
  32.   TIBDataSetUpdateObject = class(TComponent)
  33.   private
  34.     FRefreshSQL: TStrings;
  35.     procedure SetRefreshSQL(value: TStrings);
  36.   protected
  37.     function GetDataSet: TIBCustomDataSet; virtual; abstract;
  38.     procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
  39.     procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
  40.     function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
  41.     property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
  42.   public
  43.     constructor Create(AOwner: TComponent); override;
  44.     destructor Destroy; override;
  45.   published
  46.     property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
  47.   end;
  48.  
  49.   PDateTime = ^TDateTime;
  50.   TBlobDataArray = array[0..0] of TIBBlobStream;
  51.   PBlobDataArray = ^TBlobDataArray;
  52.  
  53.   { TIBCustomDataSet }
  54.   TFieldData = record
  55.     fdDataType: Short;
  56.     fdDataScale: Short;
  57.     fdNullable: Boolean;
  58.     fdIsNull: Boolean;
  59.     fdDataSize: Short;
  60.     fdDataLength: Short;
  61.     fdDataOfs: Integer;
  62.   end;
  63.   PFieldData = ^TFieldData;
  64.  
  65.   TCachedUpdateStatus = (
  66.                          cusUnmodified, cusModified, cusInserted,
  67.                          cusDeleted, cusUninserted
  68.                         );
  69.   TIBDBKey = record
  70.     DBKey: array[0..7] of Byte;
  71.   end;
  72.   PIBDBKey = ^TIBDBKey;
  73.  
  74.   TRecordData = record
  75.     rdBookmarkFlag: TBookmarkFlag;
  76.     rdFieldCount: Short;
  77.     rdRecordNumber: Long;
  78.     rdCachedUpdateStatus: TCachedUpdateStatus;
  79.     rdUpdateStatus: TUpdateStatus;
  80.     rdSavedOffset: DWORD;
  81.     rdDBKey: TIBDBKey;
  82.     rdFields: array[1..1] of TFieldData;
  83.   end;
  84.   PRecordData = ^TRecordData;
  85.  
  86.   { TIBStringField allows us to have strings longer than 8196 }
  87.  
  88.   TIBStringField = class(TStringField)
  89.   private
  90.     FBlanksToNULL: Boolean;
  91.   public
  92.     constructor create(AOwner: TComponent); override;
  93.     class procedure CheckTypeSize(Value: Integer); override;
  94.     function GetAsString: string; override;
  95.     function GetAsVariant: Variant; override;
  96.     function GetValue(var Value: string): Boolean;
  97.     procedure SetAsString(const Value: string); override;
  98.   published
  99.     property BlanksToNULL: Boolean read FBlanksToNULL
  100.                                    write FBlanksToNULL default True;
  101.   end;
  102.  
  103.   { TIBBCDField }
  104.   {  Actually, there is no BCD involved in this type,
  105.      instead it deals with currency types.
  106.      In IB, this is an encapsulation of Numeric (x, y)
  107.      where x < 18 and y <= 4.
  108.      Note: y > 4 will default to Floats
  109.   }
  110.   TIBBCDField = class(TBCDField)
  111.   protected
  112.     class procedure CheckTypeSize(Value: Integer); override;
  113.     function GetAsCurrency: Currency; override;
  114.     function GetAsString: string; override;
  115.     function GetAsVariant: Variant; override;
  116.     function GetDataSize: Integer; override;
  117.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  118.     function GetValue(var Value: Currency): Boolean;
  119.     procedure SetAsCurrency(Value: Currency); override;
  120.   public
  121.     constructor Create(AOwner: TComponent); override;
  122.   published
  123.     property Size default 8;
  124.   end;
  125.  
  126.   TIBDataLink = class(TDetailDataLink)
  127.   private
  128.     FDataSet: TIBCustomDataSet;
  129.   protected
  130.     procedure ActiveChanged; override;
  131.     procedure RecordChanged(Field: TField); override;
  132.     function GetDetailDataSet: TDataSet; override;
  133.     procedure CheckBrowseMode; override;
  134.   public
  135.     constructor Create(ADataSet: TIBCustomDataSet);
  136.     destructor Destroy; override;
  137.   end;
  138.  
  139.   { TIBCustomDataSet }
  140.   TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
  141.  
  142.   TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  143.                                  UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
  144.                                  of object;
  145.   TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
  146.                                    var UpdateAction: TIBUpdateAction) of object;
  147.  
  148.   TIBUpdateRecordTypes = set of TCachedUpdateStatus;
  149.  
  150.   TIBCustomDataSet = class(TDataset)
  151.   private
  152.     FDidActivate: Boolean;
  153.     FIBLoaded: Boolean;
  154.     FBase: TIBBase;
  155.     FBlobCacheOffset: Integer;
  156.     FBlobStreamList: TList;
  157.     FBufferChunks: Integer;
  158.     FBufferCache,
  159.     FOldBufferCache: PChar;
  160.     FBufferChunkSize,
  161.     FCacheSize,
  162.     FOldCacheSize: Integer;
  163.     FFilterBuffer: PChar;
  164.     FBPos,
  165.     FOBPos,
  166.     FBEnd,
  167.     FOBEnd: DWord;
  168.     FCachedUpdates: Boolean;
  169.     FCalcFieldsOffset: Integer;
  170.     FCurrentRecord: Long;
  171.     FDeletedRecords: Long;
  172.     FModelBuffer,
  173.     FOldBuffer: PChar;
  174.     FOpen: Boolean;
  175.     FInternalPrepared: Boolean;
  176.     FQDelete,
  177.     FQInsert,
  178.     FQRefresh,
  179.     FQSelect,
  180.     FQModify: TIBSQL;
  181.     FRecordBufferSize: Integer;
  182.     FRecordCount: Integer;
  183.     FRecordSize: Integer;
  184.     FUniDirectional: Boolean;
  185.     FUpdateMode: TUpdateMode;
  186.     FUpdateObject: TIBDataSetUpdateObject;
  187.     FParamCheck: Boolean;
  188.     FUpdatesPending: Boolean;
  189.     FUpdateRecordTypes: TIBUpdateRecordTypes;
  190.     FMappedFieldPosition: array of Integer;
  191.  
  192.     FBeforeDatabaseDisconnect,
  193.     FAfterDatabaseDisconnect,
  194.     FDatabaseFree: TNotifyEvent;
  195.     FOnUpdateError: TIBUpdateErrorEvent;
  196.     FOnUpdateRecord: TIBUpdateRecordEvent;
  197.     FBeforeTransactionEnd,
  198.     FAfterTransactionEnd,
  199.     FTransactionFree: TNotifyEvent;
  200.  
  201.     function GetSelectStmtHandle: TISC_STMT_HANDLE;
  202.     procedure SetUpdateMode(const Value: TUpdateMode);
  203.     procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
  204.  
  205.     function AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): TGetResult;
  206.     procedure AdjustRecordOnInsert(Buffer: Pointer);
  207.     function CanEdit: Boolean;
  208.     function CanInsert: Boolean;
  209.     function CanDelete: Boolean;
  210.     function CanRefresh: Boolean;
  211.     procedure CheckEditState;
  212.     procedure ClearBlobCache;
  213.     procedure CopyRecordBuffer(Source, Dest: Pointer);
  214.     procedure DoBeforeDatabaseDisconnect(Sender: TObject);
  215.     procedure DoAfterDatabaseDisconnect(Sender: TObject);
  216.     procedure DoDatabaseFree(Sender: TObject);
  217.     procedure DoBeforeTransactionEnd(Sender: TObject);
  218.     procedure DoAfterTransactionEnd(Sender: TObject);
  219.     procedure DoTransactionFree(Sender: TObject);
  220.     procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
  221.                                          Buffer: PChar);
  222.     function GetDatabase: TIBDatabase;
  223.     function GetDBHandle: PISC_DB_HANDLE;
  224.     function GetDeleteSQL: TStrings;
  225.     function GetInsertSQL: TStrings;
  226.     function GetSQLParams: TIBXSQLDA;
  227.     function GetRefreshSQL: TStrings;
  228.     function GetSelectSQL: TStrings;
  229.     function GetStatementType: TIBSQLTypes;
  230.     function GetModifySQL: TStrings;
  231.     function GetTransaction: TIBTransaction;
  232.     function GetTRHandle: PISC_TR_HANDLE;
  233.     procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
  234.     function InternalLocate(const KeyFields: string; const KeyValues: Variant;
  235.                             Options: TLocateOptions): Boolean; virtual;
  236.     procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
  237.     procedure InternalRevertRecord(RecordNumber: Integer);
  238.     function IsVisible(Buffer: PChar): Boolean;
  239.     procedure SaveOldBuffer(Buffer: PChar);
  240.     procedure SetBufferChunks(Value: Integer);
  241.     procedure SetDatabase(Value: TIBDatabase);
  242.     procedure SetDeleteSQL(Value: TStrings);
  243.     procedure SetInsertSQL(Value: TStrings);
  244.     procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
  245.     procedure SetRefreshSQL(Value: TStrings);
  246.     procedure SetSelectSQL(Value: TStrings);
  247.     procedure SetModifySQL(Value: TStrings);
  248.     procedure SetTransaction(Value: TIBTransaction);
  249.     procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
  250.     procedure SetUniDirectional(Value: Boolean);
  251.     procedure RefreshParams;
  252.     procedure SQLChanging(Sender: TObject); virtual;
  253.     function AdjustPosition(FCache: PChar; Offset: DWORD;
  254.                             Origin: Integer): Integer;
  255.     procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
  256.                        Buffer: PChar);
  257.     procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
  258.                               ReadOldBuffer: Boolean);
  259.     procedure WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;
  260.                         Buffer: PChar);
  261.     procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
  262.     function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
  263.                        DoCheck: Boolean): TGetResult;
  264.  
  265.   protected
  266.     FDataLink: TIBDataLink;
  267.     procedure ActivateConnection;
  268.     function ActivateTransaction: Boolean;
  269.     procedure DeactivateTransaction;
  270.     procedure CheckDatasetClosed;
  271.     procedure CheckDatasetOpen;
  272.     function GetActiveBuf: PChar;
  273.     procedure InternalBatchInput(InputObject: TIBBatchInput);
  274.     procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
  275.     procedure InternalPrepare;
  276.     procedure InternalUnPrepare;
  277.     procedure InternalExecQuery;
  278.     procedure InternalRefreshRow; virtual;
  279.     procedure InternalSetParamsFromCusror;
  280.     procedure CheckNotUniDirectional;
  281.  
  282.     { IProviderSupport }
  283.     procedure PSEndTransaction(Commit: Boolean); override;
  284.     function PSExecuteStatement(const ASQL: string; AParams: TParams;
  285.       ResultSet: Pointer = nil): Integer; override;
  286.     function PsGetTableName: string; override;
  287.     function PSGetQuoteChar: string; override;
  288.     function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
  289.     function PSInTransaction: Boolean; override;
  290.     function PSIsSQLBased: Boolean; override;
  291.     function PSIsSQLSupported: Boolean; override;
  292.     procedure PSStartTransaction; override;
  293.     procedure PSReset; override;
  294.     function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
  295.  
  296.     { TDataSet support }
  297.     procedure InternalInsert; override;
  298.     procedure InitRecord(Buffer: PChar); override;
  299.     procedure Disconnect; virtual;
  300.     function ConstraintsStored: Boolean;
  301.     procedure ClearCalcFields(Buffer: PChar); override;
  302.     function AllocRecordBuffer: PChar; override;
  303.     procedure DoBeforeDelete; override;
  304.     procedure DoBeforeEdit; override;
  305.     procedure DoBeforeInsert; override;
  306.     procedure FreeRecordBuffer(var Buffer: PChar); override;
  307.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  308.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  309.     function GetCanModify: Boolean; override;
  310.     function GetDataSource: TDataSource; override;
  311.     function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
  312.     function GetRecNo: Integer; override;
  313.     function GetRecord(Buffer: PChar; GetMode: TGetMode;
  314.                        DoCheck: Boolean): TGetResult; override;
  315.     function GetRecordCount: Integer; override;
  316.     function GetRecordSize: Word; override;
  317.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  318.     procedure InternalCancel; override;
  319.     procedure InternalClose; override;
  320.     procedure InternalDelete; override;
  321.     procedure InternalFirst; override;
  322.     procedure InternalGotoBookmark(Bookmark: Pointer); override;
  323.     procedure InternalHandleException; override;
  324.     procedure InternalInitFieldDefs; override;
  325.     procedure InternalInitRecord(Buffer: PChar); override;
  326.     procedure InternalLast; override;
  327.     procedure InternalOpen; override;
  328.     procedure InternalPost; override;
  329.     procedure InternalRefresh; override;
  330.     procedure InternalSetToRecord(Buffer: PChar); override;
  331.     function IsCursorOpen: Boolean; override;
  332.     procedure ReQuery;
  333.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  334.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  335.     procedure SetCachedUpdates(Value: Boolean);
  336.     procedure SetDataSource(Value: TDataSource);
  337.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  338.     procedure SetRecNo(Value: Integer); override;
  339.  
  340.   protected
  341.     property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
  342.     {Likely to be made public by descendant classes}
  343.     property SQLParams: TIBXSQLDA read GetSQLParams;
  344.     property InternalPrepared: Boolean read FInternalPrepared;
  345.     property QDelete: TIBSQL read FQDelete;
  346.     property QInsert: TIBSQL read FQInsert;
  347.     property QRefresh: TIBSQL read FQRefresh;
  348.     property QSelect: TIBSQL read FQSelect;
  349.     property QModify: TIBSQL read FQModify;
  350.     property StatementType: TIBSQLTypes read GetStatementType;
  351.  
  352.     {Likely candiatets to be made published by descendant classes}
  353.     property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
  354.     property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
  355.     property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
  356.     property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
  357.     property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
  358.     property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
  359.     property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL;
  360.     property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
  361.     property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
  362.     property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
  363.  
  364.     property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
  365.                                                  write FBeforeDatabaseDisconnect;
  366.     property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
  367.                                                 write FAfterDatabaseDisconnect;
  368.     property DatabaseFree: TNotifyEvent read FDatabaseFree
  369.                                         write FDatabaseFree;
  370.     property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
  371.                                              write FBeforeTransactionEnd;
  372.     property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
  373.                                             write FAfterTransactionEnd;
  374.     property TransactionFree: TNotifyEvent read FTransactionFree
  375.                                            write FTransactionFree;
  376.   public
  377.     constructor Create(AOwner: TComponent); override;
  378.     destructor Destroy; override;
  379.     procedure ApplyUpdates;
  380.     function CachedUpdateStatus: TCachedUpdateStatus;
  381.     procedure CancelUpdates;
  382.     procedure FetchAll;
  383.     function LocateNext(const KeyFields: string; const KeyValues: Variant;
  384.                         Options: TLocateOptions): Boolean;
  385.     procedure RecordModified(Value: Boolean);
  386.     procedure RevertRecord;
  387.     procedure Undelete;
  388.  
  389.     { TDataSet support methods }
  390.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
  391.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  392.     function GetCurrentRecord(Buffer: PChar): Boolean; override;
  393.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; override;
  394.     function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
  395.     function Locate(const KeyFields: string; const KeyValues: Variant;
  396.                     Options: TLocateOptions): Boolean; override;
  397.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  398.                     const ResultFields: string): Variant; override;
  399.     function UpdateStatus: TUpdateStatus; override;
  400.     function IsSequenced: Boolean; override;
  401.  
  402.     property DBHandle: PISC_DB_HANDLE read GetDBHandle;
  403.     property TRHandle: PISC_TR_HANDLE read GetTRHandle;
  404.     property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
  405.     property UpdatesPending: Boolean read FUpdatesPending;
  406.     property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
  407.                                                       write SetUpdateRecordTypes;
  408.  
  409.   published
  410.     property Database: TIBDatabase read GetDatabase write SetDatabase;
  411.     property Transaction: TIBTransaction read GetTransaction
  412.                                           write SetTransaction;
  413.     property Active;
  414.     property AutoCalcFields;
  415.     property ObjectView default False;
  416.  
  417.     property AfterCancel;
  418.     property AfterClose;
  419.     property AfterDelete;
  420.     property AfterEdit;
  421.     property AfterInsert;
  422.     property AfterOpen;
  423.     property AfterPost;
  424.     property AfterRefresh;
  425.     property AfterScroll;
  426.     property BeforeCancel;
  427.     property BeforeClose;
  428.     property BeforeDelete;
  429.     property BeforeEdit;
  430.     property BeforeInsert;
  431.     property BeforeOpen;
  432.     property BeforePost;
  433.     property BeforeRefresh;
  434.     property BeforeScroll;
  435.     property OnCalcFields;
  436.     property OnDeleteError;
  437.     property OnEditError;
  438.     property OnNewRecord;
  439.     property OnPostError;
  440.     property OnUpdateError: TIBUpdateErrorEvent read FOnUpdateError
  441.                                                  write FOnUpdateError;
  442.     property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
  443.                                                    write FOnUpdateRecord;
  444.   end;
  445.  
  446.   TIBDataSet = class(TIBCustomDataSet)
  447.   private
  448.     function GetPrepared: Boolean;
  449.  
  450.   protected
  451.     procedure SetFiltered(Value: Boolean); override;
  452.     procedure InternalOpen; override;
  453.  
  454.   public
  455.     procedure Prepare;
  456.     procedure UnPrepare;
  457.     procedure BatchInput(InputObject: TIBBatchInput);
  458.     procedure BatchOutput(OutputObject: TIBBatchOutput);
  459.  
  460.   public
  461.     property Params: TIBXSQLDA read GetSQLParams;
  462.     property Prepared : Boolean read GetPrepared;
  463.     property QDelete;
  464.     property QInsert;
  465.     property QRefresh;
  466.     property QSelect;
  467.     property QModify;
  468.     property StatementType;
  469.     property UpdatesPending;
  470.     { TDataSet support }
  471.     property Bof;
  472.     property Bookmark;
  473.     property DefaultFields;
  474.     property Designer;
  475.     property Eof;
  476.     property FieldCount;
  477.     property FieldDefs;
  478.     property Fields;
  479.     property FieldValues;
  480.     property Found;
  481.     property Modified;
  482.     property RecordCount;
  483.     property State;
  484.  
  485.   published
  486.     { TIBCustomDataSet }
  487.     property BufferChunks;
  488.     property CachedUpdates;
  489.     property DeleteSQL;
  490.     property InsertSQL;
  491.     property RefreshSQL;
  492.     property SelectSQL;
  493.     property UniDirectional;
  494.  
  495.     property BeforeDatabaseDisconnect;
  496.     property AfterDatabaseDisconnect;
  497.     property DatabaseFree;
  498.     property OnUpdateError;
  499.     property OnUpdateRecord;
  500.     property BeforeTransactionEnd;
  501.     property AfterTransactionEnd;
  502.     property TransactionFree;
  503.     property UpdateRecordTypes;
  504.     property ModifySQL;
  505.  
  506.     { TIBDataSet }
  507.     property Active;
  508.     property AutoCalcFields;
  509.     property DataSource read GetDataSource write SetDataSource;
  510.  
  511.     property AfterCancel;
  512.     property AfterClose;
  513.     property AfterDelete;
  514.     property AfterEdit;
  515.     property AfterInsert;
  516.     property AfterOpen;
  517.     property AfterPost;
  518.     property AfterScroll;
  519.     property BeforeCancel;
  520.     property BeforeClose;
  521.     property BeforeDelete;
  522.     property BeforeEdit;
  523.     property BeforeInsert;
  524.     property BeforeOpen;
  525.     property BeforePost;
  526.     property BeforeScroll;
  527.     property OnCalcFields;
  528.     property OnDeleteError;
  529.     property OnEditError;
  530.     property OnNewRecord;
  531.     property OnPostError;
  532.   end;
  533.  
  534.   { TIBDSBlobStream }
  535.   TIBDSBlobStream = class(TStream)
  536.   protected
  537.     FField: TField;
  538.     FBlobStream: TIBBlobStream;
  539.   public
  540.     constructor Create(AField: TField; ABlobStream: TIBBlobStream;
  541.                        Mode: TBlobStreamMode);
  542.     function Read(var Buffer; Count: Longint): Longint; override;
  543.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  544.     procedure SetSize(NewSize: Longint); override;
  545.     function Write(const Buffer; Count: Longint): Longint; override;
  546.   end;
  547.  
  548. const
  549. DefaultFieldClasses: array[TFieldType] of TFieldClass = (
  550.     nil,                { ftUnknown }
  551.     TIBStringField,     { ftString }
  552.     TSmallintField,     { ftSmallint }
  553.     TIntegerField,      { ftInteger }
  554.     TWordField,         { ftWord }
  555.     TBooleanField,      { ftBoolean }
  556.     TFloatField,        { ftFloat }
  557.     TCurrencyField,     { ftCurrency }
  558.     TIBBCDField,        { ftBCD }
  559.     TDateField,         { ftDate }
  560.     TTimeField,         { ftTime }
  561.     TDateTimeField,     { ftDateTime }
  562.     TBytesField,        { ftBytes }
  563.     TVarBytesField,     { ftVarBytes }
  564.     TAutoIncField,      { ftAutoInc }
  565.     TBlobField,         { ftBlob }
  566.     TMemoField,         { ftMemo }
  567.     TGraphicField,      { ftGraphic }
  568.     TBlobField,         { ftFmtMemo }
  569.     TBlobField,         { ftParadoxOle }
  570.     TBlobField,         { ftDBaseOle }
  571.     TBlobField,         { ftTypedBinary }
  572.     nil,                { ftCursor }
  573.     TStringField,       { ftFixedChar }
  574.     nil, {TWideStringField } { ftWideString }
  575.     TLargeIntField,     { ftLargeInt }
  576.     TADTField,          { ftADT }
  577.     TArrayField,        { ftArray }
  578.     TReferenceField,    { ftReference }
  579.     TDataSetField,     { ftDataSet }
  580.     TBlobField,         { ftOraBlob }
  581.     TMemoField,         { ftOraClob }
  582.     TVariantField,      { ftVariant }
  583.     TInterfaceField,    { ftInterface }
  584.     TIDispatchField,     { ftIDispatch }
  585.     TGuidField);        { ftGuid }
  586. var
  587.   CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
  588.  
  589. implementation
  590.  
  591. uses IBIntf, IBQuery;
  592.  
  593. { TIBStringField}
  594.  
  595. constructor TIBStringField.Create(AOwner: TComponent);
  596. begin
  597.   FBlanksToNULL := True;
  598.   inherited;
  599. end;
  600.  
  601. class procedure TIBStringField.CheckTypeSize(Value: Integer);
  602. begin
  603.   { don't check string size. all sizes valid }
  604. end;
  605.  
  606. function TIBStringField.GetAsString: string;
  607. begin
  608.   if not GetValue(Result) then Result := '';
  609. end;
  610.  
  611. function TIBStringField.GetAsVariant: Variant;
  612. var
  613.   S: string;
  614. begin
  615.   if GetValue(S) then Result := S else Result := Null;
  616. end;
  617.  
  618. function TIBStringField.GetValue(var Value: string): Boolean;
  619. var
  620.   Buffer: PChar;
  621. begin
  622.   Buffer := nil;
  623.   IBAlloc(Buffer, 0, Size + 1);
  624.   try
  625.     Result := GetData(Buffer);
  626.     if Result then
  627.     begin
  628.       Value := string(Buffer);
  629.       if Transliterate and (Value <> '') then
  630.         DataSet.Translate(PChar(Value), PChar(Value), False);
  631.     end
  632.   finally
  633.     IBAlloc(Buffer, 0, 0);
  634.   end;
  635. end;
  636.  
  637. procedure TIBStringField.SetAsString(const Value: string);
  638. var
  639.   Buffer: PChar;
  640. begin
  641.   Buffer := nil;
  642.   IBAlloc(Buffer, 0, Size + 1);
  643.   try
  644.     StrLCopy(Buffer, PChar(Value), Size);
  645.     if Transliterate then
  646.       DataSet.Translate(Buffer, Buffer, True);
  647.     SetData(Buffer);
  648.   finally
  649.     IBAlloc(Buffer, 0, 0);
  650.   end;
  651. end;
  652.  
  653. { TIBBCDField }
  654.  
  655. constructor TIBBCDField.Create(AOwner: TComponent);
  656. begin
  657.   inherited Create(AOwner);
  658.   SetDataType(ftBCD);
  659.   Size := 8;
  660. end;
  661.  
  662. class procedure TIBBCDField.CheckTypeSize(Value: Integer);
  663. begin
  664. { No need to check as the base type is currency, not BCD }
  665. end;
  666.  
  667. function TIBBCDField.GetAsCurrency: Currency;
  668. begin
  669.   if not GetValue(Result) then
  670.     Result := 0;
  671. end;
  672.  
  673. function TIBBCDField.GetAsString: string;
  674. var
  675.   C: System.Currency;
  676. begin
  677.   if GetValue(C) then
  678.     Result := CurrToStr(C)
  679.   else
  680.     Result := '';
  681. end;
  682.  
  683. function TIBBCDField.GetAsVariant: Variant;
  684. var
  685.   C: System.Currency;
  686. begin
  687.   if GetValue(C) then
  688.     Result := C
  689.   else
  690.     Result := Null;
  691. end;
  692.  
  693. function TIBBCDField.GetDataSize: Integer;
  694. begin
  695.   Result := 8;
  696. end;
  697.  
  698. procedure TIBBCDField.GetText(var Text: string; DisplayText: Boolean);
  699. var
  700.   Format: TFloatFormat;
  701.   FmtStr: string;
  702.   Digits: Integer;
  703.   C: System.Currency;
  704. begin
  705.   if GetData(@C) then
  706.   begin
  707.     if DisplayText or (EditFormat = '') then
  708.       FmtStr := DisplayFormat else
  709.       FmtStr := EditFormat;
  710.     if FmtStr = '' then
  711.     begin
  712.       if currency then
  713.       begin
  714.         if DisplayText then
  715.           Format := ffCurrency
  716.         else
  717.           Format := ffFixed;
  718.         Digits := CurrencyDecimals;
  719.       end
  720.       else begin
  721.         Format := ffGeneral;
  722.         Digits := 0;
  723.       end;
  724.       Text := CurrToStrF(C, Format, Digits);
  725.     end
  726.     else
  727.       Text := FormatCurr(FmtStr, C);
  728.   end
  729.   else
  730.     Text := '';
  731. end;
  732.  
  733. function TIBBCDField.GetValue(var Value: Currency): Boolean;
  734. begin
  735.   Result := GetData(@Value);
  736. end;
  737.  
  738. procedure TIBBCDField.SetAsCurrency(Value: Currency);
  739. begin
  740.   if (MinValue <> 0) or (MaxValue <> 0) then
  741.   begin
  742.     if (Value < MinValue) or (Value > MaxValue) then
  743.       RangeError(Value, MinValue, MaxValue);
  744.   end;
  745.   SetData(@Value);
  746. end;
  747.  
  748. { TIBDataLink }
  749.  
  750. constructor TIBDataLink.Create(ADataSet: TIBCustomDataSet);
  751. begin
  752.   inherited Create;
  753.   FDataSet := ADataSet;
  754. end;
  755.  
  756. destructor TIBDataLink.Destroy;
  757. begin
  758.   FDataSet.FDataLink := nil;
  759.   inherited;
  760. end;
  761.  
  762.  
  763. procedure TIBDataLink.ActiveChanged;
  764. begin
  765.   if FDataSet.Active then
  766.     FDataSet.RefreshParams;
  767. end;
  768.  
  769.  
  770. function TIBDataLink.GetDetailDataSet: TDataSet;
  771. begin
  772.   Result := FDataSet;
  773. end;
  774.  
  775. procedure TIBDataLink.RecordChanged(Field: TField);
  776. begin
  777.   if (Field = nil) and FDataSet.Active then
  778.     FDataSet.RefreshParams;
  779. end;
  780.  
  781. procedure TIBDataLink.CheckBrowseMode;
  782. begin
  783.   if FDataSet.Active then
  784.     FDataSet.CheckBrowseMode;
  785. end;
  786.  
  787. { TIBCustomDataSet }
  788.  
  789. constructor TIBCustomDataSet.Create(AOwner: TComponent);
  790. begin
  791.   inherited;
  792.   FIBLoaded := False;
  793.   CheckIBLoaded;
  794.   FIBLoaded := True;
  795.   FBase := TIBBase.Create(Self);
  796.   FCurrentRecord := -1;
  797.   FDeletedRecords := 0;
  798.   FUniDirectional := False;
  799.   FBufferChunks := BufferCacheSize;
  800.   FBlobStreamList := TList.Create;
  801.   FDataLink := TIBDataLink.Create(Self);
  802.   FQDelete := TIBSQL.Create(Self);
  803.   FQDelete.OnSQLChanging := SQLChanging;
  804.   FQDelete.GoToFirstRecordOnExecute := False;
  805.   FQInsert := TIBSQL.Create(Self);
  806.   FQInsert.OnSQLChanging := SQLChanging;
  807.   FQInsert.GoToFirstRecordOnExecute := False;
  808.   FQRefresh := TIBSQL.Create(Self);
  809.   FQRefresh.OnSQLChanging := SQLChanging;
  810.   FQRefresh.GoToFirstRecordOnExecute := False;
  811.   FQSelect := TIBSQL.Create(Self);
  812.   FQSelect.OnSQLChanging := SQLChanging;
  813.   FQSelect.GoToFirstRecordOnExecute := False;
  814.   FQModify := TIBSQL.Create(Self);
  815.   FQModify.OnSQLChanging := SQLChanging;
  816.   FQModify.GoToFirstRecordOnExecute := False;
  817.   FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
  818.   FParamCheck := True;
  819.   {Bookmark Size is Integer for IBX}
  820.   BookmarkSize := SizeOf(Integer);
  821.   FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
  822.   FBase.AfterDatabaseDisconnect := DoAfterDatabaseDisconnect;
  823.   FBase.OnDatabaseFree := DoDatabaseFree;
  824.   FBase.BeforeTransactionEnd := DoBeforeTransactionEnd;
  825.   FBase.AfterTransactionEnd := DoAfterTransactionEnd;
  826.   FBase.OnTransactionFree := DoTransactionFree;
  827. end;
  828.  
  829. destructor TIBCustomDataSet.Destroy;
  830. begin
  831.   inherited;
  832.   if FIBLoaded then
  833.   begin
  834.     FDataLink.Free;
  835.     FBase.Free;
  836.     ClearBlobCache;
  837.     FBlobStreamList.Free;
  838.     IBAlloc(FBufferCache, 0, 0);
  839.     IBAlloc(FOldBufferCache, 0, 0);
  840.     FCacheSize := 0;
  841.     FOldCacheSize := 0;
  842.     FMappedFieldPosition := nil;
  843.   end;
  844. end;
  845.  
  846. function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
  847.                                              TGetResult;
  848. begin
  849.   while not IsVisible(Buffer) do
  850.   begin
  851.     if GetMode = gmPrior then
  852.     begin
  853.       Dec(FCurrentRecord);
  854.       if FCurrentRecord = -1 then
  855.       begin
  856.         result := grBOF;
  857.         exit;
  858.       end;
  859.       ReadRecordCache(FCurrentRecord, Buffer, False);
  860.     end
  861.     else begin
  862.       Inc(FCurrentRecord);
  863.       if (FCurrentRecord = FRecordCount) then
  864.       begin
  865.         if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
  866.         begin
  867.           FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
  868.           Inc(FRecordCount);
  869.         end
  870.         else begin
  871.           result := grEOF;
  872.           exit;
  873.         end;
  874.       end
  875.       else
  876.         ReadRecordCache(FCurrentRecord, Buffer, False);
  877.     end;
  878.   end;
  879.   result := grOK;
  880. end;
  881.  
  882. procedure TIBCustomDataSet.ApplyUpdates;
  883. var
  884.   CurBookmark: string;
  885.   Buffer: PRecordData;
  886.   CurUpdateTypes: TIBUpdateRecordTypes;
  887.   UpdateAction: TIBUpdateAction;
  888.   UpdateKind: TUpdateKind;
  889.   bRecordsSkipped: Boolean;
  890.  
  891.   procedure GetUpdateKind;
  892.   begin
  893.     case Buffer^.rdCachedUpdateStatus of
  894.       cusModified:
  895.         UpdateKind := ukModify;
  896.       cusInserted:
  897.         UpdateKind := ukInsert;
  898.       else
  899.         UpdateKind := ukDelete;
  900.     end;
  901.   end;
  902.  
  903.   procedure ResetBufferUpdateStatus;
  904.   begin
  905.     case Buffer^.rdCachedUpdateStatus of
  906.       cusModified:
  907.       begin
  908.         PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
  909.         PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
  910.       end;
  911.       cusInserted:
  912.       begin
  913.         PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
  914.         PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
  915.       end;
  916.       cusDeleted:
  917.       begin
  918.         PRecordData(Buffer)^.rdUpdateStatus := usDeleted;
  919.         PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
  920.       end;
  921.     end;
  922.     WriteRecordCache(PRecordData(Buffer)^.rdRecordNumber, Pointer(Buffer));
  923.   end;
  924.  
  925.   procedure UpdateUsingOnUpdateRecord;
  926.   begin
  927.     UpdateAction := uaFail;
  928.     try
  929.       FOnUpdateRecord(Self, UpdateKind, UpdateAction);
  930.     except
  931.       on E: Exception do
  932.       begin
  933.         if (E is EDatabaseError) and Assigned(FOnUpdateError) then
  934.           FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
  935.         if UpdateAction = uaFail then
  936.             raise;
  937.       end;
  938.     end;
  939.   end;
  940.  
  941.   procedure UpdateUsingUpdateObject;
  942.   begin
  943.     try
  944.       FUpdateObject.Apply(UpdateKind);
  945.       ResetBufferUpdateStatus;
  946.     except
  947.       on E: Exception do
  948.         if (E is EDatabaseError) and Assigned(FOnUpdateError) then
  949.           FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
  950.     end;
  951.   end;
  952.  
  953.   procedure UpdateUsingInternalquery;
  954.   begin
  955.     try
  956.       case Buffer^.rdCachedUpdateStatus of
  957.         cusModified:
  958.           InternalPostRecord(FQModify, Buffer);
  959.         cusInserted:
  960.           InternalPostRecord(FQInsert, Buffer);
  961.         cusDeleted:
  962.           InternalDeleteRecord(FQDelete, Buffer);
  963.       end;
  964.     except
  965.       on E: EIBError do begin
  966.         UpdateAction := uaFail;
  967.         if Assigned(FOnUpdateError) then
  968.           FOnUpdateError(Self, E, UpdateKind, UpdateAction);
  969.         case UpdateAction of
  970.           uaFail: raise;
  971.           uaAbort: SysUtils.Abort;
  972.           uaSkip: bRecordsSkipped := True;
  973.         end;
  974.       end;
  975.     end;
  976.   end;
  977.  
  978. begin
  979.   if State in [dsEdit, dsInsert] then
  980.     Post;
  981.   FBase.CheckDatabase;
  982.   FBase.CheckTransaction;
  983.   DisableControls;
  984.   CurBookmark := Bookmark;
  985.   CurUpdateTypes := FUpdateRecordTypes;
  986.   FUpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
  987.   try
  988.     First;
  989.     bRecordsSkipped := False;
  990.     while not EOF do
  991.     begin
  992.       Buffer := PRecordData(GetActiveBuf);
  993.       GetUpdateKind;
  994.       UpdateAction := uaApply;
  995.       if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then
  996.       begin
  997.         if (Assigned(FOnUpdateRecord)) then
  998.           UpdateUsingOnUpdateRecord
  999.         else if Assigned(FUpdateObject) then
  1000.             UpdateUsingUpdateObject;
  1001.         case UpdateAction of
  1002.           uaFail:
  1003.             IBError(ibxeUserAbort, [nil]);
  1004.           uaAbort:
  1005.             SysUtils.Abort;
  1006.           uaApplied:
  1007.             ResetBufferUpdateStatus;
  1008.           uaSkip:
  1009.             bRecordsSkipped := True;
  1010.           uaRetry:
  1011.             Continue;
  1012.         end;
  1013.       end;
  1014.       if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then
  1015.       begin
  1016.         UpdateUsingInternalquery;
  1017.         UpdateAction := uaApplied;
  1018.       end;
  1019.       Next;
  1020.     end;
  1021.     FUpdatesPending := bRecordsSkipped;
  1022.   finally
  1023.     FUpdateRecordTypes := CurUpdateTypes;
  1024.     Bookmark := CurBookmark;
  1025.     EnableControls;
  1026.   end;
  1027. end;
  1028.  
  1029. procedure TIBCustomDataSet.InternalBatchInput(InputObject: TIBBatchInput);
  1030. begin
  1031.   FQSelect.BatchInput(InputObject);
  1032. end;
  1033.  
  1034. procedure TIBCustomDataSet.InternalBatchOutput(OutputObject: TIBBatchOutput);
  1035. var
  1036.   Qry: TIBSQL;
  1037. begin
  1038.   Qry := TIBSQL.Create(Self);
  1039.   try
  1040.     Qry.Database := FBase.Database;
  1041.     Qry.Transaction := FBase.Transaction;
  1042.     Qry.SQL.Assign(FQSelect.SQL);
  1043.     Qry.BatchOutput(OutputObject);
  1044.   finally
  1045.     Qry.Free;
  1046.   end;
  1047. end;
  1048.  
  1049. procedure TIBCustomDataSet.CancelUpdates;
  1050. var
  1051.   CurUpdateTypes: TIBUpdateRecordTypes;
  1052. begin
  1053.   if State in [dsEdit, dsInsert] then
  1054.     Post;
  1055.   if FCachedUpdates and FUpdatesPending then
  1056.   begin
  1057.     DisableControls;
  1058.     CurUpdateTypes := UpdateRecordTypes;
  1059.     UpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
  1060.     try
  1061.       First;
  1062.       while not EOF do
  1063.       begin
  1064.         RevertRecord;
  1065.         Next;
  1066.       end;
  1067.     finally
  1068.       UpdateRecordTypes := CurUpdateTypes;
  1069.       First;
  1070.       FUpdatesPending := False;
  1071.       EnableControls;
  1072.     end;
  1073.   end;
  1074. end;
  1075.  
  1076. procedure TIBCustomDataSet.ActivateConnection;
  1077. begin
  1078.   if not Assigned(Database) then
  1079.     IBError(ibxeDatabaseNotAssigned, [nil]);
  1080.   if not Assigned(Transaction) then
  1081.     IBError(ibxeTransactionNotAssigned, [nil]);
  1082.   if not Database.Connected then Database.Open;
  1083. end;
  1084.  
  1085. function TIBCustomDataSet.ActivateTransaction: Boolean;
  1086. begin
  1087.   Result := False;
  1088.   if not Assigned(Transaction) then
  1089.     IBError(ibxeTransactionNotAssigned, [nil]);
  1090.   if not Transaction.Active then
  1091.   begin
  1092.     Result := True;
  1093.     Transaction.StartTransaction;
  1094.     FDidActivate := True;
  1095.   end;
  1096. end;
  1097.  
  1098. procedure TIBCustomDataSet.DeactivateTransaction;
  1099. var
  1100.   i: Integer;
  1101. begin
  1102.   if not Assigned(Transaction) then
  1103.     IBError(ibxeTransactionNotAssigned, [nil]);
  1104.   with Transaction do
  1105.   begin
  1106.     for i := 0 to SQLObjectCount - 1 do
  1107.     begin
  1108.       if (SQLObjects[i] <> nil) and ((SQLObjects[i]).owner is TDataSet) then
  1109.       begin
  1110.         if TDataSet(SQLObjects[i].owner).Active then
  1111.         begin
  1112.           FDidActivate := False;
  1113.           exit;
  1114.         end;
  1115.       end;
  1116.     end;
  1117.   end;
  1118.   FInternalPrepared := False;
  1119.   if Transaction.InTransaction then
  1120.     Transaction.Commit;
  1121.   FDidActivate := False;
  1122. end;
  1123.  
  1124. procedure TIBCustomDataSet.CheckDatasetClosed;
  1125. begin
  1126.   if FOpen then
  1127.     IBError(ibxeDatasetOpen, [nil]);
  1128. end;
  1129.  
  1130. procedure TIBCustomDataSet.CheckDatasetOpen;
  1131. begin
  1132.   if not FOpen then
  1133.     IBError(ibxeDatasetClosed, [nil]);
  1134. end;
  1135.  
  1136. procedure TIBCustomDataSet.CheckNotUniDirectional;
  1137. begin
  1138.   if UniDirectional then
  1139.     IBError(ibxeDataSetUniDirectional, [nil]);
  1140. end;
  1141.  
  1142. procedure TIBCustomDataSet.AdjustRecordOnInsert(Buffer: Pointer);
  1143. begin
  1144.   with PRecordData(Buffer)^ do
  1145.     if (State = dsInsert) and (not Modified) then
  1146.     begin
  1147.       rdRecordNumber := FRecordCount;
  1148.       FCurrentRecord := FRecordCount;
  1149.     end;
  1150. end;
  1151.  
  1152. function TIBCustomDataSet.CanEdit: Boolean;
  1153. var
  1154.   Buff: PRecordData;
  1155. begin
  1156.   Buff := PRecordData(GetActiveBuf);
  1157.   result := (FQModify.SQL.Text <> '') or
  1158.     (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or
  1159.     ((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and
  1160.       (FCachedUpdates));
  1161. end;
  1162.  
  1163. function TIBCustomDataSet.CanInsert: Boolean;
  1164. begin
  1165.   result := (FQInsert.SQL.Text <> '') or
  1166.     (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukInsert).Text <> ''));
  1167. end;
  1168.  
  1169. function TIBCustomDataSet.CanDelete: Boolean;
  1170. begin
  1171.   if (FQDelete.SQL.Text <> '') or
  1172.     (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
  1173.     result := True
  1174.   else
  1175.     result := False;
  1176. end;
  1177.  
  1178. function TIBCustomDataSet.CanRefresh: Boolean;
  1179. begin
  1180.   result := (FQRefresh.SQL.Text <> '') or
  1181.     (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> ''));
  1182. end;
  1183.  
  1184. procedure TIBCustomDataSet.CheckEditState;
  1185. begin
  1186.   case State of
  1187.     dsEdit: if not CanEdit then IBError(ibxeCannotUpdate, [nil]);
  1188.     dsInsert: if not CanInsert then IBError(ibxeCannotInsert, [nil]);
  1189.   end;
  1190. end;
  1191.  
  1192. procedure TIBCustomDataSet.ClearBlobCache;
  1193. var
  1194.   i: Integer;
  1195. begin
  1196.   for i := 0 to FBlobStreamList.Count - 1 do
  1197.   begin
  1198.     TIBBlobStream(FBlobStreamList[i]).Free;
  1199.     FBlobStreamList[i] := nil;
  1200.   end;
  1201.   FBlobStreamList.Pack;
  1202. end;
  1203.  
  1204. procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
  1205. begin
  1206.   Move(Source^, Dest^, FRecordBufferSize);
  1207. end;
  1208.  
  1209. procedure TIBCustomDataSet.DoBeforeDatabaseDisconnect(Sender: TObject);
  1210. begin
  1211.   if Active then
  1212.     Active := False;
  1213.   FInternalPrepared := False;
  1214.   if Assigned(FBeforeDatabaseDisconnect) then
  1215.     FBeforeDatabaseDisconnect(Sender);
  1216. end;
  1217.  
  1218. procedure TIBCustomDataSet.DoAfterDatabaseDisconnect(Sender: TObject);
  1219. begin
  1220.   if Assigned(FAfterDatabaseDisconnect) then
  1221.     FAfterDatabaseDisconnect(Sender);
  1222. end;
  1223.  
  1224. procedure TIBCustomDataSet.DoDatabaseFree(Sender: TObject);
  1225. begin
  1226.   if Assigned(FDatabaseFree) then
  1227.     FDatabaseFree(Sender);
  1228. end;
  1229.  
  1230. procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
  1231. begin
  1232.   if Active then
  1233.     Active := False;
  1234.   if FQSelect <> nil then
  1235.     FQSelect.FreeHandle;
  1236.   if FQDelete <> nil then
  1237.     FQDelete.FreeHandle;
  1238.   if FQInsert <> nil then
  1239.     FQInsert.FreeHandle;
  1240.   if FQModify <> nil then
  1241.     FQModify.FreeHandle;
  1242.   if FQRefresh <> nil then
  1243.     FQRefresh.FreeHandle;
  1244.   if Assigned(FBeforeTransactionEnd) then
  1245.     FBeforeTransactionEnd(Sender);
  1246. end;
  1247.  
  1248. procedure TIBCustomDataSet.DoAfterTransactionEnd(Sender: TObject);
  1249. begin
  1250.   if Assigned(FAfterTransactionEnd) then
  1251.     FAfterTransactionEnd(Sender);
  1252. end;
  1253.  
  1254. procedure TIBCustomDataSet.DoTransactionFree(Sender: TObject);
  1255. begin
  1256.   if Assigned(FTransactionFree) then
  1257.     FTransactionFree(Sender);
  1258. end;
  1259.  
  1260. { Read the record from FQSelect.Current into the record buffer
  1261.   Then write the buffer to in memory cache }
  1262. procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
  1263.   RecordNumber: Integer; Buffer: PChar);
  1264. var
  1265.   p: PRecordData;
  1266.   pbd: PBlobDataArray;
  1267.   i, j: Integer;
  1268.   LocalData: Pointer;
  1269.   LocalDate, LocalDouble: Double;
  1270.   LocalInt: Integer;
  1271.   LocalInt64: Int64;
  1272.   LocalCurrency: Currency;
  1273.   FieldsLoaded: Integer;
  1274. begin
  1275.   p := PRecordData(Buffer);
  1276.   { Make sure blob cache is empty }
  1277.   pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
  1278.   if RecordNumber > -1 then
  1279.     for i := 0 to BlobFieldCount - 1 do
  1280.       pbd^[i] := nil;
  1281.   { Get record information }
  1282.   p^.rdBookmarkFlag := bfCurrent;
  1283.   p^.rdFieldCount := Qry.Current.Count;
  1284.   p^.rdRecordNumber := RecordNumber;
  1285.   p^.rdUpdateStatus := usUnmodified;
  1286.   p^.rdCachedUpdateStatus := cusUnmodified;
  1287.   p^.rdSavedOffset := $FFFFFFFF;
  1288.  
  1289.   { Load up the fields }
  1290.   FieldsLoaded := FQSelect.Current.Count;
  1291.   j := 1; 
  1292.   for i := 0 to Qry.Current.Count - 1 do
  1293.   begin
  1294.     if (Qry = FQSelect) then
  1295.       j := i + 1
  1296.     else begin
  1297.       if FieldsLoaded = 0 then
  1298.         break;
  1299.       j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
  1300.       if j < 1 then
  1301.         continue
  1302.       else
  1303.         Dec(FieldsLoaded);
  1304.     end;
  1305.     with FQSelect.Current[j - 1].Data^ do
  1306.       if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
  1307.       begin
  1308.         if sqllen <= 8 then
  1309.           p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
  1310.         continue;
  1311.       end;
  1312.     if j > 0 then with p^ do
  1313.     begin
  1314.       rdFields[j].fdDataType :=
  1315.         Qry.Current[i].Data^.sqltype and (not 1);
  1316.       rdFields[j].fdDataScale :=
  1317.         Qry.Current[i].Data^.sqlscale;
  1318.       rdFields[j].fdNullable :=
  1319.         (Qry.Current[i].Data^.sqltype and 1 = 1);
  1320.       rdFields[j].fdIsNull :=
  1321.         (rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
  1322.       LocalData := Qry.Current[i].Data^.sqldata;
  1323.       case rdFields[j].fdDataType of
  1324.         SQL_TIMESTAMP:
  1325.         begin
  1326.           rdFields[j].fdDataSize := SizeOf(TDateTime);
  1327.           if RecordNumber >= 0 then
  1328.             LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
  1329.           LocalData := PChar(@LocalDate);
  1330.         end;
  1331.         SQL_TYPE_DATE:
  1332.         begin
  1333.           rdFields[j].fdDataSize := SizeOf(TDateTime);
  1334.           if RecordNumber >= 0 then
  1335.             LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
  1336.           LocalData := PChar(@LocalInt);
  1337.         end;
  1338.         SQL_TYPE_TIME:
  1339.         begin
  1340.           rdFields[j].fdDataSize := SizeOf(TDateTime);
  1341.           if RecordNumber >= 0 then
  1342.             LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
  1343.           LocalData := PChar(@LocalInt);
  1344.         end;
  1345.         SQL_SHORT, SQL_LONG:
  1346.         begin
  1347.           if (rdFields[j].fdDataScale = 0) then
  1348.           begin
  1349.             rdFields[j].fdDataSize := SizeOf(Integer);
  1350.             if RecordNumber >= 0 then
  1351.               LocalInt := Qry.Current[i].AsLong;
  1352.             LocalData := PChar(@LocalInt);
  1353.           end
  1354.           else if (rdFields[j].fdDataScale >= (-4)) then
  1355.                begin
  1356.                  rdFields[j].fdDataSize := SizeOf(Currency);
  1357.                  if RecordNumber >= 0 then
  1358.                    LocalCurrency := Qry.Current[i].AsCurrency;
  1359.                  LocalData := PChar(@LocalCurrency);
  1360.                end
  1361.                else begin
  1362.                  rdFields[j].fdDataSize := SizeOf(Double);
  1363.                  if RecordNumber >= 0 then
  1364.                    LocalDouble := Qry.Current[i].AsDouble;
  1365.                 LocalData := PChar(@LocalDouble);
  1366.               end;
  1367.         end;
  1368.         SQL_INT64:
  1369.         begin
  1370.           if (rdFields[j].fdDataScale = 0) then
  1371.           begin
  1372.             rdFields[j].fdDataSize := SizeOf(Int64);
  1373.             if RecordNumber >= 0 then
  1374.               LocalInt64 := Qry.Current[i].AsInt64;
  1375.             LocalData := PChar(@LocalInt64);
  1376.           end
  1377.           else if (rdFields[j].fdDataScale >= (-4)) then
  1378.                begin
  1379.                  rdFields[j].fdDataSize := SizeOf(Currency);
  1380.                  if RecordNumber >= 0 then
  1381.                    LocalCurrency := Qry.Current[i].AsCurrency;
  1382.                    LocalData := PChar(@LocalCurrency);
  1383.                end
  1384.                else begin
  1385.                   rdFields[j].fdDataSize := SizeOf(Double);
  1386.                   if RecordNumber >= 0 then
  1387.                     LocalDouble := Qry.Current[i].AsDouble;
  1388.                   LocalData := PChar(@LocalDouble);
  1389.                end
  1390.         end;
  1391.         SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
  1392.         begin
  1393.           rdFields[j].fdDataSize := SizeOf(Double);
  1394.           if RecordNumber >= 0 then
  1395.             LocalDouble := Qry.Current[i].AsDouble;
  1396.           LocalData := PChar(@LocalDouble);
  1397.         end;
  1398.         SQL_VARYING:
  1399.         begin
  1400.           rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
  1401.           rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
  1402.           if RecordNumber >= 0 then
  1403.           begin
  1404.             if (rdFields[j].fdDataLength = 0) then
  1405.               LocalData := nil
  1406.             else
  1407.               LocalData := @Qry.Current[i].Data^.sqldata[2];
  1408.           end;
  1409.         end;
  1410.         else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
  1411.         begin
  1412.           rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
  1413.           if (rdFields[j].fdDataType = SQL_TEXT) then
  1414.             rdFields[j].fdDataLength := rdFields[j].fdDataSize;
  1415.         end;
  1416.       end;
  1417.       if RecordNumber < 0 then
  1418.       begin
  1419.         rdFields[j].fdIsNull := True;
  1420.         rdFields[j].fdDataOfs := FRecordSize;
  1421.         Inc(FRecordSize, rdFields[j].fdDataSize);
  1422.       end
  1423.       else begin
  1424.         if rdFields[j].fdDataType = SQL_VARYING then
  1425.         begin
  1426.           if LocalData <> nil then
  1427.             Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
  1428.         end
  1429.         else
  1430.           Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
  1431.       end;
  1432.     end;
  1433.   end;
  1434.   WriteRecordCache(RecordNumber, PChar(p));
  1435. end;
  1436.  
  1437. function TIBCustomDataSet.GetActiveBuf: PChar;
  1438. begin
  1439.   case State of
  1440.     dsBrowse:
  1441.       if IsEmpty then
  1442.         result := nil
  1443.       else
  1444.         result := ActiveBuffer;
  1445.     dsEdit, dsInsert:
  1446.       result := ActiveBuffer;
  1447.     dsCalcFields:
  1448.       result := CalcBuffer;
  1449.     dsFilter:
  1450.       result := FFilterBuffer;
  1451.     dsNewValue:
  1452.       result := ActiveBuffer;
  1453.     dsOldValue:
  1454.       if (PRecordData(ActiveBuffer)^.rdRecordNumber =
  1455.         PRecordData(FOldBuffer)^.rdRecordNumber) then
  1456.         result := FOldBuffer
  1457.       else
  1458.         result := ActiveBuffer;
  1459.   else if not FOpen then
  1460.     result := nil
  1461.   else
  1462.     result := ActiveBuffer;
  1463.   end;
  1464. end;
  1465.  
  1466. function TIBCustomDataSet.CachedUpdateStatus: TCachedUpdateStatus;
  1467. begin
  1468.   if Active then
  1469.     result := PRecordData(GetActiveBuf)^.rdCachedUpdateStatus
  1470.   else
  1471.     result := cusUnmodified;
  1472. end;
  1473.  
  1474. function TIBCustomDataSet.GetDatabase: TIBDatabase;
  1475. begin
  1476.   result := FBase.Database;
  1477. end;
  1478.  
  1479. function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
  1480. begin
  1481.   result := FBase.DBHandle;
  1482. end;
  1483.  
  1484. function TIBCustomDataSet.GetDeleteSQL: TStrings;
  1485. begin
  1486.   result := FQDelete.SQL;
  1487. end;
  1488.  
  1489. function TIBCustomDataSet.GetInsertSQL: TStrings;
  1490. begin
  1491.   result := FQInsert.SQL;
  1492. end;
  1493.  
  1494. function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
  1495. begin
  1496.   result := FQSelect.Params;
  1497. end;
  1498.  
  1499. function TIBCustomDataSet.GetRefreshSQL: TStrings;
  1500. begin
  1501.   result := FQRefresh.SQL;
  1502. end;
  1503.  
  1504. function TIBCustomDataSet.GetSelectSQL: TStrings;
  1505. begin
  1506.   result := FQSelect.SQL;
  1507. end;
  1508.  
  1509. function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
  1510. begin
  1511.   result := FQSelect.SQLType;
  1512. end;
  1513.  
  1514. function TIBCustomDataSet.GetModifySQL: TStrings;
  1515. begin
  1516.   result := FQModify.SQL;
  1517. end;
  1518.  
  1519. function TIBCustomDataSet.GetTransaction: TIBTransaction;
  1520. begin
  1521.   result := FBase.Transaction;
  1522. end;
  1523.  
  1524. function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
  1525. begin
  1526.   result := FBase.TRHandle;
  1527. end;
  1528.  
  1529. procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
  1530. begin
  1531.   if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
  1532.     FUpdateObject.Apply(ukDelete)
  1533.   else begin
  1534.     SetInternalSQLParams(FQDelete, Buff);
  1535.     FQDelete.ExecQuery;
  1536.   end;
  1537.   with PRecordData(Buff)^ do
  1538.   begin
  1539.     rdUpdateStatus := usDeleted;
  1540.     rdCachedUpdateStatus := cusUnmodified;
  1541.   end;
  1542.   WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
  1543. end;
  1544.  
  1545. function TIBCustomDataSet.InternalLocate(const KeyFields: string;
  1546.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  1547. var
  1548.   fl: TList;
  1549.   CurBookmark: string;
  1550.   fld, val: Variant;
  1551.   i, fld_cnt: Integer;
  1552. begin
  1553.   fl := TList.Create;
  1554.   try
  1555.     GetFieldList(fl, KeyFields);
  1556.     fld_cnt := fl.Count;
  1557.     CurBookmark := Bookmark;
  1558.     result := False;
  1559.     while ((not result) and (not EOF)) do
  1560.     begin
  1561.       i := 0;
  1562.       result := True;
  1563.       while (result and (i < fld_cnt)) do
  1564.       begin
  1565.         if fld_cnt > 1 then
  1566.           val := KeyValues[i]
  1567.         else
  1568.           val := KeyValues;
  1569.         fld := TField(fl[i]).Value;
  1570.         result := not (VarIsNull(val) or VarIsNull(fld));
  1571.         if result then
  1572.           try
  1573.             fld := VarAsType(fld, VarType(val));
  1574.           except
  1575.             on E: EVariantError do result := False;
  1576.           end;
  1577.         if result then
  1578.         begin
  1579.           if TField(fl[i]).DataType = ftString then
  1580.           begin
  1581.             if (loCaseInsensitive in Options) then
  1582.             begin
  1583.               fld := AnsiUpperCase(fld);
  1584.               val := AnsiUpperCase(val);
  1585.             end;
  1586.             fld := TrimRight(fld);
  1587.             val := TrimRight(val);
  1588.             if (loPartialKey in Options) then
  1589.               result := result and (AnsiPos(val, fld) = 1)
  1590.             else
  1591.               result := result and (val = fld);
  1592.         end else
  1593.           result := result and (val = fld);
  1594.         end;
  1595.         Inc(i);
  1596.       end;
  1597.       if not result then
  1598.         Next;
  1599.     end;
  1600.     if not result then
  1601.       Bookmark := CurBookmark
  1602.     else
  1603.       CursorPosChanged;
  1604.   finally
  1605.     fl.Free;
  1606.   end;
  1607. end;
  1608.  
  1609. procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
  1610. var
  1611.   i, j, k: Integer;
  1612.   pbd: PBlobDataArray;
  1613. begin
  1614.   pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
  1615.   j := 0;
  1616.   for i := 0 to FieldCount - 1 do
  1617.     if Fields[i].IsBlob then
  1618.     begin
  1619.       k := FMappedFieldPosition[Fields[i].FieldNo -1];
  1620.       if pbd^[j] <> nil then
  1621.       begin
  1622.         pbd^[j].Finalize;
  1623.         PISC_QUAD(
  1624.           PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
  1625.           pbd^[j].BlobID;
  1626.         PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
  1627.       end;
  1628.       Inc(j);
  1629.     end;
  1630.   if Assigned(FUpdateObject) then
  1631.   begin
  1632.     if (Qry = FQDelete) then
  1633.       FUpdateObject.Apply(ukDelete)
  1634.     else if (Qry = FQInsert) then
  1635.       FUpdateObject.Apply(ukInsert)
  1636.     else
  1637.       FUpdateObject.Apply(ukModify);
  1638.   end
  1639.   else begin
  1640.     SetInternalSQLParams(Qry, Buff);
  1641.     Qry.ExecQuery;
  1642.   end;
  1643.   PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
  1644.   PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
  1645.   SetModified(False);
  1646.   WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
  1647.   if CanRefresh then
  1648.     InternalRefreshRow;
  1649. end;
  1650.  
  1651. procedure TIBCustomDataSet.InternalRefreshRow;
  1652. var
  1653.   Buff: PChar;
  1654.   iCurScreenState: Integer;
  1655.   ofs: DWORD;
  1656.   Qry: TIBSQL;
  1657. begin
  1658.   iCurScreenState := Screen.Cursor;
  1659.   Screen.Cursor := crHourglass;
  1660.   try
  1661.     Buff := GetActiveBuf;
  1662.     if CanRefresh and (Buff <> nil) then
  1663.     begin
  1664.       if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then
  1665.       begin
  1666.         Qry := TIBSQL.Create(self);
  1667.         Qry.Database := Database;
  1668.         Qry.Transaction := Transaction;
  1669.         Qry.GoToFirstRecordOnExecute := False;
  1670.         Qry.SQL.Text := FUpdateObject.RefreshSQL.Text;
  1671.       end
  1672.       else
  1673.         Qry := FQRefresh;
  1674.       SetInternalSQLParams(Qry, Buff);
  1675.       Qry.ExecQuery;
  1676.       try
  1677.         if (Qry.SQLType = SQLExecProcedure) or
  1678.            (Qry.Next <> nil) then
  1679.         begin
  1680.           ofs := PRecordData(Buff)^.rdSavedOffset;
  1681.           FetchCurrentRecordToBuffer(Qry,
  1682.                                      PRecordData(Buff)^.rdRecordNumber,
  1683.                                      Buff);
  1684.           if (ofs <> $FFFFFFFF) then
  1685.           begin
  1686.             PRecordData(Buff)^.rdSavedOffset := ofs;
  1687.             WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
  1688.             SaveOldBuffer(Buff);
  1689.           end;
  1690.         end;
  1691.       finally
  1692.         Qry.Close;
  1693.       end;
  1694.       if Qry <> FQRefresh then
  1695.         Qry.Free;
  1696.     end
  1697.     else
  1698.       IBError(ibxeCannotRefresh, [nil]);
  1699.   finally
  1700.     Screen.Cursor := iCurScreenState;
  1701.   end;
  1702. end;
  1703.  
  1704. procedure TIBCustomDataSet.InternalRevertRecord(RecordNumber: Integer);
  1705. var
  1706.   NewBuffer, OldBuffer: PRecordData;
  1707.  
  1708. begin
  1709.   NewBuffer := nil;
  1710.   OldBuffer := nil;
  1711.   NewBuffer := PRecordData(AllocRecordBuffer);
  1712.   OldBuffer := PRecordData(AllocRecordBuffer);
  1713.   try
  1714.     ReadRecordCache(RecordNumber, PChar(NewBuffer), False);
  1715.     ReadRecordCache(RecordNumber, PChar(OldBuffer), True);
  1716.     case NewBuffer^.rdCachedUpdateStatus of
  1717.       cusInserted:
  1718.       begin
  1719.         NewBuffer^.rdCachedUpdateStatus := cusUninserted;
  1720.         Inc(FDeletedRecords);
  1721.       end;
  1722.       cusModified,
  1723.       cusDeleted:
  1724.       begin
  1725.         if (NewBuffer^.rdCachedUpdateStatus = cusDeleted) then
  1726.           Dec(FDeletedRecords);
  1727.         CopyRecordBuffer(OldBuffer, NewBuffer);
  1728.       end;
  1729.     end;
  1730.  
  1731.     if State in dsEditModes then
  1732.       Cancel;
  1733.  
  1734.     WriteRecordCache(RecordNumber, PChar(NewBuffer));
  1735.  
  1736.     if (NewBuffer^.rdCachedUpdateStatus = cusUninserted ) then
  1737.       ReSync([]);
  1738.   finally
  1739.     FreeRecordBuffer(PChar(NewBuffer));
  1740.     FreeRecordBuffer(PChar(OldBuffer));
  1741.   end;
  1742. end;
  1743.  
  1744. { A visible record is one that is not truly deleted,
  1745.   and it is also listed in the FUpdateRecordTypes set }
  1746.  
  1747. function TIBCustomDataSet.IsVisible(Buffer: PChar): Boolean;
  1748. begin
  1749.   result := True;
  1750.   if not (State = dsOldValue) then
  1751.     result :=
  1752.       (PRecordData(Buffer)^.rdCachedUpdateStatus in FUpdateRecordTypes) and
  1753.       (not ((PRecordData(Buffer)^.rdCachedUpdateStatus = cusUnmodified) and
  1754.         (PRecordData(Buffer)^.rdUpdateStatus = usDeleted)));
  1755. end;
  1756.  
  1757.  
  1758. function TIBCustomDataSet.LocateNext(const KeyFields: string;
  1759.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  1760. begin
  1761.   DisableControls;
  1762.   try
  1763.     result := InternalLocate(KeyFields, KeyValues, Options);
  1764.   finally
  1765.     EnableControls;
  1766.   end;
  1767. end;
  1768.  
  1769. procedure TIBCustomDataSet.InternalPrepare;
  1770. var
  1771.   iCurScreenState: Integer;
  1772.   DidActivate: Boolean;
  1773. begin
  1774.   DidActivate := False;
  1775.   iCurScreenState := Screen.Cursor;
  1776.   Screen.Cursor := crHourglass;
  1777.   try
  1778.     ActivateConnection;
  1779.     DidActivate := ActivateTransaction;
  1780.     FBase.CheckDatabase;
  1781.     FBase.CheckTransaction;
  1782.     if FQSelect.SQL.Text <> '' then
  1783.     begin
  1784.       if not FQSelect.Prepared then
  1785.       begin
  1786.         FQSelect.ParamCheck := ParamCheck;
  1787.         FQSelect.Prepare;
  1788.       end;
  1789.       if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
  1790.         FQDelete.Prepare;
  1791.       if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
  1792.         FQInsert.Prepare;
  1793.       if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
  1794.         FQRefresh.Prepare;
  1795.       if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
  1796.         FQModify.Prepare;
  1797.       FInternalPrepared := True;
  1798.       InternalInitFieldDefs;
  1799.     end else
  1800.       IBError(ibxeEmptyQuery, [nil]);
  1801.   finally
  1802.     if DidActivate then
  1803.       DeactivateTransaction;
  1804.     Screen.Cursor := iCurScreenState;
  1805.   end;
  1806. end;
  1807.  
  1808. procedure TIBCustomDataSet.RecordModified(Value: Boolean);
  1809. begin
  1810.   SetModified(Value);
  1811. end;
  1812.  
  1813. procedure TIBCustomDataSet.RevertRecord;
  1814. var
  1815.   Buff: PRecordData;
  1816. begin
  1817.   if FCachedUpdates and FUpdatesPending then
  1818.   begin
  1819.     Buff := PRecordData(GetActiveBuf);
  1820.     InternalRevertRecord(Buff^.rdRecordNumber);
  1821.     ReadRecordCache(Buff^.rdRecordNumber, PChar(Buff), False);
  1822.     DataEvent(deRecordChange, 0);
  1823.   end;
  1824. end;
  1825.  
  1826. procedure TIBCustomDataSet.SaveOldBuffer(Buffer: PChar);
  1827. var
  1828.   OldBuffer: Pointer;
  1829.   procedure CopyOldBuffer;
  1830.   begin
  1831.     CopyRecordBuffer(Buffer, OldBuffer);
  1832.     if BlobFieldCount > 0 then
  1833.       FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
  1834.                0);
  1835.   end;
  1836.  
  1837. begin
  1838.   if (Buffer <> nil) and (PRecordData(Buffer)^.rdRecordNumber >= 0) then
  1839.   begin
  1840.     OldBuffer := AllocRecordBuffer;
  1841.     try
  1842.       if (PRecordData(Buffer)^.rdSavedOffset = $FFFFFFFF) then
  1843.       begin
  1844.         PRecordData(Buffer)^.rdSavedOffset := AdjustPosition(FOldBufferCache, 0,
  1845.                                                              FILE_END);
  1846.         CopyOldBuffer;
  1847.           WriteCache(FOldBufferCache, 0, FILE_CURRENT, OldBuffer);
  1848.           WriteCache(FBufferCache, PRecordData(Buffer)^.rdRecordNumber * FRecordBufferSize,
  1849.                      FILE_BEGIN, Buffer);
  1850.       end
  1851.       else begin
  1852.         CopyOldBuffer;
  1853.         WriteCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN,
  1854.                    OldBuffer);
  1855.       end;
  1856.     finally
  1857.       FreeRecordBuffer(PChar(OldBuffer));
  1858.     end;
  1859.   end;
  1860. end;
  1861.  
  1862. procedure TIBCustomDataSet.SetBufferChunks(Value: Integer);
  1863. begin
  1864.   if (Value <= 0) then
  1865.     FBufferChunks := BufferCacheSize
  1866.   else
  1867.     FBufferChunks := Value;
  1868. end;
  1869.  
  1870. procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
  1871. begin
  1872.   if FBase.Database <> Value then
  1873.   begin
  1874.     CheckDatasetClosed;
  1875.     FBase.Database := Value;
  1876.     FQDelete.Database := Value;
  1877.     FQInsert.Database := Value;
  1878.     FQRefresh.Database := Value;
  1879.     FQSelect.Database := Value;
  1880.     FQModify.Database := Value;
  1881.   end;
  1882. end;
  1883.  
  1884. procedure TIBCustomDataSet.SetDeleteSQL(Value: TStrings);
  1885. begin
  1886.   CheckDatasetClosed;
  1887.   FQDelete.SQL.Assign(Value);
  1888. end;
  1889.  
  1890. procedure TIBCustomDataSet.SetInsertSQL(Value: TStrings);
  1891. begin
  1892.   CheckDatasetClosed;
  1893.   FQInsert.SQL.Assign(Value);
  1894. end;
  1895.  
  1896. procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
  1897. var
  1898.   i, j: Integer;
  1899.   cr, data: PChar;
  1900.   fn, st: string;
  1901.   OldBuffer: Pointer;
  1902.   ts: TTimeStamp;
  1903. begin
  1904.   if (Buffer = nil) then
  1905.     IBError(ibxeBufferNotSet, [nil]);
  1906.   if (not FInternalPrepared) then
  1907.     InternalPrepare;
  1908.   OldBuffer := nil;
  1909.   try
  1910.     for i := 0 to Qry.Params.Count - 1 do
  1911.     begin
  1912.       fn := Qry.Params[i].Name;
  1913.       if (Pos('OLD_', fn) = 1) then {mbcs ok}
  1914.       begin
  1915.         fn := Copy(fn, 5, Length(fn));
  1916.         OldBuffer := AllocRecordBuffer;
  1917.         ReadRecordCache(PRecordData(Buffer)^.rdRecordNumber, OldBuffer, True);
  1918.         cr := OldBuffer;
  1919.       end
  1920.       else if (Pos('NEW_', fn) = 1) then {mbcs ok}
  1921.            begin
  1922.              fn := Copy(fn, 5, Length(fn));
  1923.              cr := Buffer;
  1924.             end
  1925.             else
  1926.              cr := Buffer;
  1927.       j := FQSelect.FieldIndex[fn] + 1;
  1928.       if (j > 0) then
  1929.         with PRecordData(cr)^ do
  1930.         begin
  1931.           if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
  1932.           begin
  1933.             PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
  1934.             continue;
  1935.           end;
  1936.           if rdFields[j].fdIsNull then
  1937.             Qry.Params[i].IsNull := True
  1938.           else begin
  1939.             Qry.Params[i].IsNull := False;
  1940.             data := cr + rdFields[j].fdDataOfs;
  1941.             case rdFields[j].fdDataType of
  1942.               SQL_TEXT, SQL_VARYING:
  1943.               begin
  1944.                 SetString(st, data, rdFields[j].fdDataLength);
  1945.                 Qry.Params[i].AsString := st;
  1946.               end;
  1947.             SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
  1948.               Qry.Params[i].AsDouble := PDouble(data)^;
  1949.             SQL_SHORT, SQL_LONG:
  1950.             begin
  1951.               if rdFields[j].fdDataScale = 0 then
  1952.                 Qry.Params[i].AsLong := PLong(data)^
  1953.               else if rdFields[j].fdDataScale >= (-4) then
  1954.                 Qry.Params[i].AsCurrency := PCurrency(data)^
  1955.               else
  1956.                 Qry.Params[i].AsDouble := PDouble(data)^;
  1957.             end;
  1958.             SQL_INT64:
  1959.             begin
  1960.               if rdFields[j].fdDataScale = 0 then
  1961.                 Qry.Params[i].AsInt64 := PInt64(data)^
  1962.               else if rdFields[j].fdDataScale >= (-4) then
  1963.                 Qry.Params[i].AsCurrency := PCurrency(data)^
  1964.               else
  1965.                 Qry.Params[i].AsDouble := PDouble(data)^;
  1966.             end;
  1967.             SQL_BLOB, SQL_ARRAY, SQL_QUAD:
  1968.               Qry.Params[i].AsQuad := PISC_QUAD(data)^;
  1969.             SQL_TYPE_DATE:
  1970.             begin
  1971.               ts.Date := PInt(data)^;
  1972.               ts.Time := 0;
  1973.               Qry.Params[i].AsDate :=
  1974.                 TimeStampToDateTime(ts);
  1975.             end;
  1976.             SQL_TYPE_TIME:
  1977.             begin
  1978.               ts.Date := 0;
  1979.               ts.Time := PInt(data)^;
  1980.               Qry.Params[i].AsTime :=
  1981.                 TimeStampToDateTime(ts);
  1982.             end;
  1983.             SQL_TIMESTAMP:
  1984.               Qry.Params[i].AsDateTime :=
  1985.                 TimeStampToDateTime(
  1986.                   MSecsToTimeStamp(PDouble(data)^));
  1987.           end;
  1988.         end;
  1989.       end;
  1990.     end;
  1991.   finally
  1992.     if (OldBuffer <> nil) then
  1993.       FreeRecordBuffer(PChar(OldBuffer));
  1994.   end;
  1995. end;
  1996.  
  1997. procedure TIBCustomDataSet.SetRefreshSQL(Value: TStrings);
  1998. begin
  1999.   CheckDatasetClosed;
  2000.   FQRefresh.SQL.Assign(Value);
  2001. end;
  2002.  
  2003. procedure TIBCustomDataSet.SetSelectSQL(Value: TStrings);
  2004. begin
  2005.   CheckDatasetClosed;
  2006.   FQSelect.SQL.Assign(Value);
  2007. end;
  2008.  
  2009. procedure TIBCustomDataSet.SetModifySQL(Value: TStrings);
  2010. begin
  2011.   CheckDatasetClosed;
  2012.   FQModify.SQL.Assign(Value);
  2013. end;
  2014.  
  2015. procedure TIBCustomDataSet.SetTransaction(Value: TIBTransaction);
  2016. begin
  2017.   if (FBase.Transaction <> Value) then
  2018.   begin
  2019.     CheckDatasetClosed;
  2020.     FBase.Transaction := Value;
  2021.     FQDelete.Transaction := Value;
  2022.     FQInsert.Transaction := Value;
  2023.     FQRefresh.Transaction := Value;
  2024.     FQSelect.Transaction := Value;
  2025.     FQModify.Transaction := Value;
  2026.   end;
  2027. end;
  2028.  
  2029. procedure TIBCustomDataSet.SetUniDirectional(Value: Boolean);
  2030. begin
  2031.   CheckDatasetClosed;
  2032.   FUniDirectional := Value;
  2033. end;
  2034.  
  2035. procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
  2036. begin
  2037.   FUpdateRecordTypes := Value;
  2038.   if Active then
  2039.     First;
  2040. end;
  2041.  
  2042. procedure TIBCustomDataSet.RefreshParams;
  2043. var
  2044.   DataSet: TDataSet;
  2045. begin
  2046.   DisableControls;
  2047.   try
  2048.     if FDataLink.DataSource <> nil then
  2049.     begin
  2050.       DataSet := FDataLink.DataSource.DataSet;
  2051.       if DataSet <> nil then
  2052.         if DataSet.Active and (DataSet.State <> dsSetKey) then
  2053.         begin
  2054.           Close;
  2055.           Open;
  2056.         end;
  2057.     end;
  2058.   finally
  2059.     EnableControls;
  2060.   end;
  2061. end;
  2062.  
  2063.  
  2064. procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
  2065. begin
  2066.   InternalUnPrepare;
  2067. end;
  2068.  
  2069. { I can "undelete" uninserted records (make them "inserted" again).
  2070.   I can "undelete" cached deleted (the deletion hasn't yet occurred) }
  2071. procedure TIBCustomDataSet.Undelete;
  2072. var
  2073.   Buff: PRecordData;
  2074. begin
  2075.   CheckActive;
  2076.   Buff := PRecordData(GetActiveBuf);
  2077.   with Buff^ do
  2078.   begin
  2079.     if rdCachedUpdateStatus = cusUninserted then
  2080.     begin
  2081.       rdCachedUpdateStatus := cusInserted;
  2082.       Dec(FDeletedRecords);
  2083.     end
  2084.     else if (rdUpdateStatus = usDeleted) and
  2085.             (rdCachedUpdateStatus = cusDeleted) then
  2086.     begin
  2087.       rdCachedUpdateStatus := cusUnmodified;
  2088.       rdUpdateStatus := usUnmodified;
  2089.       Dec(FDeletedRecords);
  2090.     end;
  2091.     WriteRecordCache(rdRecordNumber, PChar(Buff));
  2092.   end;
  2093. end;
  2094.  
  2095. function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
  2096. begin
  2097.   if Active then
  2098.     result := PRecordData(GetActiveBuf)^.rdUpdateStatus
  2099.   else
  2100.     result := usUnmodified;
  2101. end;
  2102.  
  2103. function TIBCustomDataSet.IsSequenced: Boolean;
  2104. begin
  2105.   Result := Assigned( FQSelect ) and FQSelect.EOF;
  2106. end;
  2107.  
  2108. function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
  2109.                                         Origin: Integer): Integer;
  2110. var
  2111.   OldCacheSize: Integer;
  2112. begin
  2113.   if (FCache = FBufferCache) then
  2114.   begin
  2115.     case Origin of
  2116.       FILE_BEGIN:    FBPos := Offset;
  2117.       FILE_CURRENT:  FBPos := FBPos + Offset;
  2118.       FILE_END:      FBPos := DWORD(FBEnd) + Offset;
  2119.     end;
  2120.     OldCacheSize := FCacheSize;
  2121.     while (FBPos >= DWORD(FCacheSize)) do
  2122.       Inc(FCacheSize, FBufferChunkSize);
  2123.     if FCacheSize > OldCacheSize then
  2124.       IBAlloc(FBufferCache, FCacheSize, FCacheSize);
  2125.     result := FBPos;
  2126.   end
  2127.   else begin
  2128.     case Origin of
  2129.       FILE_BEGIN:    FOBPos := Offset;
  2130.       FILE_CURRENT:  FOBPos := FOBPos + Offset;
  2131.       FILE_END:      FOBPos := DWORD(FOBEnd) + Offset;
  2132.     end;
  2133.     OldCacheSize := FOldCacheSize;
  2134.     while (FBPos >= DWORD(FOldCacheSize)) do
  2135.       Inc(FOldCacheSize, FBufferChunkSize);
  2136.     if FOldCacheSize > OldCacheSize then
  2137.       IBAlloc(FOldBufferCache, FOldCacheSize, FOldCacheSize);
  2138.     result := FOBPos;
  2139.   end;
  2140. end;
  2141.  
  2142. procedure TIBCustomDataSet.ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
  2143.                                     Buffer: PChar);
  2144. var
  2145.   pCache: PChar;
  2146.   bOld: Boolean;
  2147. begin
  2148.   bOld := (FCache = FOldBufferCache);
  2149.   pCache := PChar(AdjustPosition(FCache, Offset, Origin));
  2150.   if not bOld then
  2151.     pCache := FBufferCache + Integer(pCache)
  2152.   else
  2153.     pCache := FOldBufferCache + Integer(pCache);
  2154.   Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
  2155.   AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
  2156. end;
  2157.  
  2158. procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
  2159.                                           ReadOldBuffer: Boolean);
  2160. begin
  2161.   if FUniDirectional then
  2162.     RecordNumber := RecordNumber mod UniCache;
  2163.   if (ReadOldBuffer) then
  2164.   begin
  2165.     ReadRecordCache(RecordNumber, Buffer, False);
  2166.     if (PRecordData(Buffer)^.rdSavedOffset <> $FFFFFFFF) then
  2167.       ReadCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN,
  2168.                 Buffer)
  2169.   end
  2170.   else
  2171.     ReadCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
  2172. end;
  2173.  
  2174. procedure TIBCustomDataSet.WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;
  2175.                                      Buffer: PChar);
  2176. var
  2177.   pCache: PChar;
  2178.   bOld: Boolean;
  2179.   dwEnd: DWORD;
  2180. begin
  2181.   bOld := (FCache = FOldBufferCache);
  2182.   pCache := PChar(AdjustPosition(FCache, Offset, Origin));
  2183.   if not bOld then
  2184.     pCache := FBufferCache + Integer(pCache)
  2185.   else
  2186.     pCache := FOldBufferCache + Integer(pCache);
  2187.   Move(Buffer^, pCache^, FRecordBufferSize);
  2188.   dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
  2189.   if not bOld then
  2190.   begin
  2191.     if (dwEnd > FBEnd) then
  2192.       FBEnd := dwEnd;
  2193.   end
  2194.   else begin
  2195.     if (dwEnd > FOBEnd) then
  2196.       FOBEnd := dwEnd;
  2197.   end;
  2198. end;
  2199.  
  2200. procedure TIBCustomDataSet.WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
  2201. begin
  2202.   if RecordNumber >= 0 then
  2203.   begin
  2204.     if FUniDirectional then
  2205.       RecordNumber := RecordNumber mod UniCache;
  2206.     WriteCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
  2207.   end;
  2208. end;
  2209.  
  2210. function TIBCustomDataSet.AllocRecordBuffer: PChar;
  2211. begin
  2212.   result := nil;
  2213.   IBAlloc(result, FRecordBufferSize, FRecordBufferSize);
  2214.   Move(FModelBuffer^, result^, FRecordBufferSize);
  2215. end;
  2216.  
  2217. function TIBCustomDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  2218. var
  2219.   pb: PBlobDataArray;
  2220.   fs: TIBBlobStream;
  2221.   Buff: PChar;
  2222.   bTr, bDB: Boolean;
  2223. begin
  2224.   Buff := GetActiveBuf;
  2225.   if Buff = nil then
  2226.   begin
  2227.     fs := TIBBlobStream.Create;
  2228.     fs.Mode := bmReadWrite;
  2229.     FBlobStreamList.Add(Pointer(fs));
  2230.     result := TIBDSBlobStream.Create(Field, fs, Mode);
  2231.     exit;
  2232.   end;
  2233.   pb := PBlobDataArray(Buff + FBlobCacheOffset);
  2234.   if pb^[Field.Offset] = nil then
  2235.   begin
  2236.     AdjustRecordOnInsert(Buff);
  2237.     pb^[Field.Offset] := TIBBlobStream.Create;
  2238.     fs := pb^[Field.Offset];
  2239.     FBlobStreamList.Add(Pointer(fs));
  2240.     fs.Mode := bmReadWrite;
  2241.     fs.Database := Database;
  2242.     fs.Transaction := Transaction;
  2243.     fs.BlobID :=
  2244.       PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
  2245.     if (CachedUpdates) then
  2246.     begin
  2247.       bTr := not Transaction.InTransaction;
  2248.       bDB := not Database.Connected;
  2249.       if bDB then
  2250.         Database.Open;
  2251.       if bTr then
  2252.         Transaction.StartTransaction;
  2253.       fs.Seek(0, soFromBeginning);
  2254.       if bTr then
  2255.         Transaction.Commit;
  2256.       if bDB then
  2257.         Database.Close;
  2258.     end;
  2259.     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
  2260.   end else
  2261.     fs := pb^[Field.Offset];
  2262.   result := TIBDSBlobStream.Create(Field, fs, Mode);
  2263. end;
  2264.  
  2265. function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
  2266. const
  2267.   CMPLess = -1;
  2268.   CMPEql  =  0;
  2269.   CMPGtr  =  1;
  2270.   RetCodes: array[Boolean, Boolean] of ShortInt = ((2, CMPLess),
  2271.                                                    (CMPGtr, CMPEql));
  2272. begin
  2273.   result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];
  2274.  
  2275.   if Result = 2 then
  2276.   begin
  2277.     if PInteger(Bookmark1)^ < PInteger(Bookmark2)^ then
  2278.       Result := CMPLess
  2279.     else
  2280.     if PInteger(Bookmark1)^ > PInteger(Bookmark2)^ then
  2281.       Result := CMPGtr
  2282.     else
  2283.       Result := CMPEql;
  2284.   end;
  2285. end;
  2286.  
  2287. procedure TIBCustomDataSet.DoBeforeDelete;
  2288. var
  2289.   Buff: PRecordData;
  2290. begin
  2291.   if not CanDelete then
  2292.     IBError(ibxeCannotDelete, [nil]);
  2293.   Buff := PRecordData(GetActiveBuf);
  2294.   if Buff^.rdCachedUpdateStatus in [cusUnmodified] then
  2295.     SaveOldBuffer(PChar(Buff));
  2296.   inherited;
  2297. end;
  2298.  
  2299. procedure TIBCustomDataSet.DoBeforeEdit;
  2300. var
  2301.   Buff: PRecordData;
  2302. begin
  2303.   Buff := PRecordData(GetActiveBuf);
  2304.   if not(CanEdit or (FQModify.SQL.Count <> 0) or
  2305.     (FCachedUpdates and Assigned(FOnUpdateRecord))) then
  2306.     IBError(ibxeCannotUpdate, [nil]);
  2307.   if Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted] then
  2308.     SaveOldBuffer(PChar(Buff));
  2309.   CopyRecordBuffer(GetActiveBuf, FOldBuffer);
  2310.   inherited;
  2311. end;
  2312.  
  2313. procedure TIBCustomDataSet.DoBeforeInsert;
  2314. begin
  2315.   if not CanInsert then
  2316.     IBError(ibxeCannotInsert, [nil]);
  2317.   inherited;
  2318. end;
  2319.  
  2320. procedure TIBCustomDataSet.FetchAll;
  2321. var
  2322.   CurBookmark: string;
  2323.   iCurScreenState: Integer;
  2324. begin
  2325.   iCurScreenState := Screen.Cursor;
  2326.   Screen.Cursor := crHourglass;
  2327.   try
  2328.     if FQSelect.EOF or not FQSelect.Open then
  2329.       exit;
  2330.     DisableControls;
  2331.     try
  2332.       CurBookmark := Bookmark;
  2333.       Last;
  2334.       Bookmark := CurBookmark;
  2335.     finally
  2336.       EnableControls;
  2337.     end;
  2338.   finally
  2339.     Screen.Cursor := iCurScreenState;
  2340.   end;
  2341. end;
  2342.  
  2343. procedure TIBCustomDataSet.FreeRecordBuffer(var Buffer: PChar);
  2344. begin
  2345.   IBAlloc(Buffer, 0, 0);
  2346. end;
  2347.  
  2348. procedure TIBCustomDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
  2349. begin
  2350.   Move(PRecordData(Buffer)^.rdRecordNumber, Data^, BookmarkSize);
  2351. end;
  2352.  
  2353. function TIBCustomDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  2354. begin
  2355.   result := PRecordData(Buffer)^.rdBookmarkFlag;
  2356. end;
  2357.  
  2358. function TIBCustomDataSet.GetCanModify: Boolean;
  2359. begin
  2360.   result := (FQInsert.SQL.Text <> '') or
  2361.     (FQModify.SQL.Text <> '') or
  2362.     (FQDelete.SQL.Text <> '') or
  2363.     (Assigned(FUpdateObject));
  2364. end;
  2365.  
  2366. function TIBCustomDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
  2367. begin
  2368.   if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
  2369.   begin
  2370.     UpdateCursorPos;
  2371.     ReadRecordCache(PRecordData(ActiveBuffer)^.rdRecordNumber, Buffer, False);
  2372.     result := True;
  2373.   end
  2374.   else
  2375.     result := False;
  2376. end;
  2377.  
  2378. function TIBCustomDataSet.GetDataSource: TDataSource;
  2379. begin
  2380.   if FDataLink = nil then
  2381.     result := nil
  2382.   else
  2383.     result := FDataLink.DataSource;
  2384. end;
  2385.  
  2386. function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
  2387. begin
  2388.   Result := DefaultFieldClasses[FieldType];
  2389. end;
  2390.  
  2391. function TIBCustomDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean;
  2392. begin
  2393.   result := GetFieldData(FieldByNumber(FieldNo), buffer);
  2394. end;
  2395.  
  2396. function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  2397. var
  2398.   Buff, Data: PChar;
  2399.   CurrentRecord: PRecordData;
  2400. begin
  2401.   result := False;
  2402.   Buff := GetActiveBuf;
  2403.   if (Buff = nil)
  2404.   or (not IsVisible(Buff)) then
  2405.     exit;
  2406.   { The intention here is to stuff the buffer with the data for the
  2407.    referenced field for the current record }
  2408.   CurrentRecord := PRecordData(Buff);
  2409.   if (Field.FieldNo < 0) then
  2410.   begin
  2411.     Inc(Buff, FRecordSize + Field.Offset);
  2412.     result := Boolean(Buff[0]);
  2413.     if result and (Buffer <> nil) then
  2414.       Move(Buff[1], Buffer^, Field.DataSize);
  2415.   end
  2416.   else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
  2417.      (FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
  2418.   begin
  2419.     result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
  2420.     if result and (Buffer <> nil) then
  2421.       with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
  2422.       begin
  2423.         Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
  2424.         if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
  2425.         begin
  2426.           Move(Data^, Buffer^, fdDataLength);
  2427.           PChar(Buffer)[fdDataLength] := #0;
  2428.         end
  2429.         else
  2430.           Move(Data^, Buffer^, Field.DataSize);
  2431.       end;
  2432.   end;
  2433. end;
  2434.  
  2435. { GetRecNo and SetRecNo both operate off of 1-based indexes as
  2436.  opposed to 0-based indexes.
  2437.  This is because we want LastRecordNumber/RecordCount = 1 }
  2438.  
  2439. function TIBCustomDataSet.GetRecNo: Integer;
  2440. begin
  2441.   if GetActiveBuf = nil then
  2442.     result := 0
  2443.   else
  2444.     result := PRecordData(GetActiveBuf)^.rdRecordNumber + 1;
  2445. end;
  2446.  
  2447. function TIBCustomDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
  2448.   DoCheck: Boolean): TGetResult;
  2449. var
  2450.   Accept: Boolean;
  2451.   SaveState: TDataSetState;
  2452. begin
  2453.   Result := grOK;
  2454.   if Filtered and Assigned(OnFilterRecord) then
  2455.   begin
  2456.     Accept := False;
  2457.     SaveState := SetTempState(dsFilter);
  2458.     while not Accept do
  2459.     begin
  2460.       Result := InternalGetRecord(Buffer, GetMode, DoCheck);
  2461.       if Result <> grOK then
  2462.         break;
  2463.       FFilterBuffer := Buffer;
  2464.       try
  2465.         Accept := True;
  2466.         OnFilterRecord(Self, Accept);
  2467.       except
  2468.         Application.HandleException(Self);
  2469.       end;
  2470.     end;
  2471.     RestoreState(SaveState);
  2472.   end
  2473.   else
  2474.     Result := InternalGetRecord(Buffer, GetMode, DoCheck);
  2475. end;
  2476.  
  2477. function TIBCustomDataSet.InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
  2478.   DoCheck: Boolean): TGetResult;
  2479. begin
  2480.   result := grError;
  2481.   case GetMode of
  2482.     gmCurrent: begin
  2483.       if (FCurrentRecord >= 0) then begin
  2484.         if FCurrentRecord < FRecordCount then
  2485.           ReadRecordCache(FCurrentRecord, Buffer, False)
  2486.         else begin
  2487.           while (not FQSelect.EOF) and
  2488.                 (FQSelect.Next <> nil) and
  2489.                 (FCurrentRecord >= FRecordCount) do begin
  2490.             FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
  2491.             Inc(FRecordCount);
  2492.           end;
  2493.           FCurrentRecord := FRecordCount - 1;
  2494.           if (FCurrentRecord >= 0) then
  2495.             ReadRecordCache(FCurrentRecord, Buffer, False);
  2496.         end;
  2497.         result := grOk;
  2498.       end else
  2499.         result := grBOF;
  2500.     end;
  2501.     gmNext: begin
  2502.       result := grOk;
  2503.       if FCurrentRecord = FRecordCount then
  2504.         result := grEOF
  2505.       else if FCurrentRecord = FRecordCount - 1 then begin
  2506.         if (not FQSelect.EOF) then begin
  2507.           FQSelect.Next;
  2508.           Inc(FCurrentRecord);
  2509.         end;
  2510.         if (FQSelect.EOF) then begin
  2511.           result := grEOF;
  2512.         end else begin
  2513.           Inc(FRecordCount);
  2514.           FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
  2515.         end;
  2516.       end else if (FCurrentRecord < FRecordCount) then begin
  2517.         Inc(FCurrentRecord);
  2518.         ReadRecordCache(FCurrentRecord, Buffer, False);
  2519.       end;
  2520.     end;
  2521.     else { gmPrior }
  2522.     begin
  2523.       if (FCurrentRecord = 0) then begin
  2524.         Dec(FCurrentRecord);
  2525.         result := grBOF;
  2526.       end else if (FCurrentRecord > 0) and
  2527.                   (FCurrentRecord <= FRecordCount) then begin
  2528.         Dec(FCurrentRecord);
  2529.         ReadRecordCache(FCurrentRecord, Buffer, False);
  2530.         result := grOk;
  2531.       end else if (FCurrentRecord = -1) then
  2532.         result := grBOF;
  2533.     end;
  2534.   end;
  2535.   if result = grOk then
  2536.     result := AdjustCurrentRecord(Buffer, GetMode);
  2537.   if result = grOk then with PRecordData(Buffer)^ do begin
  2538.     rdBookmarkFlag := bfCurrent;
  2539.     GetCalcFields(Buffer);
  2540.   end else if (result = grEOF) then begin
  2541.     CopyRecordBuffer(FModelBuffer, Buffer);
  2542.     PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;
  2543.   end else if (result = grBOF) then begin
  2544.     CopyRecordBuffer(FModelBuffer, Buffer);
  2545.     PRecordData(Buffer)^.rdBookmarkFlag := bfBOF;
  2546.   end else if (result = grError) then begin
  2547.     CopyRecordBuffer(FModelBuffer, Buffer);
  2548.     PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;
  2549.   end;;
  2550. end;
  2551.  
  2552. function TIBCustomDataSet.GetRecordCount: Integer;
  2553. begin
  2554.   result := FRecordCount - FDeletedRecords;
  2555. end;
  2556.  
  2557. function TIBCustomDataSet.GetRecordSize: Word;
  2558. begin
  2559.   result := FRecordBufferSize;
  2560. end;
  2561.  
  2562. procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
  2563. begin
  2564.   CheckEditState;
  2565.   begin
  2566.      { When adding records, we *always* append.
  2567.        Insertion is just too costly }
  2568.     AdjustRecordOnInsert(Buffer);
  2569.     with PRecordData(Buffer)^ do
  2570.     begin
  2571.       rdUpdateStatus := usInserted;
  2572.       rdCachedUpdateStatus := cusInserted;
  2573.     end;
  2574.     if not CachedUpdates then
  2575.       InternalPostRecord(FQInsert, Buffer)
  2576.     else begin
  2577.       WriteRecordCache(FCurrentRecord, Buffer);
  2578.       FUpdatesPending := True;
  2579.     end;
  2580.     Inc(FRecordCount);
  2581.     InternalSetToRecord(Buffer);
  2582.   end
  2583. end;
  2584.  
  2585. procedure TIBCustomDataSet.InternalCancel;
  2586. var
  2587.   Buff: PChar;
  2588.   CurRec: Integer;
  2589. begin
  2590.   inherited;
  2591.   Buff := GetActiveBuf;
  2592.   if Buff <> nil then begin
  2593.     CurRec := FCurrentRecord;
  2594.     AdjustRecordOnInsert(Buff);
  2595.     if (State = dsEdit) then begin
  2596.       CopyRecordBuffer(FOldBuffer, Buff);
  2597.       WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
  2598.     end else begin
  2599.       CopyRecordBuffer(FModelBuffer, Buff);
  2600.       PRecordData(Buff)^.rdUpdateStatus := usDeleted;
  2601.       PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
  2602.       PRecordData(Buff)^.rdBookmarkFlag := bfEOF;
  2603.       FCurrentRecord := CurRec;
  2604.     end;
  2605.   end;
  2606. end;
  2607.  
  2608.  
  2609. procedure TIBCustomDataSet.InternalClose;
  2610. begin
  2611.   if FDidActivate then
  2612.     DeactivateTransaction;
  2613.   FQSelect.Close;
  2614.   ClearBlobCache;
  2615.   FreeRecordBuffer(FModelBuffer);
  2616.   FreeRecordBuffer(FOldBuffer);
  2617.   FCurrentRecord := -1;
  2618.   FOpen := False;
  2619.   FRecordCount := 0;
  2620.   FDeletedRecords := 0;
  2621.   FRecordSize := 0;
  2622.   FBPos := 0;
  2623.   FOBPos := 0;
  2624.   FCacheSize := 0;
  2625.   FOldCacheSize := 0;
  2626.   FBEnd := 0;
  2627.   FOBEnd := 0;
  2628.   IBAlloc(FBufferCache, 0, 0);
  2629.   IBAlloc(FOldBufferCache, 0, 0);
  2630.   BindFields(False);
  2631.   if DefaultFields then DestroyFields;
  2632. end;
  2633.  
  2634. procedure TIBCustomDataSet.InternalDelete;
  2635. var
  2636.   Buff: PChar;
  2637.   iCurScreenState: Integer;
  2638. begin
  2639.   iCurScreenState := Screen.Cursor;
  2640.   Screen.Cursor := crHourglass;
  2641.   try
  2642.     Buff := GetActiveBuf;
  2643.     if CanDelete then
  2644.     begin
  2645.       if not CachedUpdates then
  2646.         InternalDeleteRecord(FQDelete, Buff)
  2647.       else
  2648.       begin
  2649.         with PRecordData(Buff)^ do
  2650.         begin
  2651.           if rdCachedUpdateStatus = cusInserted then
  2652.             rdCachedUpdateStatus := cusUninserted
  2653.           else begin
  2654.             rdUpdateStatus := usDeleted;
  2655.             rdCachedUpdateStatus := cusDeleted;
  2656.           end;
  2657.         end;
  2658.         WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
  2659.       end;
  2660.       Inc(FDeletedRecords);
  2661.       FUpdatesPending := True;
  2662.     end else
  2663.       IBError(ibxeCannotDelete, [nil]);
  2664.   finally
  2665.     Screen.Cursor := iCurScreenState;
  2666.   end;
  2667. end;
  2668.  
  2669. procedure TIBCustomDataSet.InternalFirst;
  2670. begin
  2671.   FCurrentRecord := -1;
  2672. end;
  2673.  
  2674. procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer);
  2675. begin
  2676.   FCurrentRecord := PInteger(Bookmark)^;
  2677. end;
  2678.  
  2679. procedure TIBCustomDataSet.InternalHandleException;
  2680. begin
  2681.   Application.HandleException(Self)
  2682. end;
  2683.  
  2684. procedure TIBCustomDataSet.InternalInitFieldDefs;
  2685. var
  2686.   FieldType: TFieldType;
  2687.   FieldSize: Word;
  2688.   FieldNullable : Boolean;
  2689.   i, FieldPosition, FieldPrecision: Integer;
  2690.   FieldAliasName: string;
  2691.   RelationName, FieldName: string;
  2692.   Query : TIBSQL;
  2693.   FieldIndex: Integer;
  2694.  
  2695. begin
  2696.   if not InternalPrepared then
  2697.   begin
  2698.     InternalPrepare;
  2699.     exit;
  2700.   end;
  2701.   Database.InternalTransaction.StartTransaction;
  2702.   Query := TIBSQL.Create(self);
  2703.   try
  2704.     Query.Database := DataBase;
  2705.     Query.Transaction := Database.InternalTransaction;
  2706.     FieldDefs.BeginUpdate;
  2707.     FieldDefs.Clear;
  2708.     FieldIndex := 0;
  2709.     if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
  2710.       SetLength(FMappedFieldPosition, FQSelect.Current.Count);
  2711.     for i := 0 to FQSelect.Current.Count - 1 do
  2712.       with FQSelect.Current[i].Data^ do
  2713.       begin
  2714.         { Get the field name }
  2715.         SetString(FieldAliasName, aliasname, aliasname_length);
  2716.         SetString(RelationName, relname, relname_length);
  2717.         SetString(FieldName, sqlname, sqlname_length);
  2718.         FieldSize := 0;
  2719.         FieldPrecision := 0;
  2720.         FieldNullable := FQSelect.Current[i].IsNullable;
  2721.         case sqltype and not 1 of
  2722.           { All VARCHAR's must be converted to strings before recording
  2723.            their values }
  2724.           SQL_VARYING, SQL_TEXT:
  2725.           begin
  2726.             FieldSize := sqllen;
  2727.             FieldType := ftString;
  2728.           end;
  2729.           { All Doubles/Floats should be cast to doubles }
  2730.           SQL_DOUBLE, SQL_FLOAT:
  2731.             FieldType := ftFloat;
  2732.           SQL_SHORT:
  2733.           begin
  2734.             if (sqlscale = 0) then
  2735.               FieldType := ftSmallInt
  2736.             else begin
  2737.               FieldType := ftBCD;
  2738.               FieldPrecision := 4;
  2739.             end;
  2740.           end;
  2741.           SQL_LONG:
  2742.           begin
  2743.             if (sqlscale = 0) then
  2744.               FieldType := ftInteger
  2745.             else if (sqlscale >= (-4)) then
  2746.             begin
  2747.               FieldType := ftBCD;
  2748.               FieldPrecision := 9;
  2749.             end
  2750.             else
  2751.               FieldType := ftFloat;
  2752.             end;
  2753.           SQL_INT64:
  2754.           begin
  2755.             if (sqlscale = 0) then
  2756.               FieldType := ftLargeInt
  2757.             else if (sqlscale >= (-4)) then
  2758.             begin
  2759.               FieldType := ftBCD;
  2760.               FieldPrecision := 18;
  2761.             end
  2762.             else
  2763.               FieldType := ftFloat;
  2764.             end;
  2765.           SQL_TIMESTAMP: FieldType := ftDateTime;
  2766.           SQL_TYPE_TIME: FieldType := ftTime;
  2767.           SQL_TYPE_DATE: FieldType := ftDate;
  2768.           SQL_BLOB:
  2769.           begin
  2770.             FieldSize := sizeof (TISC_QUAD);
  2771.             if (sqlsubtype = 1) then
  2772.               FieldType := ftmemo
  2773.             else
  2774.               FieldType := ftBlob;
  2775.           end;
  2776.           SQL_ARRAY:
  2777.           begin
  2778.             FieldSize := sizeof (TISC_QUAD);
  2779.             FieldType := ftUnknown;
  2780.           end;
  2781.           else
  2782.             FieldType := ftUnknown;
  2783.         end;
  2784.         FieldPosition := i + 1;
  2785.         if (FieldType <> ftUnknown) and (FieldAliasName <> 'IBX_INTERNAL_DBKEY') then {do not localize}
  2786.         begin
  2787.           FMappedFieldPosition[FieldIndex] := FieldPosition;
  2788.           Inc(FieldIndex);
  2789.           with FieldDefs.AddFieldDef do
  2790.           begin
  2791.             Name := string( FieldAliasName );
  2792.             FieldNo := FieldPosition;
  2793.             DataType := FieldType;
  2794.             Size := FieldSize;
  2795.             Precision := FieldPrecision;
  2796.             Required := False;
  2797.             InternalCalcField := False;
  2798.             if (FieldName <> '') and (RelationName <> '') then
  2799.             begin
  2800.               Query.SQL.Text := 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
  2801.                             'F.RDB$DEFAULT_VALUE ' + {do not localize}
  2802.                             'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
  2803.                             'where R.RDB$RELATION_NAME = ' + '''' + {do not localize}
  2804.                             FormatIdentifierValue(Database.SQLDialect, RelationName) + ''' ' +
  2805.                             'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
  2806.                             'and R.RDB$FIELD_NAME = ' + '''' + {do not localize}
  2807.                             FormatIdentifierValue(Database.SQLDialect, FieldName) + '''';
  2808.               Query.Prepare;
  2809.               Query.ExecQuery;
  2810.               if not (Query.Current.ByName('RDB$COMPUTED_BLR').IsNull) then {do not localize}
  2811.               begin
  2812.                 Attributes := [faReadOnly];
  2813.                 InternalCalcField := True;
  2814.               end;
  2815.               if (not InternalCalcField) and (not FieldNullable) and
  2816.                    Query.Current.ByName('RDB$DEFAULT_VALUE').IsNull then {do not localize}
  2817.               begin
  2818.                 Attributes := [faRequired];
  2819.               end;
  2820.             end;
  2821.             Query.Close;
  2822.           end;
  2823.         end;
  2824.       end;
  2825.   finally
  2826.     Query.free;
  2827.     Database.InternalTransaction.Commit;
  2828.     FieldDefs.EndUpdate;
  2829.   end;
  2830. end;
  2831.  
  2832. procedure TIBCustomDataSet.InternalInitRecord(Buffer: PChar);
  2833. begin
  2834.   CopyRecordBuffer(FModelBuffer, Buffer);
  2835. end;
  2836.  
  2837. procedure TIBCustomDataSet.InternalLast;
  2838. var
  2839.   Buffer: PChar;
  2840. begin
  2841.   if (FQSelect.EOF) then
  2842.     FCurrentRecord := FRecordCount
  2843.   else begin
  2844.     Buffer := AllocRecordBuffer;
  2845.     try
  2846.       while FQSelect.Next <> nil do
  2847.       begin
  2848.         FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
  2849.         Inc(FRecordCount);
  2850.       end;
  2851.       FCurrentRecord := FRecordCount;
  2852.     finally
  2853.       FreeRecordBuffer(Buffer);
  2854.     end;
  2855.   end;
  2856. end;
  2857.  
  2858. procedure TIBCustomDataSet.InternalSetParamsFromCusror;
  2859. var
  2860.   i: Integer;
  2861.   cur_param: TIBXSQLVAR;
  2862.   cur_field: TField;
  2863.   s: TStream;
  2864. begin
  2865.   if FQSelect.SQL.Text = '' then
  2866.     IBError(ibxeEmptyQuery, [nil]);
  2867.   if not FInternalPrepared then
  2868.     InternalPrepare;
  2869.   if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
  2870.   begin
  2871.     for i := 0 to SQLParams.Count - 1 do
  2872.     begin
  2873.       cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
  2874.       cur_param := SQLParams[i];
  2875.       if (cur_field <> nil) then begin
  2876.         if (cur_field.IsNull) then
  2877.           cur_param.IsNull := True
  2878.         else case cur_field.DataType of
  2879.           ftString:
  2880.             cur_param.AsString := cur_field.AsString;
  2881.           ftBoolean, ftSmallint, ftWord:
  2882.             cur_param.AsShort := cur_field.AsInteger;
  2883.           ftInteger:
  2884.             cur_param.AsLong := cur_field.AsInteger;
  2885.           ftLargeInt:
  2886.             cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
  2887.           ftFloat, ftCurrency:
  2888.            cur_param.AsDouble := cur_field.AsFloat;
  2889.           ftBCD:
  2890.             cur_param.AsCurrency := cur_field.AsCurrency;
  2891.           ftDate:
  2892.             cur_param.AsDate := cur_field.AsDateTime;
  2893.           ftTime:
  2894.             cur_param.AsTime := cur_field.AsDateTime;
  2895.           ftDateTime:
  2896.             cur_param.AsDateTime := cur_field.AsDateTime;
  2897.           ftBlob, ftMemo:
  2898.           begin
  2899.             s := nil;
  2900.             try
  2901.               s := DataSource.DataSet.
  2902.                      CreateBlobStream(cur_field, bmRead);
  2903.               cur_param.LoadFromStream(s);
  2904.             finally
  2905.               s.free;
  2906.             end;
  2907.           end;
  2908.           else
  2909.             IBError(ibxeNotSupported, [nil]);
  2910.         end;
  2911.       end;
  2912.     end;
  2913.   end;
  2914. end;
  2915.  
  2916. procedure TIBCustomDataSet.ReQuery;
  2917. begin
  2918.   FQSelect.Close;
  2919.   ClearBlobCache;
  2920.   FCurrentRecord := -1;
  2921.   FRecordCount := 0;
  2922.   FDeletedRecords := 0;
  2923.   FBPos := 0;
  2924.   FOBPos := 0;
  2925.   FBEnd := 0;
  2926.   FOBEnd := 0;
  2927.   FQSelect.Close;
  2928.   FQSelect.ExecQuery;
  2929.   FOpen := FQSelect.Open;
  2930.   First;
  2931. end;
  2932.  
  2933. procedure TIBCustomDataSet.InternalOpen;
  2934. var
  2935.   iCurScreenState: Integer;
  2936.  
  2937.   function RecordDataLength(n: Integer): Long;
  2938.   begin
  2939.     result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
  2940.   end;
  2941.  
  2942. begin
  2943.   iCurScreenState := Screen.Cursor;
  2944.   Screen.Cursor := crHourglass;
  2945.   try
  2946.     ActivateConnection;
  2947.     ActivateTransaction;
  2948.     if FQSelect.SQL.Text = '' then
  2949.       IBError(ibxeEmptyQuery, [nil]);
  2950.     if not FInternalPrepared then
  2951.       InternalPrepare;
  2952.    if FQSelect.SQLType = SQLSelect then
  2953.    begin
  2954.       if DefaultFields then
  2955.         CreateFields;
  2956.       BindFields(True);
  2957.       FCurrentRecord := -1;
  2958.       FQSelect.ExecQuery;
  2959.       FOpen := FQSelect.Open;
  2960.  
  2961.       { Initialize offsets, buffer sizes, etc...
  2962.         1. Initially FRecordSize is just the "RecordDataLength".
  2963.         2. Allocate a "model" buffer and do a dummy fetch
  2964.         3. After the dummy fetch, FRecordSize will be appropriately
  2965.            adjusted to reflect the additional "weight" of the field
  2966.            data.
  2967.         4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
  2968.         5. Now, with the BufferSize available, allocate memory for chunks of records
  2969.         6. Re-allocate the model buffer, accounting for the new
  2970.            FRecordBufferSize.
  2971.         7. Finally, calls to AllocRecordBuffer will work!.
  2972.        }
  2973.       {Step 1}
  2974.       FRecordSize := RecordDataLength(FQSelect.Current.Count);
  2975.       {Step 2, 3}
  2976.       IBAlloc(FModelBuffer, 0, FRecordSize);
  2977.       FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
  2978.       {Step 4}
  2979.       FCalcFieldsOffset := FRecordSize;
  2980.       FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
  2981.       FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
  2982.       {Step 5}
  2983.       if UniDirectional then
  2984.         FBufferChunkSize := FRecordBufferSize * UniCache
  2985.       else
  2986.         FBufferChunkSize := FRecordBufferSize * BufferChunks;
  2987.       IBAlloc(FBufferCache, FBufferChunkSize, FBufferChunkSize);
  2988.       IBAlloc(FOldBufferCache, FBufferChunkSize, FBufferChunkSize);
  2989.       FBPos := 0;
  2990.       FOBPos := 0;
  2991.       FBEnd := 0;
  2992.       FOBEnd := 0;
  2993.       FCacheSize := FBufferChunkSize;
  2994.       FOldCacheSize := FBufferChunkSize;
  2995.       {Step 6}
  2996.       IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
  2997.                              FRecordBufferSize);
  2998.       {Step 7}
  2999.       FOldBuffer := AllocRecordBuffer;
  3000.     end
  3001.     else
  3002.       FQSelect.ExecQuery;
  3003.   finally
  3004.     Screen.Cursor := iCurScreenState;
  3005.   end;
  3006. end;
  3007.  
  3008. procedure TIBCustomDataSet.InternalPost;
  3009. var
  3010.   Qry: TIBSQL;
  3011.   Buff: PChar;
  3012.   iCurScreenState: Integer;
  3013.   bInserting: Boolean;
  3014. begin
  3015.   iCurScreenState := Screen.Cursor;
  3016.   Screen.Cursor := crHourglass;
  3017.   try
  3018.     Buff := GetActiveBuf;
  3019.     CheckEditState;
  3020.     AdjustRecordOnInsert(Buff);
  3021.     if (State = dsInsert) then
  3022.     begin
  3023.       bInserting := True;
  3024.       Qry := FQInsert;
  3025.       PRecordData(Buff)^.rdUpdateStatus := usInserted;
  3026.       PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted;
  3027.       WriteRecordCache(FRecordCount, Buff);
  3028.       FCurrentRecord := FRecordCount;
  3029.     end
  3030.     else begin
  3031.       bInserting := False;
  3032.       Qry := FQModify;
  3033.       if PRecordData(Buff)^.rdCachedUpdateStatus = cusUnmodified then
  3034.       begin
  3035.         PRecordData(Buff)^.rdUpdateStatus := usModified;
  3036.         PRecordData(Buff)^.rdCachedUpdateStatus := cusModified;
  3037.       end
  3038.       else if PRecordData(Buff)^.
  3039.                     rdCachedUpdateStatus = cusUninserted then
  3040.             begin
  3041.               PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted;
  3042.               Dec(FDeletedRecords);
  3043.             end;
  3044.     end;
  3045.     if (not CachedUpdates) then
  3046.       InternalPostRecord(Qry, Buff)
  3047.     else begin
  3048.       WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
  3049.       FUpdatesPending := True;
  3050.     end;
  3051.     if bInserting then
  3052.       Inc(FRecordCount);
  3053.   finally
  3054.     Screen.Cursor := iCurScreenState;
  3055.   end;
  3056. end;
  3057.  
  3058. procedure TIBCustomDataSet.InternalRefresh;
  3059. begin
  3060.   inherited;
  3061.   InternalRefreshRow;
  3062. end;
  3063.  
  3064. procedure TIBCustomDataSet.InternalSetToRecord(Buffer: PChar);
  3065. begin
  3066.   InternalGotoBookmark(@(PRecordData(Buffer)^.rdRecordNumber));
  3067. end;
  3068.  
  3069. function TIBCustomDataSet.IsCursorOpen: Boolean;
  3070. begin
  3071.   result := FOpen;
  3072. end;
  3073.  
  3074. function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
  3075.                                  Options: TLocateOptions): Boolean;
  3076. var
  3077.   CurBookmark: string;
  3078. begin
  3079.   DisableControls;
  3080.   try
  3081.     CurBookmark := Bookmark;
  3082.     First;
  3083.     result := InternalLocate(KeyFields, KeyValues, Options);
  3084.     if not result then
  3085.       Bookmark := CurBookmark;
  3086.   finally
  3087.     EnableControls;
  3088.   end;
  3089. end;
  3090.  
  3091. function TIBCustomDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
  3092.                                  const ResultFields: string): Variant;
  3093. var
  3094.   fl: TList;
  3095.   CurBookmark: string;
  3096. begin
  3097.   DisableControls;
  3098.   fl := TList.Create;
  3099.   CurBookmark := Bookmark;
  3100.   try
  3101.     First;
  3102.     if InternalLocate(KeyFields, KeyValues, []) then
  3103.     begin
  3104.       if (ResultFields <> '') then
  3105.         result := FieldValues[ResultFields]
  3106.       else
  3107.         result := NULL;
  3108.     end
  3109.     else
  3110.       result := Null;
  3111.   finally
  3112.     Bookmark := CurBookmark;
  3113.     fl.Free;
  3114.     EnableControls;
  3115.   end;
  3116. end;
  3117.  
  3118. procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
  3119. begin
  3120.   PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^;
  3121. end;
  3122.  
  3123. procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  3124. begin
  3125.   PRecordData(Buffer)^.rdBookmarkFlag := Value;
  3126. end;
  3127.  
  3128. procedure TIBCustomDataSet.SetCachedUpdates(Value: Boolean);
  3129. begin
  3130.   if not Value and FCachedUpdates then
  3131.     CancelUpdates;
  3132.   FCachedUpdates := Value;
  3133. end;
  3134.  
  3135. procedure TIBCustomDataSet.SetDataSource(Value: TDataSource);
  3136. begin
  3137.   if IsLinkedTo(Value) then
  3138.     IBError(ibxeCircularReference, [nil]);
  3139.   if FDataLink <> nil then
  3140.     FDataLink.DataSource := Value;
  3141. end;
  3142.  
  3143. procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
  3144. var
  3145.   Buff, TmpBuff: PChar;
  3146. begin
  3147.   Buff := GetActiveBuf;
  3148.   if Field.FieldNo < 0 then
  3149.   begin
  3150.     TmpBuff := Buff + FRecordSize + Field.Offset;
  3151.     Boolean(TmpBuff[0]) := LongBool(Buffer);
  3152.     if Boolean(TmpBuff[0]) then
  3153.       Move(Buffer^, TmpBuff[1], Field.DataSize);
  3154.     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
  3155.   end
  3156.   else begin
  3157.     CheckEditState;
  3158.     with PRecordData(Buff)^ do
  3159.     begin
  3160.       { If inserting, Adjust record position }
  3161.       AdjustRecordOnInsert(Buff);
  3162.       if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
  3163.          (FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
  3164.       begin
  3165.         Field.Validate(Buffer);
  3166.         if (Buffer = nil) or
  3167.            (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
  3168.           rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
  3169.         else begin
  3170.           Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
  3171.                  rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
  3172.           if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
  3173.              (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
  3174.             rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
  3175.           rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
  3176.           if rdUpdateStatus = usUnmodified then
  3177.           begin
  3178.             if CachedUpdates then
  3179.             begin
  3180.               FUpdatesPending := True;
  3181.               if State = dsInsert then
  3182.                 rdCachedUpdateStatus := cusInserted
  3183.               else if State = dsEdit then
  3184.                 rdCachedUpdateStatus := cusModified;
  3185.             end;
  3186.  
  3187.             if State = dsInsert then
  3188.               rdUpdateStatus := usInserted
  3189.             else
  3190.               rdUpdateStatus := usModified;
  3191.           end;
  3192.           WriteRecordCache(rdRecordNumber, Buff);
  3193.           SetModified(True);
  3194.         end;
  3195.       end;
  3196.     end;
  3197.   end;
  3198.   if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  3199.       DataEvent(deFieldChange, Longint(Field));
  3200. end;
  3201.  
  3202. procedure TIBCustomDataSet.SetRecNo(Value: Integer);
  3203. begin
  3204.   CheckBrowseMode;
  3205.   if (Value < 1) then
  3206.     Value := 1
  3207.   else if Value > FRecordCount then
  3208.   begin
  3209.     InternalLast;
  3210.     Value := Min(FRecordCount, Value);
  3211.   end;
  3212.   if (Value <> RecNo) then
  3213.   begin
  3214.     DoBeforeScroll;
  3215.     FCurrentRecord := Value - 1;
  3216.     Resync([]);
  3217.     DoAfterScroll;
  3218.   end;
  3219. end;
  3220.  
  3221. procedure TIBCustomDataSet.Disconnect;
  3222. begin
  3223.  Close;
  3224. end;
  3225.  
  3226. procedure TIBCustomDataSet.SetUpdateMode(const Value: TUpdateMode);
  3227. begin
  3228.   if not CanModify then
  3229.     IBError(ibxeCannotUpdate, [nil])
  3230.   else
  3231.     FUpdateMode := Value;
  3232. end;
  3233.  
  3234.  
  3235. procedure TIBCustomDataSet.SetUpdateObject(Value: TIBDataSetUpdateObject);
  3236. begin
  3237.   if Value <> FUpdateObject then
  3238.   begin
  3239.     if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then
  3240.       FUpdateObject.DataSet := nil;
  3241.     FUpdateObject := Value;
  3242.     if Assigned(FUpdateObject) then
  3243.     begin
  3244.       if Assigned(FUpdateObject.DataSet) and
  3245.         (FUpdateObject.DataSet <> Self) then
  3246.         FUpdateObject.DataSet.UpdateObject := nil;
  3247.       FUpdateObject.DataSet := Self;
  3248.     end;
  3249.   end;
  3250. end;
  3251.  
  3252. function TIBCustomDataSet.ConstraintsStored: Boolean;
  3253. begin
  3254.   Result := Constraints.Count > 0;
  3255. end;
  3256.  
  3257. procedure TIBCustomDataSet.ClearCalcFields(Buffer: PChar);
  3258. begin
  3259.  FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
  3260. end;
  3261.  
  3262.  
  3263. procedure TIBCustomDataSet.InternalUnPrepare;
  3264. begin
  3265.   CheckDatasetClosed;
  3266.   FieldDefs.Clear;
  3267.   FInternalPrepared := False;
  3268. end;
  3269.  
  3270. procedure TIBCustomDataSet.InternalExecQuery;
  3271. var
  3272.   DidActivate: Boolean;
  3273.   iCurScreenState: Integer;
  3274. begin
  3275.   DidActivate := False;
  3276.   iCurScreenState := Screen.Cursor;
  3277.   Screen.Cursor := crHourglass;
  3278.   try
  3279.     ActivateConnection;
  3280.     DidActivate := ActivateTransaction;
  3281.     if FQSelect.SQL.Text = '' then
  3282.       IBError(ibxeEmptyQuery, [nil]);
  3283.     if not FInternalPrepared then
  3284.       InternalPrepare;
  3285.     if FQSelect.SQLType = SQLSelect then
  3286.     begin
  3287.       IBError(ibxeIsASelectStatement, [nil]);
  3288.     end
  3289.     else
  3290.       FQSelect.ExecQuery;
  3291.   finally
  3292.     Screen.Cursor := iCurScreenState;
  3293.     if DidActivate then
  3294.       DeactivateTransaction;
  3295.   end;
  3296. end;
  3297.  
  3298. function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
  3299. begin
  3300.   Result := FQSelect.Handle;
  3301. end;
  3302.  
  3303. procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
  3304. begin
  3305.   inherited InitRecord(Buffer);
  3306.   with PRecordData(Buffer)^ do
  3307.   begin
  3308.     rdUpdateStatus := TUpdateStatus(usInserted);
  3309.     rdBookMarkFlag := bfInserted;
  3310.     rdRecordNumber := -1;
  3311.   end;
  3312. end;
  3313.  
  3314. procedure TIBCustomDataSet.InternalInsert;
  3315. begin
  3316.   CursorPosChanged;
  3317. end;
  3318.  
  3319. { TIBDataSet IProviderSupport }
  3320.  
  3321. procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
  3322. begin
  3323.   if Commit then
  3324.     Transaction.Commit else
  3325.     Transaction.Rollback;
  3326. end;
  3327.  
  3328. function TIBCustomDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams;
  3329.   ResultSet: Pointer = nil): Integer;
  3330. var
  3331.   FQuery: TIBQuery;
  3332. begin
  3333.   if Assigned(ResultSet) then
  3334.   begin
  3335.     TDataSet(ResultSet^) := TIBQuery.Create(nil);
  3336.     with TIBQuery(ResultSet^) do
  3337.     begin
  3338.       SQL.Text := ASQL;
  3339.       Params.Assign(AParams);
  3340.       Open;
  3341.       Result := RowsAffected;
  3342.     end;
  3343.   end else
  3344.   begin
  3345.     FQuery := TIBQuery.Create(nil);
  3346.     try
  3347.       FQuery.Database := Database;
  3348.       FQuery.Transaction := Transaction;
  3349.       FQuery.GenerateParamNames := True;
  3350.       FQuery.SQL.Text := ASQL;
  3351.       FQuery.Params.Assign(AParams);
  3352.       FQuery.ExecSQL;
  3353.       Result := FQuery.RowsAffected;
  3354.     finally
  3355.       FQuery.Free;
  3356.     end;
  3357.   end;
  3358. end;
  3359.  
  3360. function TIBCustomDataSet.PSGetQuoteChar: string;
  3361. begin
  3362.   if Database.SQLDialect = 3 then
  3363.     Result := '"' else
  3364.     Result := '';
  3365. end;
  3366.  
  3367. function TIBCustomDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
  3368. var
  3369.   PrevErr: Integer;
  3370. begin
  3371.   if Prev <> nil then
  3372.     PrevErr := Prev.ErrorCode else
  3373.     PrevErr := 0;
  3374.   if E is EIBError then
  3375.     with EIBError(E) do
  3376.       Result := EUpdateError.Create(E.Message, '', SQLCode, PrevErr, E) else
  3377.       Result := inherited PSGetUpdateException(E, Prev);
  3378. end;
  3379.  
  3380. function TIBCustomDataSet.PSInTransaction: Boolean;
  3381. begin
  3382.   Result := Transaction.InTransaction;
  3383. end;
  3384.  
  3385. function TIBCustomDataSet.PSIsSQLBased: Boolean;
  3386. begin
  3387.   Result := True;
  3388. end;
  3389.  
  3390. function TIBCustomDataSet.PSIsSQLSupported: Boolean;
  3391. begin
  3392.   Result := True;
  3393. end;
  3394.  
  3395. procedure TIBCustomDataSet.PSReset;
  3396. begin
  3397.   inherited PSReset;
  3398.   if Active then
  3399.   begin
  3400.     Close;
  3401.     Open;
  3402.   end;
  3403. end;
  3404.  
  3405. function TIBCustomDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean;
  3406. var
  3407.   UpdateAction: TIBUpdateAction;
  3408.   SQL: string;
  3409.   Params: TParams;
  3410.  
  3411.   procedure AssignParams(DataSet: TDataSet; Params: TParams);
  3412.   var
  3413.     I: Integer;
  3414.     Old: Boolean;
  3415.     Param: TParam;
  3416.     PName: string;
  3417.     Field: TField;
  3418.     Value: Variant;
  3419.   begin
  3420.     for I := 0 to Params.Count - 1 do
  3421.     begin
  3422.       Param := Params[I];
  3423.       PName := Param.Name;
  3424.       Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
  3425.       if Old then System.Delete(PName, 1, 4);
  3426.       Field := DataSet.FindField(PName);
  3427.       if not Assigned(Field) then Continue;
  3428.       if Old then Param.AssignFieldValue(Field, Field.OldValue) else
  3429.       begin
  3430.         Value := Field.NewValue;
  3431.         if VarIsEmpty(Value) then Value := Field.OldValue;
  3432.         Param.AssignFieldValue(Field, Value);
  3433.       end;
  3434.     end;
  3435.   end;
  3436.  
  3437. begin
  3438.   Result := False;
  3439.   if Assigned(OnUpdateRecord) then
  3440.   begin
  3441.     UpdateAction := uaFail;
  3442.     if Assigned(FOnUpdateRecord) then
  3443.     begin
  3444.       FOnUpdateRecord(Delta, UpdateKind, UpdateAction);
  3445.       Result := UpdateAction = uaApplied;
  3446.     end;
  3447.   end
  3448.   else if Assigned(FUpdateObject) then
  3449.   begin
  3450.     SQL := FUpdateObject.GetSQL(UpdateKind).Text;
  3451.     if SQL <> '' then
  3452.     begin
  3453.       Params := TParams.Create;
  3454.       try
  3455.         Params.ParseSQL(SQL, True);
  3456.         AssignParams(Delta, Params);
  3457.         if PSExecuteStatement(SQL, Params) = 0 then
  3458.           IBError(ibxeNoRecordsAffected, [nil]);
  3459.         Result := True;
  3460.       finally
  3461.         Params.Free;
  3462.       end;
  3463.     end;
  3464.   end;
  3465. end;
  3466.  
  3467. procedure TIBCustomDataSet.PSStartTransaction;
  3468. begin
  3469.   ActivateConnection;
  3470.   Transaction.StartTransaction;
  3471. end;
  3472.  
  3473. function TIBCustomDataSet.PSGetTableName: string;
  3474. begin
  3475.   Result := FQSelect.UniqueRelationName;
  3476. end;
  3477.  
  3478. procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
  3479. begin
  3480.   InternalBatchInput(InputObject);
  3481. end;
  3482.  
  3483. procedure TIBDataSet.BatchOutput(OutputObject: TIBBatchOutput);
  3484. begin
  3485.   InternalBatchOutput(OutputObject);
  3486. end;
  3487.  
  3488. procedure TIBDataSet.Prepare;
  3489. begin
  3490.   InternalPrepare;
  3491. end;
  3492.  
  3493. procedure TIBDataSet.UnPrepare;
  3494. begin
  3495.   InternalUnPrepare;
  3496. end;
  3497.  
  3498. function TIBDataSet.GetPrepared: Boolean;
  3499. begin
  3500.   Result := InternalPrepared;
  3501. end;
  3502.  
  3503. procedure TIBDataSet.InternalOpen;
  3504. begin
  3505.   ActivateConnection;
  3506.   ActivateTransaction;
  3507.   InternalSetParamsFromCusror;
  3508.   Inherited;
  3509. end;
  3510.  
  3511. procedure TIBDataSet.SetFiltered(Value: Boolean);
  3512. begin
  3513.   if Value <> False then
  3514.     IBError(ibxeNotSupported, [nil]);
  3515. end;
  3516.  
  3517. { TIBDataSetUpdateObject }
  3518.  
  3519. constructor TIBDataSetUpdateObject.Create(AOwner: TComponent);
  3520. begin
  3521.   inherited Create(AOwner);
  3522.   FRefreshSQL := TStringList.Create;
  3523. end;
  3524.  
  3525. destructor TIBDataSetUpdateObject.Destroy;
  3526. begin
  3527.   FRefreshSQL.Free;
  3528.   inherited destroy;
  3529. end;
  3530.  
  3531. procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
  3532. begin
  3533.   FRefreshSQL.Assign(Value);
  3534. end;
  3535.  
  3536. { TIBDSBlobStream }
  3537. constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
  3538.                                     Mode: TBlobStreamMode);
  3539. begin
  3540.   FField := AField;
  3541.   FBlobStream := ABlobStream;
  3542.   FBlobStream.Seek(0, soFromBeginning);
  3543.   if (Mode = bmWrite) then
  3544.     FBlobStream.Truncate;
  3545. end;
  3546.  
  3547. function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
  3548. begin
  3549.   result := FBlobStream.Read(Buffer, Count);
  3550. end;
  3551.  
  3552. function TIBDSBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
  3553. begin
  3554.   result := FBlobStream.Seek(Offset, Origin);
  3555. end;
  3556.  
  3557. procedure TIBDSBlobStream.SetSize(NewSize: Longint);
  3558. begin
  3559.   FBlobStream.SetSize(NewSize);
  3560. end;
  3561.  
  3562. function TIBDSBlobStream.Write(const Buffer; Count: Longint): Longint;
  3563. begin
  3564.   if not (FField.DataSet.State in [dsEdit, dsInsert]) then
  3565.     IBError(ibxeNotEditing, [nil]);
  3566.   TIBCustomDataSet(FField.DataSet).RecordModified(True);
  3567.   result := FBlobStream.Write(Buffer, Count);
  3568.   TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
  3569. end;
  3570.  
  3571. end.
  3572.