ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBCustomDataSet.pas
Revision: 215
Committed: Thu Mar 15 16:25:03 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 150872 byte(s)
Log Message:
Fixes Merged

File Contents

# User Rev Content
1 tony 209 {************************************************************************}
2     { }
3     { Borland Delphi Visual Component Library }
4     { InterBase Express core components }
5     { }
6     { Copyright (c) 1998-2000 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     { The contents of this file are subject to the InterBase }
14     { Public License Version 1.0 (the "License"); you may not }
15     { use this file except in compliance with the License. You }
16     { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17     { Software distributed under the License is distributed on }
18     { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19     { express or implied. See the License for the specific language }
20     { governing rights and limitations under the License. }
21     { The Original Code was created by InterBase Software Corporation }
22     { and its successors. }
23     { Portions created by Inprise Corporation are Copyright (C) Inprise }
24     { Corporation. All Rights Reserved. }
25     { Contributor(s): Jeff Overcash }
26     { }
27     { IBX For Lazarus (Firebird Express) }
28     { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29     { Portions created by MWA Software are copyright McCallum Whyman }
30     { Associates Ltd 2011 - 2015 }
31     { }
32     {************************************************************************}
33    
34     unit IBCustomDataSet;
35    
36     {$R-}
37    
38     {$IFDEF FPC}
39     {$Mode Delphi}
40     {$codepage UTF8}
41     {$ENDIF}
42    
43     {$IFDEF DELPHI}
44     {$DEFINE TDBDFIELD_IS_BCD}
45     {$ENDIF}
46    
47     interface
48    
49     uses
50     {$IFDEF WINDOWS }
51     Windows,
52     {$ENDIF}
53 tony 215 {$IFDEF UNIX}
54     cthreads, unix,
55     {$ENDIF}
56 tony 209 SysUtils, Classes, IBDatabase, IBExternals, IB, IBSQL, Db,
57     IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, fpTimer;
58    
59     const
60     BufferCacheSize = 1000; { Allocate cache in this many record chunks}
61     UniCache = 2; { Uni-directional cache is 2 records big }
62    
63     type
64     TIBCustomDataSet = class;
65     TIBDataSet = class;
66    
67     { TIBDataSetUpdateObject }
68    
69     TIBDataSetUpdateObject = class(TComponent)
70     private
71     FRefreshSQL: TStrings;
72     procedure SetRefreshSQL(value: TStrings);
73     protected
74     function GetDataSet: TIBCustomDataSet; virtual; abstract;
75     procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
76     procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
77     function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
78     procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
79     procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
80     procedure UpdateRecordFromQuery(UpdateKind: TUpdateKind; QryResults: IResults; Buffer: PChar);
81     property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
82     public
83     constructor Create(AOwner: TComponent); override;
84     destructor Destroy; override;
85     function GetRowsAffected(var SelectCount, InsertCount, UpdateCount,
86     DeleteCount: integer): boolean; virtual;
87     published
88     property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
89     end;
90    
91     TBlobDataArray = array[0..0] of TIBBlobStream;
92     PBlobDataArray = ^TBlobDataArray;
93     TIBArrayField = class;
94    
95     { TIBArray }
96    
97     {Wrapper class to support array cache in TIBCustomDataset and event handling}
98    
99     TIBArray = class
100     private
101     FArray: IArray;
102     FRecNo: integer;
103     FField: TIBArrayField;
104     procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
105     public
106     constructor Create(aField: TIBArrayField; anArray: IArray);
107     destructor Destroy; override;
108     property ArrayIntf: IArray read FArray;
109     end;
110    
111     TArrayDataArray = array [0..0] of TIBArray;
112     PArrayDataArray = ^TArrayDataArray;
113    
114     { TIBCustomDataSet }
115    
116     TCachedUpdateStatus = (
117     cusUnmodified, cusModified, cusInserted,
118     cusDeleted, cusUninserted
119     );
120     TIBDBKey = record
121     DBKey: array[0..7] of Byte;
122     end;
123     PIBDBKey = ^TIBDBKey;
124    
125     PFieldData = ^TFieldData;
126     TFieldData = record
127     fdIsNull: Boolean;
128     fdDataLength: Short;
129     end;
130    
131     PColumnData = ^TColumnData;
132     TColumnData = record
133     fdDataType: Short;
134     fdDataScale: Short;
135     fdNullable: Boolean;
136     fdDataSize: Short;
137     fdDataOfs: Integer;
138     fdCodePage: TSystemCodePage;
139     end;
140    
141     PFieldColumns = ^TFieldColumns;
142     TFieldColumns = array[1..1] of TColumnData;
143    
144     TRecordData = record
145     rdBookmarkFlag: TBookmarkFlag;
146     rdFieldCount: Short;
147     rdRecordNumber: Integer;
148     rdCachedUpdateStatus: TCachedUpdateStatus;
149     rdUpdateStatus: TUpdateStatus;
150     rdSavedOffset: DWORD;
151     rdDBKey: TIBDBKey;
152     rdFields: array[1..1] of TFieldData;
153     end;
154     PRecordData = ^TRecordData;
155    
156     { TIBArrayField }
157    
158     TIBArrayField = class(TField)
159     private
160     FArrayBounds: TArrayBounds;
161     FArrayDimensions: integer;
162     FRelationName: string;
163     FCacheOffset: word;
164     function GetArrayID: TISC_QUAD;
165     function GetArrayIntf: IArray;
166     procedure SetArrayIntf(AValue: IArray);
167     protected
168     class procedure CheckTypeSize(AValue: Longint); override;
169     function GetAsString: string; override;
170     function GetDataSize: Integer; override;
171     procedure Bind(Binding: Boolean); override;
172     public
173     constructor Create(AOwner: TComponent); override;
174     function CreateArray: IArray;
175     property ArrayID: TISC_QUAD read GetArrayID;
176     property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
177     property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
178     property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
179     end;
180    
181     { TIBStringField allows us to have strings longer than 8196 }
182    
183     TIBStringField = class(TStringField)
184     private
185     FCharacterSetName: RawByteString;
186     FCharacterSetSize: integer;
187     FAutoFieldSize: boolean;
188     FCodePage: TSystemCodePage;
189     FDataSize: integer;
190     protected
191     procedure Bind(Binding: Boolean); override;
192     function GetDataSize: Integer; override;
193     public
194     constructor Create(aOwner: TComponent); override;
195     class procedure CheckTypeSize(Value: Integer); override;
196     function GetAsString: string; override;
197     function GetAsVariant: Variant; override;
198     function GetValue(var Value: string): Boolean;
199     procedure SetAsString(const Value: string); override;
200     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
201     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
202     property CodePage: TSystemCodePage read FCodePage write FCodePage;
203     published
204     property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
205     end;
206    
207     { TIBBCDField }
208     { Actually, there is no BCD involved in this type,
209     instead it deals with currency types.
210     In IB, this is an encapsulation of Numeric (x, y)
211     where x < 18 and y <= 4.
212     Note: y > 4 will default to Floats
213     }
214     TIBBCDField = class(TBCDField)
215     private
216     FIdentityColumn: boolean;
217     protected
218     procedure Bind(Binding: Boolean); override;
219     class procedure CheckTypeSize(Value: Integer); override;
220     function GetAsCurrency: Currency; override;
221     function GetAsString: string; override;
222     function GetAsVariant: Variant; override;
223     function GetDataSize: Integer; override;
224     public
225     constructor Create(AOwner: TComponent); override;
226     property IdentityColumn: boolean read FIdentityColumn;
227     published
228     property Size default 8;
229     end;
230    
231     {The following integer field types extend the built in versions to enable IBX appplications
232     to check for an Identity column}
233    
234     { TIBSmallintField }
235    
236     TIBSmallintField = class(TSmallintField)
237     private
238     FIdentityColumn: boolean;
239     protected
240     procedure Bind(Binding: Boolean); override;
241     public
242     property IdentityColumn: boolean read FIdentityColumn;
243     end;
244    
245     { TIBIntegerField }
246    
247     TIBIntegerField = class(TIntegerField)
248     private
249     FIdentityColumn: boolean;
250     protected
251     procedure Bind(Binding: Boolean); override;
252     public
253     property IdentityColumn: boolean read FIdentityColumn;
254     end;
255    
256     { TIBLargeIntField }
257    
258     TIBLargeIntField = class(TLargeIntField)
259     private
260     FIdentityColumn: boolean;
261     protected
262     procedure Bind(Binding: Boolean); override;
263     public
264     property IdentityColumn: boolean read FIdentityColumn;
265     end;
266    
267     {TIBMemoField}
268     {Allows us to show truncated text in DBGrids and anything else that uses
269     DisplayText}
270    
271     TIBMemoField = class(TMemoField)
272     private
273     FCharacterSetName: RawByteString;
274     FCharacterSetSize: integer;
275     FDisplayTextAsClassName: boolean;
276     function GetTruncatedText: string;
277     protected
278     procedure Bind(Binding: Boolean); override;
279     function GetAsString: string; override;
280     function GetDefaultWidth: Longint; override;
281     procedure GetText(var AText: string; ADisplayText: Boolean); override;
282     procedure SetAsString(const AValue: string); override;
283     public
284     constructor Create(AOwner: TComponent); override;
285     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
286     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
287     published
288     property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
289     write FDisplayTextAsClassName;
290     private
291     FCodePage: TSystemCodePage;
292     FFCodePage: TSystemCodePage;
293     public
294     property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
295     end;
296    
297     { TIBDataLink }
298    
299     TIBDataLink = class(TDetailDataLink)
300     private
301     FDataSet: TIBCustomDataSet;
302     FDelayTimerValue: integer;
303     FTimer: TFPTimer;
304     procedure HandleRefreshTimer(Sender: TObject);
305 tony 213 procedure SetDelayTimerValue(AValue: integer);
306 tony 209 protected
307     procedure ActiveChanged; override;
308     procedure RecordChanged(Field: TField); override;
309     function GetDetailDataSet: TDataSet; override;
310     procedure CheckBrowseMode; override;
311     public
312     constructor Create(ADataSet: TIBCustomDataSet);
313     destructor Destroy; override;
314     property DelayTimerValue: integer {in Milliseconds}
315 tony 213 read FDelayTimerValue write SetDelayTimerValue;
316 tony 209 end;
317    
318     TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
319    
320     { TIBGenerator }
321    
322     TIBGenerator = class(TPersistent)
323     private
324     FOwner: TIBCustomDataSet;
325     FApplyOnEvent: TIBGeneratorApplyOnEvent;
326     FFieldName: string;
327     FGeneratorName: string;
328     FIncrement: integer;
329     FQuery: TIBSQL;
330     function GetDatabase: TIBDatabase;
331     function GetTransaction: TIBTransaction;
332     procedure SetDatabase(AValue: TIBDatabase);
333     procedure SetGeneratorName(AValue: string);
334     procedure SetIncrement(const AValue: integer);
335     procedure SetTransaction(AValue: TIBTransaction);
336     procedure SetQuerySQL;
337     protected
338     function GetNextValue: integer;
339     public
340     constructor Create(Owner: TIBCustomDataSet);
341     destructor Destroy; override;
342     procedure Apply;
343     property Owner: TIBCustomDataSet read FOwner;
344     property Database: TIBDatabase read GetDatabase write SetDatabase;
345     property Transaction: TIBTransaction read GetTransaction write SetTransaction;
346     published
347     property Generator: string read FGeneratorName write SetGeneratorName;
348     property Field: string read FFieldName write FFieldName;
349     property Increment: integer read FIncrement write SetIncrement default 1;
350     property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
351     end;
352    
353     {TIBControlLink - Allows IB Aware controls to react to dataset state changes}
354    
355     TIBControlLink = class
356     private
357     FTIBDataSet: TIBCustomDataSet;
358     procedure SetIBDataSet(AValue: TIBCustomDataSet);
359     protected
360     procedure UpdateSQL(Sender: TObject); virtual;
361     procedure UpdateParams(Sender: TObject); virtual;
362     public
363     destructor Destroy; override;
364     property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
365     end;
366    
367     TIBAutoCommit = (acDisabled, acCommitRetaining);
368    
369     { TIBCustomDataSet }
370    
371     TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
372    
373     TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
374     UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
375     of object;
376     TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
377     var UpdateAction: TIBUpdateAction) of object;
378    
379     TIBUpdateRecordTypes = set of TCachedUpdateStatus;
380    
381     TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
382    
383     TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
384    
385     TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object;
386    
387     TIBCustomDataSet = class(TDataset)
388     private
389     FAllowAutoActivateTransaction: Boolean;
390     FArrayFieldCount: integer;
391     FArrayCacheOffset: integer;
392     FAutoCommit: TIBAutoCommit;
393     FEnableStatistics: boolean;
394     FGenerateParamNames: Boolean;
395     FGeneratorField: TIBGenerator;
396     FNeedsRefresh: Boolean;
397     FForcedRefresh: Boolean;
398     FDidActivate: Boolean;
399     FBase: TIBBase;
400     FBlobCacheOffset: Integer;
401     FBlobStreamList: TList;
402     FArrayList: TList;
403     FBufferChunks: Integer;
404     FBufferCache,
405     FOldBufferCache: PChar;
406     FBufferChunkSize,
407     FCacheSize,
408     FOldCacheSize: Integer;
409     FFilterBuffer: PChar;
410     FBPos,
411     FOBPos,
412     FBEnd,
413     FOBEnd: DWord;
414     FCachedUpdates: Boolean;
415     FCalcFieldsOffset: Integer;
416     FCurrentRecord: Long;
417     FDeletedRecords: Long;
418     FModelBuffer,
419     FOldBuffer: PChar;
420     FOnDeleteReturning: TOnDeleteReturning;
421     FOnValidatePost: TOnValidatePost;
422     FOpen: Boolean;
423     FInternalPrepared: Boolean;
424     FQDelete,
425     FQInsert,
426     FQRefresh,
427     FQSelect,
428     FQModify: TIBSQL;
429     FDatabaseInfo: TIBDatabaseInfo;
430     FRecordBufferSize: Integer;
431     FRecordCount: Integer;
432     FRecordSize: Integer;
433     FDataSetCloseAction: TDataSetCloseAction;
434     FUniDirectional: Boolean;
435     FUpdateMode: TUpdateMode;
436     FUpdateObject: TIBDataSetUpdateObject;
437     FParamCheck: Boolean;
438     FUpdatesPending: Boolean;
439     FUpdateRecordTypes: TIBUpdateRecordTypes;
440     FMappedFieldPosition: array of Integer;
441     FDataLink: TIBDataLink;
442    
443     FBeforeDatabaseDisconnect,
444     FAfterDatabaseDisconnect,
445     FDatabaseFree: TNotifyEvent;
446     FOnUpdateError: TIBUpdateErrorEvent;
447     FOnUpdateRecord: TIBUpdateRecordEvent;
448     FBeforeTransactionEnd,
449     FAfterTransactionEnd,
450     FTransactionFree: TNotifyEvent;
451     FAliasNameMap: array of string;
452     FAliasNameList: array of string;
453     FBaseSQLSelect: TStrings;
454     FParser: TSelectSQLParser;
455     FCloseAction: TTransactionAction;
456     FInTransactionEnd: boolean;
457     FIBLinks: TList;
458     FFieldColumns: PFieldColumns;
459     FBufferUpdatedOnQryReturn: boolean;
460     FSelectCount: integer;
461     FInsertCount: integer;
462     FUpdateCount: integer;
463     FDeleteCount: integer;
464     procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
465     FieldIndex: integer; Buffer: PChar);
466     procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
467     function GetSelectStmtIntf: IStatement;
468     procedure SetUpdateMode(const Value: TUpdateMode);
469     procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
470    
471     function AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode): TGetResult;
472     procedure AdjustRecordOnInsert(Buffer: Pointer);
473     function CanEdit: Boolean;
474     function CanInsert: Boolean;
475     function CanDelete: Boolean;
476     function CanRefresh: Boolean;
477     procedure CheckEditState;
478     procedure ClearBlobCache;
479     procedure ClearArrayCache;
480     procedure ClearIBLinks;
481     procedure CopyRecordBuffer(Source, Dest: Pointer);
482     procedure DoBeforeDatabaseDisconnect(Sender: TObject);
483     procedure DoAfterDatabaseDisconnect(Sender: TObject);
484     procedure DoDatabaseFree(Sender: TObject);
485     procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
486     procedure DoAfterTransactionEnd(Sender: TObject);
487     procedure DoTransactionFree(Sender: TObject);
488     procedure DoDeleteReturning(QryResults: IResults);
489     procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
490     Buffer: PChar);
491     function GetDatabase: TIBDatabase;
492     function GetDeleteSQL: TStrings;
493     function GetInsertSQL: TStrings;
494     function GetSQLParams: ISQLParams;
495     function GetRefreshSQL: TStrings;
496     function GetSelectSQL: TStrings;
497     function GetStatementType: TIBSQLStatementTypes;
498     function GetModifySQL: TStrings;
499     function GetTransaction: TIBTransaction;
500     function GetParser: TSelectSQLParser;
501     procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
502     function InternalLocate(const KeyFields: string; const KeyValues: Variant;
503     Options: TLocateOptions): Boolean; virtual;
504     procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
505     procedure InternalRevertRecord(RecordNumber: Integer); virtual;
506     function IsVisible(Buffer: PChar): Boolean;
507     procedure RegisterIBLink(Sender: TIBControlLink);
508     procedure UnRegisterIBLink(Sender: TIBControlLink);
509     procedure SaveOldBuffer(Buffer: PChar);
510     procedure SetBufferChunks(Value: Integer);
511     procedure SetDatabase(Value: TIBDatabase);
512     procedure SetDeleteSQL(Value: TStrings);
513     procedure SetInsertSQL(Value: TStrings);
514     procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
515     procedure SetRefreshSQL(Value: TStrings);
516     procedure SetSelectSQL(Value: TStrings);
517     procedure SetModifySQL(Value: TStrings);
518     procedure SetTransaction(Value: TIBTransaction);
519     procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
520     procedure SetUniDirectional(Value: Boolean);
521     procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
522     procedure RefreshParams;
523     function AdjustPosition(FCache: PChar; Offset: DWORD;
524     Origin: Integer): DWORD;
525     procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
526     Buffer: PChar);
527     procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
528     ReadOldBuffer: Boolean);
529     procedure WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;
530     Buffer: PChar);
531     procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
532     function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
533     DoCheck: Boolean): TGetResult; virtual;
534    
535     protected
536     function GetMasterDetailDelay: integer; virtual;
537     procedure SetMasterDetailDelay(AValue: integer); virtual;
538     procedure ActivateConnection;
539     function ActivateTransaction: Boolean;
540     procedure DeactivateTransaction;
541     procedure CheckDatasetClosed;
542     procedure CheckDatasetOpen;
543     function CreateParser: TSelectSQLParser; virtual;
544     procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
545     function GetActiveBuf: PChar;
546     procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
547     procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
548     procedure InternalPrepare; virtual;
549     procedure InternalUnPrepare; virtual;
550     procedure InternalExecQuery; virtual;
551     procedure InternalRefreshRow; virtual;
552     procedure InternalSetParamsFromCursor; virtual;
553     procedure CheckNotUniDirectional;
554     procedure SQLChanging(Sender: TObject); virtual;
555     procedure SQLChanged(Sender: TObject); virtual;
556    
557     { IProviderSupport }
558     procedure PSEndTransaction(Commit: Boolean); override;
559     function PSExecuteStatement(const ASQL: string; AParams: TParams;
560     ResultSet: Pointer = nil): Integer; override;
561     function PsGetTableName: string; override;
562     function PSGetQuoteChar: string; override;
563     function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
564     function PSInTransaction: Boolean; override;
565     function PSIsSQLBased: Boolean; override;
566     function PSIsSQLSupported: Boolean; override;
567     procedure PSStartTransaction; override;
568     procedure PSReset; override;
569     function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
570    
571     { TDataSet support }
572     procedure InternalInsert; override;
573     procedure InitRecord(Buffer: PChar); override;
574     procedure Disconnect; virtual;
575     function ConstraintsStored: Boolean;
576     procedure ClearCalcFields(Buffer: PChar); override;
577     function AllocRecordBuffer: PChar; override;
578     procedure DoBeforeDelete; override;
579     procedure DoAfterDelete; override;
580     procedure DoBeforeEdit; override;
581     procedure DoAfterEdit; override;
582     procedure DoBeforeInsert; override;
583     procedure DoAfterInsert; override;
584     procedure DoBeforeClose; override;
585     procedure DoBeforeOpen; override;
586     procedure DoBeforePost; override;
587     procedure DoAfterPost; override;
588     procedure FreeRecordBuffer(var Buffer: PChar); override;
589     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
590     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
591     function GetCanModify: Boolean; override;
592     function GetDataSource: TDataSource; override;
593     function GetDBAliasName(FieldNo: integer): string;
594     function GetFieldDefFromAlias(aliasName: string): TFieldDef;
595     function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
596     function GetRecNo: Integer; override;
597     function GetRecord(Buffer: PChar; GetMode: TGetMode;
598     DoCheck: Boolean): TGetResult; override;
599     function GetRecordCount: Integer; override;
600     function GetRecordSize: Word; override;
601     procedure InternalAutoCommit;
602     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
603     procedure InternalCancel; override;
604     procedure InternalClose; override;
605     procedure InternalDelete; override;
606     procedure InternalFirst; override;
607     function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
608     procedure InternalGotoBookmark(Bookmark: Pointer); override;
609     procedure InternalHandleException; override;
610     procedure InternalInitFieldDefs; override;
611     procedure InternalInitRecord(Buffer: PChar); override;
612     procedure InternalLast; override;
613     procedure InternalOpen; override;
614     procedure InternalPost; override;
615     procedure InternalRefresh; override;
616     procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
617     procedure InternalSetToRecord(Buffer: PChar); override;
618     function IsCursorOpen: Boolean; override;
619     procedure Loaded; override;
620     procedure ReQuery;
621     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
622     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
623     procedure SetCachedUpdates(Value: Boolean);
624     procedure SetDataSource(Value: TDataSource);
625     procedure SetGenerateParamNames(AValue: Boolean); virtual;
626     procedure SetFieldData(Field : TField; Buffer : Pointer); override;
627     procedure SetFieldData(Field : TField; Buffer : Pointer;
628     NativeFormat : Boolean); overload; override;
629     procedure SetRecNo(Value: Integer); override;
630    
631     protected
632     {Likely to be made public by descendant classes}
633     property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
634     property SQLParams: ISQLParams read GetSQLParams;
635     property Params: ISQLParams read GetSQLParams;
636     property InternalPrepared: Boolean read FInternalPrepared;
637     property QDelete: TIBSQL read FQDelete;
638     property QInsert: TIBSQL read FQInsert;
639     property QRefresh: TIBSQL read FQRefresh;
640     property QSelect: TIBSQL read FQSelect;
641     property QModify: TIBSQL read FQModify;
642     property StatementType: TIBSQLStatementTypes read GetStatementType;
643     property SelectStmtHandle: IStatement read GetSelectStmtIntf;
644    
645     {Likely to be made published by descendant classes}
646     property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
647     property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
648     property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
649     property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
650     property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
651     property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
652     property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
653     property SelectSQL: TStrings read GetSelectSQL write SetSelectSQL;
654     property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
655     property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
656     property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
657     property Parser: TSelectSQLParser read GetParser;
658     property BaseSQLSelect: TStrings read FBaseSQLSelect;
659    
660     property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
661     write FBeforeDatabaseDisconnect;
662     property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
663     write FAfterDatabaseDisconnect;
664     property DatabaseFree: TNotifyEvent read FDatabaseFree
665     write FDatabaseFree;
666     property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
667     write FBeforeTransactionEnd;
668     property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
669     write FAfterTransactionEnd;
670     property TransactionFree: TNotifyEvent read FTransactionFree
671     write FTransactionFree;
672     property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
673    
674     public
675     constructor Create(AOwner: TComponent); override;
676     destructor Destroy; override;
677     procedure ApplyUpdates;
678     function CachedUpdateStatus: TCachedUpdateStatus;
679     procedure CancelUpdates;
680     function GetFieldPosition(AliasName: string): integer;
681     procedure FetchAll;
682     function LocateNext(const KeyFields: string; const KeyValues: Variant;
683     Options: TLocateOptions): Boolean;
684     procedure RecordModified(Value: Boolean);
685     procedure RevertRecord;
686     procedure Undelete;
687     procedure ResetParser; virtual;
688     function HasParser: boolean;
689    
690     { TDataSet support methods }
691     function BookmarkValid(Bookmark: TBookmark): Boolean; override;
692     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
693     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
694     function GetArray(Field: TIBArrayField): IArray;
695     procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
696     function GetCurrentRecord(Buffer: PChar): Boolean; override;
697     function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
698     function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
699     function GetFieldData(Field : TField; Buffer : Pointer;
700     NativeFormat : Boolean) : Boolean; overload; override;
701     property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
702     function Locate(const KeyFields: string; const KeyValues: Variant;
703     Options: TLocateOptions): Boolean; override;
704     function Lookup(const KeyFields: string; const KeyValues: Variant;
705     const ResultFields: string): Variant; override;
706     function UpdateStatus: TUpdateStatus; override;
707     function IsSequenced: Boolean; override;
708     procedure Post; override;
709     function ParamByName(ParamName: String): ISQLParam;
710     property ArrayFieldCount: integer read FArrayFieldCount;
711     property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
712     property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
713     property UpdatesPending: Boolean read FUpdatesPending;
714     property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
715     write SetUpdateRecordTypes;
716     property MasterDetailDelay: integer read GetMasterDetailDelay write SetMasterDetailDelay;
717     property DataSetCloseAction: TDataSetCloseAction
718     read FDataSetCloseAction write FDataSetCloseAction;
719    
720     public
721     {Performance Statistics}
722     function GetRowsAffected(var SelectCount, InsertCount, UpdateCount, DeleteCount: integer): boolean;
723     function GetPerfStatistics(var stats: TPerfCounters): boolean;
724     property EnableStatistics: boolean read FEnableStatistics write FEnableStatistics;
725    
726     published
727     property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
728     write FAllowAutoActivateTransaction;
729     property Database: TIBDatabase read GetDatabase write SetDatabase;
730     property Transaction: TIBTransaction read GetTransaction
731     write SetTransaction;
732     property ForcedRefresh: Boolean read FForcedRefresh
733     write FForcedRefresh default False;
734     property AutoCalcFields;
735    
736     property AfterCancel;
737     property AfterClose;
738     property AfterDelete;
739     property AfterEdit;
740     property AfterInsert;
741     property AfterOpen;
742     property AfterPost;
743     property AfterRefresh;
744     property AfterScroll;
745     property BeforeCancel;
746     property BeforeClose;
747     property BeforeDelete;
748     property BeforeEdit;
749     property BeforeInsert;
750     property BeforeOpen;
751     property BeforePost;
752     property BeforeRefresh;
753     property BeforeScroll;
754     property OnCalcFields;
755     property OnDeleteError;
756     property OnEditError;
757     property OnNewRecord;
758     property OnPostError;
759     property OnUpdateError: TIBUpdateErrorEvent read FOnUpdateError
760     write FOnUpdateError;
761     property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
762     write FOnUpdateRecord;
763     property OnDeleteReturning: TOnDeleteReturning read FOnDeleteReturning
764     write FOnDeleteReturning;
765     end;
766    
767     TIBParserDataSet = class(TIBCustomDataSet)
768     public
769     property Parser;
770     end;
771    
772     TIBDataSet = class(TIBParserDataSet)
773     private
774     function GetPrepared: Boolean;
775    
776     protected
777     procedure SetFiltered(Value: Boolean); override;
778     procedure InternalOpen; override;
779    
780     public
781     procedure Prepare;
782     procedure UnPrepare;
783     procedure BatchInput(InputObject: TIBBatchInput);
784     procedure BatchOutput(OutputObject: TIBBatchOutput);
785     procedure ExecSQL;
786    
787     public
788     property Params;
789     property Prepared : Boolean read GetPrepared;
790     property QDelete;
791     property QInsert;
792     property QRefresh;
793     property QSelect;
794     property QModify;
795     property StatementType;
796     property SelectStmtHandle;
797     property BaseSQLSelect;
798    
799     published
800     { TIBCustomDataSet }
801     property AutoCommit;
802     property BufferChunks;
803     property CachedUpdates;
804     property EnableStatistics;
805     property DeleteSQL;
806     property InsertSQL;
807     property RefreshSQL;
808     property SelectSQL;
809     property ModifySQL;
810     property GeneratorField;
811     property GenerateParamNames;
812     property MasterDetailDelay;
813     property ParamCheck;
814     property UniDirectional;
815     property Filtered;
816     property DataSetCloseAction;
817    
818     property BeforeDatabaseDisconnect;
819     property AfterDatabaseDisconnect;
820     property DatabaseFree;
821     property BeforeTransactionEnd;
822     property AfterTransactionEnd;
823     property TransactionFree;
824    
825     { TIBDataSet }
826     property Active;
827     property AutoCalcFields;
828     property DataSource read GetDataSource write SetDataSource;
829    
830     property AfterCancel;
831     property AfterClose;
832     property AfterDelete;
833     property AfterEdit;
834     property AfterInsert;
835     property AfterOpen;
836     property AfterPost;
837     property AfterScroll;
838     property BeforeCancel;
839     property BeforeClose;
840     property BeforeDelete;
841     property BeforeEdit;
842     property BeforeInsert;
843     property BeforeOpen;
844     property BeforePost;
845     property BeforeScroll;
846     property OnCalcFields;
847     property OnDeleteError;
848     property OnEditError;
849     property OnFilterRecord;
850     property OnNewRecord;
851     property OnPostError;
852     property OnValidatePost;
853     property OnDeleteReturning;
854     end;
855    
856     { TIBDSBlobStream }
857     TIBDSBlobStream = class(TStream)
858     private
859     FHasWritten: boolean;
860     protected
861     FField: TField;
862     FBlobStream: TIBBlobStream;
863     function GetSize: Int64; override;
864     public
865     constructor Create(AField: TField; ABlobStream: TIBBlobStream;
866     Mode: TBlobStreamMode);
867     destructor Destroy; override;
868     function Read(var Buffer; Count: Longint): Longint; override;
869     function Seek(Offset: Longint; Origin: Word): Longint; override;
870     procedure SetSize(NewSize: Longint); override;
871     function Write(const Buffer; Count: Longint): Longint; override;
872     end;
873    
874     {Extended Field Def for character set info}
875    
876     { TIBFieldDef }
877    
878     TIBFieldDef = class(TFieldDef)
879     private
880     FArrayBounds: TArrayBounds;
881     FArrayDimensions: integer;
882     FCharacterSetName: RawByteString;
883     FCharacterSetSize: integer;
884     FCodePage: TSystemCodePage;
885     FIdentityColumn: boolean;
886     FRelationName: string;
887     FDataSize: integer;
888     published
889     property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
890     property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
891     property CodePage: TSystemCodePage read FCodePage write FCodePage;
892     property DataSize: integer read FDataSize write FDataSize;
893     property RelationName: string read FRelationName write FRelationName;
894     property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
895     property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
896     property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
897     end;
898    
899     const
900     DefaultFieldClasses: array[TFieldType] of TFieldClass = (
901     nil, { ftUnknown }
902     TIBStringField, { ftString }
903     TIBSmallintField, { ftSmallint }
904     TIBIntegerField, { ftInteger }
905     TWordField, { ftWord }
906     TBooleanField, { ftBoolean }
907     TFloatField, { ftFloat }
908     TCurrencyField, { ftCurrency }
909     TIBBCDField, { ftBCD }
910     TDateField, { ftDate }
911     TTimeField, { ftTime }
912     TDateTimeField, { ftDateTime }
913     TBytesField, { ftBytes }
914     TVarBytesField, { ftVarBytes }
915     TAutoIncField, { ftAutoInc }
916     TBlobField, { ftBlob }
917     TIBMemoField, { ftMemo }
918     TGraphicField, { ftGraphic }
919     TBlobField, { ftFmtMemo }
920     TBlobField, { ftParadoxOle }
921     TBlobField, { ftDBaseOle }
922     TBlobField, { ftTypedBinary }
923     nil, { ftCursor }
924     TStringField, { ftFixedChar }
925     nil, { ftWideString }
926     TIBLargeIntField, { ftLargeInt }
927     nil, { ftADT }
928     TIBArrayField, { ftArray }
929     nil, { ftReference }
930     nil, { ftDataSet }
931     TBlobField, { ftOraBlob }
932     TMemoField, { ftOraClob }
933     TVariantField, { ftVariant }
934     nil, { ftInterface }
935     nil, { ftIDispatch }
936     TGuidField, { ftGuid }
937     TDateTimeField, {ftTimestamp}
938     TIBBCDField, {ftFMTBcd}
939     nil, {ftFixedWideChar}
940     nil); {ftWideMemo}
941     (*
942     TADTField, { ftADT }
943     TArrayField, { ftArray }
944     TReferenceField, { ftReference }
945     TDataSetField, { ftDataSet }
946     TBlobField, { ftOraBlob }
947     TMemoField, { ftOraClob }
948     TVariantField, { ftVariant }
949     TInterfaceField, { ftInterface }
950     TIDispatchField, { ftIDispatch }
951     TGuidField); { ftGuid } *)
952     (*var
953     CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
954    
955     implementation
956    
957     uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
958    
959     const FILE_BEGIN = 0;
960     FILE_CURRENT = 1;
961     FILE_END = 2;
962    
963     type
964    
965     TFieldNode = class(TObject)
966     protected
967     FieldName : String;
968     COMPUTED_BLR : Boolean;
969     DEFAULT_VALUE : boolean;
970     IDENTITY_COLUMN : boolean;
971     NextField : TFieldNode;
972     end;
973    
974     TRelationNode = class(TObject)
975     protected
976     RelationName : String;
977     FieldNodes : TFieldNode;
978     NextRelation : TRelationNode;
979     end;
980    
981    
982     { Copied from LCLProc in order to avoid LCL dependency
983    
984     Ensures the covenient look of multiline string
985     when displaying it in the single line
986     * Replaces CR and LF with spaces
987     * Removes duplicate spaces
988     }
989     function TextToSingleLine(const AText: string): string;
990     var
991     str: string;
992     i, wstart, wlen: Integer;
993     begin
994     str := Trim(AText);
995     wstart := 0;
996     wlen := 0;
997     i := 1;
998     while i < Length(str) - 1 do
999     begin
1000     if (str[i] in [' ', #13, #10]) then
1001     begin
1002     if (wstart = 0) then
1003     begin
1004     wstart := i;
1005     wlen := 1;
1006     end else
1007     Inc(wlen);
1008     end else
1009     begin
1010     if wstart > 0 then
1011     begin
1012     str[wstart] := ' ';
1013     Delete(str, wstart+1, wlen-1);
1014     Dec(i, wlen-1);
1015     wstart := 0;
1016     end;
1017     end;
1018     Inc(i);
1019     end;
1020     Result := str;
1021     end;
1022    
1023     { TIBLargeIntField }
1024    
1025     procedure TIBLargeIntField.Bind(Binding: Boolean);
1026     begin
1027     inherited Bind(Binding);
1028     if Binding and (FieldDef <> nil) then
1029     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1030     end;
1031    
1032     { TIBIntegerField }
1033    
1034     procedure TIBIntegerField.Bind(Binding: Boolean);
1035     begin
1036     inherited Bind(Binding);
1037     if Binding and (FieldDef <> nil) then
1038     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1039     end;
1040    
1041     { TIBSmallintField }
1042    
1043     procedure TIBSmallintField.Bind(Binding: Boolean);
1044     begin
1045     inherited Bind(Binding);
1046     if Binding and (FieldDef <> nil) then
1047     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1048     end;
1049    
1050     { TIBArray }
1051    
1052     procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
1053     begin
1054     case Reason of
1055     arChanging:
1056     if FRecNo <> FField.Dataset.RecNo then
1057     IBError(ibxeNotCurrentArray,[nil]);
1058    
1059     arChanged:
1060     FField.DataChanged;
1061     end;
1062     end;
1063    
1064     constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
1065     begin
1066     inherited Create;
1067     FField := aField;
1068     FArray := anArray;
1069     FRecNo := FField.Dataset.RecNo;
1070     FArray.AddEventHandler(EventHandler);
1071     end;
1072    
1073     destructor TIBArray.Destroy;
1074     begin
1075     FArray.RemoveEventHandler(EventHandler);
1076     inherited Destroy;
1077     end;
1078    
1079     { TIBArrayField }
1080    
1081     function TIBArrayField.GetArrayIntf: IArray;
1082     begin
1083     Result := TIBCustomDataSet(DataSet).GetArray(self);
1084     end;
1085    
1086     function TIBArrayField.GetArrayID: TISC_QUAD;
1087     begin
1088     GetData(@Result);
1089     end;
1090    
1091     procedure TIBArrayField.SetArrayIntf(AValue: IArray);
1092     begin
1093     TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
1094     DataChanged;
1095     end;
1096    
1097     class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
1098     begin
1099     //Ignore
1100     end;
1101    
1102     function TIBArrayField.GetAsString: string;
1103     begin
1104     Result := '(Array)';
1105     end;
1106    
1107     function TIBArrayField.GetDataSize: Integer;
1108     begin
1109     Result := sizeof(TISC_QUAD);
1110     end;
1111    
1112     procedure TIBArrayField.Bind(Binding: Boolean);
1113     begin
1114     inherited Bind(Binding);
1115     if Binding then
1116     begin
1117     FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
1118     Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
1119     if FieldDef <> nil then
1120     begin
1121     FRelationName := TIBFieldDef(FieldDef).FRelationName;
1122     FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1123     FArrayBounds := TIBFieldDef(FieldDef).ArrayBounds;
1124     end;
1125     end;
1126     end;
1127    
1128     constructor TIBArrayField.Create(AOwner: TComponent);
1129     begin
1130     inherited Create(AOwner);
1131     SetDataType(ftArray);
1132     end;
1133    
1134     function TIBArrayField.CreateArray: IArray;
1135     begin
1136     with DataSet as TIBCustomDataSet do
1137     Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1138     end;
1139    
1140     { TIBMemoField }
1141    
1142     function TIBMemoField.GetTruncatedText: string;
1143     begin
1144     Result := GetAsString;
1145    
1146     if Result <> '' then
1147     begin
1148     case CharacterSetSize of
1149     1:
1150     if DisplayWidth = 0 then
1151     Result := TextToSingleLine(Result)
1152     else
1153     if Length(Result) > DisplayWidth then {Show truncation with elipses}
1154     Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1155    
1156     {2: case 2 ignored. This should be handled by TIBWideMemo}
1157    
1158     3, {Assume UNICODE_FSS is really UTF8}
1159     4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1160     if DisplayWidth = 0 then
1161     Result := ValidUTF8String(TextToSingleLine(Result))
1162     else
1163     if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1164     Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1165     end;
1166     end
1167     end;
1168    
1169     procedure TIBMemoField.Bind(Binding: Boolean);
1170     var IBFieldDef: TIBFieldDef;
1171     begin
1172     inherited Bind(Binding);
1173     if Binding and (FieldDef <> nil) then
1174     begin
1175     IBFieldDef := FieldDef as TIBFieldDef;
1176     CharacterSetSize := IBFieldDef.CharacterSetSize;
1177     CharacterSetName := IBFieldDef.CharacterSetName;
1178     CodePage := IBFieldDef.CodePage;
1179     end;
1180     end;
1181    
1182     function TIBMemoField.GetAsString: string;
1183     var s: RawByteString;
1184     begin
1185     s := inherited GetAsString;
1186     SetCodePage(s,CodePage,false);
1187     if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1188     SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
1189     Result := s;
1190     end;
1191    
1192     function TIBMemoField.GetDefaultWidth: Longint;
1193     begin
1194     if DisplayTextAsClassName then
1195     Result := inherited
1196     else
1197     Result := 128;
1198     end;
1199    
1200     procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1201     begin
1202     if ADisplayText then
1203     begin
1204     if not DisplayTextAsClassName and (CharacterSetName <> '') then
1205     AText := GetTruncatedText
1206     else
1207     inherited GetText(AText, ADisplayText);
1208     end
1209     else
1210     AText := GetAsString;
1211     end;
1212    
1213     procedure TIBMemoField.SetAsString(const AValue: string);
1214     var s: RawByteString;
1215     begin
1216     s := AValue;
1217     if StringCodePage(s) <> CodePage then
1218     SetCodePage(s,CodePage,CodePage<>CP_NONE);
1219     inherited SetAsString(s);
1220     end;
1221    
1222     constructor TIBMemoField.Create(AOwner: TComponent);
1223     begin
1224     inherited Create(AOwner);
1225     BlobType := ftMemo;
1226     FCodePage := CP_NONE;
1227     end;
1228    
1229     { TIBControlLink }
1230    
1231     destructor TIBControlLink.Destroy;
1232     begin
1233     IBDataSet := nil;
1234     inherited Destroy;
1235     end;
1236    
1237     procedure TIBControlLink.UpdateParams(Sender: TObject);
1238     begin
1239    
1240     end;
1241    
1242     procedure TIBControlLink.UpdateSQL(Sender: TObject);
1243     begin
1244    
1245     end;
1246    
1247     procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1248     begin
1249     if FTIBDataSet = AValue then Exit;
1250     if IBDataSet <> nil then
1251     IBDataSet.UnRegisterIBLink(self);
1252     FTIBDataSet := AValue;
1253     if IBDataSet <> nil then
1254     IBDataSet.RegisterIBLink(self);
1255     end;
1256    
1257    
1258     { TIBStringField}
1259    
1260     procedure TIBStringField.Bind(Binding: Boolean);
1261     var IBFieldDef: TIBFieldDef;
1262     begin
1263     inherited Bind(Binding);
1264     if Binding and (FieldDef <> nil) then
1265     begin
1266     IBFieldDef := FieldDef as TIBFieldDef;
1267     CharacterSetSize := IBFieldDef.CharacterSetSize;
1268     CharacterSetName := IBFieldDef.CharacterSetName;
1269     FDataSize := IBFieldDef.DataSize + 1;
1270     if AutoFieldSize then
1271     Size := IBFieldDef.Size;
1272     CodePage := IBFieldDef.CodePage;
1273     end;
1274     end;
1275    
1276     function TIBStringField.GetDataSize: Integer;
1277     begin
1278     Result := FDataSize;
1279     end;
1280    
1281     constructor TIBStringField.Create(aOwner: TComponent);
1282     begin
1283     inherited Create(aOwner);
1284     FCharacterSetSize := 1;
1285     FCodePage := CP_NONE;
1286     FAutoFieldSize := true;
1287     end;
1288    
1289     class procedure TIBStringField.CheckTypeSize(Value: Integer);
1290     begin
1291     { don't check string size. all sizes valid }
1292     end;
1293    
1294     function TIBStringField.GetAsString: string;
1295     begin
1296     if not GetValue(Result) then Result := '';
1297     end;
1298    
1299     function TIBStringField.GetAsVariant: Variant;
1300     var
1301     S: string;
1302     begin
1303     if GetValue(S) then Result := S else Result := Null;
1304     end;
1305    
1306     function TIBStringField.GetValue(var Value: string): Boolean;
1307     var
1308     Buffer: PChar;
1309     s: RawByteString;
1310     begin
1311     Buffer := nil;
1312     IBAlloc(Buffer, 0, DataSize);
1313     try
1314     Result := GetData(Buffer);
1315     if Result then
1316     begin
1317     s := strpas(Buffer);
1318     SetCodePage(s,CodePage,false);
1319     if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1320     SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
1321     Value := s;
1322     // writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1323     if Transliterate and (Value <> '') then
1324     DataSet.Translate(PChar(Value), PChar(Value), False);
1325     end
1326     finally
1327     FreeMem(Buffer);
1328     end;
1329     end;
1330    
1331     procedure TIBStringField.SetAsString(const Value: string);
1332     var
1333     Buffer: PChar;
1334     s: RawByteString;
1335     begin
1336     Buffer := nil;
1337     IBAlloc(Buffer, 0, DataSize);
1338     try
1339     s := Value;
1340     if StringCodePage(s) <> CodePage then
1341     SetCodePage(s,CodePage,CodePage<>CP_NONE);
1342     StrLCopy(Buffer, PChar(s), DataSize-1);
1343     if Transliterate then
1344     DataSet.Translate(Buffer, Buffer, True);
1345     SetData(Buffer);
1346     finally
1347     FreeMem(Buffer);
1348     end;
1349     end;
1350    
1351    
1352     { TIBBCDField }
1353    
1354     constructor TIBBCDField.Create(AOwner: TComponent);
1355     begin
1356     inherited Create(AOwner);
1357     SetDataType(ftBCD);
1358     Size := 8;
1359     end;
1360    
1361     procedure TIBBCDField.Bind(Binding: Boolean);
1362     begin
1363     inherited Bind(Binding);
1364     if Binding and (FieldDef <> nil) then
1365     FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1366     end;
1367    
1368     class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1369     begin
1370     { No need to check as the base type is currency, not BCD }
1371     end;
1372    
1373     function TIBBCDField.GetAsCurrency: Currency;
1374     begin
1375     if not GetValue(Result) then
1376     Result := 0;
1377     end;
1378    
1379     function TIBBCDField.GetAsString: string;
1380     var
1381     C: System.Currency;
1382     begin
1383     if GetValue(C) then
1384     Result := CurrToStr(C)
1385     else
1386     Result := '';
1387     end;
1388    
1389     function TIBBCDField.GetAsVariant: Variant;
1390     var
1391     C: System.Currency;
1392     begin
1393     if GetValue(C) then
1394     Result := C
1395     else
1396     Result := Null;
1397     end;
1398    
1399     function TIBBCDField.GetDataSize: Integer;
1400     begin
1401     {$IFDEF TBCDFIELD_IS_BCD}
1402     Result := 8;
1403     {$ELSE}
1404     Result := inherited GetDataSize
1405     {$ENDIF}
1406     end;
1407    
1408     { TIBDataLink }
1409    
1410     constructor TIBDataLink.Create(ADataSet: TIBCustomDataSet);
1411     begin
1412     inherited Create;
1413     FDataSet := ADataSet;
1414     FTimer := TFPTimer.Create(nil);
1415 tony 215 FTimer.Enabled := false;
1416 tony 209 FTimer.Interval := 0;
1417     FTimer.OnTimer := HandleRefreshTimer;
1418     FDelayTimerValue := 0;
1419     end;
1420    
1421     destructor TIBDataLink.Destroy;
1422     begin
1423     FDataSet.FDataLink := nil;
1424     if assigned(FTimer) then FTimer.Free;
1425     inherited Destroy;
1426     end;
1427    
1428     procedure TIBDataLink.HandleRefreshTimer(Sender: TObject);
1429     begin
1430 tony 215 FTimer.Enabled := false;
1431 tony 213 if FDataSet.Active then
1432     FDataSet.RefreshParams;
1433 tony 209 end;
1434    
1435 tony 213 procedure TIBDataLink.SetDelayTimerValue(AValue: integer);
1436     begin
1437     if FDelayTimerValue = AValue then Exit;
1438     FDelayTimerValue := AValue;
1439     FTimer.Interval := FDelayTimerValue;
1440     end;
1441    
1442 tony 209 procedure TIBDataLink.ActiveChanged;
1443     begin
1444     if FDataSet.Active then
1445     FDataSet.RefreshParams;
1446     end;
1447    
1448    
1449     function TIBDataLink.GetDetailDataSet: TDataSet;
1450     begin
1451     Result := FDataSet;
1452     end;
1453    
1454     procedure TIBDataLink.RecordChanged(Field: TField);
1455     begin
1456     if (Field = nil) and FDataSet.Active then
1457     begin
1458 tony 213 {$IF FPC_FULLVERSION >= 30002}
1459 tony 209 if FDelayTimerValue > 0 then
1460 tony 215 with FTimer do
1461     begin
1462     if Enabled then
1463     begin
1464     StopTimer;
1465     StartTimer;
1466     end
1467     else
1468     Enabled := true;
1469     end
1470 tony 209 else
1471 tony 213 {$IFEND}
1472 tony 209 FDataSet.RefreshParams;
1473     end;
1474     end;
1475    
1476     procedure TIBDataLink.CheckBrowseMode;
1477     begin
1478     if FDataSet.Active then
1479     FDataSet.CheckBrowseMode;
1480     end;
1481    
1482     { TIBCustomDataSet }
1483    
1484     constructor TIBCustomDataSet.Create(AOwner: TComponent);
1485     begin
1486     inherited Create(AOwner);
1487     FBase := TIBBase.Create(Self);
1488     FDatabaseInfo := TIBDatabaseInfo.Create(self);
1489     FIBLinks := TList.Create;
1490     FCurrentRecord := -1;
1491     FDeletedRecords := 0;
1492     FUniDirectional := False;
1493     FBufferChunks := BufferCacheSize;
1494     FBlobStreamList := TList.Create;
1495     FArrayList := TList.Create;
1496     FGeneratorField := TIBGenerator.Create(self);
1497     FDataLink := TIBDataLink.Create(Self);
1498     FQDelete := TIBSQL.Create(Self);
1499     FQDelete.OnSQLChanging := SQLChanging;
1500     FQDelete.GoToFirstRecordOnExecute := False;
1501     FQInsert := TIBSQL.Create(Self);
1502     FQInsert.OnSQLChanging := SQLChanging;
1503     FQInsert.GoToFirstRecordOnExecute := False;
1504     FQRefresh := TIBSQL.Create(Self);
1505     FQRefresh.OnSQLChanging := SQLChanging;
1506     FQRefresh.GoToFirstRecordOnExecute := False;
1507     FQSelect := TIBSQL.Create(Self);
1508     FQSelect.OnSQLChanging := SQLChanging;
1509     FQSelect.OnSQLChanged := SQLChanged;
1510     FQSelect.GoToFirstRecordOnExecute := False;
1511     FQModify := TIBSQL.Create(Self);
1512     FQModify.OnSQLChanging := SQLChanging;
1513     FQModify.GoToFirstRecordOnExecute := False;
1514     FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1515     FParamCheck := True;
1516     FGenerateParamNames := False;
1517     FForcedRefresh := False;
1518     FAutoCommit:= acDisabled;
1519     FDataSetCloseAction := dcDiscardChanges;
1520     {Bookmark Size is Integer for IBX}
1521     BookmarkSize := SizeOf(Integer);
1522     FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
1523     FBase.AfterDatabaseDisconnect := DoAfterDatabaseDisconnect;
1524     FBase.OnDatabaseFree := DoDatabaseFree;
1525     FBase.BeforeTransactionEnd := DoBeforeTransactionEnd;
1526     FBase.AfterTransactionEnd := DoAfterTransactionEnd;
1527     FBase.OnTransactionFree := DoTransactionFree;
1528     if AOwner is TIBDatabase then
1529     Database := TIBDatabase(AOwner)
1530     else
1531     if AOwner is TIBTransaction then
1532     Transaction := TIBTransaction(AOwner);
1533     FBaseSQLSelect := TStringList.Create;
1534     end;
1535    
1536     destructor TIBCustomDataSet.Destroy;
1537     begin
1538     if Active then Active := false;
1539     if assigned(FGeneratorField) then FGeneratorField.Free;
1540     FDataLink.Free;
1541     FBase.Free;
1542     ClearBlobCache;
1543     ClearIBLinks;
1544     FIBLinks.Free;
1545     FBlobStreamList.Free;
1546     FArrayList.Free;
1547     FreeMem(FBufferCache);
1548     FBufferCache := nil;
1549     FreeMem(FOldBufferCache);
1550     FOldBufferCache := nil;
1551     FCacheSize := 0;
1552     FOldCacheSize := 0;
1553     FMappedFieldPosition := nil;
1554     if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1555     if assigned(FParser) then FParser.Free;
1556     inherited Destroy;
1557     end;
1558    
1559     function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
1560     TGetResult;
1561     begin
1562     while not IsVisible(Buffer) do
1563     begin
1564     if GetMode = gmPrior then
1565     begin
1566     Dec(FCurrentRecord);
1567     if FCurrentRecord = -1 then
1568     begin
1569     result := grBOF;
1570     exit;
1571     end;
1572     ReadRecordCache(FCurrentRecord, Buffer, False);
1573     end
1574     else begin
1575     Inc(FCurrentRecord);
1576     if (FCurrentRecord = FRecordCount) then
1577     begin
1578     if (not FQSelect.EOF) and FQSelect.Next then
1579     begin
1580     FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1581     Inc(FRecordCount);
1582     end
1583     else begin
1584     result := grEOF;
1585     exit;
1586     end;
1587     end
1588     else
1589     ReadRecordCache(FCurrentRecord, Buffer, False);
1590     end;
1591     end;
1592     result := grOK;
1593     end;
1594    
1595     procedure TIBCustomDataSet.ApplyUpdates;
1596     var
1597     CurBookmark: TBookmark;
1598     Buffer: PRecordData;
1599     CurUpdateTypes: TIBUpdateRecordTypes;
1600     UpdateAction: TIBUpdateAction;
1601     UpdateKind: TUpdateKind;
1602     bRecordsSkipped: Boolean;
1603    
1604     procedure GetUpdateKind;
1605     begin
1606     case Buffer^.rdCachedUpdateStatus of
1607     cusModified:
1608     UpdateKind := ukModify;
1609     cusInserted:
1610     UpdateKind := ukInsert;
1611     else
1612     UpdateKind := ukDelete;
1613     end;
1614     end;
1615    
1616     procedure ResetBufferUpdateStatus;
1617     begin
1618     case Buffer^.rdCachedUpdateStatus of
1619     cusModified:
1620     begin
1621     PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
1622     PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
1623     end;
1624     cusInserted:
1625     begin
1626     PRecordData(Buffer)^.rdUpdateStatus := usUnmodified;
1627     PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
1628     end;
1629     cusDeleted:
1630     begin
1631     PRecordData(Buffer)^.rdUpdateStatus := usDeleted;
1632     PRecordData(Buffer)^.rdCachedUpdateStatus := cusUnmodified;
1633     end;
1634     end;
1635     WriteRecordCache(PRecordData(Buffer)^.rdRecordNumber, Pointer(Buffer));
1636     end;
1637    
1638     procedure UpdateUsingOnUpdateRecord;
1639     begin
1640     UpdateAction := uaFail;
1641     try
1642     FOnUpdateRecord(Self, UpdateKind, UpdateAction);
1643     except
1644     on E: Exception do
1645     begin
1646     if (E is EDatabaseError) and Assigned(FOnUpdateError) then
1647     FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
1648     if UpdateAction = uaFail then
1649     raise;
1650     end;
1651     end;
1652     end;
1653    
1654     procedure UpdateUsingUpdateObject;
1655     begin
1656     try
1657     FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1658     ResetBufferUpdateStatus;
1659     except
1660     on E: Exception do
1661     if (E is EDatabaseError) and Assigned(FOnUpdateError) then
1662     FOnUpdateError(Self, EIBError(E), UpdateKind, UpdateAction);
1663     end;
1664     end;
1665    
1666     procedure UpdateUsingInternalquery;
1667     begin
1668     try
1669     case Buffer^.rdCachedUpdateStatus of
1670     cusModified:
1671     InternalPostRecord(FQModify, Buffer);
1672     cusInserted:
1673     InternalPostRecord(FQInsert, Buffer);
1674     cusDeleted:
1675     InternalDeleteRecord(FQDelete, Buffer);
1676     end;
1677     except
1678     on E: EIBError do begin
1679     UpdateAction := uaFail;
1680     if Assigned(FOnUpdateError) then
1681     FOnUpdateError(Self, E, UpdateKind, UpdateAction);
1682     case UpdateAction of
1683     uaFail: raise;
1684     uaAbort: SysUtils.Abort;
1685     uaSkip: bRecordsSkipped := True;
1686     end;
1687     end;
1688     end;
1689     end;
1690    
1691     begin
1692     if State in [dsEdit, dsInsert] then
1693     Post;
1694     FBase.CheckDatabase;
1695     FBase.CheckTransaction;
1696     DisableControls;
1697     CurBookmark := Bookmark;
1698     CurUpdateTypes := FUpdateRecordTypes;
1699     FUpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
1700     try
1701     First;
1702     bRecordsSkipped := False;
1703     while not EOF do
1704     begin
1705     Buffer := PRecordData(GetActiveBuf);
1706     GetUpdateKind;
1707     UpdateAction := uaApply;
1708     if Assigned(FUpdateObject) or Assigned(FOnUpdateRecord) then
1709     begin
1710     if (Assigned(FOnUpdateRecord)) then
1711     UpdateUsingOnUpdateRecord
1712     else
1713     if Assigned(FUpdateObject) then
1714     UpdateUsingUpdateObject;
1715     case UpdateAction of
1716     uaFail:
1717     IBError(ibxeUserAbort, [nil]);
1718     uaAbort:
1719     SysUtils.Abort;
1720     uaApplied:
1721     ResetBufferUpdateStatus;
1722     uaSkip:
1723     bRecordsSkipped := True;
1724     uaRetry:
1725     Continue;
1726     end;
1727     end;
1728     if (not Assigned(FUpdateObject)) and (UpdateAction = UaApply) then
1729     begin
1730     UpdateUsingInternalquery;
1731     UpdateAction := uaApplied;
1732     end;
1733     Next;
1734     end;
1735     FUpdatesPending := bRecordsSkipped;
1736     finally
1737     FUpdateRecordTypes := CurUpdateTypes;
1738     Bookmark := CurBookmark;
1739     EnableControls;
1740     end;
1741     end;
1742    
1743     procedure TIBCustomDataSet.InternalBatchInput(InputObject: TIBBatchInput);
1744     begin
1745     FQSelect.BatchInput(InputObject);
1746     end;
1747    
1748     procedure TIBCustomDataSet.InternalBatchOutput(OutputObject: TIBBatchOutput);
1749     var
1750     Qry: TIBSQL;
1751     begin
1752     Qry := TIBSQL.Create(Self);
1753     try
1754     Qry.Database := FBase.Database;
1755     Qry.Transaction := FBase.Transaction;
1756     Qry.SQL.Assign(FQSelect.SQL);
1757     Qry.BatchOutput(OutputObject);
1758     finally
1759     Qry.Free;
1760     end;
1761     end;
1762    
1763     procedure TIBCustomDataSet.CancelUpdates;
1764     var
1765     CurUpdateTypes: TIBUpdateRecordTypes;
1766     begin
1767     if State in [dsEdit, dsInsert] then
1768     Post;
1769     if FCachedUpdates and FUpdatesPending then
1770     begin
1771     DisableControls;
1772     CurUpdateTypes := UpdateRecordTypes;
1773     UpdateRecordTypes := [cusModified, cusInserted, cusDeleted];
1774     try
1775     First;
1776     while not EOF do
1777     begin
1778     if UpdateStatus = usInserted then
1779     RevertRecord
1780     else
1781     begin
1782     RevertRecord;
1783     Next;
1784     end;
1785     end;
1786     finally
1787     UpdateRecordTypes := CurUpdateTypes;
1788     First;
1789     FUpdatesPending := False;
1790     EnableControls;
1791     end;
1792     end;
1793     end;
1794    
1795     function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1796     var i: integer;
1797     Prepared: boolean;
1798     begin
1799     Result := 0;
1800     Prepared := FInternalPrepared;
1801     if not Prepared then
1802     InternalPrepare;
1803     try
1804     for i := 0 to Length(FAliasNameList) - 1 do
1805     if FAliasNameList[i] = AliasName then
1806     begin
1807     Result := i + 1;
1808     Exit
1809     end;
1810     finally
1811     if not Prepared then
1812     InternalUnPrepare;
1813     end;
1814     end;
1815    
1816     procedure TIBCustomDataSet.ActivateConnection;
1817     begin
1818     if not Assigned(Database) then
1819     IBError(ibxeDatabaseNotAssigned, [nil]);
1820     if not Assigned(Transaction) then
1821     IBError(ibxeTransactionNotAssigned, [nil]);
1822     if not Database.Connected then Database.Open;
1823     end;
1824    
1825     function TIBCustomDataSet.ActivateTransaction: Boolean;
1826     begin
1827     Result := False;
1828     if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1829     begin
1830     if not Assigned(Transaction) then
1831     IBError(ibxeTransactionNotAssigned, [nil]);
1832     if not Transaction.Active then
1833     begin
1834     Result := True;
1835     Transaction.StartTransaction;
1836     FDidActivate := True;
1837     end;
1838     end;
1839     end;
1840    
1841     procedure TIBCustomDataSet.DeactivateTransaction;
1842     var
1843     i: Integer;
1844     begin
1845     if not Assigned(Transaction) then
1846     IBError(ibxeTransactionNotAssigned, [nil]);
1847     with Transaction do
1848     begin
1849     for i := 0 to SQLObjectCount - 1 do
1850     begin
1851     if (SQLObjects[i] <> nil) and ((SQLObjects[i]).owner is TDataSet) then
1852     begin
1853     if TDataSet(SQLObjects[i].owner).Active then
1854     begin
1855     FDidActivate := False;
1856     exit;
1857     end;
1858     end;
1859     end;
1860     end;
1861     FInternalPrepared := False;
1862     if Transaction.InTransaction then
1863     Transaction.Commit;
1864     FDidActivate := False;
1865     end;
1866    
1867     procedure TIBCustomDataSet.CheckDatasetClosed;
1868     begin
1869     if FOpen then
1870     IBError(ibxeDatasetOpen, [nil]);
1871     end;
1872    
1873     procedure TIBCustomDataSet.CheckDatasetOpen;
1874     begin
1875     if not FOpen then
1876     IBError(ibxeDatasetClosed, [nil]);
1877     end;
1878    
1879     function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1880     begin
1881     Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1882     Result.OnSQLChanging := SQLChanging
1883     end;
1884    
1885     procedure TIBCustomDataSet.CheckNotUniDirectional;
1886     begin
1887     if UniDirectional then
1888     IBError(ibxeDataSetUniDirectional, [nil]);
1889     end;
1890    
1891     procedure TIBCustomDataSet.AdjustRecordOnInsert(Buffer: Pointer);
1892     begin
1893     with PRecordData(Buffer)^ do
1894     if (State = dsInsert) and (not Modified) then
1895     begin
1896     rdRecordNumber := FRecordCount;
1897     FCurrentRecord := FRecordCount;
1898     end;
1899     end;
1900    
1901     function TIBCustomDataSet.CanEdit: Boolean;
1902     var
1903     Buff: PRecordData;
1904     begin
1905     Buff := PRecordData(GetActiveBuf);
1906     result := (FQModify.SQL.Text <> '') or
1907     (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukModify).Text <> '')) or
1908     ((Buff <> nil) and (Buff^.rdCachedUpdateStatus = cusInserted) and
1909     (FCachedUpdates));
1910     end;
1911    
1912     function TIBCustomDataSet.CanInsert: Boolean;
1913     begin
1914     result := (FQInsert.SQL.Text <> '') or
1915     (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukInsert).Text <> ''));
1916     end;
1917    
1918     function TIBCustomDataSet.CanDelete: Boolean;
1919     begin
1920     if (FQDelete.SQL.Text <> '') or
1921     (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
1922     result := True
1923     else
1924     result := False;
1925     end;
1926    
1927     function TIBCustomDataSet.CanRefresh: Boolean;
1928     begin
1929     result := (FQRefresh.SQL.Text <> '') or
1930     (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> ''));
1931     end;
1932    
1933     procedure TIBCustomDataSet.CheckEditState;
1934     begin
1935     case State of
1936     { Check all the wsEditMode types }
1937     dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter,
1938     dsNewValue, dsInternalCalc :
1939     begin
1940     if (State in [dsEdit]) and (not CanEdit) then
1941     IBError(ibxeCannotUpdate, [nil]);
1942     if (State in [dsInsert]) and (not CanInsert) then
1943     IBError(ibxeCannotInsert, [nil]);
1944     end;
1945     else
1946     IBError(ibxeNotEditing, [])
1947     end;
1948     end;
1949    
1950     procedure TIBCustomDataSet.ClearBlobCache;
1951     var
1952     i: Integer;
1953     begin
1954     for i := 0 to FBlobStreamList.Count - 1 do
1955     begin
1956     TIBBlobStream(FBlobStreamList[i]).Free;
1957     FBlobStreamList[i] := nil;
1958     end;
1959     FBlobStreamList.Pack;
1960     end;
1961    
1962     procedure TIBCustomDataSet.ClearArrayCache;
1963     var
1964     i: Integer;
1965     begin
1966     for i := 0 to FArrayList.Count - 1 do
1967     begin
1968     TIBArray(FArrayList[i]).Free;
1969     FArrayList[i] := nil;
1970     end;
1971     FArrayList.Pack;
1972     end;
1973    
1974     procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1975     begin
1976     Move(Source^, Dest^, FRecordBufferSize);
1977     end;
1978    
1979     procedure TIBCustomDataSet.DoBeforeDatabaseDisconnect(Sender: TObject);
1980     begin
1981     if Active then
1982     Active := False;
1983     InternalUnPrepare;
1984     if Assigned(FBeforeDatabaseDisconnect) then
1985     FBeforeDatabaseDisconnect(Sender);
1986     end;
1987    
1988     procedure TIBCustomDataSet.DoAfterDatabaseDisconnect(Sender: TObject);
1989     begin
1990     if Assigned(FAfterDatabaseDisconnect) then
1991     FAfterDatabaseDisconnect(Sender);
1992     end;
1993    
1994     procedure TIBCustomDataSet.DoDatabaseFree(Sender: TObject);
1995     begin
1996     if Assigned(FDatabaseFree) then
1997     FDatabaseFree(Sender);
1998     end;
1999    
2000     procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
2001     Action: TTransactionAction);
2002     begin
2003     FCloseAction := Action;
2004     FInTransactionEnd := true;
2005     try
2006     if Active then
2007     Active := False;
2008     finally
2009     FInTransactionEnd := false;
2010     end;
2011     if FQSelect <> nil then
2012     FQSelect.FreeHandle;
2013     if FQDelete <> nil then
2014     FQDelete.FreeHandle;
2015     if FQInsert <> nil then
2016     FQInsert.FreeHandle;
2017     if FQModify <> nil then
2018     FQModify.FreeHandle;
2019     if FQRefresh <> nil then
2020     FQRefresh.FreeHandle;
2021     InternalUnPrepare;
2022     if Assigned(FBeforeTransactionEnd) then
2023     FBeforeTransactionEnd(Sender);
2024     end;
2025    
2026     procedure TIBCustomDataSet.DoAfterTransactionEnd(Sender: TObject);
2027     begin
2028     if Assigned(FAfterTransactionEnd) then
2029     FAfterTransactionEnd(Sender);
2030     end;
2031    
2032     procedure TIBCustomDataSet.DoTransactionFree(Sender: TObject);
2033     begin
2034     if Assigned(FTransactionFree) then
2035     FTransactionFree(Sender);
2036     end;
2037    
2038     procedure TIBCustomDataSet.DoDeleteReturning(QryResults: IResults);
2039     begin
2040     if assigned(FOnDeleteReturning) then
2041     OnDeleteReturning(self,QryResults);
2042     end;
2043    
2044     procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
2045     var i, j: Integer;
2046     FieldsLoaded: integer;
2047     p: PRecordData;
2048     colMetadata: IColumnMetaData;
2049     begin
2050     p := PRecordData(Buffer);
2051     { Get record information }
2052     p^.rdBookmarkFlag := bfCurrent;
2053     p^.rdFieldCount := Qry.FieldCount;
2054     p^.rdRecordNumber := -1;
2055     p^.rdUpdateStatus := usUnmodified;
2056     p^.rdCachedUpdateStatus := cusUnmodified;
2057     p^.rdSavedOffset := $FFFFFFFF;
2058    
2059     { Load up the fields }
2060     FieldsLoaded := FQSelect.MetaData.Count;
2061     j := 1;
2062     for i := 0 to Qry.MetaData.Count - 1 do
2063     begin
2064     if (Qry = FQSelect) then
2065     j := i + 1
2066     else
2067     begin
2068     if FieldsLoaded = 0 then
2069     break;
2070     j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2071     if j < 1 then
2072     continue
2073     else
2074     Dec(FieldsLoaded);
2075     end;
2076     if j > 0 then
2077     begin
2078     colMetadata := Qry.MetaData[i];
2079     with p^.rdFields[j], FFieldColumns^[j] do
2080     begin
2081     fdDataType := colMetadata.GetSQLType;
2082     if fdDataType = SQL_BLOB then
2083     fdDataScale := 0
2084     else
2085     fdDataScale := colMetadata.getScale;
2086     fdNullable := colMetadata.getIsNullable;
2087     fdIsNull := true;
2088     fdDataSize := colMetadata.GetSize;
2089     fdDataLength := 0;
2090     fdCodePage := CP_NONE;
2091    
2092     case fdDataType of
2093     SQL_TIMESTAMP,
2094     SQL_TYPE_DATE,
2095     SQL_TYPE_TIME:
2096     fdDataSize := SizeOf(TDateTime);
2097     SQL_SHORT, SQL_LONG:
2098     begin
2099     if (fdDataScale = 0) then
2100     fdDataSize := SizeOf(Integer)
2101     else
2102     if (fdDataScale >= (-4)) then
2103     fdDataSize := SizeOf(Currency)
2104     else
2105     fdDataSize := SizeOf(Double);
2106     end;
2107     SQL_INT64:
2108     begin
2109     if (fdDataScale = 0) then
2110     fdDataSize := SizeOf(Int64)
2111     else
2112     if (fdDataScale >= (-4)) then
2113     fdDataSize := SizeOf(Currency)
2114     else
2115     fdDataSize := SizeOf(Double);
2116     end;
2117     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2118     fdDataSize := SizeOf(Double);
2119     SQL_BOOLEAN:
2120     fdDataSize := SizeOf(wordBool);
2121     SQL_VARYING,
2122     SQL_TEXT,
2123     SQL_BLOB:
2124     fdCodePage := Qry.Metadata[i].getCodePage;
2125     end;
2126     fdDataOfs := FRecordSize;
2127     Inc(FRecordSize, fdDataSize);
2128     end;
2129     end;
2130     end;
2131     end;
2132    
2133     {Update Buffer Fields from Query Results}
2134    
2135     procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2136     Buffer: PChar);
2137     var i, j: integer;
2138     begin
2139     for i := 0 to QryResults.Count - 1 do
2140     begin
2141     j := GetFieldPosition(QryResults[i].GetAliasName);
2142     if j > 0 then
2143     begin
2144     ColumnDataToBuffer(QryResults,i,j,Buffer);
2145     FBufferUpdatedOnQryReturn := true;
2146     end;
2147     end;
2148     end;
2149    
2150    
2151     {Move column data returned from query to row buffer}
2152    
2153     procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2154     ColumnIndex, FieldIndex: integer; Buffer: PChar);
2155     var
2156     LocalData: PByte;
2157     LocalDate: TDateTime;
2158     LocalDouble: Double;
2159     LocalInt: Integer;
2160     LocalBool: wordBool;
2161     LocalInt64: Int64;
2162     LocalCurrency: Currency;
2163     ColData: ISQLData;
2164     begin
2165     LocalData := nil;
2166     with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2167     begin
2168     QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2169     if not fdIsNull then
2170     begin
2171     ColData := QryResults[ColumnIndex];
2172     case fdDataType of {Get Formatted data for column types that need formatting}
2173     SQL_TYPE_DATE,
2174     SQL_TYPE_TIME,
2175     SQL_TIMESTAMP:
2176     begin
2177     {This is an IBX native format and not the TDataset approach. See also GetFieldData}
2178     LocalDate := ColData.AsDateTime;
2179     LocalData := PByte(@LocalDate);
2180     end;
2181     SQL_SHORT, SQL_LONG:
2182     begin
2183     if (fdDataScale = 0) then
2184     begin
2185     LocalInt := ColData.AsLong;
2186     LocalData := PByte(@LocalInt);
2187     end
2188     else
2189     if (fdDataScale >= (-4)) then
2190     begin
2191     LocalCurrency := ColData.AsCurrency;
2192     LocalData := PByte(@LocalCurrency);
2193     end
2194     else
2195     begin
2196     LocalDouble := ColData.AsDouble;
2197     LocalData := PByte(@LocalDouble);
2198     end;
2199     end;
2200     SQL_INT64:
2201     begin
2202     if (fdDataScale = 0) then
2203     begin
2204     LocalInt64 := ColData.AsInt64;
2205     LocalData := PByte(@LocalInt64);
2206     end
2207     else
2208     if (fdDataScale >= (-4)) then
2209     begin
2210     LocalCurrency := ColData.AsCurrency;
2211     LocalData := PByte(@LocalCurrency);
2212     end
2213     else
2214     begin
2215     LocalDouble := ColData.AsDouble;
2216     LocalData := PByte(@LocalDouble);
2217     end
2218     end;
2219     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2220     begin
2221     LocalDouble := ColData.AsDouble;
2222     LocalData := PByte(@LocalDouble);
2223     end;
2224     SQL_BOOLEAN:
2225     begin
2226     LocalBool := ColData.AsBoolean;
2227     LocalData := PByte(@LocalBool);
2228     end;
2229     end;
2230    
2231     if fdDataType = SQL_VARYING then
2232     Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2233     else
2234     Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2235     end
2236     else {Null column}
2237     if fdDataType = SQL_VARYING then
2238     FillChar(Buffer[fdDataOfs],fdDataLength,0)
2239     else
2240     FillChar(Buffer[fdDataOfs],fdDataSize,0);
2241     end;
2242     end;
2243    
2244     function TIBCustomDataSet.GetMasterDetailDelay: integer;
2245     begin
2246     Result := FDataLink.DelayTimerValue;
2247     end;
2248    
2249     { Read the record from FQSelect.Current into the record buffer
2250     Then write the buffer to in memory cache }
2251     procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
2252     RecordNumber: Integer; Buffer: PChar);
2253     var
2254     pbd: PBlobDataArray;
2255     pda: PArrayDataArray;
2256     i, j: Integer;
2257     FieldsLoaded: Integer;
2258     p: PRecordData;
2259     begin
2260     if RecordNumber = -1 then
2261     begin
2262     InitModelBuffer(Qry,Buffer);
2263     Exit;
2264     end;
2265     p := PRecordData(Buffer);
2266     { Make sure blob cache is empty }
2267     pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
2268     pda := PArrayDataArray(Buffer + FArrayCacheOffset);
2269     for i := 0 to BlobFieldCount - 1 do
2270     pbd^[i] := nil;
2271     for i := 0 to ArrayFieldCount - 1 do
2272     pda^[i] := nil;
2273    
2274     { Get record information }
2275     p^.rdBookmarkFlag := bfCurrent;
2276     p^.rdFieldCount := Qry.FieldCount;
2277     p^.rdRecordNumber := RecordNumber;
2278     p^.rdUpdateStatus := usUnmodified;
2279     p^.rdCachedUpdateStatus := cusUnmodified;
2280     p^.rdSavedOffset := $FFFFFFFF;
2281    
2282     { Load up the fields }
2283     FieldsLoaded := FQSelect.MetaData.Count;
2284     j := 1;
2285     for i := 0 to Qry.FieldCount - 1 do
2286     begin
2287     if (Qry = FQSelect) then
2288     j := i + 1
2289     else
2290     begin
2291     if FieldsLoaded = 0 then
2292     break;
2293     j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2294     if j < 1 then
2295     continue
2296     else
2297     Dec(FieldsLoaded);
2298     end;
2299     with FQSelect.MetaData[j - 1] do
2300     if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2301     begin
2302     if (GetSize <= 8) then
2303     p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2304     continue;
2305     end;
2306     if j > 0 then
2307     ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2308     end;
2309     WriteRecordCache(RecordNumber, Buffer);
2310     end;
2311    
2312     function TIBCustomDataSet.GetActiveBuf: PChar;
2313     begin
2314     case State of
2315     dsBrowse:
2316     if IsEmpty then
2317     result := nil
2318     else
2319     result := ActiveBuffer;
2320     dsEdit, dsInsert:
2321     result := ActiveBuffer;
2322     dsCalcFields:
2323     result := CalcBuffer;
2324     dsFilter:
2325     result := FFilterBuffer;
2326     dsNewValue:
2327     result := ActiveBuffer;
2328     dsOldValue:
2329     if (PRecordData(ActiveBuffer)^.rdRecordNumber =
2330     PRecordData(FOldBuffer)^.rdRecordNumber) then
2331     result := FOldBuffer
2332     else
2333     result := ActiveBuffer;
2334     else if not FOpen then
2335     result := nil
2336     else
2337     result := ActiveBuffer;
2338     end;
2339     end;
2340    
2341     function TIBCustomDataSet.CachedUpdateStatus: TCachedUpdateStatus;
2342     begin
2343     if Active then
2344     result := PRecordData(GetActiveBuf)^.rdCachedUpdateStatus
2345     else
2346     result := cusUnmodified;
2347     end;
2348    
2349     function TIBCustomDataSet.GetDatabase: TIBDatabase;
2350     begin
2351     result := FBase.Database;
2352     end;
2353    
2354     function TIBCustomDataSet.GetDeleteSQL: TStrings;
2355     begin
2356     result := FQDelete.SQL;
2357     end;
2358    
2359     function TIBCustomDataSet.GetInsertSQL: TStrings;
2360     begin
2361     result := FQInsert.SQL;
2362     end;
2363    
2364     function TIBCustomDataSet.GetSQLParams: ISQLParams;
2365     begin
2366     if not FInternalPrepared then
2367     InternalPrepare;
2368     result := FQSelect.Params;
2369     end;
2370    
2371     function TIBCustomDataSet.GetRefreshSQL: TStrings;
2372     begin
2373     result := FQRefresh.SQL;
2374     end;
2375    
2376     function TIBCustomDataSet.GetSelectSQL: TStrings;
2377     begin
2378     result := FQSelect.SQL;
2379     end;
2380    
2381     function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2382     begin
2383     result := FQSelect.SQLStatementType;
2384     end;
2385    
2386     function TIBCustomDataSet.GetModifySQL: TStrings;
2387     begin
2388     result := FQModify.SQL;
2389     end;
2390    
2391     function TIBCustomDataSet.GetTransaction: TIBTransaction;
2392     begin
2393     result := FBase.Transaction;
2394     end;
2395    
2396     procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2397     begin
2398     if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2399     FUpdateObject.Apply(ukDelete,Buff)
2400     else
2401     begin
2402     SetInternalSQLParams(FQDelete.Params, Buff);
2403     FQDelete.ExecQuery;
2404     if (FQDelete.FieldCount > 0) then
2405     DoDeleteReturning(FQDelete.Current);
2406     end;
2407     with PRecordData(Buff)^ do
2408     begin
2409     rdUpdateStatus := usDeleted;
2410     rdCachedUpdateStatus := cusUnmodified;
2411     end;
2412     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2413     end;
2414    
2415     function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2416     const KeyValues: Variant; Options: TLocateOptions): Boolean;
2417     var
2418     keyFieldList: TList;
2419     CurBookmark: TBookmark;
2420     fieldValue: Variant;
2421     lookupValues: array of variant;
2422     i, fieldCount: Integer;
2423     fieldValueAsString: string;
2424     lookupValueAsString: string;
2425     begin
2426     keyFieldList := TList.Create;
2427     try
2428     GetFieldList(keyFieldList, KeyFields);
2429     fieldCount := keyFieldList.Count;
2430     CurBookmark := Bookmark;
2431     result := false;
2432     SetLength(lookupValues, fieldCount);
2433     if not EOF then
2434     begin
2435     for i := 0 to fieldCount - 1 do {expand key values into lookupValues array}
2436     begin
2437     if VarIsArray(KeyValues) then
2438     lookupValues[i] := KeyValues[i]
2439     else
2440     if i > 0 then
2441     lookupValues[i] := NULL
2442     else
2443     lookupValues[0] := KeyValues;
2444    
2445     {convert to upper case is case insensitive search}
2446     if (TField(keyFieldList[i]).DataType = ftString) and
2447     not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2448     lookupValues[i] := UpperCase(lookupValues[i]);
2449     end;
2450     end;
2451     while not result and not EOF do {search for a matching record}
2452     begin
2453     i := 0;
2454     result := true;
2455     while result and (i < fieldCount) do
2456     {see if all of the key fields matches}
2457     begin
2458     fieldValue := TField(keyFieldList[i]).Value;
2459     result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2460     if result and not VarIsNull(fieldValue) then
2461     begin
2462     try
2463     if TField(keyFieldList[i]).DataType = ftString then
2464     begin
2465     {strings need special handling because of the locate options that
2466     apply to them}
2467     fieldValueAsString := TField(keyFieldList[i]).AsString;
2468     lookupValueAsString := lookupValues[i];
2469     if (loCaseInsensitive in Options) then
2470     fieldValueAsString := UpperCase(fieldValueAsString);
2471    
2472     if (loPartialKey in Options) then
2473     result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2474     else
2475     result := result and (fieldValueAsString = lookupValueAsString);
2476     end
2477     else
2478     result := result and (lookupValues[i] =
2479     VarAsType(fieldValue, VarType(lookupValues[i])));
2480     except on EVariantError do
2481     result := False;
2482     end;
2483     end;
2484     Inc(i);
2485     end;
2486     if not result then
2487     Next;
2488     end;
2489     if not result then
2490     Bookmark := CurBookmark
2491     else
2492     CursorPosChanged;
2493     finally
2494     keyFieldList.Free;
2495     SetLength(lookupValues,0)
2496     end;
2497     end;
2498    
2499     procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2500     var
2501     i, j, k, arr: Integer;
2502     pbd: PBlobDataArray;
2503     pda: PArrayDataArray;
2504     begin
2505     pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2506     pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2507     j := 0; arr := 0;
2508     for i := 0 to FieldCount - 1 do
2509     if Fields[i].IsBlob then
2510     begin
2511     k := FMappedFieldPosition[Fields[i].FieldNo -1];
2512     if pbd^[j] <> nil then
2513     begin
2514     pbd^[j].Finalize;
2515     PISC_QUAD(
2516     PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2517     pbd^[j].BlobID;
2518     PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2519     end
2520     else
2521     begin
2522     PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2523     with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2524     begin
2525     gds_quad_high := 0;
2526     gds_quad_low := 0;
2527     end;
2528     end;
2529     Inc(j);
2530     end
2531     else
2532     if Fields[i] is TIBArrayField then
2533     begin
2534     if pda^[arr] <> nil then
2535     begin
2536     k := FMappedFieldPosition[Fields[i].FieldNo -1];
2537     PISC_QUAD(
2538     PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ := pda^[arr].ArrayIntf.GetArrayID;
2539     PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2540     end;
2541     Inc(arr);
2542     end;
2543     FBufferUpdatedOnQryReturn := false;
2544     if Assigned(FUpdateObject) then
2545     begin
2546     if (Qry = FQDelete) then
2547     FUpdateObject.Apply(ukDelete,Buff)
2548     else if (Qry = FQInsert) then
2549     FUpdateObject.Apply(ukInsert,Buff)
2550     else
2551     FUpdateObject.Apply(ukModify,Buff);
2552     FUpdateObject.GetRowsAffected(FSelectCount, FInsertCount, FUpdateCount, FDeleteCount);
2553     end
2554     else begin
2555     SetInternalSQLParams(Qry.Params, Buff);
2556     Qry.ExecQuery;
2557     Qry.Statement.GetRowsAffected(FSelectCount, FInsertCount, FUpdateCount, FDeleteCount);
2558     if Qry.FieldCount > 0 then {Has RETURNING Clause}
2559     UpdateRecordFromQuery(Qry.Current,Buff);
2560     end;
2561     PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2562     PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2563     SetModified(False);
2564     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2565     if (FForcedRefresh or (FNeedsRefresh and not FBufferUpdatedOnQryReturn)) and CanRefresh then
2566     InternalRefreshRow;
2567     end;
2568    
2569     procedure TIBCustomDataSet.InternalRefreshRow;
2570     var
2571     Buff: PChar;
2572     ofs: DWORD;
2573     Qry: TIBSQL;
2574     begin
2575     FBase.SetCursor;
2576     try
2577     Buff := GetActiveBuf;
2578     if CanRefresh then
2579     begin
2580     if Buff <> nil then
2581     begin
2582     if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then
2583     begin
2584     Qry := TIBSQL.Create(self);
2585     Qry.Database := Database;
2586     Qry.Transaction := Transaction;
2587     Qry.GoToFirstRecordOnExecute := False;
2588     Qry.SQL.Text := FUpdateObject.RefreshSQL.Text;
2589     end
2590     else
2591     Qry := FQRefresh;
2592     SetInternalSQLParams(Qry.Params, Buff);
2593     Qry.ExecQuery;
2594     try
2595     if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2596     begin
2597     ofs := PRecordData(Buff)^.rdSavedOffset;
2598     FetchCurrentRecordToBuffer(Qry,
2599     PRecordData(Buff)^.rdRecordNumber,
2600     Buff);
2601     if FCachedUpdates and (ofs <> $FFFFFFFF) then
2602     begin
2603     PRecordData(Buff)^.rdSavedOffset := ofs;
2604     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2605     SaveOldBuffer(Buff);
2606     end;
2607     end;
2608     finally
2609     Qry.Close;
2610     end;
2611     if Qry <> FQRefresh then
2612     Qry.Free;
2613     end
2614     end
2615     else
2616     IBError(ibxeCannotRefresh, [nil]);
2617     finally
2618     FBase.RestoreCursor;
2619     end;
2620     end;
2621    
2622     procedure TIBCustomDataSet.InternalRevertRecord(RecordNumber: Integer);
2623     var
2624     NewBuffer, OldBuffer: PRecordData;
2625    
2626     begin
2627     NewBuffer := nil;
2628     OldBuffer := nil;
2629     NewBuffer := PRecordData(AllocRecordBuffer);
2630     OldBuffer := PRecordData(AllocRecordBuffer);
2631     try
2632     ReadRecordCache(RecordNumber, PChar(NewBuffer), False);
2633     ReadRecordCache(RecordNumber, PChar(OldBuffer), True);
2634     case NewBuffer^.rdCachedUpdateStatus of
2635     cusInserted:
2636     begin
2637     NewBuffer^.rdCachedUpdateStatus := cusUninserted;
2638     Inc(FDeletedRecords);
2639     end;
2640     cusModified,
2641     cusDeleted:
2642     begin
2643     if (NewBuffer^.rdCachedUpdateStatus = cusDeleted) then
2644     Dec(FDeletedRecords);
2645     CopyRecordBuffer(OldBuffer, NewBuffer);
2646     end;
2647     end;
2648    
2649     if State in dsEditModes then
2650     Cancel;
2651    
2652     WriteRecordCache(RecordNumber, PChar(NewBuffer));
2653    
2654     if (NewBuffer^.rdCachedUpdateStatus = cusUninserted ) then
2655     ReSync([]);
2656     finally
2657     FreeRecordBuffer(PChar(NewBuffer));
2658     FreeRecordBuffer(PChar(OldBuffer));
2659     end;
2660     end;
2661    
2662     { A visible record is one that is not truly deleted,
2663     and it is also listed in the FUpdateRecordTypes set }
2664    
2665     function TIBCustomDataSet.IsVisible(Buffer: PChar): Boolean;
2666     begin
2667     result := True;
2668     if not (State = dsOldValue) then
2669     result :=
2670     (PRecordData(Buffer)^.rdCachedUpdateStatus in FUpdateRecordTypes) and
2671     (not ((PRecordData(Buffer)^.rdCachedUpdateStatus = cusUnmodified) and
2672     (PRecordData(Buffer)^.rdUpdateStatus = usDeleted)));
2673     end;
2674    
2675    
2676     function TIBCustomDataSet.LocateNext(const KeyFields: string;
2677     const KeyValues: Variant; Options: TLocateOptions): Boolean;
2678     begin
2679     DisableControls;
2680     try
2681     result := InternalLocate(KeyFields, KeyValues, Options);
2682     finally
2683     EnableControls;
2684     end;
2685     end;
2686    
2687     procedure TIBCustomDataSet.InternalPrepare;
2688     begin
2689     if FInternalPrepared then
2690     Exit;
2691     FBase.SetCursor;
2692     try
2693     ActivateConnection;
2694     ActivateTransaction;
2695     FBase.CheckDatabase;
2696     FBase.CheckTransaction;
2697     if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2698     begin
2699     FQSelect.OnSQLChanged := nil; {Do not react to change}
2700     try
2701     FQSelect.SQL.Text := FParser.SQLText;
2702     finally
2703     FQSelect.OnSQLChanged := SQLChanged;
2704     end;
2705     end;
2706     // writeln( FQSelect.SQL.Text);
2707     if FQSelect.SQL.Text <> '' then
2708     begin
2709     if not FQSelect.Prepared then
2710     begin
2711     FQSelect.GenerateParamNames := FGenerateParamNames;
2712     FQSelect.ParamCheck := ParamCheck;
2713     FQSelect.Prepare;
2714     end;
2715     FQDelete.GenerateParamNames := FGenerateParamNames;
2716     if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2717     FQDelete.Prepare;
2718     FQInsert.GenerateParamNames := FGenerateParamNames;
2719     if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2720     FQInsert.Prepare;
2721     FQRefresh.GenerateParamNames := FGenerateParamNames;
2722     if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2723     FQRefresh.Prepare;
2724     FQModify.GenerateParamNames := FGenerateParamNames;
2725     if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2726     FQModify.Prepare;
2727     FInternalPrepared := True;
2728     InternalInitFieldDefs;
2729     end else
2730     IBError(ibxeEmptyQuery, [nil]);
2731     finally
2732     FBase.RestoreCursor;
2733     end;
2734     end;
2735    
2736     procedure TIBCustomDataSet.RecordModified(Value: Boolean);
2737     begin
2738     SetModified(Value);
2739     end;
2740    
2741     procedure TIBCustomDataSet.RevertRecord;
2742     var
2743     Buff: PRecordData;
2744     begin
2745     if FCachedUpdates and FUpdatesPending then
2746     begin
2747     Buff := PRecordData(GetActiveBuf);
2748     InternalRevertRecord(Buff^.rdRecordNumber);
2749     ReadRecordCache(Buff^.rdRecordNumber, PChar(Buff), False);
2750     DataEvent(deRecordChange, 0);
2751     end;
2752     end;
2753    
2754     procedure TIBCustomDataSet.SaveOldBuffer(Buffer: PChar);
2755     var
2756     OldBuffer: Pointer;
2757     procedure CopyOldBuffer;
2758     begin
2759     CopyRecordBuffer(Buffer, OldBuffer);
2760     if BlobFieldCount > 0 then
2761     FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2762     BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2763     0);
2764     end;
2765    
2766     begin
2767     if (Buffer <> nil) and (PRecordData(Buffer)^.rdRecordNumber >= 0) then
2768     begin
2769     OldBuffer := AllocRecordBuffer;
2770     try
2771     if (PRecordData(Buffer)^.rdSavedOffset = $FFFFFFFF) then
2772     begin
2773     PRecordData(Buffer)^.rdSavedOffset := AdjustPosition(FOldBufferCache, 0,
2774     FILE_END);
2775     CopyOldBuffer;
2776     WriteCache(FOldBufferCache, 0, FILE_CURRENT, OldBuffer);
2777     WriteCache(FBufferCache, PRecordData(Buffer)^.rdRecordNumber * FRecordBufferSize,
2778     FILE_BEGIN, Buffer);
2779     end
2780     else begin
2781     CopyOldBuffer;
2782     WriteCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN,
2783     OldBuffer);
2784     end;
2785     finally
2786     FreeRecordBuffer(PChar(OldBuffer));
2787     end;
2788     end;
2789     end;
2790    
2791     procedure TIBCustomDataSet.SetBufferChunks(Value: Integer);
2792     begin
2793     if (Value <= 0) then
2794     FBufferChunks := BufferCacheSize
2795     else
2796     FBufferChunks := Value;
2797     end;
2798    
2799     procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
2800     begin
2801     if (csLoading in ComponentState) or (FBase.Database <> Value) then
2802     begin
2803     CheckDatasetClosed;
2804     InternalUnPrepare;
2805     FBase.Database := Value;
2806     FQDelete.Database := Value;
2807     FQInsert.Database := Value;
2808     FQRefresh.Database := Value;
2809     FQSelect.Database := Value;
2810     FQModify.Database := Value;
2811     FDatabaseInfo.Database := Value;
2812     FGeneratorField.Database := Value;
2813     end;
2814     end;
2815    
2816     procedure TIBCustomDataSet.SetDeleteSQL(Value: TStrings);
2817     begin
2818     if FQDelete.SQL.Text <> Value.Text then
2819     begin
2820     Disconnect;
2821     FQDelete.SQL.Assign(Value);
2822     end;
2823     end;
2824    
2825     procedure TIBCustomDataSet.SetInsertSQL(Value: TStrings);
2826     begin
2827     if FQInsert.SQL.Text <> Value.Text then
2828     begin
2829     Disconnect;
2830     FQInsert.SQL.Assign(Value);
2831     end;
2832     end;
2833    
2834     procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2835     var
2836     i, j: Integer;
2837     cr, data: PChar;
2838     fn: string;
2839     st: RawByteString;
2840     OldBuffer: Pointer;
2841     Param: ISQLParam;
2842     begin
2843     if (Buffer = nil) then
2844     IBError(ibxeBufferNotSet, [nil]);
2845     if (not FInternalPrepared) then
2846     InternalPrepare;
2847     OldBuffer := nil;
2848     try
2849     for i := 0 to Params.GetCount - 1 do
2850     begin
2851     Param := Params[i];
2852     fn := Param.Name;
2853     if (Pos('OLD_', fn) = 1) then {mbcs ok}
2854     begin
2855     fn := Copy(fn, 5, Length(fn));
2856     if not Assigned(OldBuffer) then
2857     begin
2858     OldBuffer := AllocRecordBuffer;
2859     ReadRecordCache(PRecordData(Buffer)^.rdRecordNumber, OldBuffer, True);
2860     end;
2861     cr := OldBuffer;
2862     end
2863     else if (Pos('NEW_', fn) = 1) then {mbcs ok}
2864     begin
2865     fn := Copy(fn, 5, Length(fn));
2866     cr := Buffer;
2867     end
2868     else
2869     cr := Buffer;
2870     j := FQSelect.FieldIndex[fn] + 1;
2871     if (j > 0) then
2872     with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2873     begin
2874     if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2875     begin
2876     PIBDBKey(Param.AsPointer)^ := rdDBKey;
2877     continue;
2878     end;
2879     if fdIsNull then
2880     Param.IsNull := True
2881     else begin
2882     Param.IsNull := False;
2883     data := cr + fdDataOfs;
2884     case fdDataType of
2885     SQL_TEXT, SQL_VARYING:
2886     begin
2887     SetString(st, data, fdDataLength);
2888     SetCodePage(st,fdCodePage,false);
2889     Param.AsString := st;
2890     end;
2891     SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2892     Param.AsDouble := PDouble(data)^;
2893     SQL_SHORT, SQL_LONG:
2894     begin
2895     if fdDataScale = 0 then
2896     Param.AsLong := PLong(data)^
2897     else
2898     if fdDataScale >= (-4) then
2899     Param.AsCurrency := PCurrency(data)^
2900     else
2901     Param.AsDouble := PDouble(data)^;
2902     end;
2903     SQL_INT64:
2904     begin
2905     if fdDataScale = 0 then
2906     Param.AsInt64 := PInt64(data)^
2907     else
2908     if fdDataScale >= (-4) then
2909     Param.AsCurrency := PCurrency(data)^
2910     else
2911     Param.AsDouble := PDouble(data)^;
2912     end;
2913     SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2914     Param.AsQuad := PISC_QUAD(data)^;
2915     SQL_TYPE_DATE,
2916     SQL_TYPE_TIME,
2917     SQL_TIMESTAMP:
2918     {This is an IBX native format and not the TDataset approach. See also SetFieldData}
2919     Param.AsDateTime := PDateTime(data)^;
2920     SQL_BOOLEAN:
2921     Param.AsBoolean := PWordBool(data)^;
2922     end;
2923     end;
2924     end;
2925     end;
2926     finally
2927     if (OldBuffer <> nil) then
2928     FreeRecordBuffer(PChar(OldBuffer));
2929     end;
2930     end;
2931    
2932     procedure TIBCustomDataSet.SetRefreshSQL(Value: TStrings);
2933     begin
2934     if FQRefresh.SQL.Text <> Value.Text then
2935     begin
2936     Disconnect;
2937     FQRefresh.SQL.Assign(Value);
2938     end;
2939     end;
2940    
2941     procedure TIBCustomDataSet.SetSelectSQL(Value: TStrings);
2942     begin
2943     if FQSelect.SQL.Text <> Value.Text then
2944     begin
2945     Disconnect;
2946     FQSelect.SQL.Assign(Value);
2947     end;
2948     end;
2949    
2950     procedure TIBCustomDataSet.SetModifySQL(Value: TStrings);
2951     begin
2952     if FQModify.SQL.Text <> Value.Text then
2953     begin
2954     Disconnect;
2955     FQModify.SQL.Assign(Value);
2956     end;
2957     end;
2958    
2959     procedure TIBCustomDataSet.SetTransaction(Value: TIBTransaction);
2960     begin
2961     if (FBase.Transaction <> Value) then
2962     begin
2963     CheckDatasetClosed;
2964     FBase.Transaction := Value;
2965     FQDelete.Transaction := Value;
2966     FQInsert.Transaction := Value;
2967     FQRefresh.Transaction := Value;
2968     FQSelect.Transaction := Value;
2969     FQModify.Transaction := Value;
2970     FGeneratorField.Transaction := Value;
2971     end;
2972     end;
2973    
2974     procedure TIBCustomDataSet.SetUniDirectional(Value: Boolean);
2975     begin
2976     CheckDatasetClosed;
2977     FUniDirectional := Value;
2978     end;
2979    
2980     procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
2981     begin
2982     FUpdateRecordTypes := Value;
2983     if Active then
2984     First;
2985     end;
2986    
2987     procedure TIBCustomDataSet.RefreshParams;
2988     var
2989     DataSet: TDataSet;
2990     begin
2991     DisableControls;
2992     try
2993     if FDataLink.DataSource <> nil then
2994     begin
2995     DataSet := FDataLink.DataSource.DataSet;
2996     if DataSet <> nil then
2997     if DataSet.Active and (DataSet.State <> dsSetKey) then
2998     begin
2999     Close;
3000     Open;
3001     end;
3002     end;
3003     finally
3004     EnableControls;
3005     end;
3006     end;
3007    
3008     procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
3009     begin
3010     if FIBLinks.IndexOf(Sender) = -1 then
3011     begin
3012     FIBLinks.Add(Sender);
3013     if Active then
3014     begin
3015     Active := false;
3016     Active := true;
3017     end;
3018     end;
3019     end;
3020    
3021    
3022     procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
3023     begin
3024     Active := false;
3025     { if FOpen then
3026     InternalClose;}
3027     if FInternalPrepared then
3028     InternalUnPrepare;
3029     FieldDefs.Clear;
3030     FieldDefs.Updated := false;
3031     end;
3032    
3033     procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
3034     begin
3035     FBaseSQLSelect.assign(FQSelect.SQL);
3036     end;
3037    
3038     { I can "undelete" uninserted records (make them "inserted" again).
3039     I can "undelete" cached deleted (the deletion hasn't yet occurred) }
3040     procedure TIBCustomDataSet.Undelete;
3041     var
3042     Buff: PRecordData;
3043     begin
3044     CheckActive;
3045     Buff := PRecordData(GetActiveBuf);
3046     with Buff^ do
3047     begin
3048     if rdCachedUpdateStatus = cusUninserted then
3049     begin
3050     rdCachedUpdateStatus := cusInserted;
3051     Dec(FDeletedRecords);
3052     end
3053     else if (rdUpdateStatus = usDeleted) and
3054     (rdCachedUpdateStatus = cusDeleted) then
3055     begin
3056     rdCachedUpdateStatus := cusUnmodified;
3057     rdUpdateStatus := usUnmodified;
3058     Dec(FDeletedRecords);
3059     end;
3060     WriteRecordCache(rdRecordNumber, PChar(Buff));
3061     end;
3062     end;
3063    
3064     procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
3065     begin
3066     FIBLinks.Remove(Sender);
3067     end;
3068    
3069     function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
3070     begin
3071     if Active then
3072     if GetActiveBuf <> nil then
3073     result := PRecordData(GetActiveBuf)^.rdUpdateStatus
3074     else
3075     result := usUnmodified
3076     else
3077     result := usUnmodified;
3078     end;
3079    
3080     function TIBCustomDataSet.IsSequenced: Boolean;
3081     begin
3082     Result := Assigned( FQSelect ) and FQSelect.EOF;
3083     end;
3084    
3085     function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
3086     begin
3087     ActivateConnection;
3088     ActivateTransaction;
3089     if not FInternalPrepared then
3090     InternalPrepare;
3091     Result := Params.ByName(ParamName);
3092     end;
3093    
3094     function TIBCustomDataSet.GetRowsAffected(var SelectCount, InsertCount,
3095     UpdateCount, DeleteCount: integer): boolean;
3096     begin
3097     Result := Active;
3098     SelectCount := FSelectCount;
3099     InsertCount := FInsertCount;
3100     UpdateCount := FUpdateCount;
3101     DeleteCount := FDeleteCount;
3102     end;
3103    
3104     function TIBCustomDataSet.GetPerfStatistics(var stats: TPerfCounters): boolean;
3105     begin
3106     Result := EnableStatistics and (FQSelect.Statement <> nil) and
3107     FQSelect.Statement.GetPerfStatistics(stats);
3108     end;
3109    
3110     {Beware: the parameter FCache is used as an identifier to determine which
3111     cache is being operated on and is not referenced in the computation.
3112     The result is an adjusted offset into the identified cache, either the
3113     Buffer Cache or the old Buffer Cache.}
3114    
3115     function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
3116     Origin: Integer): DWORD;
3117     var
3118     OldCacheSize: Integer;
3119     begin
3120     if (FCache = FBufferCache) then
3121     begin
3122     case Origin of
3123     FILE_BEGIN: FBPos := Offset;
3124     FILE_CURRENT: FBPos := FBPos + Offset;
3125     FILE_END: FBPos := DWORD(FBEnd) + Offset;
3126     end;
3127     OldCacheSize := FCacheSize;
3128     while (FBPos >= DWORD(FCacheSize)) do
3129     Inc(FCacheSize, FBufferChunkSize);
3130     if FCacheSize > OldCacheSize then
3131     IBAlloc(FBufferCache, FCacheSize, FCacheSize);
3132     result := FBPos;
3133     end
3134     else begin
3135     case Origin of
3136     FILE_BEGIN: FOBPos := Offset;
3137     FILE_CURRENT: FOBPos := FOBPos + Offset;
3138     FILE_END: FOBPos := DWORD(FOBEnd) + Offset;
3139     end;
3140     OldCacheSize := FOldCacheSize;
3141     while (FBPos >= DWORD(FOldCacheSize)) do
3142     Inc(FOldCacheSize, FBufferChunkSize);
3143     if FOldCacheSize > OldCacheSize then
3144     IBAlloc(FOldBufferCache, FOldCacheSize, FOldCacheSize);
3145     result := FOBPos;
3146     end;
3147     end;
3148    
3149     procedure TIBCustomDataSet.ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
3150     Buffer: PChar);
3151     var
3152     pCache: PChar;
3153     AdjustedOffset: DWORD;
3154     bOld: Boolean;
3155     begin
3156     bOld := (FCache = FOldBufferCache);
3157     AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
3158     if not bOld then
3159     pCache := FBufferCache + AdjustedOffset
3160     else
3161     pCache := FOldBufferCache + AdjustedOffset;
3162     Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
3163     AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
3164     end;
3165    
3166     procedure TIBCustomDataSet.ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
3167     ReadOldBuffer: Boolean);
3168     begin
3169     if FUniDirectional then
3170     RecordNumber := RecordNumber mod UniCache;
3171     if (ReadOldBuffer) then
3172     begin
3173     ReadRecordCache(RecordNumber, Buffer, False);
3174     if FCachedUpdates and
3175     (PRecordData(Buffer)^.rdSavedOffset <> $FFFFFFFF) then
3176     ReadCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN,
3177     Buffer)
3178     else
3179     if ReadOldBuffer and
3180     (PRecordData(FOldBuffer)^.rdRecordNumber = RecordNumber) then
3181     CopyRecordBuffer( FOldBuffer, Buffer )
3182     end
3183     else
3184     ReadCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
3185     end;
3186    
3187     procedure TIBCustomDataSet.WriteCache(FCache: PChar; Offset: DWORD; Origin: Integer;
3188     Buffer: PChar);
3189     var
3190     pCache: PChar;
3191     AdjustedOffset: DWORD;
3192     bOld: Boolean;
3193     dwEnd: DWORD;
3194     begin
3195     bOld := (FCache = FOldBufferCache);
3196     AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
3197     if not bOld then
3198     pCache := FBufferCache + AdjustedOffset
3199     else
3200     pCache := FOldBufferCache + AdjustedOffset;
3201     Move(Buffer^, pCache^, FRecordBufferSize);
3202     dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
3203     if not bOld then
3204     begin
3205     if (dwEnd > FBEnd) then
3206     FBEnd := dwEnd;
3207     end
3208     else begin
3209     if (dwEnd > FOBEnd) then
3210     FOBEnd := dwEnd;
3211     end;
3212     end;
3213    
3214     procedure TIBCustomDataSet.WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
3215     begin
3216     if RecordNumber >= 0 then
3217     begin
3218     if FUniDirectional then
3219     RecordNumber := RecordNumber mod UniCache;
3220     WriteCache(FBufferCache, RecordNumber * FRecordBufferSize, FILE_BEGIN, Buffer);
3221     end;
3222     end;
3223    
3224     function TIBCustomDataSet.AllocRecordBuffer: PChar;
3225     begin
3226     result := nil;
3227     IBAlloc(result, FRecordBufferSize, FRecordBufferSize);
3228     Move(FModelBuffer^, result^, FRecordBufferSize);
3229     end;
3230    
3231     function TIBCustomDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
3232     var
3233     pb: PBlobDataArray;
3234     fs: TIBBlobStream;
3235     Buff: PChar;
3236     bTr, bDB: Boolean;
3237     begin
3238     if (Field = nil) or (Field.DataSet <> self) then
3239     IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3240     Buff := GetActiveBuf;
3241     if Buff = nil then
3242     begin
3243     fs := TIBBlobStream.Create;
3244     fs.Mode := bmReadWrite;
3245     fs.Database := Database;
3246     fs.Transaction := Transaction;
3247     fs.SetField(Field);
3248     FBlobStreamList.Add(Pointer(fs));
3249     result := TIBDSBlobStream.Create(Field, fs, Mode);
3250     exit;
3251     end;
3252     pb := PBlobDataArray(Buff + FBlobCacheOffset);
3253     if pb^[Field.Offset] = nil then
3254     begin
3255     AdjustRecordOnInsert(Buff);
3256     pb^[Field.Offset] := TIBBlobStream.Create;
3257     fs := pb^[Field.Offset];
3258     FBlobStreamList.Add(Pointer(fs));
3259     fs.Mode := bmReadWrite;
3260     fs.Database := Database;
3261     fs.Transaction := Transaction;
3262     fs.SetField(Field);
3263     fs.BlobID :=
3264     PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3265     if (CachedUpdates) then
3266     begin
3267     bTr := not Transaction.InTransaction;
3268     bDB := not Database.Connected;
3269     if bDB then
3270     Database.Open;
3271     if bTr then
3272     Transaction.StartTransaction;
3273     fs.Seek(0, soFromBeginning);
3274     if bTr then
3275     Transaction.Commit;
3276     if bDB then
3277     Database.Close;
3278     end;
3279     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3280     end else
3281     fs := pb^[Field.Offset];
3282     result := TIBDSBlobStream.Create(Field, fs, Mode);
3283     end;
3284    
3285     function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3286     var Buff: PChar;
3287     pda: PArrayDataArray;
3288     bTr, bDB: Boolean;
3289     begin
3290     if (Field = nil) or (Field.DataSet <> self) then
3291     IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3292     Buff := GetActiveBuf;
3293     if Buff = nil then
3294     Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3295     Field.FRelationName,Field.FieldName)
3296     else
3297     begin
3298     pda := PArrayDataArray(Buff + FArrayCacheOffset);
3299     if pda^[Field.FCacheOffset] = nil then
3300     begin
3301     AdjustRecordOnInsert(Buff);
3302     if Field.IsNull then
3303     Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3304     Field.FRelationName,Field.FieldName)
3305     else
3306     Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3307     Field.FRelationName,Field.FieldName,Field.ArrayID);
3308     pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3309     FArrayList.Add(pda^[Field.FCacheOffset]);
3310     if (CachedUpdates) then
3311     begin
3312     bTr := not Transaction.InTransaction;
3313     bDB := not Database.Connected;
3314     if bDB then
3315     Database.Open;
3316     if bTr then
3317     Transaction.StartTransaction;
3318     pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3319     if bTr then
3320     Transaction.Commit;
3321     if bDB then
3322     Database.Close;
3323     end;
3324     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3325     end
3326     else
3327     Result := pda^[Field.FCacheOffset].ArrayIntf;
3328     end;
3329     end;
3330    
3331     procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3332     var Buff: PChar;
3333     pda: PArrayDataArray;
3334     begin
3335     if (Field = nil) or (Field.DataSet <> self) then
3336     IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3337     Buff := GetActiveBuf;
3338     if Buff <> nil then
3339     begin
3340     AdjustRecordOnInsert(Buff);
3341     pda := PArrayDataArray(Buff + FArrayCacheOffset);
3342     pda^[Field.FCacheOffset].FArray := AnArray;
3343     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3344     end;
3345     end;
3346    
3347     function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3348     const
3349     CMPLess = -1;
3350     CMPEql = 0;
3351     CMPGtr = 1;
3352     RetCodes: array[Boolean, Boolean] of ShortInt = ((2, CMPLess),
3353     (CMPGtr, CMPEql));
3354     begin
3355     result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];
3356    
3357     if Result = 2 then
3358     begin
3359     if PInteger(Bookmark1)^ < PInteger(Bookmark2)^ then
3360     Result := CMPLess
3361     else
3362     if PInteger(Bookmark1)^ > PInteger(Bookmark2)^ then
3363     Result := CMPGtr
3364     else
3365     Result := CMPEql;
3366     end;
3367     end;
3368    
3369     procedure TIBCustomDataSet.DoBeforeDelete;
3370     var
3371     Buff: PRecordData;
3372     begin
3373     if not CanDelete then
3374     IBError(ibxeCannotDelete, [nil]);
3375     Buff := PRecordData(GetActiveBuf);
3376     if FCachedUpdates and
3377     (Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
3378     SaveOldBuffer(PChar(Buff));
3379     inherited DoBeforeDelete;
3380     end;
3381    
3382     procedure TIBCustomDataSet.DoAfterDelete;
3383     begin
3384     inherited DoAfterDelete;
3385     FBase.DoAfterDelete(self);
3386     InternalAutoCommit;
3387     end;
3388    
3389     procedure TIBCustomDataSet.DoBeforeEdit;
3390     var
3391     Buff: PRecordData;
3392     begin
3393     Buff := PRecordData(GetActiveBuf);
3394     if not(CanEdit or (FQModify.SQL.Count <> 0) or
3395     (FCachedUpdates and Assigned(FOnUpdateRecord))) then
3396     IBError(ibxeCannotUpdate, [nil]);
3397     if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
3398     SaveOldBuffer(PChar(Buff));
3399     CopyRecordBuffer(GetActiveBuf, FOldBuffer);
3400     inherited DoBeforeEdit;
3401     end;
3402    
3403     procedure TIBCustomDataSet.DoAfterEdit;
3404     begin
3405     inherited DoAfterEdit;
3406     FBase.DoAfterEdit(self);
3407     end;
3408    
3409     procedure TIBCustomDataSet.DoBeforeInsert;
3410     begin
3411     if not CanInsert then
3412     IBError(ibxeCannotInsert, [nil]);
3413     inherited DoBeforeInsert;
3414     end;
3415    
3416     procedure TIBCustomDataSet.DoAfterInsert;
3417     begin
3418     if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
3419     GeneratorField.Apply;
3420     inherited DoAfterInsert;
3421     FBase.DoAfterInsert(self);
3422     end;
3423    
3424     procedure TIBCustomDataSet.DoBeforeClose;
3425     begin
3426     inherited DoBeforeClose;
3427     if FInTransactionEnd and (FCloseAction = TARollback) then
3428     Exit;
3429     if State in [dsInsert,dsEdit] then
3430     begin
3431     if DataSetCloseAction = dcSaveChanges then
3432     Post;
3433     {Note this can fail with an exception e.g. due to
3434     database validation error. In which case the dataset remains open }
3435     end;
3436     if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3437     ApplyUpdates;
3438     end;
3439    
3440     procedure TIBCustomDataSet.DoBeforeOpen;
3441     var i: integer;
3442     begin
3443     if assigned(FParser) then
3444     FParser.Reset;
3445     for i := 0 to FIBLinks.Count - 1 do
3446     TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3447     inherited DoBeforeOpen;
3448     for i := 0 to FIBLinks.Count - 1 do
3449     TIBControlLink(FIBLinks[i]).UpdateParams(self);
3450     end;
3451    
3452     procedure TIBCustomDataSet.DoBeforePost;
3453     begin
3454     inherited DoBeforePost;
3455     if (State = dsInsert) and
3456     (GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
3457     GeneratorField.Apply
3458     end;
3459    
3460     procedure TIBCustomDataSet.DoAfterPost;
3461     begin
3462     inherited DoAfterPost;
3463     FBase.DoAfterPost(self);
3464     InternalAutoCommit;
3465     end;
3466    
3467     procedure TIBCustomDataSet.FetchAll;
3468     var
3469     CurBookmark: TBookmark;
3470     begin
3471     FBase.SetCursor;
3472     try
3473     if FQSelect.EOF or not FQSelect.Open then
3474     exit;
3475     DisableControls;
3476     try
3477     CurBookmark := Bookmark;
3478     Last;
3479     Bookmark := CurBookmark;
3480     finally
3481     EnableControls;
3482     end;
3483     finally
3484     FBase.RestoreCursor;
3485     end;
3486     end;
3487    
3488     procedure TIBCustomDataSet.FreeRecordBuffer(var Buffer: PChar);
3489     begin
3490     FreeMem(Buffer);
3491     Buffer := nil;
3492     end;
3493    
3494     procedure TIBCustomDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
3495     begin
3496     Move(PRecordData(Buffer)^.rdRecordNumber, Data^, BookmarkSize);
3497     end;
3498    
3499     function TIBCustomDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
3500     begin
3501     result := PRecordData(Buffer)^.rdBookmarkFlag;
3502     end;
3503    
3504     function TIBCustomDataSet.GetCanModify: Boolean;
3505     begin
3506     result := (FQInsert.SQL.Text <> '') or
3507     (FQModify.SQL.Text <> '') or
3508     (FQDelete.SQL.Text <> '') or
3509     (Assigned(FUpdateObject));
3510     end;
3511    
3512     function TIBCustomDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
3513     begin
3514     if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
3515     begin
3516     UpdateCursorPos;
3517     ReadRecordCache(PRecordData(ActiveBuffer)^.rdRecordNumber, Buffer, False);
3518     result := True;
3519     end
3520     else
3521     result := False;
3522     end;
3523    
3524     function TIBCustomDataSet.GetDataSource: TDataSource;
3525     begin
3526     if FDataLink = nil then
3527     result := nil
3528     else
3529     result := FDataLink.DataSource;
3530     end;
3531    
3532     function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3533     begin
3534     Result := FAliasNameMap[FieldNo-1]
3535     end;
3536    
3537     function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3538     var
3539     i: integer;
3540     begin
3541     Result := nil;
3542     for i := 0 to Length(FAliasNameMap) - 1 do
3543     if FAliasNameMap[i] = aliasName then
3544     begin
3545     Result := FieldDefs[i];
3546     Exit
3547     end;
3548     end;
3549    
3550     function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3551     begin
3552     Result := DefaultFieldClasses[FieldType];
3553     end;
3554    
3555     function TIBCustomDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean;
3556     begin
3557     result := GetFieldData(FieldByNumber(FieldNo), buffer);
3558     end;
3559    
3560     function TIBCustomDataSet.InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
3561     var
3562     Buff, Data: PChar;
3563     CurrentRecord: PRecordData;
3564     begin
3565     result := False;
3566     Buff := GetActiveBuf;
3567     if (Buff = nil) or
3568     (not IsVisible(Buff)) or not assigned(Field.DataSet) then
3569     exit;
3570     { The intention here is to stuff the buffer with the data for the
3571     referenced field for the current record }
3572     CurrentRecord := PRecordData(Buff);
3573     if (Field.FieldNo < 0) then
3574     begin
3575     Inc(Buff, FRecordSize + Field.Offset);
3576     result := Boolean(Buff[0]);
3577     if result and (Buffer <> nil) then
3578     Move(Buff[1], Buffer^, Field.DataSize);
3579     end
3580     else
3581     if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3582     (FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3583     with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3584     FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3585     begin
3586     result := not fdIsNull;
3587     if result and (Buffer <> nil) then
3588     begin
3589     Data := Buff + fdDataOfs;
3590     if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3591     begin
3592     if fdDataLength < Field.DataSize then
3593     begin
3594     Move(Data^, Buffer^, fdDataLength);
3595     PChar(Buffer)[fdDataLength] := #0;
3596     end
3597     else
3598     IBError(ibxeFieldSizeError,[Field.FieldName])
3599     end
3600     else
3601     Move(Data^, Buffer^, Field.DataSize);
3602     end;
3603     end;
3604     end;
3605    
3606     { GetRecNo and SetRecNo both operate off of 1-based indexes as
3607     opposed to 0-based indexes.
3608     This is because we want LastRecordNumber/RecordCount = 1 }
3609    
3610     function TIBCustomDataSet.GetRecNo: Integer;
3611     begin
3612     if GetActiveBuf = nil then
3613     result := 0
3614     else
3615     result := PRecordData(GetActiveBuf)^.rdRecordNumber + 1;
3616     end;
3617    
3618     function TIBCustomDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
3619     DoCheck: Boolean): TGetResult;
3620     var
3621     Accept: Boolean;
3622     SaveState: TDataSetState;
3623     begin
3624     Result := grOK;
3625     if Filtered and Assigned(OnFilterRecord) then
3626     begin
3627     Accept := False;
3628     SaveState := SetTempState(dsFilter);
3629     while not Accept do
3630     begin
3631     Result := InternalGetRecord(Buffer, GetMode, DoCheck);
3632     if Result <> grOK then
3633     break;
3634     FFilterBuffer := Buffer;
3635     try
3636     Accept := True;
3637     OnFilterRecord(Self, Accept);
3638     if not Accept and (GetMode = gmCurrent) then
3639     GetMode := gmPrior;
3640     except
3641     // FBase.HandleException(Self);
3642     end;
3643     end;
3644     RestoreState(SaveState);
3645     end
3646     else
3647     Result := InternalGetRecord(Buffer, GetMode, DoCheck);
3648     end;
3649    
3650     function TIBCustomDataSet.InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
3651     DoCheck: Boolean): TGetResult;
3652     begin
3653     result := grError;
3654     case GetMode of
3655     gmCurrent: begin
3656     if (FCurrentRecord >= 0) then begin
3657     if FCurrentRecord < FRecordCount then
3658     ReadRecordCache(FCurrentRecord, Buffer, False)
3659     else begin
3660     while (not FQSelect.EOF) and FQSelect.Next and
3661     (FCurrentRecord >= FRecordCount) do begin
3662     FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3663     Inc(FRecordCount);
3664     end;
3665     FCurrentRecord := FRecordCount - 1;
3666     if (FCurrentRecord >= 0) then
3667     ReadRecordCache(FCurrentRecord, Buffer, False);
3668     end;
3669     result := grOk;
3670     end else
3671     result := grBOF;
3672     end;
3673     gmNext: begin
3674     result := grOk;
3675     if FCurrentRecord = FRecordCount then
3676     result := grEOF
3677     else if FCurrentRecord = FRecordCount - 1 then begin
3678     if (not FQSelect.EOF) then begin
3679     FQSelect.Next;
3680     Inc(FCurrentRecord);
3681     end;
3682     if (FQSelect.EOF) then begin
3683     result := grEOF;
3684     end else begin
3685     Inc(FRecordCount);
3686     FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
3687     end;
3688     end else if (FCurrentRecord < FRecordCount) then begin
3689     Inc(FCurrentRecord);
3690     ReadRecordCache(FCurrentRecord, Buffer, False);
3691     end;
3692     end;
3693     else { gmPrior }
3694     begin
3695     if (FCurrentRecord = 0) then begin
3696     Dec(FCurrentRecord);
3697     result := grBOF;
3698     end else if (FCurrentRecord > 0) and
3699     (FCurrentRecord <= FRecordCount) then begin
3700     Dec(FCurrentRecord);
3701     ReadRecordCache(FCurrentRecord, Buffer, False);
3702     result := grOk;
3703     end else if (FCurrentRecord = -1) then
3704     result := grBOF;
3705     end;
3706     end;
3707     if result = grOk then
3708     result := AdjustCurrentRecord(Buffer, GetMode);
3709     if result = grOk then with PRecordData(Buffer)^ do begin
3710     rdBookmarkFlag := bfCurrent;
3711     GetCalcFields(Buffer);
3712     end else if (result = grEOF) then begin
3713     CopyRecordBuffer(FModelBuffer, Buffer);
3714     PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;
3715     end else if (result = grBOF) then begin
3716     CopyRecordBuffer(FModelBuffer, Buffer);
3717     PRecordData(Buffer)^.rdBookmarkFlag := bfBOF;
3718     end else if (result = grError) then begin
3719     CopyRecordBuffer(FModelBuffer, Buffer);
3720     PRecordData(Buffer)^.rdBookmarkFlag := bfEOF;
3721     end;;
3722     end;
3723    
3724     function TIBCustomDataSet.GetRecordCount: Integer;
3725     begin
3726     result := FRecordCount - FDeletedRecords;
3727     end;
3728    
3729     function TIBCustomDataSet.GetRecordSize: Word;
3730     begin
3731     result := FRecordBufferSize;
3732     end;
3733    
3734     procedure TIBCustomDataSet.InternalAutoCommit;
3735     begin
3736     with Transaction do
3737     if InTransaction and (FAutoCommit = acCommitRetaining) then
3738     begin
3739     if CachedUpdates then ApplyUpdates;
3740     CommitRetaining;
3741     end;
3742     end;
3743    
3744     procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3745     begin
3746     CheckEditState;
3747     begin
3748     { When adding records, we *always* append.
3749     Insertion is just too costly }
3750     AdjustRecordOnInsert(Buffer);
3751     with PRecordData(Buffer)^ do
3752     begin
3753     rdUpdateStatus := usInserted;
3754     rdCachedUpdateStatus := cusInserted;
3755     end;
3756     if not CachedUpdates then
3757     InternalPostRecord(FQInsert, Buffer)
3758     else begin
3759     WriteRecordCache(FCurrentRecord, Buffer);
3760     FUpdatesPending := True;
3761     end;
3762     Inc(FRecordCount);
3763     InternalSetToRecord(Buffer);
3764     end
3765     end;
3766    
3767     procedure TIBCustomDataSet.InternalCancel;
3768     var
3769     Buff: PChar;
3770     CurRec: Integer;
3771     pda: PArrayDataArray;
3772     i: integer;
3773     begin
3774     inherited InternalCancel;
3775     Buff := GetActiveBuf;
3776     if Buff <> nil then
3777     begin
3778     pda := PArrayDataArray(Buff + FArrayCacheOffset);
3779     for i := 0 to ArrayFieldCount - 1 do
3780     pda^[i].ArrayIntf.CancelChanges;
3781     CurRec := FCurrentRecord;
3782     AdjustRecordOnInsert(Buff);
3783     if (State = dsEdit) then begin
3784     CopyRecordBuffer(FOldBuffer, Buff);
3785     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3786     end else begin
3787     CopyRecordBuffer(FModelBuffer, Buff);
3788     PRecordData(Buff)^.rdUpdateStatus := usDeleted;
3789     PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
3790     PRecordData(Buff)^.rdBookmarkFlag := bfEOF;
3791     FCurrentRecord := CurRec;
3792     end;
3793     end;
3794     end;
3795    
3796    
3797     procedure TIBCustomDataSet.InternalClose;
3798     begin
3799     if FDidActivate then
3800     DeactivateTransaction;
3801     FQSelect.Close;
3802     ClearBlobCache;
3803     ClearArrayCache;
3804     FreeRecordBuffer(FModelBuffer);
3805     FreeRecordBuffer(FOldBuffer);
3806     FCurrentRecord := -1;
3807     FOpen := False;
3808     FRecordCount := 0;
3809     FDeletedRecords := 0;
3810     FRecordSize := 0;
3811     FBPos := 0;
3812     FOBPos := 0;
3813     FCacheSize := 0;
3814     FOldCacheSize := 0;
3815     FBEnd := 0;
3816     FOBEnd := 0;
3817     FreeMem(FBufferCache);
3818     FBufferCache := nil;
3819     FreeMem(FFieldColumns);
3820     FFieldColumns := nil;
3821     FreeMem(FOldBufferCache);
3822     FOldBufferCache := nil;
3823     BindFields(False);
3824     ResetParser;
3825     if DefaultFields then DestroyFields;
3826     end;
3827    
3828     procedure TIBCustomDataSet.InternalDelete;
3829     var
3830     Buff: PChar;
3831     begin
3832     FBase.SetCursor;
3833     try
3834     Buff := GetActiveBuf;
3835     if CanDelete then
3836     begin
3837     if not CachedUpdates then
3838     InternalDeleteRecord(FQDelete, Buff)
3839     else
3840     begin
3841     with PRecordData(Buff)^ do
3842     begin
3843     if rdCachedUpdateStatus = cusInserted then
3844     rdCachedUpdateStatus := cusUninserted
3845     else begin
3846     rdUpdateStatus := usDeleted;
3847     rdCachedUpdateStatus := cusDeleted;
3848     end;
3849     end;
3850     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3851     end;
3852     Inc(FDeletedRecords);
3853     FUpdatesPending := True;
3854     end else
3855     IBError(ibxeCannotDelete, [nil]);
3856     finally
3857     FBase.RestoreCursor;
3858     end;
3859     end;
3860    
3861     procedure TIBCustomDataSet.InternalFirst;
3862     begin
3863     FCurrentRecord := -1;
3864     end;
3865    
3866     procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer);
3867     begin
3868     FCurrentRecord := PInteger(Bookmark)^;
3869     end;
3870    
3871     procedure TIBCustomDataSet.InternalHandleException;
3872     begin
3873     FBase.HandleException(Self)
3874     end;
3875    
3876     procedure TIBCustomDataSet.InternalInitFieldDefs;
3877     begin
3878     if not InternalPrepared then
3879     begin
3880     InternalPrepare;
3881     exit;
3882     end;
3883     FieldDefsFromQuery(FQSelect);
3884     end;
3885    
3886     procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3887     const
3888     DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3889     'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
3890     'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3891     'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize}
3892     'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3893     'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3894     ' (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3895    
3896     DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3897     'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3898     'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3899     'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize}
3900     'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3901     'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3902     ' (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3903     ' ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3904    
3905     var
3906     FieldType: TFieldType;
3907     FieldSize: Word;
3908     FieldDataSize: integer;
3909     CharSetSize: integer;
3910     CharSetName: RawByteString;
3911     FieldCodePage: TSystemCodePage;
3912     FieldNullable : Boolean;
3913     i, FieldPosition, FieldPrecision: Integer;
3914     FieldAliasName, DBAliasName: string;
3915     aRelationName, FieldName: string;
3916     Query : TIBSQL;
3917     FieldIndex: Integer;
3918     FRelationNodes : TRelationNode;
3919     aArrayDimensions: integer;
3920     aArrayBounds: TArrayBounds;
3921     ArrayMetaData: IArrayMetaData;
3922    
3923     function Add_Node(Relation, Field : String) : TRelationNode;
3924     var
3925     FField : TFieldNode;
3926     begin
3927     if FRelationNodes.RelationName = '' then
3928     Result := FRelationNodes
3929     else
3930     begin
3931     Result := TRelationNode.Create;
3932     Result.NextRelation := FRelationNodes;
3933     end;
3934     Result.RelationName := Relation;
3935     FRelationNodes := Result;
3936     Query.Params[0].AsString := Relation;
3937     Query.ExecQuery;
3938     while not Query.Eof do
3939     begin
3940     FField := TFieldNode.Create;
3941     FField.FieldName := Query.Fields[2].AsString;
3942     FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3943     FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3944     FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3945     FField.NextField := Result.FieldNodes;
3946     Result.FieldNodes := FField;
3947     Query.Next;
3948     end;
3949     Query.Close;
3950     end;
3951    
3952     function Has_COMPUTED_BLR(Relation, Field : String) : Boolean;
3953     var
3954     FRelation : TRelationNode;
3955     FField : TFieldNode;
3956     begin
3957     FRelation := FRelationNodes;
3958     while Assigned(FRelation) and
3959     (FRelation.RelationName <> Relation) do
3960     FRelation := FRelation.NextRelation;
3961     if not Assigned(FRelation) then
3962     FRelation := Add_Node(Relation, Field);
3963     Result := false;
3964     FField := FRelation.FieldNodes;
3965     while Assigned(FField) do
3966     if FField.FieldName = Field then
3967     begin
3968     Result := Ffield.COMPUTED_BLR;
3969     Exit;
3970     end
3971     else
3972     FField := Ffield.NextField;
3973     end;
3974    
3975     function Has_DEFAULT_VALUE(Relation, Field : String) : Boolean;
3976     var
3977     FRelation : TRelationNode;
3978     FField : TFieldNode;
3979     begin
3980     FRelation := FRelationNodes;
3981     while Assigned(FRelation) and
3982     (FRelation.RelationName <> Relation) do
3983     FRelation := FRelation.NextRelation;
3984     if not Assigned(FRelation) then
3985     FRelation := Add_Node(Relation, Field);
3986     Result := false;
3987     FField := FRelation.FieldNodes;
3988     while Assigned(FField) do
3989     if FField.FieldName = Field then
3990     begin
3991     Result := Ffield.DEFAULT_VALUE;
3992     Exit;
3993     end
3994     else
3995     FField := Ffield.NextField;
3996     end;
3997    
3998     function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3999     var
4000     FRelation : TRelationNode;
4001     FField : TFieldNode;
4002     begin
4003     FRelation := FRelationNodes;
4004     while Assigned(FRelation) and
4005     (FRelation.RelationName <> Relation) do
4006     FRelation := FRelation.NextRelation;
4007     if not Assigned(FRelation) then
4008     FRelation := Add_Node(Relation, Field);
4009     Result := false;
4010     FField := FRelation.FieldNodes;
4011     while Assigned(FField) do
4012     if FField.FieldName = Field then
4013     begin
4014     Result := Ffield.IDENTITY_COLUMN;
4015     Exit;
4016     end
4017     else
4018     FField := Ffield.NextField;
4019     end;
4020    
4021     Procedure FreeNodes;
4022     var
4023     FRelation : TRelationNode;
4024     FField : TFieldNode;
4025     begin
4026     while Assigned(FRelationNodes) do
4027     begin
4028     While Assigned(FRelationNodes.FieldNodes) do
4029     begin
4030     FField := FRelationNodes.FieldNodes.NextField;
4031     FRelationNodes.FieldNodes.Free;
4032     FRelationNodes.FieldNodes := FField;
4033     end;
4034     FRelation := FRelationNodes.NextRelation;
4035     FRelationNodes.Free;
4036     FRelationNodes := FRelation;
4037     end;
4038     end;
4039    
4040     begin
4041     FRelationNodes := TRelationNode.Create;
4042     FNeedsRefresh := False;
4043     if not Database.InternalTransaction.InTransaction then
4044     Database.InternalTransaction.StartTransaction;
4045     Query := TIBSQL.Create(self);
4046     try
4047     Query.Database := DataBase;
4048     Query.Transaction := Database.InternalTransaction;
4049     FieldDefs.BeginUpdate;
4050     FieldDefs.Clear;
4051     FieldIndex := 0;
4052     if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
4053     SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
4054     if FDatabaseInfo.ODSMajorVersion >= 12 then
4055     Query.SQL.Text := DefaultSQLODS12
4056     else
4057     Query.SQL.Text := DefaultSQL;
4058     Query.Prepare;
4059     SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
4060     SetLength(FAliasNameList, SourceQuery.MetaData.Count);
4061     for i := 0 to SourceQuery.MetaData.GetCount - 1 do
4062     with SourceQuery.MetaData[i] do
4063     begin
4064     { Get the field name }
4065     FieldAliasName := GetName;
4066     DBAliasName := GetAliasname;
4067     aRelationName := getRelationName;
4068     FieldName := getSQLName;
4069     FAliasNameList[i] := DBAliasName;
4070     FieldSize := 0;
4071     FieldDataSize := GetSize;
4072     FieldPrecision := 0;
4073     FieldNullable := IsNullable;
4074     CharSetSize := 0;
4075     CharSetName := '';
4076     FieldCodePage := CP_NONE;
4077     aArrayDimensions := 0;
4078     SetLength(aArrayBounds,0);
4079     case SQLType of
4080     { All VARCHAR's must be converted to strings before recording
4081     their values }
4082     SQL_VARYING, SQL_TEXT:
4083     begin
4084     if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4085     CharSetSize := 1;
4086     CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4087     Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4088     FieldSize := FieldDataSize div CharSetSize;
4089     FieldType := ftString;
4090     end;
4091     { All Doubles/Floats should be cast to doubles }
4092     SQL_DOUBLE, SQL_FLOAT:
4093     FieldType := ftFloat;
4094     SQL_SHORT:
4095     begin
4096     if (getScale = 0) then
4097     FieldType := ftSmallInt
4098     else begin
4099     FieldType := ftBCD;
4100     FieldPrecision := 4;
4101     FieldSize := -getScale;
4102     end;
4103     end;
4104     SQL_LONG:
4105     begin
4106     if (getScale = 0) then
4107     FieldType := ftInteger
4108     else if (getScale >= (-4)) then
4109     begin
4110     FieldType := ftBCD;
4111     FieldPrecision := 9;
4112     FieldSize := -getScale;
4113     end
4114     else
4115     if Database.SQLDialect = 1 then
4116     FieldType := ftFloat
4117     else
4118     if (FieldCount > i) and (Fields[i] is TFloatField) then
4119     FieldType := ftFloat
4120     else
4121     begin
4122     FieldType := ftFMTBCD;
4123     FieldPrecision := 9;
4124     FieldSize := -getScale;
4125     end;
4126     end;
4127    
4128     SQL_INT64:
4129     begin
4130     if (getScale = 0) then
4131     FieldType := ftLargeInt
4132     else if (getScale >= (-4)) then
4133     begin
4134     FieldType := ftBCD;
4135     FieldPrecision := 18;
4136     FieldSize := -getScale;
4137     end
4138     else
4139     FieldType := ftFloat;
4140     end;
4141     SQL_TIMESTAMP: FieldType := ftDateTime;
4142     SQL_TYPE_TIME: FieldType := ftTime;
4143     SQL_TYPE_DATE: FieldType := ftDate;
4144     SQL_BLOB:
4145     begin
4146     FieldSize := sizeof (TISC_QUAD);
4147     if (getSubtype = 1) then
4148     begin
4149     if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4150     CharSetSize := 1;
4151     CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4152     Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4153     FieldType := ftMemo;
4154     end
4155     else
4156     FieldType := ftBlob;
4157     end;
4158     SQL_ARRAY:
4159     begin
4160     FieldSize := sizeof (TISC_QUAD);
4161     FieldType := ftArray;
4162     ArrayMetaData := GetArrayMetaData;
4163     if ArrayMetaData <> nil then
4164     begin
4165     aArrayDimensions := ArrayMetaData.GetDimensions;
4166     aArrayBounds := ArrayMetaData.GetBounds;
4167     end;
4168     end;
4169     SQL_BOOLEAN:
4170     FieldType:= ftBoolean;
4171     else
4172     FieldType := ftUnknown;
4173     end;
4174     FieldPosition := i + 1;
4175     if (FieldType <> ftUnknown) and (FieldAliasName <> 'IBX_INTERNAL_DBKEY') then {do not localize}
4176     begin
4177     FMappedFieldPosition[FieldIndex] := FieldPosition;
4178     Inc(FieldIndex);
4179     with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
4180     begin
4181     Name := FieldAliasName;
4182     FAliasNameMap[FieldNo-1] := DBAliasName;
4183     Size := FieldSize;
4184     DataSize := FieldDataSize;
4185     Precision := FieldPrecision;
4186     Required := not FieldNullable;
4187     RelationName := aRelationName;
4188     InternalCalcField := False;
4189     CharacterSetSize := CharSetSize;
4190     CharacterSetName := CharSetName;
4191     CodePage := FieldCodePage;
4192     ArrayDimensions := aArrayDimensions;
4193     ArrayBounds := aArrayBounds;
4194     if (FieldName <> '') and (RelationName <> '') then
4195     begin
4196     IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4197     if Has_COMPUTED_BLR(RelationName, FieldName) then
4198     begin
4199     Attributes := [faReadOnly];
4200     InternalCalcField := True;
4201     FNeedsRefresh := True;
4202     end
4203     else
4204     begin
4205     if Has_DEFAULT_VALUE(RelationName, FieldName) then
4206     begin
4207     if not FieldNullable then
4208     Attributes := [faRequired];
4209     end
4210     else
4211     FNeedsRefresh := True;
4212     end;
4213     end;
4214     end;
4215     end;
4216     end;
4217     finally
4218     Query.free;
4219     FreeNodes;
4220     Database.InternalTransaction.Commit;
4221     FieldDefs.EndUpdate;
4222     FieldDefs.Updated := true;
4223     end;
4224     end;
4225    
4226     procedure TIBCustomDataSet.InternalInitRecord(Buffer: PChar);
4227     begin
4228     CopyRecordBuffer(FModelBuffer, Buffer);
4229     end;
4230    
4231     procedure TIBCustomDataSet.InternalLast;
4232     var
4233     Buffer: PChar;
4234     begin
4235     if (FQSelect.EOF) then
4236     FCurrentRecord := FRecordCount
4237     else begin
4238     Buffer := AllocRecordBuffer;
4239     try
4240     while FQSelect.Next do
4241     begin
4242     FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
4243     Inc(FRecordCount);
4244     end;
4245     FCurrentRecord := FRecordCount;
4246     finally
4247     FreeRecordBuffer(Buffer);
4248     end;
4249     end;
4250     end;
4251    
4252     procedure TIBCustomDataSet.InternalSetParamsFromCursor;
4253     var
4254     i: Integer;
4255     cur_param: ISQLParam;
4256     cur_field: TField;
4257     s: TStream;
4258     begin
4259     if FQSelect.SQL.Text = '' then
4260     IBError(ibxeEmptyQuery, [nil]);
4261     if not FInternalPrepared then
4262     InternalPrepare;
4263     if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4264     begin
4265     for i := 0 to SQLParams.GetCount - 1 do
4266     begin
4267     cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4268     if (cur_field <> nil) then
4269     begin
4270     cur_param := SQLParams[i];
4271     if (cur_field.IsNull) then
4272     cur_param.IsNull := True
4273     else
4274     case cur_field.DataType of
4275     ftString:
4276     cur_param.AsString := cur_field.AsString;
4277     ftBoolean:
4278     cur_param.AsBoolean := cur_field.AsBoolean;
4279     ftSmallint, ftWord:
4280     cur_param.AsShort := cur_field.AsInteger;
4281     ftInteger:
4282     cur_param.AsLong := cur_field.AsInteger;
4283     ftLargeInt:
4284     cur_param.AsInt64 := cur_field.AsLargeInt;
4285     ftFloat, ftCurrency:
4286     cur_param.AsDouble := cur_field.AsFloat;
4287     ftBCD:
4288     cur_param.AsCurrency := cur_field.AsCurrency;
4289     ftDate:
4290     cur_param.AsDate := cur_field.AsDateTime;
4291     ftTime:
4292     cur_param.AsTime := cur_field.AsDateTime;
4293     ftDateTime:
4294     cur_param.AsDateTime := cur_field.AsDateTime;
4295     ftBlob, ftMemo:
4296     begin
4297     s := nil;
4298     try
4299     s := DataSource.DataSet.
4300     CreateBlobStream(cur_field, bmRead);
4301     cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4302     finally
4303     s.free;
4304     end;
4305     end;
4306     ftArray:
4307     cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4308     else
4309     IBError(ibxeNotSupported, [nil]);
4310     end;
4311     end;
4312     end;
4313     end;
4314     end;
4315    
4316     procedure TIBCustomDataSet.ReQuery;
4317     begin
4318     FQSelect.Close;
4319     ClearBlobCache;
4320     FCurrentRecord := -1;
4321     FRecordCount := 0;
4322     FDeletedRecords := 0;
4323     FBPos := 0;
4324     FOBPos := 0;
4325     FBEnd := 0;
4326     FOBEnd := 0;
4327     FQSelect.Close;
4328     FQSelect.ExecQuery;
4329     FOpen := FQSelect.Open;
4330     First;
4331     end;
4332    
4333     procedure TIBCustomDataSet.InternalOpen;
4334    
4335     function RecordDataLength(n: Integer): Long;
4336     begin
4337     result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
4338     end;
4339    
4340     begin
4341     FBase.SetCursor;
4342     try
4343     ActivateConnection;
4344     ActivateTransaction;
4345     if FQSelect.SQL.Text = '' then
4346     IBError(ibxeEmptyQuery, [nil]);
4347     if not FInternalPrepared then
4348     InternalPrepare;
4349     if FQSelect.Statement <> nil then
4350     FQSelect.Statement.EnableStatistics(FEnableStatistics);
4351     if FQSelect.SQLStatementType = SQLSelect then
4352     begin
4353     if DefaultFields then
4354     CreateFields;
4355     FArrayFieldCount := 0;
4356     BindFields(True);
4357     FCurrentRecord := -1;
4358     FQSelect.ExecQuery;
4359     FOpen := FQSelect.Open;
4360    
4361     { Initialize offsets, buffer sizes, etc...
4362     1. Initially FRecordSize is just the "RecordDataLength".
4363     2. Allocate a "model" buffer and do a dummy fetch
4364     3. After the dummy fetch, FRecordSize will be appropriately
4365     adjusted to reflect the additional "weight" of the field
4366     data.
4367     4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4368     5. Now, with the BufferSize available, allocate memory for chunks of records
4369     6. Re-allocate the model buffer, accounting for the new
4370     FRecordBufferSize.
4371     7. Finally, calls to AllocRecordBuffer will work!.
4372     }
4373     {Step 1}
4374     FRecordSize := RecordDataLength(FQSelect.FieldCount);
4375     {Step 2, 3}
4376     GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4377     IBAlloc(FModelBuffer, 0, FRecordSize);
4378     InitModelBuffer(FQSelect, FModelBuffer);
4379     {Step 4}
4380     FCalcFieldsOffset := FRecordSize;
4381     FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4382     FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4383     FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4384     {Step 5}
4385     if UniDirectional then
4386     FBufferChunkSize := FRecordBufferSize * UniCache
4387     else
4388     FBufferChunkSize := FRecordBufferSize * BufferChunks;
4389     IBAlloc(FBufferCache, FBufferChunkSize, FBufferChunkSize);
4390     if FCachedUpdates or (csReading in ComponentState) then
4391     IBAlloc(FOldBufferCache, FBufferChunkSize, FBufferChunkSize);
4392     FBPos := 0;
4393     FOBPos := 0;
4394     FBEnd := 0;
4395     FOBEnd := 0;
4396     FCacheSize := FBufferChunkSize;
4397     FOldCacheSize := FBufferChunkSize;
4398     {Step 6}
4399     IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4400     FRecordBufferSize);
4401     {Step 7}
4402     FOldBuffer := AllocRecordBuffer;
4403     end
4404     else
4405     FQSelect.ExecQuery;
4406     finally
4407     FBase.RestoreCursor;
4408     end;
4409     end;
4410    
4411     procedure TIBCustomDataSet.InternalPost;
4412     var
4413     Qry: TIBSQL;
4414     Buff: PChar;
4415     bInserting: Boolean;
4416     begin
4417     FBase.SetCursor;
4418     try
4419     Buff := GetActiveBuf;
4420     CheckEditState;
4421     AdjustRecordOnInsert(Buff);
4422     if (State = dsInsert) then
4423     begin
4424     bInserting := True;
4425     Qry := FQInsert;
4426     PRecordData(Buff)^.rdUpdateStatus := usInserted;
4427     PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted;
4428     WriteRecordCache(FRecordCount, Buff);
4429     FCurrentRecord := FRecordCount;
4430     end
4431     else begin
4432     bInserting := False;
4433     Qry := FQModify;
4434     if PRecordData(Buff)^.rdCachedUpdateStatus = cusUnmodified then
4435     begin
4436     PRecordData(Buff)^.rdUpdateStatus := usModified;
4437     PRecordData(Buff)^.rdCachedUpdateStatus := cusModified;
4438     end
4439     else if PRecordData(Buff)^.
4440     rdCachedUpdateStatus = cusUninserted then
4441     begin
4442     PRecordData(Buff)^.rdCachedUpdateStatus := cusInserted;
4443     Dec(FDeletedRecords);
4444     end;
4445     end;
4446     if (not CachedUpdates) then
4447     InternalPostRecord(Qry, Buff)
4448     else begin
4449     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
4450     FUpdatesPending := True;
4451     end;
4452     if bInserting then
4453     Inc(FRecordCount);
4454     finally
4455     FBase.RestoreCursor;
4456     end;
4457     end;
4458    
4459     procedure TIBCustomDataSet.InternalRefresh;
4460     begin
4461     inherited InternalRefresh;
4462     InternalRefreshRow;
4463     end;
4464    
4465     procedure TIBCustomDataSet.InternalSetToRecord(Buffer: PChar);
4466     begin
4467     InternalGotoBookmark(@(PRecordData(Buffer)^.rdRecordNumber));
4468     end;
4469    
4470     function TIBCustomDataSet.IsCursorOpen: Boolean;
4471     begin
4472     result := FOpen;
4473     end;
4474    
4475     procedure TIBCustomDataSet.Loaded;
4476     begin
4477     if assigned(FQSelect) then
4478     FBaseSQLSelect.assign(FQSelect.SQL);
4479     inherited Loaded;
4480     end;
4481    
4482     procedure TIBCustomDataSet.Post;
4483     var CancelPost: boolean;
4484     begin
4485     CancelPost := false;
4486     if assigned(FOnValidatePost) then
4487     OnValidatePost(self,CancelPost);
4488     if CancelPost then
4489     Cancel
4490     else
4491     inherited Post;
4492     end;
4493    
4494     function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4495     Options: TLocateOptions): Boolean;
4496     var
4497     CurBookmark: TBookmark;
4498     begin
4499     DisableControls;
4500     try
4501     CurBookmark := Bookmark;
4502     First;
4503     result := InternalLocate(KeyFields, KeyValues, Options);
4504     if not result then
4505     Bookmark := CurBookmark;
4506     finally
4507     EnableControls;
4508     end;
4509     end;
4510    
4511     function TIBCustomDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
4512     const ResultFields: string): Variant;
4513     var
4514     fl: TList;
4515     CurBookmark: TBookmark;
4516     begin
4517     DisableControls;
4518     fl := TList.Create;
4519     CurBookmark := Bookmark;
4520     try
4521     First;
4522     if InternalLocate(KeyFields, KeyValues, []) then
4523     begin
4524     if (ResultFields <> '') then
4525     result := FieldValues[ResultFields]
4526     else
4527     result := NULL;
4528     end
4529     else
4530     result := Null;
4531     finally
4532     Bookmark := CurBookmark;
4533     fl.Free;
4534     EnableControls;
4535     end;
4536     end;
4537    
4538     procedure TIBCustomDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
4539     begin
4540     PRecordData(Buffer)^.rdRecordNumber := PInteger(Data)^;
4541     end;
4542    
4543     procedure TIBCustomDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
4544     begin
4545     PRecordData(Buffer)^.rdBookmarkFlag := Value;
4546     end;
4547    
4548     procedure TIBCustomDataSet.SetCachedUpdates(Value: Boolean);
4549     begin
4550     if not Value and FCachedUpdates then
4551     CancelUpdates;
4552     if (not (csReading in ComponentState)) and Value then
4553     CheckDatasetClosed;
4554     FCachedUpdates := Value;
4555     end;
4556    
4557     procedure TIBCustomDataSet.SetDataSource(Value: TDataSource);
4558     begin
4559     if IsLinkedTo(Value) then
4560     IBError(ibxeCircularReference, [nil]);
4561     if FDataLink <> nil then
4562     FDataLink.DataSource := Value;
4563     end;
4564    
4565     procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4566     var
4567     Buff, TmpBuff: PChar;
4568     MappedFieldPos: integer;
4569     begin
4570     Buff := GetActiveBuf;
4571     if Field.FieldNo < 0 then
4572     begin
4573     TmpBuff := Buff + FRecordSize + Field.Offset;
4574     Boolean(TmpBuff[0]) := LongBool(Buffer);
4575     if Boolean(TmpBuff[0]) then
4576     Move(Buffer^, TmpBuff[1], Field.DataSize);
4577     WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
4578     end
4579     else begin
4580     CheckEditState;
4581     with PRecordData(Buff)^ do
4582     begin
4583     { If inserting, Adjust record position }
4584     AdjustRecordOnInsert(Buff);
4585     MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4586     if (MappedFieldPos > 0) and
4587     (MappedFieldPos <= rdFieldCount) then
4588     with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4589     begin
4590     Field.Validate(Buffer);
4591     if (Buffer = nil) or
4592     (Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4593     fdIsNull := True
4594     else
4595     begin
4596     Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4597     if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4598     fdDataLength := StrLen(PChar(Buffer));
4599     fdIsNull := False;
4600     if rdUpdateStatus = usUnmodified then
4601     begin
4602     if CachedUpdates then
4603     begin
4604     FUpdatesPending := True;
4605     if State = dsInsert then
4606     rdCachedUpdateStatus := cusInserted
4607     else if State = dsEdit then
4608     rdCachedUpdateStatus := cusModified;
4609     end;
4610    
4611     if State = dsInsert then
4612     rdUpdateStatus := usInserted
4613     else
4614     rdUpdateStatus := usModified;
4615     end;
4616     WriteRecordCache(rdRecordNumber, Buff);
4617     SetModified(True);
4618     end;
4619     end;
4620     end;
4621     end;
4622     if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4623     DataEvent(deFieldChange, PtrInt(Field));
4624     end;
4625    
4626     procedure TIBCustomDataSet.SetRecNo(Value: Integer);
4627     begin
4628     CheckBrowseMode;
4629     if (Value < 1) then
4630     Value := 1
4631     else if Value > FRecordCount then
4632     begin
4633     InternalLast;
4634     Value := Min(FRecordCount, Value);
4635     end;
4636     if (Value <> RecNo) then
4637     begin
4638     DoBeforeScroll;
4639     FCurrentRecord := Value - 1;
4640     Resync([]);
4641     DoAfterScroll;
4642     end;
4643     end;
4644    
4645     procedure TIBCustomDataSet.Disconnect;
4646     begin
4647     Close;
4648     InternalUnPrepare;
4649     end;
4650    
4651     procedure TIBCustomDataSet.SetUpdateMode(const Value: TUpdateMode);
4652     begin
4653     if not CanModify then
4654     IBError(ibxeCannotUpdate, [nil])
4655     else
4656     FUpdateMode := Value;
4657     end;
4658    
4659    
4660     procedure TIBCustomDataSet.SetUpdateObject(Value: TIBDataSetUpdateObject);
4661     begin
4662     if Value <> FUpdateObject then
4663     begin
4664     if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then
4665     FUpdateObject.DataSet := nil;
4666     FUpdateObject := Value;
4667     if Assigned(FUpdateObject) then
4668     begin
4669     if Assigned(FUpdateObject.DataSet) and
4670     (FUpdateObject.DataSet <> Self) then
4671     FUpdateObject.DataSet.UpdateObject := nil;
4672     FUpdateObject.DataSet := Self;
4673     end;
4674     end;
4675     end;
4676    
4677     function TIBCustomDataSet.ConstraintsStored: Boolean;
4678     begin
4679     Result := Constraints.Count > 0;
4680     end;
4681    
4682     procedure TIBCustomDataSet.ClearCalcFields(Buffer: PChar);
4683     begin
4684     FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4685     end;
4686    
4687     procedure TIBCustomDataSet.ClearIBLinks;
4688     var i: integer;
4689     begin
4690     for i := FIBLinks.Count - 1 downto 0 do
4691     TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4692     end;
4693    
4694    
4695     procedure TIBCustomDataSet.InternalUnPrepare;
4696     begin
4697     if FInternalPrepared then
4698     begin
4699     CheckDatasetClosed;
4700     if FDidActivate then
4701     DeactivateTransaction;
4702     FieldDefs.Clear;
4703     FieldDefs.Updated := false;
4704     FInternalPrepared := False;
4705     Setlength(FAliasNameList,0);
4706     end;
4707     end;
4708    
4709     procedure TIBCustomDataSet.InternalExecQuery;
4710     var
4711     DidActivate: Boolean;
4712     begin
4713     DidActivate := False;
4714     FBase.SetCursor;
4715     try
4716     ActivateConnection;
4717     DidActivate := ActivateTransaction;
4718     if FQSelect.SQL.Text = '' then
4719     IBError(ibxeEmptyQuery, [nil]);
4720     if not FInternalPrepared then
4721     InternalPrepare;
4722     if FQSelect.SQLStatementType = SQLSelect then
4723     begin
4724     IBError(ibxeIsASelectStatement, [nil]);
4725     end
4726     else
4727     FQSelect.ExecQuery;
4728     finally
4729     if DidActivate then
4730     DeactivateTransaction;
4731     FBase.RestoreCursor;
4732     end;
4733     end;
4734    
4735     function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4736     begin
4737     Result := FQSelect.Statement;
4738     end;
4739    
4740     procedure TIBCustomDataSet.SetMasterDetailDelay(AValue: integer);
4741     begin
4742     FDataLink.DelayTimerValue := AValue;
4743     end;
4744    
4745     function TIBCustomDataSet.GetParser: TSelectSQLParser;
4746     begin
4747     if not assigned(FParser) then
4748     FParser := CreateParser;
4749     Result := FParser
4750     end;
4751    
4752     procedure TIBCustomDataSet.ResetParser;
4753     begin
4754     if assigned(FParser) then
4755     begin
4756     FParser.Free;
4757     FParser := nil;
4758     FQSelect.OnSQLChanged := nil; {Do not react to change}
4759     try
4760     FQSelect.SQL.Assign(FBaseSQLSelect);
4761     finally
4762     FQSelect.OnSQLChanged := SQLChanged;
4763     end;
4764     end;
4765     end;
4766    
4767     function TIBCustomDataSet.HasParser: boolean;
4768     begin
4769     Result := not (csDesigning in ComponentState) and (FParser <> nil)
4770     end;
4771    
4772     procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4773     begin
4774     if FGenerateParamNames = AValue then Exit;
4775     FGenerateParamNames := AValue;
4776     Disconnect
4777     end;
4778    
4779     procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
4780     begin
4781     inherited InitRecord(Buffer);
4782     with PRecordData(Buffer)^ do
4783     begin
4784     rdUpdateStatus := TUpdateStatus(usInserted);
4785     rdBookMarkFlag := bfInserted;
4786     rdRecordNumber := -1;
4787     end;
4788     end;
4789    
4790     procedure TIBCustomDataSet.InternalInsert;
4791     begin
4792     CursorPosChanged;
4793     end;
4794    
4795     { TIBDataSet IProviderSupport }
4796    
4797     procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4798     begin
4799     if Commit then
4800     Transaction.Commit else
4801     Transaction.Rollback;
4802     end;
4803    
4804     function TIBCustomDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams;
4805     ResultSet: Pointer = nil): Integer;
4806     var
4807     FQuery: TIBQuery;
4808     begin
4809     if Assigned(ResultSet) then
4810     begin
4811     TDataSet(ResultSet^) := TIBQuery.Create(nil);
4812     with TIBQuery(ResultSet^) do
4813     begin
4814     SQL.Text := ASQL;
4815     Params.Assign(AParams);
4816     Open;
4817     Result := RowsAffected;
4818     end;
4819     end
4820     else
4821     begin
4822     FQuery := TIBQuery.Create(nil);
4823     try
4824     FQuery.Database := Database;
4825     FQuery.Transaction := Transaction;
4826     FQuery.GenerateParamNames := True;
4827     FQuery.SQL.Text := ASQL;
4828     FQuery.Params.Assign(AParams);
4829     FQuery.ExecSQL;
4830     Result := FQuery.RowsAffected;
4831     finally
4832     FQuery.Free;
4833     end;
4834     end;
4835     end;
4836    
4837     function TIBCustomDataSet.PSGetQuoteChar: string;
4838     begin
4839     if Database.SQLDialect = 3 then
4840     Result := '"' else
4841     Result := '';
4842     end;
4843    
4844     function TIBCustomDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
4845     var
4846     PrevErr: Integer;
4847     begin
4848     if Prev <> nil then
4849     PrevErr := Prev.ErrorCode else
4850     PrevErr := 0;
4851     if E is EIBError then
4852     with EIBError(E) do
4853     Result := EUpdateError.Create(E.Message, '', SQLCode, PrevErr, E) else
4854     Result := inherited PSGetUpdateException(E, Prev);
4855     end;
4856    
4857     function TIBCustomDataSet.PSInTransaction: Boolean;
4858     begin
4859     Result := Transaction.InTransaction;
4860     end;
4861    
4862     function TIBCustomDataSet.PSIsSQLBased: Boolean;
4863     begin
4864     Result := True;
4865     end;
4866    
4867     function TIBCustomDataSet.PSIsSQLSupported: Boolean;
4868     begin
4869     Result := True;
4870     end;
4871    
4872     procedure TIBCustomDataSet.PSReset;
4873     begin
4874     inherited PSReset;
4875     if Active then
4876     begin
4877     Close;
4878     Open;
4879     end;
4880     end;
4881    
4882     function TIBCustomDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean;
4883     var
4884     UpdateAction: TIBUpdateAction;
4885     SQL: string;
4886     Params: TParams;
4887    
4888     procedure AssignParams(DataSet: TDataSet; Params: TParams);
4889     var
4890     I: Integer;
4891     Old: Boolean;
4892     Param: TParam;
4893     PName: string;
4894     Field: TField;
4895     Value: Variant;
4896     begin
4897     for I := 0 to Params.Count - 1 do
4898     begin
4899     Param := Params[I];
4900     PName := Param.Name;
4901     Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
4902     if Old then System.Delete(PName, 1, 4);
4903     Field := DataSet.FindField(PName);
4904     if not Assigned(Field) then Continue;
4905     if Old then Param.AssignFieldValue(Field, Field.OldValue) else
4906     begin
4907     Value := Field.NewValue;
4908     if VarIsEmpty(Value) then Value := Field.OldValue;
4909     Param.AssignFieldValue(Field, Value);
4910     end;
4911     end;
4912     end;
4913    
4914     begin
4915     Result := False;
4916     if Assigned(OnUpdateRecord) then
4917     begin
4918     UpdateAction := uaFail;
4919     if Assigned(FOnUpdateRecord) then
4920     begin
4921     FOnUpdateRecord(Delta, UpdateKind, UpdateAction);
4922     Result := UpdateAction = uaApplied;
4923     end;
4924     end
4925     else if Assigned(FUpdateObject) then
4926     begin
4927     SQL := FUpdateObject.GetSQL(UpdateKind).Text;
4928     if SQL <> '' then
4929     begin
4930     Params := TParams.Create;
4931     try
4932     Params.ParseSQL(SQL, True);
4933     AssignParams(Delta, Params);
4934     if PSExecuteStatement(SQL, Params) = 0 then
4935     IBError(ibxeNoRecordsAffected, [nil]);
4936     Result := True;
4937     finally
4938     Params.Free;
4939     end;
4940     end;
4941     end;
4942     end;
4943    
4944     procedure TIBCustomDataSet.PSStartTransaction;
4945     begin
4946     ActivateConnection;
4947     Transaction.StartTransaction;
4948     end;
4949    
4950     function TIBCustomDataSet.PsGetTableName: string;
4951     begin
4952     // if not FInternalPrepared then
4953     // InternalPrepare;
4954     { It is possible for the FQSelectSQL to be unprepared
4955     with FInternalPreprepared being true (see DoBeforeTransactionEnd).
4956     So check the Prepared of the SelectSQL instead }
4957     if not FQSelect.Prepared then
4958     FQSelect.Prepare;
4959     Result := FQSelect.UniqueRelationName;
4960     end;
4961    
4962     procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4963     begin
4964     InternalBatchInput(InputObject);
4965     end;
4966    
4967     procedure TIBDataSet.BatchOutput(OutputObject: TIBBatchOutput);
4968     begin
4969     InternalBatchOutput(OutputObject);
4970     end;
4971    
4972     procedure TIBDataSet.ExecSQL;
4973     begin
4974     InternalExecQuery;
4975     end;
4976    
4977     procedure TIBDataSet.Prepare;
4978     begin
4979     InternalPrepare;
4980     end;
4981    
4982     procedure TIBDataSet.UnPrepare;
4983     begin
4984     InternalUnPrepare;
4985     end;
4986    
4987     function TIBDataSet.GetPrepared: Boolean;
4988     begin
4989     Result := InternalPrepared;
4990     end;
4991    
4992     procedure TIBDataSet.InternalOpen;
4993     begin
4994     ActivateConnection;
4995     ActivateTransaction;
4996     InternalSetParamsFromCursor;
4997     Inherited InternalOpen;
4998     end;
4999    
5000     procedure TIBDataSet.SetFiltered(Value: Boolean);
5001     begin
5002     if(Filtered <> Value) then
5003     begin
5004     inherited SetFiltered(value);
5005     if Active then
5006     begin
5007     Close;
5008     Open;
5009     end;
5010     end
5011     else
5012     inherited SetFiltered(value);
5013     end;
5014    
5015     function TIBCustomDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
5016     begin
5017     Result := false;
5018     if not Assigned(Bookmark) then
5019     exit;
5020     Result := PInteger(Bookmark)^ < FRecordCount;
5021     end;
5022    
5023     function TIBCustomDataSet.GetFieldData(Field: TField;
5024     Buffer: Pointer): Boolean;
5025     {$IFDEF TBCDFIELD_IS_BCD}
5026     var
5027     lTempCurr : System.Currency;
5028     begin
5029     if (Field.DataType = ftBCD) and (Buffer <> nil) then
5030     begin
5031     Result := InternalGetFieldData(Field, @lTempCurr);
5032     if Result then
5033     CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
5034     end
5035     else
5036     {$ELSE}
5037     begin
5038     {$ENDIF}
5039     Result := InternalGetFieldData(Field, Buffer);
5040     end;
5041    
5042     function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
5043     NativeFormat: Boolean): Boolean;
5044     begin
5045     {These datatypes use IBX conventions and not TDataset conventions}
5046     if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
5047     Result := InternalGetFieldData(Field, Buffer)
5048     else
5049     Result := inherited GetFieldData(Field, Buffer, NativeFormat);
5050     end;
5051    
5052     procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
5053     {$IFDEF TDBDFIELD_IS_BCD}
5054     var
5055     lTempCurr : System.Currency;
5056     begin
5057     if (Field.DataType = ftBCD) and (Buffer <> nil) then
5058     begin
5059     BCDToCurr(TBCD(Buffer^), lTempCurr);
5060     InternalSetFieldData(Field, @lTempCurr);
5061     end
5062     else
5063     {$ELSE}
5064     begin
5065     {$ENDIF}
5066     InternalSetFieldData(Field, Buffer);
5067     end;
5068    
5069     procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
5070     NativeFormat: Boolean);
5071     begin
5072     {These datatypes use IBX conventions and not TDataset conventions}
5073     if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
5074     InternalSetfieldData(Field, Buffer)
5075     else
5076     inherited SetFieldData(Field, buffer, NativeFormat);
5077     end;
5078    
5079     { TIBDataSetUpdateObject }
5080    
5081     constructor TIBDataSetUpdateObject.Create(AOwner: TComponent);
5082     begin
5083     inherited Create(AOwner);
5084     FRefreshSQL := TStringList.Create;
5085     end;
5086    
5087     destructor TIBDataSetUpdateObject.Destroy;
5088     begin
5089     FRefreshSQL.Free;
5090     inherited Destroy;
5091     end;
5092    
5093     function TIBDataSetUpdateObject.GetRowsAffected(
5094     var SelectCount, InsertCount, UpdateCount, DeleteCount: integer): boolean;
5095     begin
5096     SelectCount := 0;
5097     InsertCount := 0;
5098     UpdateCount := 0;
5099     DeleteCount := 0;
5100     end;
5101    
5102     procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
5103     begin
5104     FRefreshSQL.Assign(Value);
5105     end;
5106    
5107     procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
5108     buff: PChar);
5109     begin
5110     if not Assigned(DataSet) then Exit;
5111     DataSet.SetInternalSQLParams(Params, buff);
5112     end;
5113    
5114     procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
5115     begin
5116     InternalSetParams(Query.Params,buff);
5117     end;
5118    
5119     procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5120     QryResults: IResults; Buffer: PChar);
5121     begin
5122     if not Assigned(DataSet) then Exit;
5123     case UpdateKind of
5124     ukModify, ukInsert:
5125     DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5126     ukDelete:
5127     DataSet.DoDeleteReturning(QryResults);
5128     end;
5129     end;
5130    
5131     function TIBDSBlobStream.GetSize: Int64;
5132     begin
5133     Result := FBlobStream.BlobSize;
5134     end;
5135    
5136     { TIBDSBlobStream }
5137     constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
5138     Mode: TBlobStreamMode);
5139     begin
5140     FField := AField;
5141     FBlobStream := ABlobStream;
5142     FBlobStream.Seek(0, soFromBeginning);
5143     if (Mode = bmWrite) then
5144     begin
5145     FBlobStream.Truncate;
5146     TIBCustomDataSet(FField.DataSet).RecordModified(True);
5147     TBlobField(FField).Modified := true;
5148     FHasWritten := true;
5149     end;
5150     end;
5151    
5152     destructor TIBDSBlobStream.Destroy;
5153     begin
5154     if FHasWritten then
5155     TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5156     inherited Destroy;
5157     end;
5158    
5159     function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
5160     begin
5161     result := FBlobStream.Read(Buffer, Count);
5162     end;
5163    
5164     function TIBDSBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
5165     begin
5166     result := FBlobStream.Seek(Offset, Origin);
5167     end;
5168    
5169     procedure TIBDSBlobStream.SetSize(NewSize: Longint);
5170     begin
5171     FBlobStream.SetSize(NewSize);
5172     end;
5173    
5174     function TIBDSBlobStream.Write(const Buffer; Count: Longint): Longint;
5175     begin
5176     if not (FField.DataSet.State in [dsEdit, dsInsert]) then
5177     IBError(ibxeNotEditing, [nil]);
5178     TIBCustomDataSet(FField.DataSet).RecordModified(True);
5179     TBlobField(FField).Modified := true;
5180     result := FBlobStream.Write(Buffer, Count);
5181     FHasWritten := true;
5182     { TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5183     Removed as this caused a seek to beginning of the blob stream thus corrupting
5184     the blob stream. Moved to the destructor i.e. called after blob written}
5185     end;
5186    
5187     { TIBGenerator }
5188    
5189     procedure TIBGenerator.SetIncrement(const AValue: integer);
5190     begin
5191     if FIncrement = AValue then Exit;
5192     if AValue < 0 then
5193     IBError(ibxeNegativeGenerator,[]);
5194     FIncrement := AValue;
5195     SetQuerySQL;
5196     end;
5197    
5198     procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5199     begin
5200     FQuery.Transaction := AValue;
5201     end;
5202    
5203     procedure TIBGenerator.SetQuerySQL;
5204     begin
5205     FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5206     end;
5207    
5208     function TIBGenerator.GetDatabase: TIBDatabase;
5209     begin
5210     Result := FQuery.Database;
5211     end;
5212    
5213     function TIBGenerator.GetTransaction: TIBTransaction;
5214     begin
5215     Result := FQuery.Transaction;
5216     end;
5217    
5218     procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5219     begin
5220     FQuery.Database := AValue;
5221     end;
5222    
5223     procedure TIBGenerator.SetGeneratorName(AValue: string);
5224     begin
5225     if FGeneratorName = AValue then Exit;
5226     FGeneratorName := AValue;
5227     SetQuerySQL;
5228     end;
5229    
5230     function TIBGenerator.GetNextValue: integer;
5231     begin
5232     with FQuery do
5233     begin
5234     Transaction.Active := true;
5235     ExecQuery;
5236     try
5237     Result := Fields[0].AsInteger
5238     finally
5239     Close
5240     end;
5241     end;
5242     end;
5243    
5244     constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
5245     begin
5246     FOwner := Owner;
5247     FIncrement := 1;
5248     FQuery := TIBSQL.Create(nil);
5249     end;
5250    
5251     destructor TIBGenerator.Destroy;
5252     begin
5253     if assigned(FQuery) then FQuery.Free;
5254     inherited Destroy;
5255     end;
5256    
5257    
5258     procedure TIBGenerator.Apply;
5259     begin
5260     if assigned(Database) and assigned(Transaction) and
5261     (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5262     Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5263     end;
5264    
5265    
5266     end.