[ViewVC] Diff of: public/ibx/trunk/runtime/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 24 \| Line 24
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	<	Windows, SysUtils, Classes, Forms, Controls, StdVCL,
51	<	IBExternals, IB, IBHeader, IBDatabase, IBSQL, Db,
52	<	IBUtils, IBBlob;
50	>	{$IFDEF WINDOWS }
51	>	Windows,
52	>	{$ELSE}
53	>	unix,
54	>	{$ENDIF}
55	>	SysUtils, Classes, IBDatabase, IBExternals, IB, IBSQL, Db,
56	>	IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo;
57
58		const
59		BufferCacheSize = 1000; { Allocate cache in this many record chunks}
#	Line 43 \| Line 63 \| type
63		TIBCustomDataSet = class;
64		TIBDataSet = class;
65
66	+	{ TIBDataSetUpdateObject }
67	+
68		TIBDataSetUpdateObject = class(TComponent)
69		private
70		FRefreshSQL: TStrings;
#	Line 50 \| Line 72 \| type
72		protected
73		function GetDataSet: TIBCustomDataSet; virtual; abstract;
74		procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
75	<	procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
75	>	procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
76		function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77	+	procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78	+	procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79	+	procedure UpdateRecordFromQuery(UpdateKind: TUpdateKind; QryResults: IResults; Buffer: PChar);
80		property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
81		public
82		constructor Create(AOwner: TComponent); override;
#	Line 60 \| Line 85 \| type
85		property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
86		end;
87
63	–	PDateTime = ^TDateTime;
88		TBlobDataArray = array[0..0] of TIBBlobStream;
89		PBlobDataArray = ^TBlobDataArray;
90	+	TIBArrayField = class;
91
92	<	{ TIBCustomDataSet }
93	<	TFieldData = record
94	<	fdDataType: Short;
95	<	fdDataScale: Short;
96	<	fdNullable: Boolean;
97	<	fdIsNull: Boolean;
98	<	fdDataSize: Short;
99	<	fdDataLength: Short;
100	<	fdDataOfs: Integer;
92	>	{ TIBArray }
93	>
94	>	{Wrapper class to support array cache in TIBCustomDataset and event handling}
95	>
96	>	TIBArray = class
97	>	private
98	>	FArray: IArray;
99	>	FRecNo: integer;
100	>	FField: TIBArrayField;
101	>	procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
102	>	public
103	>	constructor Create(aField: TIBArrayField; anArray: IArray);
104	>	destructor Destroy; override;
105	>	property ArrayIntf: IArray read FArray;
106		end;
107	<	PFieldData = ^TFieldData;
107	>
108	>	TArrayDataArray = array [0..0] of TIBArray;
109	>	PArrayDataArray = ^TArrayDataArray;
110	>
111	>	{ TIBCustomDataSet }
112
113		TCachedUpdateStatus = (
114		cusUnmodified, cusModified, cusInserted,
#	Line 85 \| Line 119 \| type
119		end;
120		PIBDBKey = ^TIBDBKey;
121
122	+	PFieldData = ^TFieldData;
123	+	TFieldData = record
124	+	fdIsNull: Boolean;
125	+	fdDataLength: Short;
126	+	end;
127	+
128	+	PColumnData = ^TColumnData;
129	+	TColumnData = record
130	+	fdDataType: Short;
131	+	fdDataScale: Short;
132	+	fdNullable: Boolean;
133	+	fdDataSize: Short;
134	+	fdDataOfs: Integer;
135	+	fdCodePage: TSystemCodePage;
136	+	end;
137	+
138	+	PFieldColumns = ^TFieldColumns;
139	+	TFieldColumns = array[1..1] of TColumnData;
140	+
141		TRecordData = record
142		rdBookmarkFlag: TBookmarkFlag;
143		rdFieldCount: Short;
144	<	rdRecordNumber: Long;
144	>	rdRecordNumber: Integer;
145		rdCachedUpdateStatus: TCachedUpdateStatus;
146		rdUpdateStatus: TUpdateStatus;
147		rdSavedOffset: DWORD;
#	Line 97 \| Line 150 \| type
150		end;
151		PRecordData = ^TRecordData;
152
153	+	{ TIBArrayField }
154	+
155	+	TIBArrayField = class(TField)
156	+	private
157	+	FArrayBounds: TArrayBounds;
158	+	FArrayDimensions: integer;
159	+	FRelationName: string;
160	+	FCacheOffset: word;
161	+	function GetArrayID: TISC_QUAD;
162	+	function GetArrayIntf: IArray;
163	+	procedure SetArrayIntf(AValue: IArray);
164	+	protected
165	+	class procedure CheckTypeSize(AValue: Longint); override;
166	+	function GetAsString: string; override;
167	+	function GetDataSize: Integer; override;
168	+	procedure Bind(Binding: Boolean); override;
169	+	public
170	+	constructor Create(AOwner: TComponent); override;
171	+	function CreateArray: IArray;
172	+	property ArrayID: TISC_QUAD read GetArrayID;
173	+	property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
174	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
175	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
176	+	end;
177	+
178		{ TIBStringField allows us to have strings longer than 8196 }
179
180		TIBStringField = class(TStringField)
181	+	private
182	+	FCharacterSetName: RawByteString;
183	+	FCharacterSetSize: integer;
184	+	FAutoFieldSize: boolean;
185	+	FCodePage: TSystemCodePage;
186	+	FDataSize: integer;
187	+	protected
188	+	procedure Bind(Binding: Boolean); override;
189	+	function GetDataSize: Integer; override;
190		public
191	<	constructor create(AOwner: TComponent); override;
191	>	constructor Create(aOwner: TComponent); override;
192		class procedure CheckTypeSize(Value: Integer); override;
193		function GetAsString: string; override;
194		function GetAsVariant: Variant; override;
195		function GetValue(var Value: string): Boolean;
196		procedure SetAsString(const Value: string); override;
197	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
198	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
199	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
200	+	published
201	+	property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
202		end;
203
204		{ TIBBCDField }
#	Line 117 \| Line 209 \| type
209		Note: y > 4 will default to Floats
210		}
211		TIBBCDField = class(TBCDField)
212	+	private
213	+	FIdentityColumn: boolean;
214		protected
215	+	procedure Bind(Binding: Boolean); override;
216		class procedure CheckTypeSize(Value: Integer); override;
217		function GetAsCurrency: Currency; override;
218		function GetAsString: string; override;
#	Line 125 \| Line 220 \| type
220		function GetDataSize: Integer; override;
221		public
222		constructor Create(AOwner: TComponent); override;
223	+	property IdentityColumn: boolean read FIdentityColumn;
224		published
225		property Size default 8;
226		end;
227
228	+	{The following integer field types extend the built in versions to enable IBX appplications
229	+	to check for an Identity column}
230	+
231	+	{ TIBSmallintField }
232	+
233	+	TIBSmallintField = class(TSmallintField)
234	+	private
235	+	FIdentityColumn: boolean;
236	+	protected
237	+	procedure Bind(Binding: Boolean); override;
238	+	public
239	+	property IdentityColumn: boolean read FIdentityColumn;
240	+	end;
241	+
242	+	{ TIBIntegerField }
243	+
244	+	TIBIntegerField = class(TIntegerField)
245	+	private
246	+	FIdentityColumn: boolean;
247	+	protected
248	+	procedure Bind(Binding: Boolean); override;
249	+	public
250	+	property IdentityColumn: boolean read FIdentityColumn;
251	+	end;
252	+
253	+	{ TIBLargeIntField }
254	+
255	+	TIBLargeIntField = class(TLargeIntField)
256	+	private
257	+	FIdentityColumn: boolean;
258	+	protected
259	+	procedure Bind(Binding: Boolean); override;
260	+	public
261	+	property IdentityColumn: boolean read FIdentityColumn;
262	+	end;
263	+
264	+	{TIBMemoField}
265	+	{Allows us to show truncated text in DBGrids and anything else that uses
266	+	DisplayText}
267	+
268	+	TIBMemoField = class(TMemoField)
269	+	private
270	+	FCharacterSetName: RawByteString;
271	+	FCharacterSetSize: integer;
272	+	FDisplayTextAsClassName: boolean;
273	+	function GetTruncatedText: string;
274	+	protected
275	+	procedure Bind(Binding: Boolean); override;
276	+	function GetAsString: string; override;
277	+	function GetDefaultWidth: Longint; override;
278	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
279	+	procedure SetAsString(const AValue: string); override;
280	+	public
281	+	constructor Create(AOwner: TComponent); override;
282	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
283	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
284	+	published
285	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
286	+	write FDisplayTextAsClassName;
287	+	private
288	+	FCodePage: TSystemCodePage;
289	+	FFCodePage: TSystemCodePage;
290	+	public
291	+	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
292	+	end;
293	+
294		TIBDataLink = class(TDetailDataLink)
295		private
296		FDataSet: TIBCustomDataSet;
#	Line 142 \| Line 304 \| type
304		destructor Destroy; override;
305		end;
306
307	+	TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
308	+
309	+	{ TIBGenerator }
310	+
311	+	TIBGenerator = class(TPersistent)
312	+	private
313	+	FOwner: TIBCustomDataSet;
314	+	FApplyOnEvent: TIBGeneratorApplyOnEvent;
315	+	FFieldName: string;
316	+	FGeneratorName: string;
317	+	FIncrement: integer;
318	+	FQuery: TIBSQL;
319	+	function GetDatabase: TIBDatabase;
320	+	function GetTransaction: TIBTransaction;
321	+	procedure SetDatabase(AValue: TIBDatabase);
322	+	procedure SetGeneratorName(AValue: string);
323	+	procedure SetIncrement(const AValue: integer);
324	+	procedure SetTransaction(AValue: TIBTransaction);
325	+	procedure SetQuerySQL;
326	+	protected
327	+	function GetNextValue: integer;
328	+	public
329	+	constructor Create(Owner: TIBCustomDataSet);
330	+	destructor Destroy; override;
331	+	procedure Apply;
332	+	property Owner: TIBCustomDataSet read FOwner;
333	+	property Database: TIBDatabase read GetDatabase write SetDatabase;
334	+	property Transaction: TIBTransaction read GetTransaction write SetTransaction;
335	+	published
336	+	property Generator: string read FGeneratorName write SetGeneratorName;
337	+	property Field: string read FFieldName write FFieldName;
338	+	property Increment: integer read FIncrement write SetIncrement default 1;
339	+	property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
340	+	end;
341	+
342	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
343	+
344	+	TIBControlLink = class
345	+	private
346	+	FTIBDataSet: TIBCustomDataSet;
347	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
348	+	protected
349	+	procedure UpdateSQL(Sender: TObject); virtual;
350	+	procedure UpdateParams(Sender: TObject); virtual;
351	+	public
352	+	destructor Destroy; override;
353	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
354	+	end;
355	+
356	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
357	+
358		{ TIBCustomDataSet }
359	+
360		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
361
362		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
363	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
363	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
364		of object;
365		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
366		var UpdateAction: TIBUpdateAction) of object;
367
368		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
369
370	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
371	+
372	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
373	+
374	+	TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object;
375	+
376		TIBCustomDataSet = class(TDataset)
377		private
378	+	FAllowAutoActivateTransaction: Boolean;
379	+	FArrayFieldCount: integer;
380	+	FArrayCacheOffset: integer;
381	+	FAutoCommit: TIBAutoCommit;
382	+	FGenerateParamNames: Boolean;
383	+	FGeneratorField: TIBGenerator;
384		FNeedsRefresh: Boolean;
385		FForcedRefresh: Boolean;
386		FDidActivate: Boolean;
161	–	FIBLoaded: Boolean;
387		FBase: TIBBase;
388		FBlobCacheOffset: Integer;
389		FBlobStreamList: TList;
390	+	FArrayList: TList;
391		FBufferChunks: Integer;
392		FBufferCache,
393		FOldBufferCache: PChar;
#	Line 179 \| Line 405 \| type
405		FDeletedRecords: Long;
406		FModelBuffer,
407		FOldBuffer: PChar;
408	+	FOnDeleteReturning: TOnDeleteReturning;
409	+	FOnValidatePost: TOnValidatePost;
410		FOpen: Boolean;
411		FInternalPrepared: Boolean;
412		FQDelete,
#	Line 186 \| Line 414 \| type
414		FQRefresh,
415		FQSelect,
416		FQModify: TIBSQL;
417	+	FDatabaseInfo: TIBDatabaseInfo;
418		FRecordBufferSize: Integer;
419		FRecordCount: Integer;
420		FRecordSize: Integer;
421	+	FDataSetCloseAction: TDataSetCloseAction;
422		FUniDirectional: Boolean;
423		FUpdateMode: TUpdateMode;
424		FUpdateObject: TIBDataSetUpdateObject;
#	Line 206 \| Line 436 \| type
436		FBeforeTransactionEnd,
437		FAfterTransactionEnd,
438		FTransactionFree: TNotifyEvent;
439	<
440	<	function GetSelectStmtHandle: TISC_STMT_HANDLE;
439	>	FAliasNameMap: array of string;
440	>	FAliasNameList: array of string;
441	>	FBaseSQLSelect: TStrings;
442	>	FParser: TSelectSQLParser;
443	>	FCloseAction: TTransactionAction;
444	>	FInTransactionEnd: boolean;
445	>	FIBLinks: TList;
446	>	FFieldColumns: PFieldColumns;
447	>	FBufferUpdatedOnQryReturn: boolean;
448	>	procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
449	>	FieldIndex: integer; Buffer: PChar);
450	>	procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
451	>	function GetSelectStmtIntf: IStatement;
452		procedure SetUpdateMode(const Value: TUpdateMode);
453		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
454
#	Line 219 \| Line 460 \| type
460		function CanRefresh: Boolean;
461		procedure CheckEditState;
462		procedure ClearBlobCache;
463	+	procedure ClearArrayCache;
464	+	procedure ClearIBLinks;
465		procedure CopyRecordBuffer(Source, Dest: Pointer);
466		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
467		procedure DoAfterDatabaseDisconnect(Sender: TObject);
468		procedure DoDatabaseFree(Sender: TObject);
469	<	procedure DoBeforeTransactionEnd(Sender: TObject);
469	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
470		procedure DoAfterTransactionEnd(Sender: TObject);
471		procedure DoTransactionFree(Sender: TObject);
472	+	procedure DoDeleteReturning(QryResults: IResults);
473		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
474		Buffer: PChar);
475		function GetDatabase: TIBDatabase;
232	–	function GetDBHandle: PISC_DB_HANDLE;
476		function GetDeleteSQL: TStrings;
477		function GetInsertSQL: TStrings;
478	<	function GetSQLParams: TIBXSQLDA;
478	>	function GetSQLParams: ISQLParams;
479		function GetRefreshSQL: TStrings;
480		function GetSelectSQL: TStrings;
481	<	function GetStatementType: TIBSQLTypes;
481	>	function GetStatementType: TIBSQLStatementTypes;
482		function GetModifySQL: TStrings;
483		function GetTransaction: TIBTransaction;
484	<	function GetTRHandle: PISC_TR_HANDLE;
485	<	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
484	>	function GetParser: TSelectSQLParser;
485	>	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
486		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
487		Options: TLocateOptions): Boolean; virtual;
488	<	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
489	<	procedure InternalRevertRecord(RecordNumber: Integer);
488	>	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
489	>	procedure InternalRevertRecord(RecordNumber: Integer); virtual;
490		function IsVisible(Buffer: PChar): Boolean;
491	+	procedure RegisterIBLink(Sender: TIBControlLink);
492	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
493		procedure SaveOldBuffer(Buffer: PChar);
494		procedure SetBufferChunks(Value: Integer);
495		procedure SetDatabase(Value: TIBDatabase);
496		procedure SetDeleteSQL(Value: TStrings);
497		procedure SetInsertSQL(Value: TStrings);
498	<	procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
498	>	procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
499		procedure SetRefreshSQL(Value: TStrings);
500		procedure SetSelectSQL(Value: TStrings);
501		procedure SetModifySQL(Value: TStrings);
502		procedure SetTransaction(Value: TIBTransaction);
503		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
504		procedure SetUniDirectional(Value: Boolean);
505	+	procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
506		procedure RefreshParams;
261	–	procedure SQLChanging(Sender: TObject); virtual;
507		function AdjustPosition(FCache: PChar; Offset: DWORD;
508	<	Origin: Integer): Integer;
508	>	Origin: Integer): DWORD;
509		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
510		Buffer: PChar);
511		procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
#	Line 269 \| Line 514 \| type
514		Buffer: PChar);
515		procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
516		function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
517	<	DoCheck: Boolean): TGetResult;
517	>	DoCheck: Boolean): TGetResult; virtual;
518
519		protected
520		procedure ActivateConnection;
#	Line 277 \| Line 522 \| type
522		procedure DeactivateTransaction;
523		procedure CheckDatasetClosed;
524		procedure CheckDatasetOpen;
525	+	function CreateParser: TSelectSQLParser; virtual;
526	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
527		function GetActiveBuf: PChar;
528	<	procedure InternalBatchInput(InputObject: TIBBatchInput);
529	<	procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
528	>	procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
529	>	procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
530		procedure InternalPrepare; virtual;
531		procedure InternalUnPrepare; virtual;
532		procedure InternalExecQuery; virtual;
533		procedure InternalRefreshRow; virtual;
534	<	procedure InternalSetParamsFromCursor;
534	>	procedure InternalSetParamsFromCursor; virtual;
535		procedure CheckNotUniDirectional;
536	+	procedure SQLChanging(Sender: TObject); virtual;
537	+	procedure SQLChanged(Sender: TObject); virtual;
538
539		{ IProviderSupport }
540		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 309 \| Line 558 \| type
558		procedure ClearCalcFields(Buffer: PChar); override;
559		function AllocRecordBuffer: PChar; override;
560		procedure DoBeforeDelete; override;
561	+	procedure DoAfterDelete; override;
562		procedure DoBeforeEdit; override;
563	+	procedure DoAfterEdit; override;
564		procedure DoBeforeInsert; override;
565	+	procedure DoAfterInsert; override;
566	+	procedure DoBeforeClose; override;
567	+	procedure DoBeforeOpen; override;
568	+	procedure DoBeforePost; override;
569	+	procedure DoAfterPost; override;
570		procedure FreeRecordBuffer(var Buffer: PChar); override;
571		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
572		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
573		function GetCanModify: Boolean; override;
574		function GetDataSource: TDataSource; override;
575	+	function GetDBAliasName(FieldNo: integer): string;
576	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
577		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
578		function GetRecNo: Integer; override;
579		function GetRecord(Buffer: PChar; GetMode: TGetMode;
580		DoCheck: Boolean): TGetResult; override;
581		function GetRecordCount: Integer; override;
582		function GetRecordSize: Word; override;
583	+	procedure InternalAutoCommit;
584		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
585		procedure InternalCancel; override;
586		procedure InternalClose; override;
587		procedure InternalDelete; override;
588		procedure InternalFirst; override;
589	<	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
589	>	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
590		procedure InternalGotoBookmark(Bookmark: Pointer); override;
591		procedure InternalHandleException; override;
592		procedure InternalInitFieldDefs; override;
#	Line 336 \| Line 595 \| type
595		procedure InternalOpen; override;
596		procedure InternalPost; override;
597		procedure InternalRefresh; override;
598	<	procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
598	>	procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
599		procedure InternalSetToRecord(Buffer: PChar); override;
600		function IsCursorOpen: Boolean; override;
601	+	procedure Loaded; override;
602		procedure ReQuery;
603		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
604		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
605		procedure SetCachedUpdates(Value: Boolean);
606		procedure SetDataSource(Value: TDataSource);
607	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
608		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
609		procedure SetFieldData(Field : TField; Buffer : Pointer;
610		NativeFormat : Boolean); overload; override;
#	Line 351 \| Line 612 \| type
612
613		protected
614		{Likely to be made public by descendant classes}
615	<	property SQLParams: TIBXSQLDA read GetSQLParams;
616	<	property Params: TIBXSQLDA read GetSQLParams;
615	>	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
616	>	property SQLParams: ISQLParams read GetSQLParams;
617	>	property Params: ISQLParams read GetSQLParams;
618		property InternalPrepared: Boolean read FInternalPrepared;
619		property QDelete: TIBSQL read FQDelete;
620		property QInsert: TIBSQL read FQInsert;
621		property QRefresh: TIBSQL read FQRefresh;
622		property QSelect: TIBSQL read FQSelect;
623		property QModify: TIBSQL read FQModify;
624	<	property StatementType: TIBSQLTypes read GetStatementType;
625	<	property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
624	>	property StatementType: TIBSQLStatementTypes read GetStatementType;
625	>	property SelectStmtHandle: IStatement read GetSelectStmtIntf;
626
627		{Likely to be made published by descendant classes}
628		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
629		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
630		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
631	+	property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
632		property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
633		property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
634		property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
#	Line 373 \| Line 636 \| type
636		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
637		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
638		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
639	+	property Parser: TSelectSQLParser read GetParser;
640	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
641
642		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
643		write FBeforeDatabaseDisconnect;
#	Line 386 \| Line 651 \| type
651		write FAfterTransactionEnd;
652		property TransactionFree: TNotifyEvent read FTransactionFree
653		write FTransactionFree;
654	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
655
656		public
657		constructor Create(AOwner: TComponent); override;
#	Line 393 \| Line 659 \| type
659		procedure ApplyUpdates;
660		function CachedUpdateStatus: TCachedUpdateStatus;
661		procedure CancelUpdates;
662	+	function GetFieldPosition(AliasName: string): integer;
663		procedure FetchAll;
664		function LocateNext(const KeyFields: string; const KeyValues: Variant;
665		Options: TLocateOptions): Boolean;
666		procedure RecordModified(Value: Boolean);
667		procedure RevertRecord;
668		procedure Undelete;
669	+	procedure ResetParser; virtual;
670	+	function HasParser: boolean;
671
672		{ TDataSet support methods }
673		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
674		function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
675		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
676	+	function GetArray(Field: TIBArrayField): IArray;
677	+	procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
678		function GetCurrentRecord(Buffer: PChar): Boolean; override;
679		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
680	<	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
680	>	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (override;)
681		function GetFieldData(Field : TField; Buffer : Pointer;
682		NativeFormat : Boolean) : Boolean; overload; override;
683	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
684		function Locate(const KeyFields: string; const KeyValues: Variant;
685		Options: TLocateOptions): Boolean; override;
686		function Lookup(const KeyFields: string; const KeyValues: Variant;
687		const ResultFields: string): Variant; override;
688		function UpdateStatus: TUpdateStatus; override;
689		function IsSequenced: Boolean; override;
690	<
691	<	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
692	<	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
690	>	procedure Post; override;
691	>	function ParamByName(ParamName: String): ISQLParam;
692	>	property ArrayFieldCount: integer read FArrayFieldCount;
693	>	property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
694		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
695		property UpdatesPending: Boolean read FUpdatesPending;
696		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
697		write SetUpdateRecordTypes;
698	+	property DataSetCloseAction: TDataSetCloseAction
699	+	read FDataSetCloseAction write FDataSetCloseAction;
700
701		published
702	+	property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
703	+	write FAllowAutoActivateTransaction;
704		property Database: TIBDatabase read GetDatabase write SetDatabase;
705		property Transaction: TIBTransaction read GetTransaction
706		write SetTransaction;
707		property ForcedRefresh: Boolean read FForcedRefresh
708		write FForcedRefresh default False;
709		property AutoCalcFields;
433	–	property ObjectView default False;
710
711		property AfterCancel;
712		property AfterClose;
#	Line 459 \| Line 735 \| type
735		write FOnUpdateError;
736		property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
737		write FOnUpdateRecord;
738	+	property OnDeleteReturning: TOnDeleteReturning read FOnDeleteReturning
739	+	write FOnDeleteReturning;
740	+	end;
741	+
742	+	TIBParserDataSet = class(TIBCustomDataSet)
743	+	public
744	+	property Parser;
745		end;
746
747	<	TIBDataSet = class(TIBCustomDataSet)
747	>	TIBDataSet = class(TIBParserDataSet)
748		private
749		function GetPrepared: Boolean;
750
#	Line 486 \| Line 769 \| type
769		property QModify;
770		property StatementType;
771		property SelectStmtHandle;
772	+	property BaseSQLSelect;
773
774		published
775		{ TIBCustomDataSet }
776	+	property AutoCommit;
777		property BufferChunks;
778		property CachedUpdates;
779		property DeleteSQL;
#	Line 496 \| Line 781 \| type
781		property RefreshSQL;
782		property SelectSQL;
783		property ModifySQL;
784	+	property GeneratorField;
785	+	property GenerateParamNames;
786		property ParamCheck;
787		property UniDirectional;
788		property Filtered;
789	+	property DataSetCloseAction;
790
791		property BeforeDatabaseDisconnect;
792		property AfterDatabaseDisconnect;
#	Line 534 \| Line 822 \| type
822		property OnFilterRecord;
823		property OnNewRecord;
824		property OnPostError;
825	+	property OnValidatePost;
826	+	property OnDeleteReturning;
827		end;
828
829		{ TIBDSBlobStream }
830		TIBDSBlobStream = class(TStream)
831	+	private
832	+	FHasWritten: boolean;
833		protected
834		FField: TField;
835		FBlobStream: TIBBlobStream;
836	+	function GetSize: Int64; override;
837		public
838		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
839		Mode: TBlobStreamMode);
840	+	destructor Destroy; override;
841		function Read(var Buffer; Count: Longint): Longint; override;
842		function Seek(Offset: Longint; Origin: Word): Longint; override;
843		procedure SetSize(NewSize: Longint); override;
844		function Write(const Buffer; Count: Longint): Longint; override;
845		end;
846
847	+	{Extended Field Def for character set info}
848	+
849	+	{ TIBFieldDef }
850	+
851	+	TIBFieldDef = class(TFieldDef)
852	+	private
853	+	FArrayBounds: TArrayBounds;
854	+	FArrayDimensions: integer;
855	+	FCharacterSetName: RawByteString;
856	+	FCharacterSetSize: integer;
857	+	FCodePage: TSystemCodePage;
858	+	FIdentityColumn: boolean;
859	+	FRelationName: string;
860	+	FDataSize: integer;
861	+	published
862	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
863	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
864	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
865	+	property DataSize: integer read FDataSize write FDataSize;
866	+	property RelationName: string read FRelationName write FRelationName;
867	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
868	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
869	+	property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
870	+	end;
871	+
872		const
873		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
874		nil, { ftUnknown }
875		TIBStringField, { ftString }
876	<	TSmallintField, { ftSmallint }
877	<	TIntegerField, { ftInteger }
876	>	TIBSmallintField, { ftSmallint }
877	>	TIBIntegerField, { ftInteger }
878		TWordField, { ftWord }
879		TBooleanField, { ftBoolean }
880		TFloatField, { ftFloat }
#	Line 568 \| Line 887 \| DefaultFieldClasses: array[TFieldType] o
887		TVarBytesField, { ftVarBytes }
888		TAutoIncField, { ftAutoInc }
889		TBlobField, { ftBlob }
890	<	TMemoField, { ftMemo }
890	>	TIBMemoField, { ftMemo }
891		TGraphicField, { ftGraphic }
892		TBlobField, { ftFmtMemo }
893		TBlobField, { ftParadoxOle }
#	Line 576 \| Line 895 \| DefaultFieldClasses: array[TFieldType] o
895		TBlobField, { ftTypedBinary }
896		nil, { ftCursor }
897		TStringField, { ftFixedChar }
898	<	nil, {TWideStringField } { ftWideString }
899	<	TLargeIntField, { ftLargeInt }
898	>	nil, { ftWideString }
899	>	TIBLargeIntField, { ftLargeInt }
900	>	nil, { ftADT }
901	>	TIBArrayField, { ftArray }
902	>	nil, { ftReference }
903	>	nil, { ftDataSet }
904	>	TBlobField, { ftOraBlob }
905	>	TMemoField, { ftOraClob }
906	>	TVariantField, { ftVariant }
907	>	nil, { ftInterface }
908	>	nil, { ftIDispatch }
909	>	TGuidField, { ftGuid }
910	>	TDateTimeField, {ftTimestamp}
911	>	TIBBCDField, {ftFMTBcd}
912	>	nil, {ftFixedWideChar}
913	>	nil); {ftWideMemo}
914	>	(*
915		TADTField, { ftADT }
916		TArrayField, { ftArray }
917		TReferenceField, { ftReference }
#	Line 587 \| Line 921 \| DefaultFieldClasses: array[TFieldType] o
921		TVariantField, { ftVariant }
922		TInterfaceField, { ftInterface }
923		TIDispatchField, { ftIDispatch }
924	<	TGuidField); { ftGuid }
925	<	var
926	<	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
924	>	TGuidField); { ftGuid } *)
925	>	(*var
926	>	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
927
928		implementation
929
930	<	uses IBIntf, IBQuery;
930	>	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
931	>
932	>	const FILE_BEGIN = 0;
933	>	FILE_CURRENT = 1;
934	>	FILE_END = 2;
935
936		type
937
#	Line 602 \| Line 940 \| type
940		FieldName : String;
941		COMPUTED_BLR : Boolean;
942		DEFAULT_VALUE : boolean;
943	+	IDENTITY_COLUMN : boolean;
944		NextField : TFieldNode;
945		end;
946
#	Line 613 \| Line 952 \| type
952		end;
953
954
955	+	{ Copied from LCLProc in order to avoid LCL dependency
956	+
957	+	Ensures the covenient look of multiline string
958	+	when displaying it in the single line
959	+	* Replaces CR and LF with spaces
960	+	* Removes duplicate spaces
961	+	}
962	+	function TextToSingleLine(const AText: string): string;
963	+	var
964	+	str: string;
965	+	i, wstart, wlen: Integer;
966	+	begin
967	+	str := Trim(AText);
968	+	wstart := 0;
969	+	wlen := 0;
970	+	i := 1;
971	+	while i < Length(str) - 1 do
972	+	begin
973	+	if (str[i] in [' ', #13, #10]) then
974	+	begin
975	+	if (wstart = 0) then
976	+	begin
977	+	wstart := i;
978	+	wlen := 1;
979	+	end else
980	+	Inc(wlen);
981	+	end else
982	+	begin
983	+	if wstart > 0 then
984	+	begin
985	+	str[wstart] := ' ';
986	+	Delete(str, wstart+1, wlen-1);
987	+	Dec(i, wlen-1);
988	+	wstart := 0;
989	+	end;
990	+	end;
991	+	Inc(i);
992	+	end;
993	+	Result := str;
994	+	end;
995	+
996	+	{ TIBLargeIntField }
997	+
998	+	procedure TIBLargeIntField.Bind(Binding: Boolean);
999	+	begin
1000	+	inherited Bind(Binding);
1001	+	if Binding and (FieldDef <> nil) then
1002	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1003	+	end;
1004	+
1005	+	{ TIBIntegerField }
1006	+
1007	+	procedure TIBIntegerField.Bind(Binding: Boolean);
1008	+	begin
1009	+	inherited Bind(Binding);
1010	+	if Binding and (FieldDef <> nil) then
1011	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1012	+	end;
1013	+
1014	+	{ TIBSmallintField }
1015	+
1016	+	procedure TIBSmallintField.Bind(Binding: Boolean);
1017	+	begin
1018	+	inherited Bind(Binding);
1019	+	if Binding and (FieldDef <> nil) then
1020	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1021	+	end;
1022	+
1023	+	{ TIBArray }
1024	+
1025	+	procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
1026	+	begin
1027	+	case Reason of
1028	+	arChanging:
1029	+	if FRecNo <> FField.Dataset.RecNo then
1030	+	IBError(ibxeNotCurrentArray,[nil]);
1031	+
1032	+	arChanged:
1033	+	FField.DataChanged;
1034	+	end;
1035	+	end;
1036	+
1037	+	constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
1038	+	begin
1039	+	inherited Create;
1040	+	FField := aField;
1041	+	FArray := anArray;
1042	+	FRecNo := FField.Dataset.RecNo;
1043	+	FArray.AddEventHandler(EventHandler);
1044	+	end;
1045	+
1046	+	destructor TIBArray.Destroy;
1047	+	begin
1048	+	FArray.RemoveEventHandler(EventHandler);
1049	+	inherited Destroy;
1050	+	end;
1051	+
1052	+	{ TIBArrayField }
1053	+
1054	+	function TIBArrayField.GetArrayIntf: IArray;
1055	+	begin
1056	+	Result := TIBCustomDataSet(DataSet).GetArray(self);
1057	+	end;
1058	+
1059	+	function TIBArrayField.GetArrayID: TISC_QUAD;
1060	+	begin
1061	+	GetData(@Result);
1062	+	end;
1063	+
1064	+	procedure TIBArrayField.SetArrayIntf(AValue: IArray);
1065	+	begin
1066	+	TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
1067	+	DataChanged;
1068	+	end;
1069	+
1070	+	class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
1071	+	begin
1072	+	//Ignore
1073	+	end;
1074	+
1075	+	function TIBArrayField.GetAsString: string;
1076	+	begin
1077	+	Result := '(Array)';
1078	+	end;
1079	+
1080	+	function TIBArrayField.GetDataSize: Integer;
1081	+	begin
1082	+	Result := sizeof(TISC_QUAD);
1083	+	end;
1084	+
1085	+	procedure TIBArrayField.Bind(Binding: Boolean);
1086	+	begin
1087	+	inherited Bind(Binding);
1088	+	if Binding then
1089	+	begin
1090	+	FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
1091	+	Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
1092	+	if FieldDef <> nil then
1093	+	begin
1094	+	FRelationName := TIBFieldDef(FieldDef).FRelationName;
1095	+	FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1096	+	FArrayBounds := TIBFieldDef(FieldDef).ArrayBounds;
1097	+	end;
1098	+	end;
1099	+	end;
1100	+
1101	+	constructor TIBArrayField.Create(AOwner: TComponent);
1102	+	begin
1103	+	inherited Create(AOwner);
1104	+	SetDataType(ftArray);
1105	+	end;
1106	+
1107	+	function TIBArrayField.CreateArray: IArray;
1108	+	begin
1109	+	with DataSet as TIBCustomDataSet do
1110	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1111	+	end;
1112	+
1113	+	{ TIBMemoField }
1114	+
1115	+	function TIBMemoField.GetTruncatedText: string;
1116	+	begin
1117	+	Result := GetAsString;
1118	+
1119	+	if Result <> '' then
1120	+	begin
1121	+	case CharacterSetSize of
1122	+	1:
1123	+	if DisplayWidth = 0 then
1124	+	Result := TextToSingleLine(Result)
1125	+	else
1126	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
1127	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1128	+
1129	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
1130	+
1131	+	3, {Assume UNICODE_FSS is really UTF8}
1132	+	4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1133	+	if DisplayWidth = 0 then
1134	+	Result := ValidUTF8String(TextToSingleLine(Result))
1135	+	else
1136	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1137	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1138	+	end;
1139	+	end
1140	+	end;
1141	+
1142	+	procedure TIBMemoField.Bind(Binding: Boolean);
1143	+	var IBFieldDef: TIBFieldDef;
1144	+	begin
1145	+	inherited Bind(Binding);
1146	+	if Binding and (FieldDef <> nil) then
1147	+	begin
1148	+	IBFieldDef := FieldDef as TIBFieldDef;
1149	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
1150	+	CharacterSetName := IBFieldDef.CharacterSetName;
1151	+	CodePage := IBFieldDef.CodePage;
1152	+	end;
1153	+	end;
1154	+
1155	+	function TIBMemoField.GetAsString: string;
1156	+	var s: RawByteString;
1157	+	begin
1158	+	s := inherited GetAsString;
1159	+	SetCodePage(s,CodePage,false);
1160	+	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1161	+	SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
1162	+	Result := s;
1163	+	end;
1164	+
1165	+	function TIBMemoField.GetDefaultWidth: Longint;
1166	+	begin
1167	+	if DisplayTextAsClassName then
1168	+	Result := inherited
1169	+	else
1170	+	Result := 128;
1171	+	end;
1172	+
1173	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1174	+	begin
1175	+	if ADisplayText then
1176	+	begin
1177	+	if not DisplayTextAsClassName and (CharacterSetName <> '') then
1178	+	AText := GetTruncatedText
1179	+	else
1180	+	inherited GetText(AText, ADisplayText);
1181	+	end
1182	+	else
1183	+	AText := GetAsString;
1184	+	end;
1185	+
1186	+	procedure TIBMemoField.SetAsString(const AValue: string);
1187	+	var s: RawByteString;
1188	+	begin
1189	+	s := AValue;
1190	+	if StringCodePage(s) <> CodePage then
1191	+	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1192	+	inherited SetAsString(s);
1193	+	end;
1194	+
1195	+	constructor TIBMemoField.Create(AOwner: TComponent);
1196	+	begin
1197	+	inherited Create(AOwner);
1198	+	BlobType := ftMemo;
1199	+	FCodePage := CP_NONE;
1200	+	end;
1201	+
1202	+	{ TIBControlLink }
1203	+
1204	+	destructor TIBControlLink.Destroy;
1205	+	begin
1206	+	IBDataSet := nil;
1207	+	inherited Destroy;
1208	+	end;
1209	+
1210	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
1211	+	begin
1212	+
1213	+	end;
1214	+
1215	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
1216	+	begin
1217	+
1218	+	end;
1219	+
1220	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1221	+	begin
1222	+	if FTIBDataSet = AValue then Exit;
1223	+	if IBDataSet <> nil then
1224	+	IBDataSet.UnRegisterIBLink(self);
1225	+	FTIBDataSet := AValue;
1226	+	if IBDataSet <> nil then
1227	+	IBDataSet.RegisterIBLink(self);
1228	+	end;
1229	+
1230	+
1231		{ TIBStringField}
1232
1233	<	constructor TIBStringField.Create(AOwner: TComponent);
1233	>	procedure TIBStringField.Bind(Binding: Boolean);
1234	>	var IBFieldDef: TIBFieldDef;
1235		begin
1236	<	inherited;
1236	>	inherited Bind(Binding);
1237	>	if Binding and (FieldDef <> nil) then
1238	>	begin
1239	>	IBFieldDef := FieldDef as TIBFieldDef;
1240	>	CharacterSetSize := IBFieldDef.CharacterSetSize;
1241	>	CharacterSetName := IBFieldDef.CharacterSetName;
1242	>	FDataSize := IBFieldDef.DataSize + 1;
1243	>	if AutoFieldSize then
1244	>	Size := IBFieldDef.Size;
1245	>	CodePage := IBFieldDef.CodePage;
1246	>	end;
1247	>	end;
1248	>
1249	>	function TIBStringField.GetDataSize: Integer;
1250	>	begin
1251	>	Result := FDataSize;
1252	>	end;
1253	>
1254	>	constructor TIBStringField.Create(aOwner: TComponent);
1255	>	begin
1256	>	inherited Create(aOwner);
1257	>	FCharacterSetSize := 1;
1258	>	FCodePage := CP_NONE;
1259	>	FAutoFieldSize := true;
1260		end;
1261
1262		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 640 \| Line 1279 \| end;
1279		function TIBStringField.GetValue(var Value: string): Boolean;
1280		var
1281		Buffer: PChar;
1282	+	s: RawByteString;
1283		begin
1284		Buffer := nil;
1285	<	IBAlloc(Buffer, 0, Size + 1);
1285	>	IBAlloc(Buffer, 0, DataSize);
1286		try
1287		Result := GetData(Buffer);
1288		if Result then
1289		begin
1290	<	Value := string(Buffer);
1290	>	s := strpas(Buffer);
1291	>	SetCodePage(s,CodePage,false);
1292	>	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1293	>	SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
1294	>	Value := s;
1295	>	// writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1296		if Transliterate and (Value <> '') then
1297		DataSet.Translate(PChar(Value), PChar(Value), False);
1298		end
#	Line 659 \| Line 1304 \| end;
1304		procedure TIBStringField.SetAsString(const Value: string);
1305		var
1306		Buffer: PChar;
1307	+	s: RawByteString;
1308		begin
1309		Buffer := nil;
1310	<	IBAlloc(Buffer, 0, Size + 1);
1310	>	IBAlloc(Buffer, 0, DataSize);
1311		try
1312	<	StrLCopy(Buffer, PChar(Value), Size);
1312	>	s := Value;
1313	>	if StringCodePage(s) <> CodePage then
1314	>	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1315	>	StrLCopy(Buffer, PChar(s), DataSize-1);
1316		if Transliterate then
1317		DataSet.Translate(Buffer, Buffer, True);
1318		SetData(Buffer);
#	Line 672 \| Line 1321 \| begin
1321		end;
1322		end;
1323
1324	+
1325		{ TIBBCDField }
1326
1327		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 681 \| Line 1331 \| begin
1331		Size := 8;
1332		end;
1333
1334	+	procedure TIBBCDField.Bind(Binding: Boolean);
1335	+	begin
1336	+	inherited Bind(Binding);
1337	+	if Binding and (FieldDef <> nil) then
1338	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1339	+	end;
1340	+
1341		class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1342		begin
1343		{ No need to check as the base type is currency, not BCD }
#	Line 714 \| Line 1371 \| end;
1371
1372		function TIBBCDField.GetDataSize: Integer;
1373		begin
1374	+	{$IFDEF TBCDFIELD_IS_BCD}
1375		Result := 8;
1376	+	{$ELSE}
1377	+	Result := inherited GetDataSize
1378	+	{$ENDIF}
1379		end;
1380
1381		{ TIBDataLink }
#	Line 728 \| Line 1389 \| end;
1389		destructor TIBDataLink.Destroy;
1390		begin
1391		FDataSet.FDataLink := nil;
1392	<	inherited;
1392	>	inherited Destroy;
1393		end;
1394
1395
#	Line 760 \| Line 1421 \| end;
1421
1422		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1423		begin
1424	<	inherited;
764	<	FIBLoaded := False;
765	<	CheckIBLoaded;
766	<	FIBLoaded := True;
1424	>	inherited Create(AOwner);
1425		FBase := TIBBase.Create(Self);
1426	+	FDatabaseInfo := TIBDatabaseInfo.Create(self);
1427	+	FIBLinks := TList.Create;
1428		FCurrentRecord := -1;
1429		FDeletedRecords := 0;
1430		FUniDirectional := False;
1431		FBufferChunks := BufferCacheSize;
1432		FBlobStreamList := TList.Create;
1433	+	FArrayList := TList.Create;
1434	+	FGeneratorField := TIBGenerator.Create(self);
1435		FDataLink := TIBDataLink.Create(Self);
1436		FQDelete := TIBSQL.Create(Self);
1437		FQDelete.OnSQLChanging := SQLChanging;
#	Line 782 \| Line 1444 \| begin
1444		FQRefresh.GoToFirstRecordOnExecute := False;
1445		FQSelect := TIBSQL.Create(Self);
1446		FQSelect.OnSQLChanging := SQLChanging;
1447	+	FQSelect.OnSQLChanged := SQLChanged;
1448		FQSelect.GoToFirstRecordOnExecute := False;
1449		FQModify := TIBSQL.Create(Self);
1450		FQModify.OnSQLChanging := SQLChanging;
1451		FQModify.GoToFirstRecordOnExecute := False;
1452		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1453		FParamCheck := True;
1454	+	FGenerateParamNames := False;
1455		FForcedRefresh := False;
1456	+	FAutoCommit:= acDisabled;
1457	+	FDataSetCloseAction := dcDiscardChanges;
1458		{Bookmark Size is Integer for IBX}
1459		BookmarkSize := SizeOf(Integer);
1460		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 802 \| Line 1468 \| begin
1468		else
1469		if AOwner is TIBTransaction then
1470		Transaction := TIBTransaction(AOwner);
1471	+	FBaseSQLSelect := TStringList.Create;
1472		end;
1473
1474		destructor TIBCustomDataSet.Destroy;
1475		begin
1476	<	inherited;
1477	<	if FIBLoaded then
1478	<	begin
1479	<	FDataLink.Free;
1480	<	FBase.Free;
1481	<	ClearBlobCache;
1482	<	FBlobStreamList.Free;
1483	<	FreeMem(FBufferCache);
1484	<	FBufferCache := nil;
1485	<	FreeMem(FOldBufferCache);
1486	<	FOldBufferCache := nil;
1487	<	FCacheSize := 0;
1488	<	FOldCacheSize := 0;
1489	<	FMappedFieldPosition := nil;
1490	<	end;
1476	>	if Active then Active := false;
1477	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1478	>	FDataLink.Free;
1479	>	FBase.Free;
1480	>	ClearBlobCache;
1481	>	ClearIBLinks;
1482	>	FIBLinks.Free;
1483	>	FBlobStreamList.Free;
1484	>	FArrayList.Free;
1485	>	FreeMem(FBufferCache);
1486	>	FBufferCache := nil;
1487	>	FreeMem(FOldBufferCache);
1488	>	FOldBufferCache := nil;
1489	>	FCacheSize := 0;
1490	>	FOldCacheSize := 0;
1491	>	FMappedFieldPosition := nil;
1492	>	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1493	>	if assigned(FParser) then FParser.Free;
1494	>	inherited Destroy;
1495		end;
1496
1497		function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
#	Line 842 \| Line 1513 \| begin
1513		Inc(FCurrentRecord);
1514		if (FCurrentRecord = FRecordCount) then
1515		begin
1516	<	if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1516	>	if (not FQSelect.EOF) and FQSelect.Next then
1517		begin
1518		FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1519		Inc(FRecordCount);
#	Line 861 \| Line 1532 \| end;
1532
1533		procedure TIBCustomDataSet.ApplyUpdates;
1534		var
1535	<	CurBookmark: string;
1535	>	CurBookmark: TBookmark;
1536		Buffer: PRecordData;
1537		CurUpdateTypes: TIBUpdateRecordTypes;
1538		UpdateAction: TIBUpdateAction;
#	Line 921 \| Line 1592 \| var
1592		procedure UpdateUsingUpdateObject;
1593		begin
1594		try
1595	<	FUpdateObject.Apply(UpdateKind);
1595	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1596		ResetBufferUpdateStatus;
1597		except
1598		on E: Exception do
#	Line 1059 \| Line 1730 \| begin
1730		end;
1731		end;
1732
1733	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1734	+	var i: integer;
1735	+	Prepared: boolean;
1736	+	begin
1737	+	Result := 0;
1738	+	Prepared := FInternalPrepared;
1739	+	if not Prepared then
1740	+	InternalPrepare;
1741	+	try
1742	+	for i := 0 to Length(FAliasNameList) - 1 do
1743	+	if FAliasNameList[i] = AliasName then
1744	+	begin
1745	+	Result := i + 1;
1746	+	Exit
1747	+	end;
1748	+	finally
1749	+	if not Prepared then
1750	+	InternalUnPrepare;
1751	+	end;
1752	+	end;
1753	+
1754		procedure TIBCustomDataSet.ActivateConnection;
1755		begin
1756		if not Assigned(Database) then
#	Line 1071 \| Line 1763 \| end;
1763		function TIBCustomDataSet.ActivateTransaction: Boolean;
1764		begin
1765		Result := False;
1766	<	if not Assigned(Transaction) then
1075	<	IBError(ibxeTransactionNotAssigned, [nil]);
1076	<	if not Transaction.Active then
1766	>	if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1767		begin
1768	<	Result := True;
1769	<	Transaction.StartTransaction;
1770	<	FDidActivate := True;
1768	>	if not Assigned(Transaction) then
1769	>	IBError(ibxeTransactionNotAssigned, [nil]);
1770	>	if not Transaction.Active then
1771	>	begin
1772	>	Result := True;
1773	>	Transaction.StartTransaction;
1774	>	FDidActivate := True;
1775	>	end;
1776		end;
1777		end;
1778
#	Line 1119 \| Line 1814 \| begin
1814		IBError(ibxeDatasetClosed, [nil]);
1815		end;
1816
1817	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1818	+	begin
1819	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1820	+	Result.OnSQLChanging := SQLChanging
1821	+	end;
1822	+
1823		procedure TIBCustomDataSet.CheckNotUniDirectional;
1824		begin
1825		if UniDirectional then
#	Line 1196 \| Line 1897 \| begin
1897		FBlobStreamList.Pack;
1898		end;
1899
1900	+	procedure TIBCustomDataSet.ClearArrayCache;
1901	+	var
1902	+	i: Integer;
1903	+	begin
1904	+	for i := 0 to FArrayList.Count - 1 do
1905	+	begin
1906	+	TIBArray(FArrayList[i]).Free;
1907	+	FArrayList[i] := nil;
1908	+	end;
1909	+	FArrayList.Pack;
1910	+	end;
1911	+
1912		procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1913		begin
1914		Move(Source^, Dest^, FRecordBufferSize);
#	Line 1205 \| Line 1918 \| procedure TIBCustomDataSet.DoBeforeDatab
1918		begin
1919		if Active then
1920		Active := False;
1921	<	FInternalPrepared := False;
1921	>	InternalUnPrepare;
1922		if Assigned(FBeforeDatabaseDisconnect) then
1923		FBeforeDatabaseDisconnect(Sender);
1924		end;
#	Line 1222 \| Line 1935 \| begin
1935		FDatabaseFree(Sender);
1936		end;
1937
1938	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1938	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1939	>	Action: TTransactionAction);
1940		begin
1941	<	if Active then
1942	<	Active := False;
1941	>	FCloseAction := Action;
1942	>	FInTransactionEnd := true;
1943	>	try
1944	>	if Active then
1945	>	Active := False;
1946	>	finally
1947	>	FInTransactionEnd := false;
1948	>	end;
1949		if FQSelect <> nil then
1950		FQSelect.FreeHandle;
1951		if FQDelete <> nil then
#	Line 1236 \| Line 1956 \| begin
1956		FQModify.FreeHandle;
1957		if FQRefresh <> nil then
1958		FQRefresh.FreeHandle;
1959	+	InternalUnPrepare;
1960		if Assigned(FBeforeTransactionEnd) then
1961		FBeforeTransactionEnd(Sender);
1962		end;
#	Line 1252 \| Line 1973 \| begin
1973		FTransactionFree(Sender);
1974		end;
1975
1976	<	{ Read the record from FQSelect.Current into the record buffer
1977	<	Then write the buffer to in memory cache }
1978	<	procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1979	<	RecordNumber: Integer; Buffer: PChar);
1980	<	var
1981	<	p: PRecordData;
1982	<	pbd: PBlobDataArray;
1983	<	i, j: Integer;
1984	<	LocalData: Pointer;
1985	<	LocalDate, LocalDouble: Double;
1986	<	LocalInt: Integer;
1266	<	LocalInt64: Int64;
1267	<	LocalCurrency: Currency;
1268	<	FieldsLoaded: Integer;
1976	>	procedure TIBCustomDataSet.DoDeleteReturning(QryResults: IResults);
1977	>	begin
1978	>	if assigned(FOnDeleteReturning) then
1979	>	OnDeleteReturning(self,QryResults);
1980	>	end;
1981	>
1982	>	procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1983	>	var i, j: Integer;
1984	>	FieldsLoaded: integer;
1985	>	p: PRecordData;
1986	>	colMetadata: IColumnMetaData;
1987		begin
1988		p := PRecordData(Buffer);
1271	–	{ Make sure blob cache is empty }
1272	–	pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1273	–	if RecordNumber > -1 then
1274	–	for i := 0 to BlobFieldCount - 1 do
1275	–	pbd^[i] := nil;
1989		{ Get record information }
1990		p^.rdBookmarkFlag := bfCurrent;
1991	<	p^.rdFieldCount := Qry.Current.Count;
1992	<	p^.rdRecordNumber := RecordNumber;
1991	>	p^.rdFieldCount := Qry.FieldCount;
1992	>	p^.rdRecordNumber := -1;
1993		p^.rdUpdateStatus := usUnmodified;
1994		p^.rdCachedUpdateStatus := cusUnmodified;
1995		p^.rdSavedOffset := $FFFFFFFF;
1996
1997		{ Load up the fields }
1998	<	FieldsLoaded := FQSelect.Current.Count;
1998	>	FieldsLoaded := FQSelect.MetaData.Count;
1999		j := 1;
2000	<	for i := 0 to Qry.Current.Count - 1 do
2000	>	for i := 0 to Qry.MetaData.Count - 1 do
2001		begin
2002		if (Qry = FQSelect) then
2003		j := i + 1
2004	<	else begin
2004	>	else
2005	>	begin
2006		if FieldsLoaded = 0 then
2007		break;
2008	<	j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
2008	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2009		if j < 1 then
2010		continue
2011		else
2012		Dec(FieldsLoaded);
2013		end;
2014	<	with FQSelect.Current[j - 1].Data^ do
2015	<	if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2014	>	if j > 0 then
2015	>	begin
2016	>	colMetadata := Qry.MetaData[i];
2017	>	with p^.rdFields[j], FFieldColumns^[j] do
2018		begin
2019	<	if sqllen <= 8 then
2020	<	p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
2021	<	continue;
2019	>	fdDataType := colMetadata.GetSQLType;
2020	>	if fdDataType = SQL_BLOB then
2021	>	fdDataScale := 0
2022	>	else
2023	>	fdDataScale := colMetadata.getScale;
2024	>	fdNullable := colMetadata.getIsNullable;
2025	>	fdIsNull := true;
2026	>	fdDataSize := colMetadata.GetSize;
2027	>	fdDataLength := 0;
2028	>	fdCodePage := CP_NONE;
2029	>
2030	>	case fdDataType of
2031	>	SQL_TIMESTAMP,
2032	>	SQL_TYPE_DATE,
2033	>	SQL_TYPE_TIME:
2034	>	fdDataSize := SizeOf(TDateTime);
2035	>	SQL_SHORT, SQL_LONG:
2036	>	begin
2037	>	if (fdDataScale = 0) then
2038	>	fdDataSize := SizeOf(Integer)
2039	>	else
2040	>	if (fdDataScale >= (-4)) then
2041	>	fdDataSize := SizeOf(Currency)
2042	>	else
2043	>	fdDataSize := SizeOf(Double);
2044	>	end;
2045	>	SQL_INT64:
2046	>	begin
2047	>	if (fdDataScale = 0) then
2048	>	fdDataSize := SizeOf(Int64)
2049	>	else
2050	>	if (fdDataScale >= (-4)) then
2051	>	fdDataSize := SizeOf(Currency)
2052	>	else
2053	>	fdDataSize := SizeOf(Double);
2054	>	end;
2055	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2056	>	fdDataSize := SizeOf(Double);
2057	>	SQL_BOOLEAN:
2058	>	fdDataSize := SizeOf(wordBool);
2059	>	SQL_VARYING,
2060	>	SQL_TEXT,
2061	>	SQL_BLOB:
2062	>	fdCodePage := Qry.Metadata[i].getCodePage;
2063	>	end;
2064	>	fdDataOfs := FRecordSize;
2065	>	Inc(FRecordSize, fdDataSize);
2066		end;
2067	<	if j > 0 then with p^ do
2067	>	end;
2068	>	end;
2069	>	end;
2070	>
2071	>	{Update Buffer Fields from Query Results}
2072	>
2073	>	procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2074	>	Buffer: PChar);
2075	>	var i, j: integer;
2076	>	begin
2077	>	for i := 0 to QryResults.Count - 1 do
2078	>	begin
2079	>	j := GetFieldPosition(QryResults[i].GetAliasName);
2080	>	if j > 0 then
2081		begin
2082	<	rdFields[j].fdDataType :=
2083	<	Qry.Current[i].Data^.sqltype and (not 1);
2084	<	rdFields[j].fdDataScale :=
2085	<	Qry.Current[i].Data^.sqlscale;
2086	<	rdFields[j].fdNullable :=
2087	<	(Qry.Current[i].Data^.sqltype and 1 = 1);
2088	<	rdFields[j].fdIsNull :=
2089	<	(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
2090	<	LocalData := Qry.Current[i].Data^.sqldata;
2091	<	case rdFields[j].fdDataType of
2082	>	ColumnDataToBuffer(QryResults,i,j,Buffer);
2083	>	FBufferUpdatedOnQryReturn := true;
2084	>	end;
2085	>	end;
2086	>	end;
2087	>
2088	>
2089	>	{Move column data returned from query to row buffer}
2090	>
2091	>	procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2092	>	ColumnIndex, FieldIndex: integer; Buffer: PChar);
2093	>	var
2094	>	LocalData: PByte;
2095	>	LocalDate: TDateTime;
2096	>	LocalDouble: Double;
2097	>	LocalInt: Integer;
2098	>	LocalBool: wordBool;
2099	>	LocalInt64: Int64;
2100	>	LocalCurrency: Currency;
2101	>	ColData: ISQLData;
2102	>	begin
2103	>	LocalData := nil;
2104	>	with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2105	>	begin
2106	>	QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2107	>	if not fdIsNull then
2108	>	begin
2109	>	ColData := QryResults[ColumnIndex];
2110	>	case fdDataType of {Get Formatted data for column types that need formatting}
2111	>	SQL_TYPE_DATE,
2112	>	SQL_TYPE_TIME,
2113		SQL_TIMESTAMP:
2114		begin
2115	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2116	<	if RecordNumber >= 0 then
2117	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1324	<	LocalData := PChar(@LocalDate);
1325	<	end;
1326	<	SQL_TYPE_DATE:
1327	<	begin
1328	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
1329	<	if RecordNumber >= 0 then
1330	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1331	<	LocalData := PChar(@LocalInt);
1332	<	end;
1333	<	SQL_TYPE_TIME:
1334	<	begin
1335	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
1336	<	if RecordNumber >= 0 then
1337	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1338	<	LocalData := PChar(@LocalInt);
2115	>	{This is an IBX native format and not the TDataset approach. See also GetFieldData}
2116	>	LocalDate := ColData.AsDateTime;
2117	>	LocalData := PByte(@LocalDate);
2118		end;
2119		SQL_SHORT, SQL_LONG:
2120		begin
2121	<	if (rdFields[j].fdDataScale = 0) then
2121	>	if (fdDataScale = 0) then
2122		begin
2123	<	rdFields[j].fdDataSize := SizeOf(Integer);
2124	<	if RecordNumber >= 0 then
1346	<	LocalInt := Qry.Current[i].AsLong;
1347	<	LocalData := PChar(@LocalInt);
2123	>	LocalInt := ColData.AsLong;
2124	>	LocalData := PByte(@LocalInt);
2125		end
2126	<	else if (rdFields[j].fdDataScale >= (-4)) then
2127	<	begin
2128	<	rdFields[j].fdDataSize := SizeOf(Currency);
2129	<	if RecordNumber >= 0 then
2130	<	LocalCurrency := Qry.Current[i].AsCurrency;
2131	<	LocalData := PChar(@LocalCurrency);
2132	<	end
2133	<	else begin
2134	<	rdFields[j].fdDataSize := SizeOf(Double);
2135	<	if RecordNumber >= 0 then
2136	<	LocalDouble := Qry.Current[i].AsDouble;
1360	<	LocalData := PChar(@LocalDouble);
1361	<	end;
2126	>	else
2127	>	if (fdDataScale >= (-4)) then
2128	>	begin
2129	>	LocalCurrency := ColData.AsCurrency;
2130	>	LocalData := PByte(@LocalCurrency);
2131	>	end
2132	>	else
2133	>	begin
2134	>	LocalDouble := ColData.AsDouble;
2135	>	LocalData := PByte(@LocalDouble);
2136	>	end;
2137		end;
2138		SQL_INT64:
2139		begin
2140	<	if (rdFields[j].fdDataScale = 0) then
2140	>	if (fdDataScale = 0) then
2141		begin
2142	<	rdFields[j].fdDataSize := SizeOf(Int64);
2143	<	if RecordNumber >= 0 then
1369	<	LocalInt64 := Qry.Current[i].AsInt64;
1370	<	LocalData := PChar(@LocalInt64);
2142	>	LocalInt64 := ColData.AsInt64;
2143	>	LocalData := PByte(@LocalInt64);
2144		end
2145	<	else if (rdFields[j].fdDataScale >= (-4)) then
2146	<	begin
2147	<	rdFields[j].fdDataSize := SizeOf(Currency);
2148	<	if RecordNumber >= 0 then
2149	<	LocalCurrency := Qry.Current[i].AsCurrency;
2150	<	LocalData := PChar(@LocalCurrency);
2151	<	end
2152	<	else begin
2153	<	rdFields[j].fdDataSize := SizeOf(Double);
2154	<	if RecordNumber >= 0 then
2155	<	LocalDouble := Qry.Current[i].AsDouble;
1383	<	LocalData := PChar(@LocalDouble);
1384	<	end
2145	>	else
2146	>	if (fdDataScale >= (-4)) then
2147	>	begin
2148	>	LocalCurrency := ColData.AsCurrency;
2149	>	LocalData := PByte(@LocalCurrency);
2150	>	end
2151	>	else
2152	>	begin
2153	>	LocalDouble := ColData.AsDouble;
2154	>	LocalData := PByte(@LocalDouble);
2155	>	end
2156		end;
2157		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2158		begin
2159	<	rdFields[j].fdDataSize := SizeOf(Double);
2160	<	if RecordNumber >= 0 then
1390	<	LocalDouble := Qry.Current[i].AsDouble;
1391	<	LocalData := PChar(@LocalDouble);
1392	<	end;
1393	<	SQL_VARYING:
1394	<	begin
1395	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1396	<	rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1397	<	if RecordNumber >= 0 then
1398	<	begin
1399	<	if (rdFields[j].fdDataLength = 0) then
1400	<	LocalData := nil
1401	<	else
1402	<	LocalData := @Qry.Current[i].Data^.sqldata[2];
1403	<	end;
2159	>	LocalDouble := ColData.AsDouble;
2160	>	LocalData := PByte(@LocalDouble);
2161		end;
2162	<	else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2162	>	SQL_BOOLEAN:
2163		begin
2164	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2165	<	if (rdFields[j].fdDataType = SQL_TEXT) then
1409	<	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
2164	>	LocalBool := ColData.AsBoolean;
2165	>	LocalData := PByte(@LocalBool);
2166		end;
2167		end;
2168	<	if RecordNumber < 0 then
2168	>
2169	>	if fdDataType = SQL_VARYING then
2170	>	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2171	>	else
2172	>	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2173	>	end
2174	>	else {Null column}
2175	>	if fdDataType = SQL_VARYING then
2176	>	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2177	>	else
2178	>	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2179	>	end;
2180	>	end;
2181	>
2182	>	{ Read the record from FQSelect.Current into the record buffer
2183	>	Then write the buffer to in memory cache }
2184	>	procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
2185	>	RecordNumber: Integer; Buffer: PChar);
2186	>	var
2187	>	pbd: PBlobDataArray;
2188	>	pda: PArrayDataArray;
2189	>	i, j: Integer;
2190	>	FieldsLoaded: Integer;
2191	>	p: PRecordData;
2192	>	begin
2193	>	if RecordNumber = -1 then
2194	>	begin
2195	>	InitModelBuffer(Qry,Buffer);
2196	>	Exit;
2197	>	end;
2198	>	p := PRecordData(Buffer);
2199	>	{ Make sure blob cache is empty }
2200	>	pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
2201	>	pda := PArrayDataArray(Buffer + FArrayCacheOffset);
2202	>	for i := 0 to BlobFieldCount - 1 do
2203	>	pbd^[i] := nil;
2204	>	for i := 0 to ArrayFieldCount - 1 do
2205	>	pda^[i] := nil;
2206	>
2207	>	{ Get record information }
2208	>	p^.rdBookmarkFlag := bfCurrent;
2209	>	p^.rdFieldCount := Qry.FieldCount;
2210	>	p^.rdRecordNumber := RecordNumber;
2211	>	p^.rdUpdateStatus := usUnmodified;
2212	>	p^.rdCachedUpdateStatus := cusUnmodified;
2213	>	p^.rdSavedOffset := $FFFFFFFF;
2214	>
2215	>	{ Load up the fields }
2216	>	FieldsLoaded := FQSelect.MetaData.Count;
2217	>	j := 1;
2218	>	for i := 0 to Qry.FieldCount - 1 do
2219	>	begin
2220	>	if (Qry = FQSelect) then
2221	>	j := i + 1
2222	>	else
2223	>	begin
2224	>	if FieldsLoaded = 0 then
2225	>	break;
2226	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2227	>	if j < 1 then
2228	>	continue
2229	>	else
2230	>	Dec(FieldsLoaded);
2231	>	end;
2232	>	with FQSelect.MetaData[j - 1] do
2233	>	if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2234		begin
2235	<	rdFields[j].fdIsNull := True;
2236	<	rdFields[j].fdDataOfs := FRecordSize;
2237	<	Inc(FRecordSize, rdFields[j].fdDataSize);
1417	<	end
1418	<	else begin
1419	<	if rdFields[j].fdDataType = SQL_VARYING then
1420	<	begin
1421	<	if LocalData <> nil then
1422	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
1423	<	end
1424	<	else
1425	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2235	>	if (GetSize <= 8) then
2236	>	p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2237	>	continue;
2238		end;
2239	<	end;
2239	>	if j > 0 then
2240	>	ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2241		end;
2242	<	WriteRecordCache(RecordNumber, PChar(p));
2242	>	WriteRecordCache(RecordNumber, Buffer);
2243		end;
2244
2245		function TIBCustomDataSet.GetActiveBuf: PChar;
#	Line 1471 \| Line 2284 \| begin
2284		result := FBase.Database;
2285		end;
2286
1474	–	function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1475	–	begin
1476	–	result := FBase.DBHandle;
1477	–	end;
1478	–
2287		function TIBCustomDataSet.GetDeleteSQL: TStrings;
2288		begin
2289		result := FQDelete.SQL;
#	Line 1486 \| Line 2294 \| begin
2294		result := FQInsert.SQL;
2295		end;
2296
2297	<	function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2297	>	function TIBCustomDataSet.GetSQLParams: ISQLParams;
2298		begin
2299		if not FInternalPrepared then
2300		InternalPrepare;
#	Line 1503 \| Line 2311 \| begin
2311		result := FQSelect.SQL;
2312		end;
2313
2314	<	function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2314	>	function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2315		begin
2316	<	result := FQSelect.SQLType;
2316	>	result := FQSelect.SQLStatementType;
2317		end;
2318
2319		function TIBCustomDataSet.GetModifySQL: TStrings;
#	Line 1518 \| Line 2326 \| begin
2326		result := FBase.Transaction;
2327		end;
2328
1521	–	function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1522	–	begin
1523	–	result := FBase.TRHandle;
1524	–	end;
1525	–
2329		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2330		begin
2331		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2332	<	FUpdateObject.Apply(ukDelete)
2332	>	FUpdateObject.Apply(ukDelete,Buff)
2333		else
2334		begin
2335	<	SetInternalSQLParams(FQDelete, Buff);
2335	>	SetInternalSQLParams(FQDelete.Params, Buff);
2336		FQDelete.ExecQuery;
2337	+	if (FQDelete.FieldCount > 0) then
2338	+	DoDeleteReturning(FQDelete.Current);
2339		end;
2340		with PRecordData(Buff)^ do
2341		begin
#	Line 1543 \| Line 2348 \| end;
2348		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2349		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2350		var
2351	<	fl: TList;
2352	<	CurBookmark: string;
2353	<	fld, val: Variant;
2354	<	i, fld_cnt: Integer;
2351	>	keyFieldList: TList;
2352	>	CurBookmark: TBookmark;
2353	>	fieldValue: Variant;
2354	>	lookupValues: array of variant;
2355	>	i, fieldCount: Integer;
2356	>	fieldValueAsString: string;
2357	>	lookupValueAsString: string;
2358		begin
2359	<	fl := TList.Create;
2359	>	keyFieldList := TList.Create;
2360		try
2361	<	GetFieldList(fl, KeyFields);
2362	<	fld_cnt := fl.Count;
2361	>	GetFieldList(keyFieldList, KeyFields);
2362	>	fieldCount := keyFieldList.Count;
2363		CurBookmark := Bookmark;
2364	<	result := False;
2365	<	while ((not result) and (not EOF)) do
2364	>	result := false;
2365	>	SetLength(lookupValues, fieldCount);
2366	>	if not EOF then
2367		begin
2368	<	i := 0;
1560	<	result := True;
1561	<	while (result and (i < fld_cnt)) do
2368	>	for i := 0 to fieldCount - 1 do {expand key values into lookupValues array}
2369		begin
2370	<	if fld_cnt > 1 then
2371	<	val := KeyValues[i]
2370	>	if VarIsArray(KeyValues) then
2371	>	lookupValues[i] := KeyValues[i]
2372		else
2373	<	val := KeyValues;
2374	<	fld := TField(fl[i]).Value;
2375	<	result := not (VarIsNull(val) xor VarIsNull(fld));
2376	<	if result and not VarIsNull(val) then
2373	>	if i > 0 then
2374	>	lookupValues[i] := NULL
2375	>	else
2376	>	lookupValues[0] := KeyValues;
2377	>
2378	>	{convert to upper case is case insensitive search}
2379	>	if (TField(keyFieldList[i]).DataType = ftString) and
2380	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2381	>	lookupValues[i] := UpperCase(lookupValues[i]);
2382	>	end;
2383	>	end;
2384	>	while not result and not EOF do {search for a matching record}
2385	>	begin
2386	>	i := 0;
2387	>	result := true;
2388	>	while result and (i < fieldCount) do
2389	>	{see if all of the key fields matches}
2390	>	begin
2391	>	fieldValue := TField(keyFieldList[i]).Value;
2392	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2393	>	if result and not VarIsNull(fieldValue) then
2394		begin
2395		try
2396	<	fld := VarAsType(fld, VarType(val));
1573	<	except
1574	<	on E: EVariantError do result := False;
1575	<	end;
1576	<	if Result then
1577	<	if TField(fl[i]).DataType = ftString then
2396	>	if TField(keyFieldList[i]).DataType = ftString then
2397		begin
2398	+	{strings need special handling because of the locate options that
2399	+	apply to them}
2400	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
2401	+	lookupValueAsString := lookupValues[i];
2402		if (loCaseInsensitive in Options) then
2403	<	begin
2404	<	fld := AnsiUpperCase(fld);
1582	<	val := AnsiUpperCase(val);
1583	<	end;
1584	<	fld := TrimRight(fld);
1585	<	val := TrimRight(val);
2403	>	fieldValueAsString := UpperCase(fieldValueAsString);
2404	>
2405		if (loPartialKey in Options) then
2406	<	result := result and (AnsiPos(val, fld) = 1)
2406	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2407		else
2408	<	result := result and (val = fld);
2409	<	end else
2410	<	result := result and (val = fld);
2408	>	result := result and (fieldValueAsString = lookupValueAsString);
2409	>	end
2410	>	else
2411	>	result := result and (lookupValues[i] =
2412	>	VarAsType(fieldValue, VarType(lookupValues[i])));
2413	>	except on EVariantError do
2414	>	result := False;
2415	>	end;
2416		end;
2417		Inc(i);
2418		end;
2419		if not result then
2420	<	Next;
2420	>	Next;
2421		end;
2422		if not result then
2423		Bookmark := CurBookmark
2424		else
2425		CursorPosChanged;
2426		finally
2427	<	fl.Free;
2427	>	keyFieldList.Free;
2428	>	SetLength(lookupValues,0)
2429		end;
2430		end;
2431
2432		procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2433		var
2434	<	i, j, k: Integer;
2434	>	i, j, k, arr: Integer;
2435		pbd: PBlobDataArray;
2436	+	pda: PArrayDataArray;
2437		begin
2438		pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2439	<	j := 0;
2439	>	pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2440	>	j := 0; arr := 0;
2441		for i := 0 to FieldCount - 1 do
2442		if Fields[i].IsBlob then
2443		begin
#	Line 1619 \| Line 2446 \| begin
2446		begin
2447		pbd^[j].Finalize;
2448		PISC_QUAD(
2449	<	PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2449	>	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2450		pbd^[j].BlobID;
2451		PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2452	+	end
2453	+	else
2454	+	begin
2455	+	PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2456	+	with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2457	+	begin
2458	+	gds_quad_high := 0;
2459	+	gds_quad_low := 0;
2460	+	end;
2461		end;
2462		Inc(j);
2463	+	end
2464	+	else
2465	+	if Fields[i] is TIBArrayField then
2466	+	begin
2467	+	if pda^[arr] <> nil then
2468	+	begin
2469	+	k := FMappedFieldPosition[Fields[i].FieldNo -1];
2470	+	PISC_QUAD(
2471	+	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ := pda^[arr].ArrayIntf.GetArrayID;
2472	+	PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2473	+	end;
2474	+	Inc(arr);
2475		end;
2476	+	FBufferUpdatedOnQryReturn := false;
2477		if Assigned(FUpdateObject) then
2478		begin
2479		if (Qry = FQDelete) then
2480	<	FUpdateObject.Apply(ukDelete)
2480	>	FUpdateObject.Apply(ukDelete,Buff)
2481		else if (Qry = FQInsert) then
2482	<	FUpdateObject.Apply(ukInsert)
2482	>	FUpdateObject.Apply(ukInsert,Buff)
2483		else
2484	<	FUpdateObject.Apply(ukModify);
2484	>	FUpdateObject.Apply(ukModify,Buff);
2485		end
2486		else begin
2487	<	SetInternalSQLParams(Qry, Buff);
2487	>	SetInternalSQLParams(Qry.Params, Buff);
2488		Qry.ExecQuery;
2489	+	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2490	+	UpdateRecordFromQuery(Qry.Current,Buff);
2491		end;
2492		PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2493		PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2494		SetModified(False);
2495		WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2496	<	if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
2496	>	if (FForcedRefresh or (FNeedsRefresh and not FBufferUpdatedOnQryReturn)) and CanRefresh then
2497		InternalRefreshRow;
2498		end;
2499
2500		procedure TIBCustomDataSet.InternalRefreshRow;
2501		var
2502		Buff: PChar;
1652	–	SetCursor: Boolean;
2503		ofs: DWORD;
2504		Qry: TIBSQL;
2505		begin
2506	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657	<	if SetCursor then
1658	<	Screen.Cursor := crHourGlass;
2506	>	FBase.SetCursor;
2507		try
2508		Buff := GetActiveBuf;
2509		if CanRefresh then
#	Line 1672 \| Line 2520 \| begin
2520		end
2521		else
2522		Qry := FQRefresh;
2523	<	SetInternalSQLParams(Qry, Buff);
2523	>	SetInternalSQLParams(Qry.Params, Buff);
2524		Qry.ExecQuery;
2525		try
2526	<	if (Qry.SQLType = SQLExecProcedure) or
1679	<	(Qry.Next <> nil) then
2526	>	if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2527		begin
2528		ofs := PRecordData(Buff)^.rdSavedOffset;
2529		FetchCurrentRecordToBuffer(Qry,
#	Line 1699 \| Line 2546 \| begin
2546		else
2547		IBError(ibxeCannotRefresh, [nil]);
2548		finally
2549	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1703	<	Screen.Cursor := crDefault;
2549	>	FBase.RestoreCursor;
2550		end;
2551		end;
2552
#	Line 1770 \| Line 2616 \| begin
2616		end;
2617
2618		procedure TIBCustomDataSet.InternalPrepare;
1773	–	var
1774	–	SetCursor: Boolean;
1775	–	DidActivate: Boolean;
2619		begin
2620		if FInternalPrepared then
2621		Exit;
2622	<	DidActivate := False;
1780	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781	<	if SetCursor then
1782	<	Screen.Cursor := crHourGlass;
2622	>	FBase.SetCursor;
2623		try
2624		ActivateConnection;
2625	<	DidActivate := ActivateTransaction;
2625	>	ActivateTransaction;
2626		FBase.CheckDatabase;
2627		FBase.CheckTransaction;
2628	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2629	+	begin
2630	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2631	+	try
2632	+	FQSelect.SQL.Text := FParser.SQLText;
2633	+	finally
2634	+	FQSelect.OnSQLChanged := SQLChanged;
2635	+	end;
2636	+	end;
2637	+	// writeln( FQSelect.SQL.Text);
2638		if FQSelect.SQL.Text <> '' then
2639		begin
2640		if not FQSelect.Prepared then
2641		begin
2642	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2643		FQSelect.ParamCheck := ParamCheck;
2644		FQSelect.Prepare;
2645		end;
2646	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2646	>	FQDelete.GenerateParamNames := FGenerateParamNames;
2647	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2648		FQDelete.Prepare;
2649	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2649	>	FQInsert.GenerateParamNames := FGenerateParamNames;
2650	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2651		FQInsert.Prepare;
2652	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2652	>	FQRefresh.GenerateParamNames := FGenerateParamNames;
2653	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2654		FQRefresh.Prepare;
2655	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2655	>	FQModify.GenerateParamNames := FGenerateParamNames;
2656	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2657		FQModify.Prepare;
2658		FInternalPrepared := True;
2659		InternalInitFieldDefs;
2660		end else
2661		IBError(ibxeEmptyQuery, [nil]);
2662		finally
2663	<	if DidActivate then
1809	<	DeactivateTransaction;
1810	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1811	<	Screen.Cursor := crDefault;
2663	>	FBase.RestoreCursor;
2664		end;
2665		end;
2666
#	Line 1837 \| Line 2689 \| var
2689		begin
2690		CopyRecordBuffer(Buffer, OldBuffer);
2691		if BlobFieldCount > 0 then
2692	<	FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2692	>	FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2693	>	BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2694		0);
2695		end;
2696
#	Line 1876 \| Line 2729 \| end;
2729
2730		procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
2731		begin
2732	<	if (FBase.Database <> Value) then
2732	>	if (csLoading in ComponentState) or (FBase.Database <> Value) then
2733		begin
2734		CheckDatasetClosed;
2735	+	InternalUnPrepare;
2736		FBase.Database := Value;
2737		FQDelete.Database := Value;
2738		FQInsert.Database := Value;
2739		FQRefresh.Database := Value;
2740		FQSelect.Database := Value;
2741		FQModify.Database := Value;
2742	+	FDatabaseInfo.Database := Value;
2743	+	FGeneratorField.Database := Value;
2744		end;
2745		end;
2746
#	Line 1906 \| Line 2762 \| begin
2762		end;
2763		end;
2764
2765	<	procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2765	>	procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2766		var
2767		i, j: Integer;
2768		cr, data: PChar;
2769	<	fn, st: string;
2769	>	fn: string;
2770	>	st: RawByteString;
2771		OldBuffer: Pointer;
2772	<	ts: TTimeStamp;
2772	>	Param: ISQLParam;
2773		begin
2774		if (Buffer = nil) then
2775		IBError(ibxeBufferNotSet, [nil]);
#	Line 1920 \| Line 2777 \| begin
2777		InternalPrepare;
2778		OldBuffer := nil;
2779		try
2780	<	for i := 0 to Qry.Params.Count - 1 do
2780	>	for i := 0 to Params.GetCount - 1 do
2781		begin
2782	<	fn := Qry.Params[i].Name;
2782	>	Param := Params[i];
2783	>	fn := Param.Name;
2784		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2785		begin
2786		fn := Copy(fn, 5, Length(fn));
#	Line 1942 \| Line 2800 \| begin
2800		cr := Buffer;
2801		j := FQSelect.FieldIndex[fn] + 1;
2802		if (j > 0) then
2803	<	with PRecordData(cr)^ do
2803	>	with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2804		begin
2805	<	if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2805	>	if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2806		begin
2807	<	PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2807	>	PIBDBKey(Param.AsPointer)^ := rdDBKey;
2808		continue;
2809		end;
2810	<	if rdFields[j].fdIsNull then
2811	<	Qry.Params[i].IsNull := True
2810	>	if fdIsNull then
2811	>	Param.IsNull := True
2812		else begin
2813	<	Qry.Params[i].IsNull := False;
2814	<	data := cr + rdFields[j].fdDataOfs;
2815	<	case rdFields[j].fdDataType of
2813	>	Param.IsNull := False;
2814	>	data := cr + fdDataOfs;
2815	>	case fdDataType of
2816		SQL_TEXT, SQL_VARYING:
2817		begin
2818	<	SetString(st, data, rdFields[j].fdDataLength);
2819	<	Qry.Params[i].AsString := st;
2818	>	SetString(st, data, fdDataLength);
2819	>	SetCodePage(st,fdCodePage,false);
2820	>	Param.AsString := st;
2821		end;
2822		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2823	<	Qry.Params[i].AsDouble := PDouble(data)^;
2823	>	Param.AsDouble := PDouble(data)^;
2824		SQL_SHORT, SQL_LONG:
2825		begin
2826	<	if rdFields[j].fdDataScale = 0 then
2827	<	Qry.Params[i].AsLong := PLong(data)^
1969	<	else if rdFields[j].fdDataScale >= (-4) then
1970	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2826	>	if fdDataScale = 0 then
2827	>	Param.AsLong := PLong(data)^
2828		else
2829	<	Qry.Params[i].AsDouble := PDouble(data)^;
2829	>	if fdDataScale >= (-4) then
2830	>	Param.AsCurrency := PCurrency(data)^
2831	>	else
2832	>	Param.AsDouble := PDouble(data)^;
2833		end;
2834		SQL_INT64:
2835		begin
2836	<	if rdFields[j].fdDataScale = 0 then
2837	<	Qry.Params[i].AsInt64 := PInt64(data)^
2838	<	else if rdFields[j].fdDataScale >= (-4) then
2839	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2836	>	if fdDataScale = 0 then
2837	>	Param.AsInt64 := PInt64(data)^
2838	>	else
2839	>	if fdDataScale >= (-4) then
2840	>	Param.AsCurrency := PCurrency(data)^
2841		else
2842	<	Qry.Params[i].AsDouble := PDouble(data)^;
2842	>	Param.AsDouble := PDouble(data)^;
2843		end;
2844		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2845	<	Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2846	<	SQL_TYPE_DATE:
2847	<	begin
1987	<	ts.Date := PInt(data)^;
1988	<	ts.Time := 0;
1989	<	Qry.Params[i].AsDate :=
1990	<	TimeStampToDateTime(ts);
1991	<	end;
1992	<	SQL_TYPE_TIME:
1993	<	begin
1994	<	ts.Date := 0;
1995	<	ts.Time := PInt(data)^;
1996	<	Qry.Params[i].AsTime :=
1997	<	TimeStampToDateTime(ts);
1998	<	end;
2845	>	Param.AsQuad := PISC_QUAD(data)^;
2846	>	SQL_TYPE_DATE,
2847	>	SQL_TYPE_TIME,
2848		SQL_TIMESTAMP:
2849	<	Qry.Params[i].AsDateTime :=
2850	<	TimeStampToDateTime(
2851	<	MSecsToTimeStamp(PDouble(data)^));
2849	>	{This is an IBX native format and not the TDataset approach. See also SetFieldData}
2850	>	Param.AsDateTime := PDateTime(data)^;
2851	>	SQL_BOOLEAN:
2852	>	Param.AsBoolean := PWordBool(data)^;
2853		end;
2854		end;
2855		end;
#	Line 2048 \| Line 2898 \| begin
2898		FQRefresh.Transaction := Value;
2899		FQSelect.Transaction := Value;
2900		FQModify.Transaction := Value;
2901	+	FGeneratorField.Transaction := Value;
2902		end;
2903		end;
2904
#	Line 2085 \| Line 2936 \| begin
2936		end;
2937		end;
2938
2939	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2940	+	begin
2941	+	if FIBLinks.IndexOf(Sender) = -1 then
2942	+	begin
2943	+	FIBLinks.Add(Sender);
2944	+	if Active then
2945	+	begin
2946	+	Active := false;
2947	+	Active := true;
2948	+	end;
2949	+	end;
2950	+	end;
2951	+
2952
2953		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2954		begin
2955	<	if FOpen then
2956	<	InternalClose;
2955	>	Active := false;
2956	>	{ if FOpen then
2957	>	InternalClose;}
2958		if FInternalPrepared then
2959		InternalUnPrepare;
2960	+	FieldDefs.Clear;
2961	+	FieldDefs.Updated := false;
2962	+	end;
2963	+
2964	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2965	+	begin
2966	+	FBaseSQLSelect.assign(FQSelect.SQL);
2967		end;
2968
2969		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2120 \| Line 2992 \| begin
2992		end;
2993		end;
2994
2995	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2996	+	begin
2997	+	FIBLinks.Remove(Sender);
2998	+	end;
2999	+
3000		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
3001		begin
3002		if Active then
#	Line 2136 \| Line 3013 \| begin
3013		Result := Assigned( FQSelect ) and FQSelect.EOF;
3014		end;
3015
3016	+	function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
3017	+	begin
3018	+	ActivateConnection;
3019	+	ActivateTransaction;
3020	+	if not FInternalPrepared then
3021	+	InternalPrepare;
3022	+	Result := Params.ByName(ParamName);
3023	+	end;
3024	+
3025	+	{Beware: the parameter FCache is used as an identifier to determine which
3026	+	cache is being operated on and is not referenced in the computation.
3027	+	The result is an adjusted offset into the identified cache, either the
3028	+	Buffer Cache or the old Buffer Cache.}
3029	+
3030		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
3031	<	Origin: Integer): Integer;
3031	>	Origin: Integer): DWORD;
3032		var
3033		OldCacheSize: Integer;
3034		begin
#	Line 2174 \| Line 3065 \| procedure TIBCustomDataSet.ReadCache(FCa
3065		Buffer: PChar);
3066		var
3067		pCache: PChar;
3068	+	AdjustedOffset: DWORD;
3069		bOld: Boolean;
3070		begin
3071		bOld := (FCache = FOldBufferCache);
3072	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
3072	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
3073		if not bOld then
3074	<	pCache := FBufferCache + Integer(pCache)
3074	>	pCache := FBufferCache + AdjustedOffset
3075		else
3076	<	pCache := FOldBufferCache + Integer(pCache);
3076	>	pCache := FOldBufferCache + AdjustedOffset;
3077		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
3078		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
3079		end;
#	Line 2211 \| Line 3103 \| procedure TIBCustomDataSet.WriteCache(FC
3103		Buffer: PChar);
3104		var
3105		pCache: PChar;
3106	+	AdjustedOffset: DWORD;
3107		bOld: Boolean;
3108		dwEnd: DWORD;
3109		begin
3110		bOld := (FCache = FOldBufferCache);
3111	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
3111	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
3112		if not bOld then
3113	<	pCache := FBufferCache + Integer(pCache)
3113	>	pCache := FBufferCache + AdjustedOffset
3114		else
3115	<	pCache := FOldBufferCache + Integer(pCache);
3115	>	pCache := FOldBufferCache + AdjustedOffset;
3116		Move(Buffer^, pCache^, FRecordBufferSize);
3117		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
3118		if not bOld then
#	Line 2257 \| Line 3150 \| var
3150		Buff: PChar;
3151		bTr, bDB: Boolean;
3152		begin
3153	+	if (Field = nil) or (Field.DataSet <> self) then
3154	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3155		Buff := GetActiveBuf;
3156		if Buff = nil then
3157		begin
3158		fs := TIBBlobStream.Create;
3159		fs.Mode := bmReadWrite;
3160	+	fs.Database := Database;
3161	+	fs.Transaction := Transaction;
3162	+	fs.SetField(Field);
3163		FBlobStreamList.Add(Pointer(fs));
3164		result := TIBDSBlobStream.Create(Field, fs, Mode);
3165		exit;
#	Line 2276 \| Line 3174 \| begin
3174		fs.Mode := bmReadWrite;
3175		fs.Database := Database;
3176		fs.Transaction := Transaction;
3177	+	fs.SetField(Field);
3178		fs.BlobID :=
3179	<	PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3179	>	PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3180		if (CachedUpdates) then
3181		begin
3182		bTr := not Transaction.InTransaction;
#	Line 2298 \| Line 3197 \| begin
3197		result := TIBDSBlobStream.Create(Field, fs, Mode);
3198		end;
3199
3200	+	function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3201	+	var Buff: PChar;
3202	+	pda: PArrayDataArray;
3203	+	bTr, bDB: Boolean;
3204	+	begin
3205	+	if (Field = nil) or (Field.DataSet <> self) then
3206	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3207	+	Buff := GetActiveBuf;
3208	+	if Buff = nil then
3209	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3210	+	Field.FRelationName,Field.FieldName)
3211	+	else
3212	+	begin
3213	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3214	+	if pda^[Field.FCacheOffset] = nil then
3215	+	begin
3216	+	AdjustRecordOnInsert(Buff);
3217	+	if Field.IsNull then
3218	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3219	+	Field.FRelationName,Field.FieldName)
3220	+	else
3221	+	Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3222	+	Field.FRelationName,Field.FieldName,Field.ArrayID);
3223	+	pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3224	+	FArrayList.Add(pda^[Field.FCacheOffset]);
3225	+	if (CachedUpdates) then
3226	+	begin
3227	+	bTr := not Transaction.InTransaction;
3228	+	bDB := not Database.Connected;
3229	+	if bDB then
3230	+	Database.Open;
3231	+	if bTr then
3232	+	Transaction.StartTransaction;
3233	+	pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3234	+	if bTr then
3235	+	Transaction.Commit;
3236	+	if bDB then
3237	+	Database.Close;
3238	+	end;
3239	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3240	+	end
3241	+	else
3242	+	Result := pda^[Field.FCacheOffset].ArrayIntf;
3243	+	end;
3244	+	end;
3245	+
3246	+	procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3247	+	var Buff: PChar;
3248	+	pda: PArrayDataArray;
3249	+	begin
3250	+	if (Field = nil) or (Field.DataSet <> self) then
3251	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3252	+	Buff := GetActiveBuf;
3253	+	if Buff <> nil then
3254	+	begin
3255	+	AdjustRecordOnInsert(Buff);
3256	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3257	+	pda^[Field.FCacheOffset].FArray := AnArray;
3258	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3259	+	end;
3260	+	end;
3261	+
3262		function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3263		const
3264		CMPLess = -1;
#	Line 2330 \| Line 3291 \| begin
3291		if FCachedUpdates and
3292		(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
3293		SaveOldBuffer(PChar(Buff));
3294	<	inherited;
3294	>	inherited DoBeforeDelete;
3295	>	end;
3296	>
3297	>	procedure TIBCustomDataSet.DoAfterDelete;
3298	>	begin
3299	>	inherited DoAfterDelete;
3300	>	FBase.DoAfterDelete(self);
3301	>	InternalAutoCommit;
3302		end;
3303
3304		procedure TIBCustomDataSet.DoBeforeEdit;
#	Line 2344 \| Line 3312 \| begin
3312		if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
3313		SaveOldBuffer(PChar(Buff));
3314		CopyRecordBuffer(GetActiveBuf, FOldBuffer);
3315	<	inherited;
3315	>	inherited DoBeforeEdit;
3316	>	end;
3317	>
3318	>	procedure TIBCustomDataSet.DoAfterEdit;
3319	>	begin
3320	>	inherited DoAfterEdit;
3321	>	FBase.DoAfterEdit(self);
3322		end;
3323
3324		procedure TIBCustomDataSet.DoBeforeInsert;
3325		begin
3326		if not CanInsert then
3327		IBError(ibxeCannotInsert, [nil]);
3328	<	inherited;
3328	>	inherited DoBeforeInsert;
3329	>	end;
3330	>
3331	>	procedure TIBCustomDataSet.DoAfterInsert;
3332	>	begin
3333	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
3334	>	GeneratorField.Apply;
3335	>	inherited DoAfterInsert;
3336	>	FBase.DoAfterInsert(self);
3337	>	end;
3338	>
3339	>	procedure TIBCustomDataSet.DoBeforeClose;
3340	>	begin
3341	>	inherited DoBeforeClose;
3342	>	if FInTransactionEnd and (FCloseAction = TARollback) then
3343	>	Exit;
3344	>	if State in [dsInsert,dsEdit] then
3345	>	begin
3346	>	if DataSetCloseAction = dcSaveChanges then
3347	>	Post;
3348	>	{Note this can fail with an exception e.g. due to
3349	>	database validation error. In which case the dataset remains open }
3350	>	end;
3351	>	if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3352	>	ApplyUpdates;
3353	>	end;
3354	>
3355	>	procedure TIBCustomDataSet.DoBeforeOpen;
3356	>	var i: integer;
3357	>	begin
3358	>	if assigned(FParser) then
3359	>	FParser.Reset;
3360	>	for i := 0 to FIBLinks.Count - 1 do
3361	>	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3362	>	inherited DoBeforeOpen;
3363	>	for i := 0 to FIBLinks.Count - 1 do
3364	>	TIBControlLink(FIBLinks[i]).UpdateParams(self);
3365	>	end;
3366	>
3367	>	procedure TIBCustomDataSet.DoBeforePost;
3368	>	begin
3369	>	inherited DoBeforePost;
3370	>	if (State = dsInsert) and
3371	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
3372	>	GeneratorField.Apply
3373	>	end;
3374	>
3375	>	procedure TIBCustomDataSet.DoAfterPost;
3376	>	begin
3377	>	inherited DoAfterPost;
3378	>	FBase.DoAfterPost(self);
3379	>	InternalAutoCommit;
3380		end;
3381
3382		procedure TIBCustomDataSet.FetchAll;
3383		var
3384	<	SetCursor: Boolean;
2360	<	CurBookmark: string;
3384	>	CurBookmark: TBookmark;
3385		begin
3386	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3387	<	if SetCursor then
2364	<	Screen.Cursor := crHourGlass;
2365	<	try
3386	>	FBase.SetCursor;
3387	>	try
3388		if FQSelect.EOF or not FQSelect.Open then
3389		exit;
3390		DisableControls;
#	Line 2374 \| Line 3396 \| begin
3396		EnableControls;
3397		end;
3398		finally
3399	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2378	<	Screen.Cursor := crDefault;
3399	>	FBase.RestoreCursor;
3400		end;
3401		end;
3402
#	Line 2423 \| Line 3444 \| begin
3444		result := FDataLink.DataSource;
3445		end;
3446
3447	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3448	+	begin
3449	+	Result := FAliasNameMap[FieldNo-1]
3450	+	end;
3451	+
3452	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3453	+	var
3454	+	i: integer;
3455	+	begin
3456	+	Result := nil;
3457	+	for i := 0 to Length(FAliasNameMap) - 1 do
3458	+	if FAliasNameMap[i] = aliasName then
3459	+	begin
3460	+	Result := FieldDefs[i];
3461	+	Exit
3462	+	end;
3463	+	end;
3464	+
3465		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3466		begin
3467		Result := DefaultFieldClasses[FieldType];
#	Line 2441 \| Line 3480 \| begin
3480		result := False;
3481		Buff := GetActiveBuf;
3482		if (Buff = nil) or
3483	<	(not IsVisible(Buff)) then
3483	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
3484		exit;
3485		{ The intention here is to stuff the buffer with the data for the
3486		referenced field for the current record }
#	Line 2453 \| Line 3492 \| begin
3492		if result and (Buffer <> nil) then
3493		Move(Buff[1], Buffer^, Field.DataSize);
3494		end
3495	<	else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3495	>	else
3496	>	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3497		(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3498	+	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3499	+	FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3500		begin
3501	<	result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3501	>	result := not fdIsNull;
3502		if result and (Buffer <> nil) then
2461	–	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3503		begin
3504	<	Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3504	>	Data := Buff + fdDataOfs;
3505		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3506		begin
3507	<	Move(Data^, Buffer^, fdDataLength);
3508	<	PChar(Buffer)[fdDataLength] := #0;
3507	>	if fdDataLength < Field.DataSize then
3508	>	begin
3509	>	Move(Data^, Buffer^, fdDataLength);
3510	>	PChar(Buffer)[fdDataLength] := #0;
3511	>	end
3512	>	else
3513	>	IBError(ibxeFieldSizeError,[Field.FieldName])
3514		end
3515		else
3516		Move(Data^, Buffer^, Field.DataSize);
#	Line 2507 \| Line 3553 \| begin
3553		if not Accept and (GetMode = gmCurrent) then
3554		GetMode := gmPrior;
3555		except
3556	<	// Application.HandleException(Self);
3556	>	// FBase.HandleException(Self);
3557		end;
3558		end;
3559		RestoreState(SaveState);
#	Line 2526 \| Line 3572 \| begin
3572		if FCurrentRecord < FRecordCount then
3573		ReadRecordCache(FCurrentRecord, Buffer, False)
3574		else begin
3575	<	while (not FQSelect.EOF) and
2530	<	(FQSelect.Next <> nil) and
3575	>	while (not FQSelect.EOF) and FQSelect.Next and
3576		(FCurrentRecord >= FRecordCount) do begin
3577		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3578		Inc(FRecordCount);
#	Line 2601 \| Line 3646 \| begin
3646		result := FRecordBufferSize;
3647		end;
3648
3649	+	procedure TIBCustomDataSet.InternalAutoCommit;
3650	+	begin
3651	+	with Transaction do
3652	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3653	+	begin
3654	+	if CachedUpdates then ApplyUpdates;
3655	+	CommitRetaining;
3656	+	end;
3657	+	end;
3658	+
3659		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3660		begin
3661		CheckEditState;
#	Line 2628 \| Line 3683 \| procedure TIBCustomDataSet.InternalCance
3683		var
3684		Buff: PChar;
3685		CurRec: Integer;
3686	+	pda: PArrayDataArray;
3687	+	i: integer;
3688		begin
3689	<	inherited;
3689	>	inherited InternalCancel;
3690		Buff := GetActiveBuf;
3691	<	if Buff <> nil then begin
3691	>	if Buff <> nil then
3692	>	begin
3693	>	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3694	>	for i := 0 to ArrayFieldCount - 1 do
3695	>	pda^[i].ArrayIntf.CancelChanges;
3696		CurRec := FCurrentRecord;
3697		AdjustRecordOnInsert(Buff);
3698		if (State = dsEdit) then begin
#	Line 2654 \| Line 3715 \| begin
3715		DeactivateTransaction;
3716		FQSelect.Close;
3717		ClearBlobCache;
3718	+	ClearArrayCache;
3719		FreeRecordBuffer(FModelBuffer);
3720		FreeRecordBuffer(FOldBuffer);
3721		FCurrentRecord := -1;
#	Line 2669 \| Line 3731 \| begin
3731		FOBEnd := 0;
3732		FreeMem(FBufferCache);
3733		FBufferCache := nil;
3734	+	FreeMem(FFieldColumns);
3735	+	FFieldColumns := nil;
3736		FreeMem(FOldBufferCache);
3737		FOldBufferCache := nil;
3738		BindFields(False);
3739	+	ResetParser;
3740		if DefaultFields then DestroyFields;
3741		end;
3742
3743		procedure TIBCustomDataSet.InternalDelete;
3744		var
3745		Buff: PChar;
2681	–	SetCursor: Boolean;
3746		begin
3747	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684	<	if SetCursor then
2685	<	Screen.Cursor := crHourGlass;
3747	>	FBase.SetCursor;
3748		try
3749		Buff := GetActiveBuf;
3750		if CanDelete then
#	Line 2707 \| Line 3769 \| begin
3769		end else
3770		IBError(ibxeCannotDelete, [nil]);
3771		finally
3772	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2711	<	Screen.Cursor := crDefault;
3772	>	FBase.RestoreCursor;
3773		end;
3774		end;
3775
#	Line 2724 \| Line 3785 \| end;
3785
3786		procedure TIBCustomDataSet.InternalHandleException;
3787		begin
3788	<	Application.HandleException(Self)
3788	>	FBase.HandleException(Self)
3789		end;
3790
3791		procedure TIBCustomDataSet.InternalInitFieldDefs;
3792	+	begin
3793	+	if not InternalPrepared then
3794	+	begin
3795	+	InternalPrepare;
3796	+	exit;
3797	+	end;
3798	+	FieldDefsFromQuery(FQSelect);
3799	+	end;
3800	+
3801	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3802		const
3803		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3804		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2736 \| Line 3807 \| const
3807		'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3808		'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3809		' (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3810	+
3811	+	DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3812	+	'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3813	+	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3814	+	'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize}
3815	+	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3816	+	'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3817	+	' (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3818	+	' ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3819	+
3820		var
3821		FieldType: TFieldType;
3822		FieldSize: Word;
3823	+	FieldDataSize: integer;
3824	+	CharSetSize: integer;
3825	+	CharSetName: RawByteString;
3826	+	FieldCodePage: TSystemCodePage;
3827		FieldNullable : Boolean;
3828		i, FieldPosition, FieldPrecision: Integer;
3829	<	FieldAliasName: string;
3830	<	RelationName, FieldName: string;
3829	>	FieldAliasName, DBAliasName: string;
3830	>	aRelationName, FieldName: string;
3831		Query : TIBSQL;
3832		FieldIndex: Integer;
3833		FRelationNodes : TRelationNode;
3834	+	aArrayDimensions: integer;
3835	+	aArrayBounds: TArrayBounds;
3836	+	ArrayMetaData: IArrayMetaData;
3837
3838		function Add_Node(Relation, Field : String) : TRelationNode;
3839		var
#	Line 2768 \| Line 3856 \| var
3856		FField.FieldName := Query.Fields[2].AsString;
3857		FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3858		FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3859	+	FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3860		FField.NextField := Result.FieldNodes;
3861		Result.FieldNodes := FField;
3862		Query.Next;
#	Line 2821 \| Line 3910 \| var
3910		FField := Ffield.NextField;
3911		end;
3912
3913	+	function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3914	+	var
3915	+	FRelation : TRelationNode;
3916	+	FField : TFieldNode;
3917	+	begin
3918	+	FRelation := FRelationNodes;
3919	+	while Assigned(FRelation) and
3920	+	(FRelation.RelationName <> Relation) do
3921	+	FRelation := FRelation.NextRelation;
3922	+	if not Assigned(FRelation) then
3923	+	FRelation := Add_Node(Relation, Field);
3924	+	Result := false;
3925	+	FField := FRelation.FieldNodes;
3926	+	while Assigned(FField) do
3927	+	if FField.FieldName = Field then
3928	+	begin
3929	+	Result := Ffield.IDENTITY_COLUMN;
3930	+	Exit;
3931	+	end
3932	+	else
3933	+	FField := Ffield.NextField;
3934	+	end;
3935	+
3936		Procedure FreeNodes;
3937		var
3938		FRelation : TRelationNode;
#	Line 2841 \| Line 3953 \| var
3953		end;
3954
3955		begin
2844	–	if not InternalPrepared then
2845	–	begin
2846	–	InternalPrepare;
2847	–	exit;
2848	–	end;
3956		FRelationNodes := TRelationNode.Create;
3957		FNeedsRefresh := False;
3958	<	Database.InternalTransaction.StartTransaction;
3958	>	if not Database.InternalTransaction.InTransaction then
3959	>	Database.InternalTransaction.StartTransaction;
3960		Query := TIBSQL.Create(self);
3961		try
3962		Query.Database := DataBase;
#	Line 2856 \| Line 3964 \| begin
3964		FieldDefs.BeginUpdate;
3965		FieldDefs.Clear;
3966		FieldIndex := 0;
3967	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3968	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3969	<	Query.SQL.Text := DefaultSQL;
3967	>	if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3968	>	SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3969	>	if FDatabaseInfo.ODSMajorVersion >= 12 then
3970	>	Query.SQL.Text := DefaultSQLODS12
3971	>	else
3972	>	Query.SQL.Text := DefaultSQL;
3973		Query.Prepare;
3974	<	for i := 0 to FQSelect.Current.Count - 1 do
3975	<	with FQSelect.Current[i].Data^ do
3974	>	SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3975	>	SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3976	>	for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3977	>	with SourceQuery.MetaData[i] do
3978		begin
3979		{ Get the field name }
3980	<	SetString(FieldAliasName, aliasname, aliasname_length);
3981	<	SetString(RelationName, relname, relname_length);
3982	<	SetString(FieldName, sqlname, sqlname_length);
3980	>	FieldAliasName := GetName;
3981	>	DBAliasName := GetAliasname;
3982	>	aRelationName := getRelationName;
3983	>	FieldName := getSQLName;
3984	>	FAliasNameList[i] := DBAliasName;
3985		FieldSize := 0;
3986	+	FieldDataSize := GetSize;
3987		FieldPrecision := 0;
3988	<	FieldNullable := FQSelect.Current[i].IsNullable;
3989	<	case sqltype and not 1 of
3988	>	FieldNullable := IsNullable;
3989	>	CharSetSize := 0;
3990	>	CharSetName := '';
3991	>	FieldCodePage := CP_NONE;
3992	>	aArrayDimensions := 0;
3993	>	SetLength(aArrayBounds,0);
3994	>	case SQLType of
3995		{ All VARCHAR's must be converted to strings before recording
3996		their values }
3997		SQL_VARYING, SQL_TEXT:
3998		begin
3999	<	FieldSize := sqllen;
3999	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4000	>	CharSetSize := 1;
4001	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4002	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4003	>	FieldSize := FieldDataSize div CharSetSize;
4004		FieldType := ftString;
4005		end;
4006		{ All Doubles/Floats should be cast to doubles }
#	Line 2883 \| Line 4008 \| begin
4008		FieldType := ftFloat;
4009		SQL_SHORT:
4010		begin
4011	<	if (sqlscale = 0) then
4011	>	if (getScale = 0) then
4012		FieldType := ftSmallInt
4013		else begin
4014		FieldType := ftBCD;
4015		FieldPrecision := 4;
4016	<	FieldSize := -sqlscale;
4016	>	FieldSize := -getScale;
4017		end;
4018		end;
4019		SQL_LONG:
4020		begin
4021	<	if (sqlscale = 0) then
4021	>	if (getScale = 0) then
4022		FieldType := ftInteger
4023	<	else if (sqlscale >= (-4)) then
4023	>	else if (getScale >= (-4)) then
4024		begin
4025		FieldType := ftBCD;
4026		FieldPrecision := 9;
4027	<	FieldSize := -sqlscale;
4027	>	FieldSize := -getScale;
4028		end
4029		else
4030	<	FieldType := ftFloat;
4030	>	if Database.SQLDialect = 1 then
4031	>	FieldType := ftFloat
4032	>	else
4033	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
4034	>	FieldType := ftFloat
4035	>	else
4036	>	begin
4037	>	FieldType := ftFMTBCD;
4038	>	FieldPrecision := 9;
4039	>	FieldSize := -getScale;
4040		end;
4041	+	end;
4042	+
4043		SQL_INT64:
4044		begin
4045	<	if (sqlscale = 0) then
4045	>	if (getScale = 0) then
4046		FieldType := ftLargeInt
4047	<	else if (sqlscale >= (-4)) then
4047	>	else if (getScale >= (-4)) then
4048		begin
4049		FieldType := ftBCD;
4050		FieldPrecision := 18;
4051	<	FieldSize := -sqlscale;
4051	>	FieldSize := -getScale;
4052		end
4053		else
4054		FieldType := ftFloat;
4055	<	end;
4055	>	end;
4056		SQL_TIMESTAMP: FieldType := ftDateTime;
4057		SQL_TYPE_TIME: FieldType := ftTime;
4058		SQL_TYPE_DATE: FieldType := ftDate;
4059		SQL_BLOB:
4060		begin
4061		FieldSize := sizeof (TISC_QUAD);
4062	<	if (sqlsubtype = 1) then
4063	<	FieldType := ftmemo
4062	>	if (getSubtype = 1) then
4063	>	begin
4064	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4065	>	CharSetSize := 1;
4066	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4067	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4068	>	FieldType := ftMemo;
4069	>	end
4070		else
4071		FieldType := ftBlob;
4072		end;
4073		SQL_ARRAY:
4074		begin
4075		FieldSize := sizeof (TISC_QUAD);
4076	<	FieldType := ftUnknown;
4076	>	FieldType := ftArray;
4077	>	ArrayMetaData := GetArrayMetaData;
4078	>	if ArrayMetaData <> nil then
4079	>	begin
4080	>	aArrayDimensions := ArrayMetaData.GetDimensions;
4081	>	aArrayBounds := ArrayMetaData.GetBounds;
4082	>	end;
4083		end;
4084	+	SQL_BOOLEAN:
4085	+	FieldType:= ftBoolean;
4086		else
4087		FieldType := ftUnknown;
4088		end;
#	Line 2941 \| Line 4091 \| begin
4091		begin
4092		FMappedFieldPosition[FieldIndex] := FieldPosition;
4093		Inc(FieldIndex);
4094	<	with FieldDefs.AddFieldDef do
4094	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
4095		begin
4096	<	Name := string( FieldAliasName );
4097	<	FieldNo := FieldPosition;
2948	<	DataType := FieldType;
4096	>	Name := FieldAliasName;
4097	>	FAliasNameMap[FieldNo-1] := DBAliasName;
4098		Size := FieldSize;
4099	+	DataSize := FieldDataSize;
4100		Precision := FieldPrecision;
4101	<	Required := False;
4101	>	Required := not FieldNullable;
4102	>	RelationName := aRelationName;
4103		InternalCalcField := False;
4104	+	CharacterSetSize := CharSetSize;
4105	+	CharacterSetName := CharSetName;
4106	+	CodePage := FieldCodePage;
4107	+	ArrayDimensions := aArrayDimensions;
4108	+	ArrayBounds := aArrayBounds;
4109		if (FieldName <> '') and (RelationName <> '') then
4110		begin
4111	+	IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4112		if Has_COMPUTED_BLR(RelationName, FieldName) then
4113		begin
4114		Attributes := [faReadOnly];
#	Line 2977 \| Line 4134 \| begin
4134		FreeNodes;
4135		Database.InternalTransaction.Commit;
4136		FieldDefs.EndUpdate;
4137	+	FieldDefs.Updated := true;
4138		end;
4139		end;
4140
#	Line 2994 \| Line 4152 \| begin
4152		else begin
4153		Buffer := AllocRecordBuffer;
4154		try
4155	<	while FQSelect.Next <> nil do
4155	>	while FQSelect.Next do
4156		begin
4157		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
4158		Inc(FRecordCount);
#	Line 3009 \| Line 4167 \| end;
4167		procedure TIBCustomDataSet.InternalSetParamsFromCursor;
4168		var
4169		i: Integer;
4170	<	cur_param: TIBXSQLVAR;
4170	>	cur_param: ISQLParam;
4171		cur_field: TField;
4172		s: TStream;
4173		begin
#	Line 3017 \| Line 4175 \| begin
4175		IBError(ibxeEmptyQuery, [nil]);
4176		if not FInternalPrepared then
4177		InternalPrepare;
4178	<	if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4178	>	if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4179		begin
4180	<	for i := 0 to SQLParams.Count - 1 do
4180	>	for i := 0 to SQLParams.GetCount - 1 do
4181		begin
4182		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4183	<	cur_param := SQLParams[i];
4184	<	if (cur_field <> nil) then begin
4183	>	if (cur_field <> nil) then
4184	>	begin
4185	>	cur_param := SQLParams[i];
4186		if (cur_field.IsNull) then
4187		cur_param.IsNull := True
4188	<	else case cur_field.DataType of
4188	>	else
4189	>	case cur_field.DataType of
4190		ftString:
4191		cur_param.AsString := cur_field.AsString;
4192	<	ftBoolean, ftSmallint, ftWord:
4192	>	ftBoolean:
4193	>	cur_param.AsBoolean := cur_field.AsBoolean;
4194	>	ftSmallint, ftWord:
4195		cur_param.AsShort := cur_field.AsInteger;
4196		ftInteger:
4197		cur_param.AsLong := cur_field.AsInteger;
4198		ftLargeInt:
4199	<	cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4199	>	cur_param.AsInt64 := cur_field.AsLargeInt;
4200		ftFloat, ftCurrency:
4201		cur_param.AsDouble := cur_field.AsFloat;
4202		ftBCD:
#	Line 3051 \| Line 4213 \| begin
4213		try
4214		s := DataSource.DataSet.
4215		CreateBlobStream(cur_field, bmRead);
4216	<	cur_param.LoadFromStream(s);
4216	>	cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4217		finally
4218		s.free;
4219		end;
4220		end;
4221	+	ftArray:
4222	+	cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4223		else
4224		IBError(ibxeNotSupported, [nil]);
4225		end;
#	Line 3082 \| Line 4246 \| begin
4246		end;
4247
4248		procedure TIBCustomDataSet.InternalOpen;
3085	–	var
3086	–	SetCursor: Boolean;
4249
4250		function RecordDataLength(n: Integer): Long;
4251		begin
#	Line 3091 \| Line 4253 \| var
4253		end;
4254
4255		begin
4256	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095	<	if SetCursor then
3096	<	Screen.Cursor := crHourGlass;
4256	>	FBase.SetCursor;
4257		try
4258		ActivateConnection;
4259		ActivateTransaction;
#	Line 3101 \| Line 4261 \| begin
4261		IBError(ibxeEmptyQuery, [nil]);
4262		if not FInternalPrepared then
4263		InternalPrepare;
4264	<	if FQSelect.SQLType = SQLSelect then
4264	>	if FQSelect.SQLStatementType = SQLSelect then
4265		begin
4266		if DefaultFields then
4267		CreateFields;
4268	+	FArrayFieldCount := 0;
4269		BindFields(True);
4270		FCurrentRecord := -1;
4271		FQSelect.ExecQuery;
#	Line 3116 \| Line 4277 \| begin
4277		3. After the dummy fetch, FRecordSize will be appropriately
4278		adjusted to reflect the additional "weight" of the field
4279		data.
4280	<	4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4280	>	4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4281		5. Now, with the BufferSize available, allocate memory for chunks of records
4282		6. Re-allocate the model buffer, accounting for the new
4283		FRecordBufferSize.
4284		7. Finally, calls to AllocRecordBuffer will work!.
4285		}
4286		{Step 1}
4287	<	FRecordSize := RecordDataLength(FQSelect.Current.Count);
4287	>	FRecordSize := RecordDataLength(FQSelect.FieldCount);
4288		{Step 2, 3}
4289	+	GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4290		IBAlloc(FModelBuffer, 0, FRecordSize);
4291	<	FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4291	>	InitModelBuffer(FQSelect, FModelBuffer);
4292		{Step 4}
4293		FCalcFieldsOffset := FRecordSize;
4294		FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4295	<	FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4295	>	FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4296	>	FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4297		{Step 5}
4298		if UniDirectional then
4299		FBufferChunkSize := FRecordBufferSize * UniCache
#	Line 3146 \| Line 4309 \| begin
4309		FCacheSize := FBufferChunkSize;
4310		FOldCacheSize := FBufferChunkSize;
4311		{Step 6}
4312	<	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4312	>	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4313		FRecordBufferSize);
4314		{Step 7}
4315		FOldBuffer := AllocRecordBuffer;
#	Line 3154 \| Line 4317 \| begin
4317		else
4318		FQSelect.ExecQuery;
4319		finally
4320	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3158	<	Screen.Cursor := crDefault;
4320	>	FBase.RestoreCursor;
4321		end;
4322		end;
4323
#	Line 3163 \| Line 4325 \| procedure TIBCustomDataSet.InternalPost;
4325		var
4326		Qry: TIBSQL;
4327		Buff: PChar;
3166	–	SetCursor: Boolean;
4328		bInserting: Boolean;
4329		begin
4330	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170	<	if SetCursor then
3171	<	Screen.Cursor := crHourGlass;
4330	>	FBase.SetCursor;
4331		try
4332		Buff := GetActiveBuf;
4333		CheckEditState;
#	Line 3206 \| Line 4365 \| begin
4365		if bInserting then
4366		Inc(FRecordCount);
4367		finally
4368	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3210	<	Screen.Cursor := crDefault;
4368	>	FBase.RestoreCursor;
4369		end;
4370		end;
4371
4372		procedure TIBCustomDataSet.InternalRefresh;
4373		begin
4374	<	inherited;
4374	>	inherited InternalRefresh;
4375		InternalRefreshRow;
4376		end;
4377
#	Line 3227 \| Line 4385 \| begin
4385		result := FOpen;
4386		end;
4387
4388	+	procedure TIBCustomDataSet.Loaded;
4389	+	begin
4390	+	if assigned(FQSelect) then
4391	+	FBaseSQLSelect.assign(FQSelect.SQL);
4392	+	inherited Loaded;
4393	+	end;
4394	+
4395	+	procedure TIBCustomDataSet.Post;
4396	+	var CancelPost: boolean;
4397	+	begin
4398	+	CancelPost := false;
4399	+	if assigned(FOnValidatePost) then
4400	+	OnValidatePost(self,CancelPost);
4401	+	if CancelPost then
4402	+	Cancel
4403	+	else
4404	+	inherited Post;
4405	+	end;
4406	+
4407		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4408		Options: TLocateOptions): Boolean;
4409		var
4410	<	CurBookmark: string;
4410	>	CurBookmark: TBookmark;
4411		begin
4412		DisableControls;
4413		try
#	Line 3248 \| Line 4425 \| function TIBCustomDataSet.Lookup(const K
4425		const ResultFields: string): Variant;
4426		var
4427		fl: TList;
4428	<	CurBookmark: string;
4428	>	CurBookmark: TBookmark;
4429		begin
4430		DisableControls;
4431		fl := TList.Create;
#	Line 3301 \| Line 4478 \| end;
4478		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4479		var
4480		Buff, TmpBuff: PChar;
4481	+	MappedFieldPos: integer;
4482		begin
4483		Buff := GetActiveBuf;
4484		if Field.FieldNo < 0 then
#	Line 3317 \| Line 4495 \| begin
4495		begin
4496		{ If inserting, Adjust record position }
4497		AdjustRecordOnInsert(Buff);
4498	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4499	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4498	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4499	>	if (MappedFieldPos > 0) and
4500	>	(MappedFieldPos <= rdFieldCount) then
4501	>	with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4502		begin
4503		Field.Validate(Buffer);
4504		if (Buffer = nil) or
4505		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4506	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4507	<	else begin
4508	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4509	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4510	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4511	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4512	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3333	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4506	>	fdIsNull := True
4507	>	else
4508	>	begin
4509	>	Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4510	>	if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4511	>	fdDataLength := StrLen(PChar(Buffer));
4512	>	fdIsNull := False;
4513		if rdUpdateStatus = usUnmodified then
4514		begin
4515		if CachedUpdates then
#	Line 3354 \| Line 4533 \| begin
4533		end;
4534		end;
4535		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4536	<	DataEvent(deFieldChange, Longint(Field));
4536	>	DataEvent(deFieldChange, PtrInt(Field));
4537		end;
4538
4539		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3418 \| Line 4597 \| begin
4597		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4598		end;
4599
4600	+	procedure TIBCustomDataSet.ClearIBLinks;
4601	+	var i: integer;
4602	+	begin
4603	+	for i := FIBLinks.Count - 1 downto 0 do
4604	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4605	+	end;
4606	+
4607
4608		procedure TIBCustomDataSet.InternalUnPrepare;
4609		begin
4610		if FInternalPrepared then
4611		begin
4612		CheckDatasetClosed;
4613	+	if FDidActivate then
4614	+	DeactivateTransaction;
4615		FieldDefs.Clear;
4616	+	FieldDefs.Updated := false;
4617		FInternalPrepared := False;
4618	+	Setlength(FAliasNameList,0);
4619		end;
4620		end;
4621
4622		procedure TIBCustomDataSet.InternalExecQuery;
4623		var
4624		DidActivate: Boolean;
3435	–	SetCursor: Boolean;
4625		begin
4626		DidActivate := False;
4627	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439	<	if SetCursor then
3440	<	Screen.Cursor := crHourGlass;
4627	>	FBase.SetCursor;
4628		try
4629		ActivateConnection;
4630		DidActivate := ActivateTransaction;
#	Line 3445 \| Line 4632 \| begin
4632		IBError(ibxeEmptyQuery, [nil]);
4633		if not FInternalPrepared then
4634		InternalPrepare;
4635	<	if FQSelect.SQLType = SQLSelect then
4635	>	if FQSelect.SQLStatementType = SQLSelect then
4636		begin
4637		IBError(ibxeIsASelectStatement, [nil]);
4638		end
#	Line 3454 \| Line 4641 \| begin
4641		finally
4642		if DidActivate then
4643		DeactivateTransaction;
4644	<	if SetCursor and (Screen.Cursor = crHourGlass) then
4645	<	Screen.Cursor := crDefault;
4644	>	FBase.RestoreCursor;
4645	>	end;
4646	>	end;
4647	>
4648	>	function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4649	>	begin
4650	>	Result := FQSelect.Statement;
4651	>	end;
4652	>
4653	>	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4654	>	begin
4655	>	if not assigned(FParser) then
4656	>	FParser := CreateParser;
4657	>	Result := FParser
4658	>	end;
4659	>
4660	>	procedure TIBCustomDataSet.ResetParser;
4661	>	begin
4662	>	if assigned(FParser) then
4663	>	begin
4664	>	FParser.Free;
4665	>	FParser := nil;
4666	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
4667	>	try
4668	>	FQSelect.SQL.Assign(FBaseSQLSelect);
4669	>	finally
4670	>	FQSelect.OnSQLChanged := SQLChanged;
4671	>	end;
4672		end;
4673		end;
4674
4675	<	function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4675	>	function TIBCustomDataSet.HasParser: boolean;
4676		begin
4677	<	Result := FQSelect.Handle;
4677	>	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4678	>	end;
4679	>
4680	>	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4681	>	begin
4682	>	if FGenerateParamNames = AValue then Exit;
4683	>	FGenerateParamNames := AValue;
4684	>	Disconnect
4685		end;
4686
4687		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
#	Line 3635 \| Line 4855 \| begin
4855		Transaction.StartTransaction;
4856		end;
4857
4858	<	function TIBCustomDataSet.PSGetTableName: string;
4858	>	function TIBCustomDataSet.PsGetTableName: string;
4859		begin
4860		// if not FInternalPrepared then
4861		// InternalPrepare;
#	Line 3682 \| Line 4902 \| begin
4902		ActivateConnection;
4903		ActivateTransaction;
4904		InternalSetParamsFromCursor;
4905	<	Inherited;
4905	>	Inherited InternalOpen;
4906		end;
4907
4908		procedure TIBDataSet.SetFiltered(Value: Boolean);
#	Line 3710 \| Line 4930 \| end;
4930
4931		function TIBCustomDataSet.GetFieldData(Field: TField;
4932		Buffer: Pointer): Boolean;
4933	+	{$IFDEF TBCDFIELD_IS_BCD}
4934		var
4935		lTempCurr : System.Currency;
4936		begin
#	Line 3720 \| Line 4941 \| begin
4941		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4942		end
4943		else
4944	+	{$ELSE}
4945	+	begin
4946	+	{$ENDIF}
4947		Result := InternalGetFieldData(Field, Buffer);
4948		end;
4949
4950		function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4951		NativeFormat: Boolean): Boolean;
4952		begin
4953	<	if (Field.DataType = ftBCD) and not NativeFormat then
4953	>	{These datatypes use IBX conventions and not TDataset conventions}
4954	>	if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4955		Result := InternalGetFieldData(Field, Buffer)
4956		else
4957		Result := inherited GetFieldData(Field, Buffer, NativeFormat);
4958		end;
4959
4960		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4961	+	{$IFDEF TDBDFIELD_IS_BCD}
4962		var
4963		lTempCurr : System.Currency;
4964		begin
4965	<	if Field.DataType = ftBCD then
4965	>	if (Field.DataType = ftBCD) and (Buffer <> nil) then
4966		begin
4967		BCDToCurr(TBCD(Buffer^), lTempCurr);
4968		InternalSetFieldData(Field, @lTempCurr);
4969		end
4970		else
4971	+	{$ELSE}
4972	+	begin
4973	+	{$ENDIF}
4974		InternalSetFieldData(Field, Buffer);
4975		end;
4976
4977		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4978		NativeFormat: Boolean);
4979		begin
4980	<	if (not NativeFormat) and (Field.DataType = ftBCD) then
4980	>	{These datatypes use IBX conventions and not TDataset conventions}
4981	>	if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4982		InternalSetfieldData(Field, Buffer)
4983		else
4984		inherited SetFieldData(Field, buffer, NativeFormat);
#	Line 3765 \| Line 4995 \| end;
4995		destructor TIBDataSetUpdateObject.Destroy;
4996		begin
4997		FRefreshSQL.Free;
4998	<	inherited destroy;
4998	>	inherited Destroy;
4999		end;
5000
5001	<	procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
5001	>	procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
5002		begin
5003		FRefreshSQL.Assign(Value);
5004		end;
5005
5006	+	procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
5007	+	buff: PChar);
5008	+	begin
5009	+	if not Assigned(DataSet) then Exit;
5010	+	DataSet.SetInternalSQLParams(Params, buff);
5011	+	end;
5012	+
5013	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
5014	+	begin
5015	+	InternalSetParams(Query.Params,buff);
5016	+	end;
5017	+
5018	+	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5019	+	QryResults: IResults; Buffer: PChar);
5020	+	begin
5021	+	if not Assigned(DataSet) then Exit;
5022	+	case UpdateKind of
5023	+	ukModify, ukInsert:
5024	+	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5025	+	ukDelete:
5026	+	DataSet.DoDeleteReturning(QryResults);
5027	+	end;
5028	+	end;
5029	+
5030	+	function TIBDSBlobStream.GetSize: Int64;
5031	+	begin
5032	+	Result := FBlobStream.BlobSize;
5033	+	end;
5034	+
5035		{ TIBDSBlobStream }
5036		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
5037		Mode: TBlobStreamMode);
#	Line 3781 \| Line 5040 \| begin
5040		FBlobStream := ABlobStream;
5041		FBlobStream.Seek(0, soFromBeginning);
5042		if (Mode = bmWrite) then
5043	+	begin
5044		FBlobStream.Truncate;
5045	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
5046	+	TBlobField(FField).Modified := true;
5047	+	FHasWritten := true;
5048	+	end;
5049	+	end;
5050	+
5051	+	destructor TIBDSBlobStream.Destroy;
5052	+	begin
5053	+	if FHasWritten then
5054	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5055	+	inherited Destroy;
5056		end;
5057
5058		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
#	Line 3804 \| Line 5075 \| begin
5075		if not (FField.DataSet.State in [dsEdit, dsInsert]) then
5076		IBError(ibxeNotEditing, [nil]);
5077		TIBCustomDataSet(FField.DataSet).RecordModified(True);
5078	+	TBlobField(FField).Modified := true;
5079		result := FBlobStream.Write(Buffer, Count);
5080	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
5080	>	FHasWritten := true;
5081	>	{ TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
5082	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
5083	>	the blob stream. Moved to the destructor i.e. called after blob written}
5084	>	end;
5085	>
5086	>	{ TIBGenerator }
5087	>
5088	>	procedure TIBGenerator.SetIncrement(const AValue: integer);
5089	>	begin
5090	>	if FIncrement = AValue then Exit;
5091	>	if AValue < 0 then
5092	>	IBError(ibxeNegativeGenerator,[]);
5093	>	FIncrement := AValue;
5094	>	SetQuerySQL;
5095	>	end;
5096	>
5097	>	procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5098	>	begin
5099	>	FQuery.Transaction := AValue;
5100	>	end;
5101	>
5102	>	procedure TIBGenerator.SetQuerySQL;
5103	>	begin
5104	>	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5105	>	end;
5106	>
5107	>	function TIBGenerator.GetDatabase: TIBDatabase;
5108	>	begin
5109	>	Result := FQuery.Database;
5110		end;
5111
5112	+	function TIBGenerator.GetTransaction: TIBTransaction;
5113	+	begin
5114	+	Result := FQuery.Transaction;
5115	+	end;
5116	+
5117	+	procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5118	+	begin
5119	+	FQuery.Database := AValue;
5120	+	end;
5121	+
5122	+	procedure TIBGenerator.SetGeneratorName(AValue: string);
5123	+	begin
5124	+	if FGeneratorName = AValue then Exit;
5125	+	FGeneratorName := AValue;
5126	+	SetQuerySQL;
5127	+	end;
5128	+
5129	+	function TIBGenerator.GetNextValue: integer;
5130	+	begin
5131	+	with FQuery do
5132	+	begin
5133	+	Transaction.Active := true;
5134	+	ExecQuery;
5135	+	try
5136	+	Result := Fields[0].AsInteger
5137	+	finally
5138	+	Close
5139	+	end;
5140	+	end;
5141	+	end;
5142	+
5143	+	constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
5144	+	begin
5145	+	FOwner := Owner;
5146	+	FIncrement := 1;
5147	+	FQuery := TIBSQL.Create(nil);
5148	+	end;
5149	+
5150	+	destructor TIBGenerator.Destroy;
5151	+	begin
5152	+	if assigned(FQuery) then FQuery.Free;
5153	+	inherited Destroy;
5154	+	end;
5155	+
5156	+
5157	+	procedure TIBGenerator.Apply;
5158	+	begin
5159	+	if assigned(Database) and assigned(Transaction) and
5160	+	(FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5161	+	Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5162	+	end;
5163	+
5164	+
5165		end.

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents): Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs. Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

Diff Legend

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC