[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 45 by tony, Tue Dec 6 10:33:46 2016 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;
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(Query: TIBSQL; buff: PChar);
78		property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
79		public
80		constructor Create(AOwner: TComponent); override;
#	Line 60 \| Line 83 \| type
83		property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
84		end;
85
63	–	PDateTime = ^TDateTime;
86		TBlobDataArray = array[0..0] of TIBBlobStream;
87		PBlobDataArray = ^TBlobDataArray;
88	+	TIBArrayField = class;
89
90	<	{ TIBCustomDataSet }
91	<	TFieldData = record
92	<	fdDataType: Short;
93	<	fdDataScale: Short;
94	<	fdNullable: Boolean;
95	<	fdIsNull: Boolean;
96	<	fdDataSize: Short;
97	<	fdDataLength: Short;
98	<	fdDataOfs: Integer;
90	>	{ TIBArray }
91	>
92	>	{Wrapper class to support array cache in TIBCustomDataset and event handling}
93	>
94	>	TIBArray = class
95	>	private
96	>	FArray: IArray;
97	>	FRecNo: integer;
98	>	FField: TIBArrayField;
99	>	procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
100	>	public
101	>	constructor Create(aField: TIBArrayField; anArray: IArray);
102	>	destructor Destroy; override;
103	>	property ArrayIntf: IArray read FArray;
104		end;
105	<	PFieldData = ^TFieldData;
105	>
106	>	TArrayDataArray = array [0..0] of TIBArray;
107	>	PArrayDataArray = ^TArrayDataArray;
108	>
109	>	{ TIBCustomDataSet }
110
111		TCachedUpdateStatus = (
112		cusUnmodified, cusModified, cusInserted,
#	Line 85 \| Line 117 \| type
117		end;
118		PIBDBKey = ^TIBDBKey;
119
120	+	PFieldData = ^TFieldData;
121	+	TFieldData = record
122	+	fdIsNull: Boolean;
123	+	fdDataLength: Short;
124	+	end;
125	+
126	+	PColumnData = ^TColumnData;
127	+	TColumnData = record
128	+	fdDataType: Short;
129	+	fdDataScale: Short;
130	+	fdNullable: Boolean;
131	+	fdDataSize: Short;
132	+	fdDataOfs: Integer;
133	+	fdCodePage: TSystemCodePage;
134	+	end;
135	+
136	+	PFieldColumns = ^TFieldColumns;
137	+	TFieldColumns = array[1..1] of TColumnData;
138	+
139		TRecordData = record
140		rdBookmarkFlag: TBookmarkFlag;
141		rdFieldCount: Short;
142	<	rdRecordNumber: Long;
142	>	rdRecordNumber: Integer;
143		rdCachedUpdateStatus: TCachedUpdateStatus;
144		rdUpdateStatus: TUpdateStatus;
145		rdSavedOffset: DWORD;
#	Line 97 \| Line 148 \| type
148		end;
149		PRecordData = ^TRecordData;
150
151	+	{ TIBArrayField }
152	+
153	+	TIBArrayField = class(TField)
154	+	private
155	+	FArrayBounds: TArrayBounds;
156	+	FArrayDimensions: integer;
157	+	FRelationName: string;
158	+	FCacheOffset: word;
159	+	function GetArrayID: TISC_QUAD;
160	+	function GetArrayIntf: IArray;
161	+	procedure SetArrayIntf(AValue: IArray);
162	+	protected
163	+	class procedure CheckTypeSize(AValue: Longint); override;
164	+	function GetAsString: string; override;
165	+	function GetDataSize: Integer; override;
166	+	procedure Bind(Binding: Boolean); override;
167	+	public
168	+	constructor Create(AOwner: TComponent); override;
169	+	function CreateArray: IArray;
170	+	property ArrayID: TISC_QUAD read GetArrayID;
171	+	property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
172	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
173	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
174	+	end;
175	+
176		{ TIBStringField allows us to have strings longer than 8196 }
177
178		TIBStringField = class(TStringField)
179	+	private
180	+	FCharacterSetName: RawByteString;
181	+	FCharacterSetSize: integer;
182	+	FAutoFieldSize: boolean;
183	+	FCodePage: TSystemCodePage;
184	+	protected
185	+	procedure Bind(Binding: Boolean); override;
186	+	function GetDataSize: Integer; override;
187		public
188	<	constructor create(AOwner: TComponent); override;
188	>	constructor Create(aOwner: TComponent); override;
189		class procedure CheckTypeSize(Value: Integer); override;
190		function GetAsString: string; override;
191		function GetAsVariant: Variant; override;
192		function GetValue(var Value: string): Boolean;
193		procedure SetAsString(const Value: string); override;
194	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
195	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
196	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
197	+	published
198	+	property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
199		end;
200
201		{ TIBBCDField }
#	Line 129 \| Line 218 \| type
218		property Size default 8;
219		end;
220
221	+	{TIBMemoField}
222	+	{Allows us to show truncated text in DBGrids and anything else that uses
223	+	DisplayText}
224	+
225	+	TIBMemoField = class(TMemoField)
226	+	private
227	+	FCharacterSetName: RawByteString;
228	+	FCharacterSetSize: integer;
229	+	FDisplayTextAsClassName: boolean;
230	+	function GetTruncatedText: string;
231	+	protected
232	+	procedure Bind(Binding: Boolean); override;
233	+	function GetAsString: string; override;
234	+	function GetDefaultWidth: Longint; override;
235	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
236	+	procedure SetAsString(const AValue: string); override;
237	+	public
238	+	constructor Create(AOwner: TComponent); override;
239	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
240	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
241	+	published
242	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
243	+	write FDisplayTextAsClassName;
244	+	private
245	+	FCodePage: TSystemCodePage;
246	+	FFCodePage: TSystemCodePage;
247	+	public
248	+	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
249	+	end;
250	+
251		TIBDataLink = class(TDetailDataLink)
252		private
253		FDataSet: TIBCustomDataSet;
#	Line 142 \| Line 261 \| type
261		destructor Destroy; override;
262		end;
263
264	+	TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
265	+
266	+	{ TIBGenerator }
267	+
268	+	TIBGenerator = class(TPersistent)
269	+	private
270	+	FOwner: TIBCustomDataSet;
271	+	FApplyOnEvent: TIBGeneratorApplyOnEvent;
272	+	FFieldName: string;
273	+	FGeneratorName: string;
274	+	FIncrement: integer;
275	+	procedure SetIncrement(const AValue: integer);
276	+	protected
277	+	function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
278	+	public
279	+	constructor Create(Owner: TIBCustomDataSet);
280	+	procedure Apply;
281	+	property Owner: TIBCustomDataSet read FOwner;
282	+	published
283	+	property Generator: string read FGeneratorName write FGeneratorName;
284	+	property Field: string read FFieldName write FFieldName;
285	+	property Increment: integer read FIncrement write SetIncrement default 1;
286	+	property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
287	+	end;
288	+
289	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
290	+
291	+	TIBControlLink = class
292	+	private
293	+	FTIBDataSet: TIBCustomDataSet;
294	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
295	+	protected
296	+	procedure UpdateSQL(Sender: TObject); virtual;
297	+	procedure UpdateParams(Sender: TObject); virtual;
298	+	public
299	+	destructor Destroy; override;
300	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
301	+	end;
302	+
303	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
304	+
305		{ TIBCustomDataSet }
306	+
307		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
308
309		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
310	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
310	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
311		of object;
312		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
313		var UpdateAction: TIBUpdateAction) of object;
314
315		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
316
317	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
318	+
319	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
320	+
321		TIBCustomDataSet = class(TDataset)
322		private
323	+	FAllowAutoActivateTransaction: Boolean;
324	+	FArrayFieldCount: integer;
325	+	FArrayCacheOffset: integer;
326	+	FAutoCommit: TIBAutoCommit;
327	+	FGenerateParamNames: Boolean;
328	+	FGeneratorField: TIBGenerator;
329		FNeedsRefresh: Boolean;
330		FForcedRefresh: Boolean;
331		FDidActivate: Boolean;
161	–	FIBLoaded: Boolean;
332		FBase: TIBBase;
333		FBlobCacheOffset: Integer;
334		FBlobStreamList: TList;
335	+	FArrayList: TList;
336		FBufferChunks: Integer;
337		FBufferCache,
338		FOldBufferCache: PChar;
#	Line 179 \| Line 350 \| type
350		FDeletedRecords: Long;
351		FModelBuffer,
352		FOldBuffer: PChar;
353	+	FOnValidatePost: TOnValidatePost;
354		FOpen: Boolean;
355		FInternalPrepared: Boolean;
356		FQDelete,
#	Line 189 \| Line 361 \| type
361		FRecordBufferSize: Integer;
362		FRecordCount: Integer;
363		FRecordSize: Integer;
364	+	FDataSetCloseAction: TDataSetCloseAction;
365		FUniDirectional: Boolean;
366		FUpdateMode: TUpdateMode;
367		FUpdateObject: TIBDataSetUpdateObject;
#	Line 206 \| Line 379 \| type
379		FBeforeTransactionEnd,
380		FAfterTransactionEnd,
381		FTransactionFree: TNotifyEvent;
382	<
383	<	function GetSelectStmtHandle: TISC_STMT_HANDLE;
382	>	FAliasNameMap: array of string;
383	>	FAliasNameList: array of string;
384	>	FBaseSQLSelect: TStrings;
385	>	FParser: TSelectSQLParser;
386	>	FCloseAction: TTransactionAction;
387	>	FInTransactionEnd: boolean;
388	>	FIBLinks: TList;
389	>	FFieldColumns: PFieldColumns;
390	>	procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
391	>	function GetSelectStmtIntf: IStatement;
392		procedure SetUpdateMode(const Value: TUpdateMode);
393		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
394
#	Line 219 \| Line 400 \| type
400		function CanRefresh: Boolean;
401		procedure CheckEditState;
402		procedure ClearBlobCache;
403	+	procedure ClearArrayCache;
404	+	procedure ClearIBLinks;
405		procedure CopyRecordBuffer(Source, Dest: Pointer);
406		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
407		procedure DoAfterDatabaseDisconnect(Sender: TObject);
408		procedure DoDatabaseFree(Sender: TObject);
409	<	procedure DoBeforeTransactionEnd(Sender: TObject);
409	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
410		procedure DoAfterTransactionEnd(Sender: TObject);
411		procedure DoTransactionFree(Sender: TObject);
412		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
413		Buffer: PChar);
414		function GetDatabase: TIBDatabase;
232	–	function GetDBHandle: PISC_DB_HANDLE;
415		function GetDeleteSQL: TStrings;
416		function GetInsertSQL: TStrings;
417	<	function GetSQLParams: TIBXSQLDA;
417	>	function GetSQLParams: ISQLParams;
418		function GetRefreshSQL: TStrings;
419		function GetSelectSQL: TStrings;
420	<	function GetStatementType: TIBSQLTypes;
420	>	function GetStatementType: TIBSQLStatementTypes;
421		function GetModifySQL: TStrings;
422		function GetTransaction: TIBTransaction;
423	<	function GetTRHandle: PISC_TR_HANDLE;
424	<	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
423	>	function GetParser: TSelectSQLParser;
424	>	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
425		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
426		Options: TLocateOptions): Boolean; virtual;
427	<	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
428	<	procedure InternalRevertRecord(RecordNumber: Integer);
427	>	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
428	>	procedure InternalRevertRecord(RecordNumber: Integer); virtual;
429		function IsVisible(Buffer: PChar): Boolean;
430	+	procedure RegisterIBLink(Sender: TIBControlLink);
431	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
432		procedure SaveOldBuffer(Buffer: PChar);
433		procedure SetBufferChunks(Value: Integer);
434		procedure SetDatabase(Value: TIBDatabase);
#	Line 258 \| Line 442 \| type
442		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
443		procedure SetUniDirectional(Value: Boolean);
444		procedure RefreshParams;
261	–	procedure SQLChanging(Sender: TObject); virtual;
445		function AdjustPosition(FCache: PChar; Offset: DWORD;
446	<	Origin: Integer): Integer;
446	>	Origin: Integer): DWORD;
447		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
448		Buffer: PChar);
449		procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
#	Line 269 \| Line 452 \| type
452		Buffer: PChar);
453		procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
454		function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
455	<	DoCheck: Boolean): TGetResult;
455	>	DoCheck: Boolean): TGetResult; virtual;
456
457		protected
458		procedure ActivateConnection;
#	Line 277 \| Line 460 \| type
460		procedure DeactivateTransaction;
461		procedure CheckDatasetClosed;
462		procedure CheckDatasetOpen;
463	+	function CreateParser: TSelectSQLParser; virtual;
464	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
465		function GetActiveBuf: PChar;
466	<	procedure InternalBatchInput(InputObject: TIBBatchInput);
467	<	procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
466	>	procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
467	>	procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
468		procedure InternalPrepare; virtual;
469		procedure InternalUnPrepare; virtual;
470		procedure InternalExecQuery; virtual;
471		procedure InternalRefreshRow; virtual;
472	<	procedure InternalSetParamsFromCursor;
472	>	procedure InternalSetParamsFromCursor; virtual;
473		procedure CheckNotUniDirectional;
474	+	procedure SQLChanging(Sender: TObject); virtual;
475	+	procedure SQLChanged(Sender: TObject); virtual;
476
477		{ IProviderSupport }
478		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 309 \| Line 496 \| type
496		procedure ClearCalcFields(Buffer: PChar); override;
497		function AllocRecordBuffer: PChar; override;
498		procedure DoBeforeDelete; override;
499	+	procedure DoAfterDelete; override;
500		procedure DoBeforeEdit; override;
501	+	procedure DoAfterEdit; override;
502		procedure DoBeforeInsert; override;
503	+	procedure DoAfterInsert; override;
504	+	procedure DoBeforeClose; override;
505	+	procedure DoBeforeOpen; override;
506	+	procedure DoBeforePost; override;
507	+	procedure DoAfterPost; override;
508		procedure FreeRecordBuffer(var Buffer: PChar); override;
509		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
510		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
511		function GetCanModify: Boolean; override;
512		function GetDataSource: TDataSource; override;
513	+	function GetDBAliasName(FieldNo: integer): string;
514	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
515		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
516		function GetRecNo: Integer; override;
517		function GetRecord(Buffer: PChar; GetMode: TGetMode;
518		DoCheck: Boolean): TGetResult; override;
519		function GetRecordCount: Integer; override;
520		function GetRecordSize: Word; override;
521	+	procedure InternalAutoCommit;
522		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
523		procedure InternalCancel; override;
524		procedure InternalClose; override;
525		procedure InternalDelete; override;
526		procedure InternalFirst; override;
527	<	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
527	>	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
528		procedure InternalGotoBookmark(Bookmark: Pointer); override;
529		procedure InternalHandleException; override;
530		procedure InternalInitFieldDefs; override;
#	Line 336 \| Line 533 \| type
533		procedure InternalOpen; override;
534		procedure InternalPost; override;
535		procedure InternalRefresh; override;
536	<	procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
536	>	procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
537		procedure InternalSetToRecord(Buffer: PChar); override;
538		function IsCursorOpen: Boolean; override;
539	+	procedure Loaded; override;
540		procedure ReQuery;
541		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
542		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
543		procedure SetCachedUpdates(Value: Boolean);
544		procedure SetDataSource(Value: TDataSource);
545	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
546		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
547		procedure SetFieldData(Field : TField; Buffer : Pointer;
548		NativeFormat : Boolean); overload; override;
#	Line 351 \| Line 550 \| type
550
551		protected
552		{Likely to be made public by descendant classes}
553	<	property SQLParams: TIBXSQLDA read GetSQLParams;
554	<	property Params: TIBXSQLDA read GetSQLParams;
553	>	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
554	>	property SQLParams: ISQLParams read GetSQLParams;
555	>	property Params: ISQLParams read GetSQLParams;
556		property InternalPrepared: Boolean read FInternalPrepared;
557		property QDelete: TIBSQL read FQDelete;
558		property QInsert: TIBSQL read FQInsert;
559		property QRefresh: TIBSQL read FQRefresh;
560		property QSelect: TIBSQL read FQSelect;
561		property QModify: TIBSQL read FQModify;
562	<	property StatementType: TIBSQLTypes read GetStatementType;
563	<	property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
562	>	property StatementType: TIBSQLStatementTypes read GetStatementType;
563	>	property SelectStmtHandle: IStatement read GetSelectStmtIntf;
564
565		{Likely to be made published by descendant classes}
566		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
567		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
568		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
569	+	property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
570		property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
571		property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
572		property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
#	Line 373 \| Line 574 \| type
574		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
575		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
576		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
577	+	property Parser: TSelectSQLParser read GetParser;
578	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
579
580		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
581		write FBeforeDatabaseDisconnect;
#	Line 386 \| Line 589 \| type
589		write FAfterTransactionEnd;
590		property TransactionFree: TNotifyEvent read FTransactionFree
591		write FTransactionFree;
592	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
593
594		public
595		constructor Create(AOwner: TComponent); override;
#	Line 393 \| Line 597 \| type
597		procedure ApplyUpdates;
598		function CachedUpdateStatus: TCachedUpdateStatus;
599		procedure CancelUpdates;
600	+	function GetFieldPosition(AliasName: string): integer;
601		procedure FetchAll;
602		function LocateNext(const KeyFields: string; const KeyValues: Variant;
603		Options: TLocateOptions): Boolean;
604		procedure RecordModified(Value: Boolean);
605		procedure RevertRecord;
606		procedure Undelete;
607	+	procedure ResetParser; virtual;
608	+	function HasParser: boolean;
609
610		{ TDataSet support methods }
611		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
612		function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
613		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
614	+	function GetArray(Field: TIBArrayField): IArray;
615	+	procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
616		function GetCurrentRecord(Buffer: PChar): Boolean; override;
617		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
618	<	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
618	>	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (override;)
619		function GetFieldData(Field : TField; Buffer : Pointer;
620		NativeFormat : Boolean) : Boolean; overload; override;
621	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
622		function Locate(const KeyFields: string; const KeyValues: Variant;
623		Options: TLocateOptions): Boolean; override;
624		function Lookup(const KeyFields: string; const KeyValues: Variant;
625		const ResultFields: string): Variant; override;
626		function UpdateStatus: TUpdateStatus; override;
627		function IsSequenced: Boolean; override;
628	<
629	<	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
630	<	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
628	>	procedure Post; override;
629	>	function ParamByName(ParamName: String): ISQLParam;
630	>	property ArrayFieldCount: integer read FArrayFieldCount;
631		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
632		property UpdatesPending: Boolean read FUpdatesPending;
633		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
634		write SetUpdateRecordTypes;
635	+	property DataSetCloseAction: TDataSetCloseAction
636	+	read FDataSetCloseAction write FDataSetCloseAction;
637
638		published
639	+	property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
640	+	write FAllowAutoActivateTransaction;
641		property Database: TIBDatabase read GetDatabase write SetDatabase;
642		property Transaction: TIBTransaction read GetTransaction
643		write SetTransaction;
644		property ForcedRefresh: Boolean read FForcedRefresh
645		write FForcedRefresh default False;
646		property AutoCalcFields;
433	–	property ObjectView default False;
647
648		property AfterCancel;
649		property AfterClose;
#	Line 461 \| Line 674 \| type
674		write FOnUpdateRecord;
675		end;
676
677	<	TIBDataSet = class(TIBCustomDataSet)
677	>	TIBParserDataSet = class(TIBCustomDataSet)
678	>	public
679	>	property Parser;
680	>	end;
681	>
682	>	TIBDataSet = class(TIBParserDataSet)
683		private
684		function GetPrepared: Boolean;
685
#	Line 486 \| Line 704 \| type
704		property QModify;
705		property StatementType;
706		property SelectStmtHandle;
707	+	property BaseSQLSelect;
708
709		published
710		{ TIBCustomDataSet }
711	+	property AutoCommit;
712		property BufferChunks;
713		property CachedUpdates;
714		property DeleteSQL;
#	Line 496 \| Line 716 \| type
716		property RefreshSQL;
717		property SelectSQL;
718		property ModifySQL;
719	+	property GeneratorField;
720	+	property GenerateParamNames;
721		property ParamCheck;
722		property UniDirectional;
723		property Filtered;
724	+	property DataSetCloseAction;
725
726		property BeforeDatabaseDisconnect;
727		property AfterDatabaseDisconnect;
#	Line 534 \| Line 757 \| type
757		property OnFilterRecord;
758		property OnNewRecord;
759		property OnPostError;
760	+	property OnValidatePost;
761		end;
762
763		{ TIBDSBlobStream }
764		TIBDSBlobStream = class(TStream)
765	+	private
766	+	FHasWritten: boolean;
767		protected
768		FField: TField;
769		FBlobStream: TIBBlobStream;
770	+	function GetSize: Int64; override;
771		public
772		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
773		Mode: TBlobStreamMode);
774	+	destructor Destroy; override;
775		function Read(var Buffer; Count: Longint): Longint; override;
776		function Seek(Offset: Longint; Origin: Word): Longint; override;
777		procedure SetSize(NewSize: Longint); override;
778		function Write(const Buffer; Count: Longint): Longint; override;
779		end;
780
781	+	{Extended Field Def for character set info}
782	+
783	+	{ TIBFieldDef }
784	+
785	+	TIBFieldDef = class(TFieldDef)
786	+	private
787	+	FArrayBounds: TArrayBounds;
788	+	FArrayDimensions: integer;
789	+	FCharacterSetName: RawByteString;
790	+	FCharacterSetSize: integer;
791	+	FCodePage: TSystemCodePage;
792	+	FRelationName: string;
793	+	published
794	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
795	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
796	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
797	+	property RelationName: string read FRelationName write FRelationName;
798	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
799	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
800	+	end;
801	+
802		const
803		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
804		nil, { ftUnknown }
#	Line 568 \| Line 817 \| DefaultFieldClasses: array[TFieldType] o
817		TVarBytesField, { ftVarBytes }
818		TAutoIncField, { ftAutoInc }
819		TBlobField, { ftBlob }
820	<	TMemoField, { ftMemo }
820	>	TIBMemoField, { ftMemo }
821		TGraphicField, { ftGraphic }
822		TBlobField, { ftFmtMemo }
823		TBlobField, { ftParadoxOle }
#	Line 576 \| Line 825 \| DefaultFieldClasses: array[TFieldType] o
825		TBlobField, { ftTypedBinary }
826		nil, { ftCursor }
827		TStringField, { ftFixedChar }
828	<	nil, {TWideStringField } { ftWideString }
828	>	nil, { ftWideString }
829		TLargeIntField, { ftLargeInt }
830	+	nil, { ftADT }
831	+	TIBArrayField, { ftArray }
832	+	nil, { ftReference }
833	+	nil, { ftDataSet }
834	+	TBlobField, { ftOraBlob }
835	+	TMemoField, { ftOraClob }
836	+	TVariantField, { ftVariant }
837	+	nil, { ftInterface }
838	+	nil, { ftIDispatch }
839	+	TGuidField, { ftGuid }
840	+	TDateTimeField, {ftTimestamp}
841	+	TIBBCDField, {ftFMTBcd}
842	+	nil, {ftFixedWideChar}
843	+	nil); {ftWideMemo}
844	+	(*
845		TADTField, { ftADT }
846		TArrayField, { ftArray }
847		TReferenceField, { ftReference }
#	Line 587 \| Line 851 \| DefaultFieldClasses: array[TFieldType] o
851		TVariantField, { ftVariant }
852		TInterfaceField, { ftInterface }
853		TIDispatchField, { ftIDispatch }
854	<	TGuidField); { ftGuid }
855	<	var
856	<	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
854	>	TGuidField); { ftGuid } *)
855	>	(*var
856	>	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
857
858		implementation
859
860	<	uses IBIntf, IBQuery;
860	>	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
861	>
862	>	const FILE_BEGIN = 0;
863	>	FILE_CURRENT = 1;
864	>	FILE_END = 2;
865
866		type
867
#	Line 613 \| Line 881 \| type
881		end;
882
883
884	+	{ Copied from LCLProc in order to avoid LCL dependency
885	+
886	+	Ensures the covenient look of multiline string
887	+	when displaying it in the single line
888	+	* Replaces CR and LF with spaces
889	+	* Removes duplicate spaces
890	+	}
891	+	function TextToSingleLine(const AText: string): string;
892	+	var
893	+	str: string;
894	+	i, wstart, wlen: Integer;
895	+	begin
896	+	str := Trim(AText);
897	+	wstart := 0;
898	+	wlen := 0;
899	+	i := 1;
900	+	while i < Length(str) - 1 do
901	+	begin
902	+	if (str[i] in [' ', #13, #10]) then
903	+	begin
904	+	if (wstart = 0) then
905	+	begin
906	+	wstart := i;
907	+	wlen := 1;
908	+	end else
909	+	Inc(wlen);
910	+	end else
911	+	begin
912	+	if wstart > 0 then
913	+	begin
914	+	str[wstart] := ' ';
915	+	Delete(str, wstart+1, wlen-1);
916	+	Dec(i, wlen-1);
917	+	wstart := 0;
918	+	end;
919	+	end;
920	+	Inc(i);
921	+	end;
922	+	Result := str;
923	+	end;
924	+
925	+	{ TIBArray }
926	+
927	+	procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
928	+	begin
929	+	case Reason of
930	+	arChanging:
931	+	if FRecNo <> FField.Dataset.RecNo then
932	+	IBError(ibxeNotCurrentArray,[nil]);
933	+
934	+	arChanged:
935	+	FField.DataChanged;
936	+	end;
937	+	end;
938	+
939	+	constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
940	+	begin
941	+	inherited Create;
942	+	FField := aField;
943	+	FArray := anArray;
944	+	FRecNo := FField.Dataset.RecNo;
945	+	FArray.AddEventHandler(EventHandler);
946	+	end;
947	+
948	+	destructor TIBArray.Destroy;
949	+	begin
950	+	FArray.RemoveEventHandler(EventHandler);
951	+	inherited Destroy;
952	+	end;
953	+
954	+	{ TIBArrayField }
955	+
956	+	function TIBArrayField.GetArrayIntf: IArray;
957	+	begin
958	+	Result := TIBCustomDataSet(DataSet).GetArray(self);
959	+	end;
960	+
961	+	function TIBArrayField.GetArrayID: TISC_QUAD;
962	+	begin
963	+	GetData(@Result);
964	+	end;
965	+
966	+	procedure TIBArrayField.SetArrayIntf(AValue: IArray);
967	+	begin
968	+	TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
969	+	DataChanged;
970	+	end;
971	+
972	+	class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
973	+	begin
974	+	//Ignore
975	+	end;
976	+
977	+	function TIBArrayField.GetAsString: string;
978	+	begin
979	+	Result := '(Array)';
980	+	end;
981	+
982	+	function TIBArrayField.GetDataSize: Integer;
983	+	begin
984	+	Result := sizeof(TISC_QUAD);
985	+	end;
986	+
987	+	procedure TIBArrayField.Bind(Binding: Boolean);
988	+	begin
989	+	inherited Bind(Binding);
990	+	if Binding then
991	+	begin
992	+	FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
993	+	Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
994	+	if FieldDef <> nil then
995	+	begin
996	+	FRelationName := TIBFieldDef(FieldDef).FRelationName;
997	+	FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
998	+	FArrayBounds := TIBFieldDef(FieldDef).ArrayBounds;
999	+	end;
1000	+	end;
1001	+	end;
1002	+
1003	+	constructor TIBArrayField.Create(AOwner: TComponent);
1004	+	begin
1005	+	inherited Create(AOwner);
1006	+	SetDataType(ftArray);
1007	+	end;
1008	+
1009	+	function TIBArrayField.CreateArray: IArray;
1010	+	begin
1011	+	with DataSet as TIBCustomDataSet do
1012	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1013	+	end;
1014	+
1015	+	{ TIBMemoField }
1016	+
1017	+	function TIBMemoField.GetTruncatedText: string;
1018	+	begin
1019	+	Result := GetAsString;
1020	+
1021	+	if Result <> '' then
1022	+	begin
1023	+	case CharacterSetSize of
1024	+	1:
1025	+	if DisplayWidth = 0 then
1026	+	Result := TextToSingleLine(Result)
1027	+	else
1028	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
1029	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1030	+
1031	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
1032	+
1033	+	3, {Assume UNICODE_FSS is really UTF8}
1034	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1035	+	if DisplayWidth = 0 then
1036	+	Result := ValidUTF8String(TextToSingleLine(Result))
1037	+	else
1038	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1039	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1040	+	end;
1041	+	end
1042	+	end;
1043	+
1044	+	procedure TIBMemoField.Bind(Binding: Boolean);
1045	+	var IBFieldDef: TIBFieldDef;
1046	+	begin
1047	+	inherited Bind(Binding);
1048	+	if Binding and (FieldDef <> nil) then
1049	+	begin
1050	+	IBFieldDef := FieldDef as TIBFieldDef;
1051	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
1052	+	CharacterSetName := IBFieldDef.CharacterSetName;
1053	+	CodePage := IBFieldDef.CodePage;
1054	+	end;
1055	+	end;
1056	+
1057	+	function TIBMemoField.GetAsString: string;
1058	+	var s: RawByteString;
1059	+	begin
1060	+	s := inherited GetAsString;
1061	+	SetCodePage(s,CodePage,false);
1062	+	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1063	+	SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
1064	+	Result := s;
1065	+	end;
1066	+
1067	+	function TIBMemoField.GetDefaultWidth: Longint;
1068	+	begin
1069	+	if DisplayTextAsClassName then
1070	+	Result := inherited
1071	+	else
1072	+	Result := 128;
1073	+	end;
1074	+
1075	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1076	+	begin
1077	+	if ADisplayText then
1078	+	begin
1079	+	if not DisplayTextAsClassName and (CharacterSetName <> '') then
1080	+	AText := GetTruncatedText
1081	+	else
1082	+	inherited GetText(AText, ADisplayText);
1083	+	end
1084	+	else
1085	+	AText := GetAsString;
1086	+	end;
1087	+
1088	+	procedure TIBMemoField.SetAsString(const AValue: string);
1089	+	var s: RawByteString;
1090	+	begin
1091	+	s := AValue;
1092	+	if StringCodePage(Value) <> CodePage then
1093	+	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1094	+	inherited SetAsString(s);
1095	+	end;
1096	+
1097	+	constructor TIBMemoField.Create(AOwner: TComponent);
1098	+	begin
1099	+	inherited Create(AOwner);
1100	+	BlobType := ftMemo;
1101	+	FCodePage := CP_NONE;
1102	+	end;
1103	+
1104	+	{ TIBControlLink }
1105	+
1106	+	destructor TIBControlLink.Destroy;
1107	+	begin
1108	+	IBDataSet := nil;
1109	+	inherited Destroy;
1110	+	end;
1111	+
1112	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
1113	+	begin
1114	+
1115	+	end;
1116	+
1117	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
1118	+	begin
1119	+
1120	+	end;
1121	+
1122	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1123	+	begin
1124	+	if FTIBDataSet = AValue then Exit;
1125	+	if IBDataSet <> nil then
1126	+	IBDataSet.UnRegisterIBLink(self);
1127	+	FTIBDataSet := AValue;
1128	+	if IBDataSet <> nil then
1129	+	IBDataSet.RegisterIBLink(self);
1130	+	end;
1131	+
1132	+
1133		{ TIBStringField}
1134
1135	<	constructor TIBStringField.Create(AOwner: TComponent);
1135	>	procedure TIBStringField.Bind(Binding: Boolean);
1136	>	var IBFieldDef: TIBFieldDef;
1137	>	begin
1138	>	inherited Bind(Binding);
1139	>	if Binding and (FieldDef <> nil) then
1140	>	begin
1141	>	IBFieldDef := FieldDef as TIBFieldDef;
1142	>	CharacterSetSize := IBFieldDef.CharacterSetSize;
1143	>	CharacterSetName := IBFieldDef.CharacterSetName;
1144	>	if AutoFieldSize then
1145	>	Size := IBFieldDef.Size;
1146	>	CodePage := IBFieldDef.CodePage;
1147	>	end;
1148	>	end;
1149	>
1150	>	function TIBStringField.GetDataSize: Integer;
1151	>	begin
1152	>	Result := Size * CharacterSetSize + 1;
1153	>	end;
1154	>
1155	>	constructor TIBStringField.Create(aOwner: TComponent);
1156		begin
1157	<	inherited;
1157	>	inherited Create(aOwner);
1158	>	FCharacterSetSize := 1;
1159	>	FCodePage := CP_NONE;
1160	>	FAutoFieldSize := true;
1161		end;
1162
1163		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 640 \| Line 1180 \| end;
1180		function TIBStringField.GetValue(var Value: string): Boolean;
1181		var
1182		Buffer: PChar;
1183	+	s: RawByteString;
1184		begin
1185		Buffer := nil;
1186	<	IBAlloc(Buffer, 0, Size + 1);
1186	>	IBAlloc(Buffer, 0, DataSize);
1187		try
1188		Result := GetData(Buffer);
1189		if Result then
1190		begin
1191	<	Value := string(Buffer);
1191	>	s := strpas(Buffer);
1192	>	SetCodePage(s,CodePage,false);
1193	>	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1194	>	SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
1195	>	Value := s;
1196	>	// writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1197		if Transliterate and (Value <> '') then
1198		DataSet.Translate(PChar(Value), PChar(Value), False);
1199		end
#	Line 659 \| Line 1205 \| end;
1205		procedure TIBStringField.SetAsString(const Value: string);
1206		var
1207		Buffer: PChar;
1208	+	s: RawByteString;
1209		begin
1210		Buffer := nil;
1211		IBAlloc(Buffer, 0, Size + 1);
1212		try
1213	<	StrLCopy(Buffer, PChar(Value), Size);
1213	>	s := Value;
1214	>	if StringCodePage(s) <> CodePage then
1215	>	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1216	>	StrLCopy(Buffer, PChar(s), Size);
1217		if Transliterate then
1218		DataSet.Translate(Buffer, Buffer, True);
1219		SetData(Buffer);
#	Line 672 \| Line 1222 \| begin
1222		end;
1223		end;
1224
1225	+
1226		{ TIBBCDField }
1227
1228		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 714 \| Line 1265 \| end;
1265
1266		function TIBBCDField.GetDataSize: Integer;
1267		begin
1268	+	{$IFDEF TBCDFIELD_IS_BCD}
1269		Result := 8;
1270	+	{$ELSE}
1271	+	Result := inherited GetDataSize
1272	+	{$ENDIF}
1273		end;
1274
1275		{ TIBDataLink }
#	Line 728 \| Line 1283 \| end;
1283		destructor TIBDataLink.Destroy;
1284		begin
1285		FDataSet.FDataLink := nil;
1286	<	inherited;
1286	>	inherited Destroy;
1287		end;
1288
1289
#	Line 760 \| Line 1315 \| end;
1315
1316		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1317		begin
1318	<	inherited;
764	<	FIBLoaded := False;
765	<	CheckIBLoaded;
766	<	FIBLoaded := True;
1318	>	inherited Create(AOwner);
1319		FBase := TIBBase.Create(Self);
1320	+	FIBLinks := TList.Create;
1321		FCurrentRecord := -1;
1322		FDeletedRecords := 0;
1323		FUniDirectional := False;
1324		FBufferChunks := BufferCacheSize;
1325		FBlobStreamList := TList.Create;
1326	+	FArrayList := TList.Create;
1327	+	FGeneratorField := TIBGenerator.Create(self);
1328		FDataLink := TIBDataLink.Create(Self);
1329		FQDelete := TIBSQL.Create(Self);
1330		FQDelete.OnSQLChanging := SQLChanging;
#	Line 782 \| Line 1337 \| begin
1337		FQRefresh.GoToFirstRecordOnExecute := False;
1338		FQSelect := TIBSQL.Create(Self);
1339		FQSelect.OnSQLChanging := SQLChanging;
1340	+	FQSelect.OnSQLChanged := SQLChanged;
1341		FQSelect.GoToFirstRecordOnExecute := False;
1342		FQModify := TIBSQL.Create(Self);
1343		FQModify.OnSQLChanging := SQLChanging;
1344		FQModify.GoToFirstRecordOnExecute := False;
1345		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1346		FParamCheck := True;
1347	+	FGenerateParamNames := False;
1348		FForcedRefresh := False;
1349	+	FAutoCommit:= acDisabled;
1350	+	FDataSetCloseAction := dcDiscardChanges;
1351		{Bookmark Size is Integer for IBX}
1352		BookmarkSize := SizeOf(Integer);
1353		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 802 \| Line 1361 \| begin
1361		else
1362		if AOwner is TIBTransaction then
1363		Transaction := TIBTransaction(AOwner);
1364	+	FBaseSQLSelect := TStringList.Create;
1365		end;
1366
1367		destructor TIBCustomDataSet.Destroy;
1368		begin
1369	<	inherited;
1370	<	if FIBLoaded then
1371	<	begin
1372	<	FDataLink.Free;
1373	<	FBase.Free;
1374	<	ClearBlobCache;
1375	<	FBlobStreamList.Free;
1376	<	FreeMem(FBufferCache);
1377	<	FBufferCache := nil;
1378	<	FreeMem(FOldBufferCache);
1379	<	FOldBufferCache := nil;
1380	<	FCacheSize := 0;
1381	<	FOldCacheSize := 0;
1382	<	FMappedFieldPosition := nil;
1383	<	end;
1369	>	if Active then Active := false;
1370	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1371	>	FDataLink.Free;
1372	>	FBase.Free;
1373	>	ClearBlobCache;
1374	>	ClearIBLinks;
1375	>	FIBLinks.Free;
1376	>	FBlobStreamList.Free;
1377	>	FArrayList.Free;
1378	>	FreeMem(FBufferCache);
1379	>	FBufferCache := nil;
1380	>	FreeMem(FOldBufferCache);
1381	>	FOldBufferCache := nil;
1382	>	FCacheSize := 0;
1383	>	FOldCacheSize := 0;
1384	>	FMappedFieldPosition := nil;
1385	>	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1386	>	if assigned(FParser) then FParser.Free;
1387	>	inherited Destroy;
1388		end;
1389
1390		function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
#	Line 842 \| Line 1406 \| begin
1406		Inc(FCurrentRecord);
1407		if (FCurrentRecord = FRecordCount) then
1408		begin
1409	<	if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1409	>	if (not FQSelect.EOF) and FQSelect.Next then
1410		begin
1411		FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1412		Inc(FRecordCount);
#	Line 861 \| Line 1425 \| end;
1425
1426		procedure TIBCustomDataSet.ApplyUpdates;
1427		var
1428	<	CurBookmark: string;
1428	>	CurBookmark: TBookmark;
1429		Buffer: PRecordData;
1430		CurUpdateTypes: TIBUpdateRecordTypes;
1431		UpdateAction: TIBUpdateAction;
#	Line 921 \| Line 1485 \| var
1485		procedure UpdateUsingUpdateObject;
1486		begin
1487		try
1488	<	FUpdateObject.Apply(UpdateKind);
1488	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1489		ResetBufferUpdateStatus;
1490		except
1491		on E: Exception do
#	Line 1059 \| Line 1623 \| begin
1623		end;
1624		end;
1625
1626	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1627	+	var i: integer;
1628	+	Prepared: boolean;
1629	+	begin
1630	+	Result := 0;
1631	+	Prepared := FInternalPrepared;
1632	+	if not Prepared then
1633	+	InternalPrepare;
1634	+	try
1635	+	for i := 0 to Length(FAliasNameList) - 1 do
1636	+	if FAliasNameList[i] = AliasName then
1637	+	begin
1638	+	Result := i + 1;
1639	+	Exit
1640	+	end;
1641	+	finally
1642	+	if not Prepared then
1643	+	InternalUnPrepare;
1644	+	end;
1645	+	end;
1646	+
1647		procedure TIBCustomDataSet.ActivateConnection;
1648		begin
1649		if not Assigned(Database) then
#	Line 1071 \| Line 1656 \| end;
1656		function TIBCustomDataSet.ActivateTransaction: Boolean;
1657		begin
1658		Result := False;
1659	<	if not Assigned(Transaction) then
1075	<	IBError(ibxeTransactionNotAssigned, [nil]);
1076	<	if not Transaction.Active then
1659	>	if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1660		begin
1661	<	Result := True;
1662	<	Transaction.StartTransaction;
1663	<	FDidActivate := True;
1661	>	if not Assigned(Transaction) then
1662	>	IBError(ibxeTransactionNotAssigned, [nil]);
1663	>	if not Transaction.Active then
1664	>	begin
1665	>	Result := True;
1666	>	Transaction.StartTransaction;
1667	>	FDidActivate := True;
1668	>	end;
1669		end;
1670		end;
1671
#	Line 1119 \| Line 1707 \| begin
1707		IBError(ibxeDatasetClosed, [nil]);
1708		end;
1709
1710	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1711	+	begin
1712	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1713	+	Result.OnSQLChanging := SQLChanging
1714	+	end;
1715	+
1716		procedure TIBCustomDataSet.CheckNotUniDirectional;
1717		begin
1718		if UniDirectional then
#	Line 1196 \| Line 1790 \| begin
1790		FBlobStreamList.Pack;
1791		end;
1792
1793	+	procedure TIBCustomDataSet.ClearArrayCache;
1794	+	var
1795	+	i: Integer;
1796	+	begin
1797	+	for i := 0 to FArrayList.Count - 1 do
1798	+	begin
1799	+	TIBArray(FArrayList[i]).Free;
1800	+	FArrayList[i] := nil;
1801	+	end;
1802	+	FArrayList.Pack;
1803	+	end;
1804	+
1805		procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1806		begin
1807		Move(Source^, Dest^, FRecordBufferSize);
#	Line 1205 \| Line 1811 \| procedure TIBCustomDataSet.DoBeforeDatab
1811		begin
1812		if Active then
1813		Active := False;
1814	<	FInternalPrepared := False;
1814	>	InternalUnPrepare;
1815		if Assigned(FBeforeDatabaseDisconnect) then
1816		FBeforeDatabaseDisconnect(Sender);
1817		end;
#	Line 1222 \| Line 1828 \| begin
1828		FDatabaseFree(Sender);
1829		end;
1830
1831	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1831	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1832	>	Action: TTransactionAction);
1833		begin
1834	<	if Active then
1835	<	Active := False;
1834	>	FCloseAction := Action;
1835	>	FInTransactionEnd := true;
1836	>	try
1837	>	if Active then
1838	>	Active := False;
1839	>	finally
1840	>	FInTransactionEnd := false;
1841	>	end;
1842		if FQSelect <> nil then
1843		FQSelect.FreeHandle;
1844		if FQDelete <> nil then
#	Line 1252 \| Line 1865 \| begin
1865		FTransactionFree(Sender);
1866		end;
1867
1868	+	procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1869	+	var i, j: Integer;
1870	+	FieldsLoaded: integer;
1871	+	p: PRecordData;
1872	+	colMetadata: IColumnMetaData;
1873	+	begin
1874	+	p := PRecordData(Buffer);
1875	+	{ Get record information }
1876	+	p^.rdBookmarkFlag := bfCurrent;
1877	+	p^.rdFieldCount := Qry.FieldCount;
1878	+	p^.rdRecordNumber := -1;
1879	+	p^.rdUpdateStatus := usUnmodified;
1880	+	p^.rdCachedUpdateStatus := cusUnmodified;
1881	+	p^.rdSavedOffset := $FFFFFFFF;
1882	+
1883	+	{ Load up the fields }
1884	+	FieldsLoaded := FQSelect.MetaData.Count;
1885	+	j := 1;
1886	+	for i := 0 to Qry.MetaData.Count - 1 do
1887	+	begin
1888	+	if (Qry = FQSelect) then
1889	+	j := i + 1
1890	+	else
1891	+	begin
1892	+	if FieldsLoaded = 0 then
1893	+	break;
1894	+	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1895	+	if j < 1 then
1896	+	continue
1897	+	else
1898	+	Dec(FieldsLoaded);
1899	+	end;
1900	+	if j > 0 then
1901	+	begin
1902	+	colMetadata := Qry.MetaData[i];
1903	+	with p^.rdFields[j], FFieldColumns^[j] do
1904	+	begin
1905	+	fdDataType := colMetadata.GetSQLType;
1906	+	if fdDataType = SQL_BLOB then
1907	+	fdDataScale := 0
1908	+	else
1909	+	fdDataScale := colMetadata.getScale;
1910	+	fdNullable := colMetadata.getIsNullable;
1911	+	fdIsNull := true;
1912	+	fdDataSize := colMetadata.GetSize;
1913	+	fdDataLength := 0;
1914	+	fdCodePage := CP_NONE;
1915	+
1916	+	case fdDataType of
1917	+	SQL_TIMESTAMP,
1918	+	SQL_TYPE_DATE,
1919	+	SQL_TYPE_TIME:
1920	+	fdDataSize := SizeOf(TDateTime);
1921	+	SQL_SHORT, SQL_LONG:
1922	+	begin
1923	+	if (fdDataScale = 0) then
1924	+	fdDataSize := SizeOf(Integer)
1925	+	else
1926	+	if (fdDataScale >= (-4)) then
1927	+	fdDataSize := SizeOf(Currency)
1928	+	else
1929	+	fdDataSize := SizeOf(Double);
1930	+	end;
1931	+	SQL_INT64:
1932	+	begin
1933	+	if (fdDataScale = 0) then
1934	+	fdDataSize := SizeOf(Int64)
1935	+	else
1936	+	if (fdDataScale >= (-4)) then
1937	+	fdDataSize := SizeOf(Currency)
1938	+	else
1939	+	fdDataSize := SizeOf(Double);
1940	+	end;
1941	+	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1942	+	fdDataSize := SizeOf(Double);
1943	+	SQL_BOOLEAN:
1944	+	fdDataSize := SizeOf(wordBool);
1945	+	SQL_VARYING,
1946	+	SQL_TEXT,
1947	+	SQL_BLOB:
1948	+	fdCodePage := Qry.Metadata[i].getCodePage;
1949	+	end;
1950	+	fdDataOfs := FRecordSize;
1951	+	Inc(FRecordSize, fdDataSize);
1952	+	end;
1953	+	end;
1954	+	end;
1955	+	end;
1956	+
1957		{ Read the record from FQSelect.Current into the record buffer
1958		Then write the buffer to in memory cache }
1959		procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1960		RecordNumber: Integer; Buffer: PChar);
1961		var
1260	–	p: PRecordData;
1962		pbd: PBlobDataArray;
1963	+	pda: PArrayDataArray;
1964		i, j: Integer;
1965	<	LocalData: Pointer;
1965	>	LocalData: PChar;
1966		LocalDate, LocalDouble: Double;
1967		LocalInt: Integer;
1968	+	LocalBool: wordBool;
1969		LocalInt64: Int64;
1970		LocalCurrency: Currency;
1971		FieldsLoaded: Integer;
1972	+	p: PRecordData;
1973		begin
1974	+	if RecordNumber = -1 then
1975	+	begin
1976	+	InitModelBuffer(Qry,Buffer);
1977	+	Exit;
1978	+	end;
1979		p := PRecordData(Buffer);
1980		{ Make sure blob cache is empty }
1981		pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1982	<	if RecordNumber > -1 then
1983	<	for i := 0 to BlobFieldCount - 1 do
1984	<	pbd^[i] := nil;
1982	>	pda := PArrayDataArray(Buffer + FArrayCacheOffset);
1983	>	for i := 0 to BlobFieldCount - 1 do
1984	>	pbd^[i] := nil;
1985	>	for i := 0 to ArrayFieldCount - 1 do
1986	>	pda^[i] := nil;
1987	>
1988		{ Get record information }
1989		p^.rdBookmarkFlag := bfCurrent;
1990	<	p^.rdFieldCount := Qry.Current.Count;
1990	>	p^.rdFieldCount := Qry.FieldCount;
1991		p^.rdRecordNumber := RecordNumber;
1992		p^.rdUpdateStatus := usUnmodified;
1993		p^.rdCachedUpdateStatus := cusUnmodified;
1994		p^.rdSavedOffset := $FFFFFFFF;
1995
1996		{ Load up the fields }
1997	<	FieldsLoaded := FQSelect.Current.Count;
1997	>	FieldsLoaded := FQSelect.MetaData.Count;
1998		j := 1;
1999	<	for i := 0 to Qry.Current.Count - 1 do
1999	>	for i := 0 to Qry.FieldCount - 1 do
2000		begin
2001		if (Qry = FQSelect) then
2002		j := i + 1
2003	<	else begin
2003	>	else
2004	>	begin
2005		if FieldsLoaded = 0 then
2006		break;
2007	<	j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
2007	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2008		if j < 1 then
2009		continue
2010		else
2011		Dec(FieldsLoaded);
2012		end;
2013	<	with FQSelect.Current[j - 1].Data^ do
2014	<	if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2013	>	with FQSelect.MetaData[j - 1] do
2014	>	if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2015		begin
2016	<	if sqllen <= 8 then
2017	<	p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
2016	>	if (GetSize <= 8) then
2017	>	p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2018		continue;
2019		end;
2020	<	if j > 0 then with p^ do
2020	>	if j > 0 then
2021		begin
2022	<	rdFields[j].fdDataType :=
2023	<	Qry.Current[i].Data^.sqltype and (not 1);
2024	<	rdFields[j].fdDataScale :=
2025	<	Qry.Current[i].Data^.sqlscale;
2026	<	rdFields[j].fdNullable :=
1314	<	(Qry.Current[i].Data^.sqltype and 1 = 1);
1315	<	rdFields[j].fdIsNull :=
1316	<	(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1317	<	LocalData := Qry.Current[i].Data^.sqldata;
1318	<	case rdFields[j].fdDataType of
1319	<	SQL_TIMESTAMP:
1320	<	begin
1321	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
1322	<	if RecordNumber >= 0 then
1323	<	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);
1339	<	end;
1340	<	SQL_SHORT, SQL_LONG:
2022	>	LocalData := nil;
2023	>	with p^.rdFields[j], FFieldColumns^[j] do
2024	>	begin
2025	>	Qry.Current.GetData(i,fdIsNull,fdDataLength,LocalData);
2026	>	if not fdIsNull then
2027		begin
2028	<	if (rdFields[j].fdDataScale = 0) then
2029	<	begin
2030	<	rdFields[j].fdDataSize := SizeOf(Integer);
2031	<	if RecordNumber >= 0 then
2032	<	LocalInt := Qry.Current[i].AsLong;
2033	<	LocalData := PChar(@LocalInt);
2034	<	end
2035	<	else if (rdFields[j].fdDataScale >= (-4)) then
2036	<	begin
2037	<	rdFields[j].fdDataSize := SizeOf(Currency);
2038	<	if RecordNumber >= 0 then
2039	<	LocalCurrency := Qry.Current[i].AsCurrency;
2040	<	LocalData := PChar(@LocalCurrency);
2041	<	end
2042	<	else begin
2043	<	rdFields[j].fdDataSize := SizeOf(Double);
2044	<	if RecordNumber >= 0 then
2045	<	LocalDouble := Qry.Current[i].AsDouble;
2046	<	LocalData := PChar(@LocalDouble);
2028	>	case fdDataType of {Get Formatted data for column types that need formatting}
2029	>	SQL_TIMESTAMP:
2030	>	begin
2031	>	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry[i].AsDateTime));
2032	>	LocalData := PChar(@LocalDate);
2033	>	end;
2034	>	SQL_TYPE_DATE:
2035	>	begin
2036	>	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Date;
2037	>	LocalData := PChar(@LocalInt);
2038	>	end;
2039	>	SQL_TYPE_TIME:
2040	>	begin
2041	>	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Time;
2042	>	LocalData := PChar(@LocalInt);
2043	>	end;
2044	>	SQL_SHORT, SQL_LONG:
2045	>	begin
2046	>	if (fdDataScale = 0) then
2047	>	begin
2048	>	LocalInt := Qry[i].AsLong;
2049	>	LocalData := PChar(@LocalInt);
2050	>	end
2051	>	else
2052	>	if (fdDataScale >= (-4)) then
2053	>	begin
2054	>	LocalCurrency := Qry[i].AsCurrency;
2055	>	LocalData := PChar(@LocalCurrency);
2056	>	end
2057	>	else
2058	>	begin
2059	>	LocalDouble := Qry[i].AsDouble;
2060	>	LocalData := PChar(@LocalDouble);
2061		end;
2062	<	end;
2063	<	SQL_INT64:
2064	<	begin
2065	<	if (rdFields[j].fdDataScale = 0) then
2066	<	begin
2067	<	rdFields[j].fdDataSize := SizeOf(Int64);
2068	<	if RecordNumber >= 0 then
2069	<	LocalInt64 := Qry.Current[i].AsInt64;
2070	<	LocalData := PChar(@LocalInt64);
2071	<	end
2072	<	else if (rdFields[j].fdDataScale >= (-4)) then
2073	<	begin
2074	<	rdFields[j].fdDataSize := SizeOf(Currency);
2075	<	if RecordNumber >= 0 then
2076	<	LocalCurrency := Qry.Current[i].AsCurrency;
2077	<	LocalData := PChar(@LocalCurrency);
2078	<	end
1379	<	else begin
1380	<	rdFields[j].fdDataSize := SizeOf(Double);
1381	<	if RecordNumber >= 0 then
1382	<	LocalDouble := Qry.Current[i].AsDouble;
2062	>	end;
2063	>	SQL_INT64:
2064	>	begin
2065	>	if (fdDataScale = 0) then
2066	>	begin
2067	>	LocalInt64 := Qry[i].AsInt64;
2068	>	LocalData := PChar(@LocalInt64);
2069	>	end
2070	>	else
2071	>	if (fdDataScale >= (-4)) then
2072	>	begin
2073	>	LocalCurrency := Qry[i].AsCurrency;
2074	>	LocalData := PChar(@LocalCurrency);
2075	>	end
2076	>	else
2077	>	begin
2078	>	LocalDouble := Qry[i].AsDouble;
2079		LocalData := PChar(@LocalDouble);
2080	<	end
2081	<	end;
2082	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2083	<	begin
2084	<	rdFields[j].fdDataSize := SizeOf(Double);
2085	<	if RecordNumber >= 0 then
2086	<	LocalDouble := Qry.Current[i].AsDouble;
2087	<	LocalData := PChar(@LocalDouble);
2088	<	end;
2089	<	SQL_VARYING:
2090	<	begin
2091	<	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];
2080	>	end
2081	>	end;
2082	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2083	>	begin
2084	>	LocalDouble := Qry[i].AsDouble;
2085	>	LocalData := PChar(@LocalDouble);
2086	>	end;
2087	>	SQL_BOOLEAN:
2088	>	begin
2089	>	LocalBool := Qry[i].AsBoolean;
2090	>	LocalData := PChar(@LocalBool);
2091	>	end;
2092		end;
2093	<	end;
2094	<	else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2095	<	begin
2096	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2097	<	if (rdFields[j].fdDataType = SQL_TEXT) then
1409	<	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1410	<	end;
1411	<	end;
1412	<	if RecordNumber < 0 then
1413	<	begin
1414	<	rdFields[j].fdIsNull := True;
1415	<	rdFields[j].fdDataOfs := FRecordSize;
1416	<	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)
2093	>
2094	>	if fdDataType = SQL_VARYING then
2095	>	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2096	>	else
2097	>	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2098		end
2099	+	else {Null column}
2100	+	if fdDataType = SQL_VARYING then
2101	+	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2102		else
2103	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2103	>	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2104		end;
2105		end;
2106		end;
2107	<	WriteRecordCache(RecordNumber, PChar(p));
2107	>	WriteRecordCache(RecordNumber, Buffer);
2108		end;
2109
2110		function TIBCustomDataSet.GetActiveBuf: PChar;
#	Line 1471 \| Line 2149 \| begin
2149		result := FBase.Database;
2150		end;
2151
1474	–	function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1475	–	begin
1476	–	result := FBase.DBHandle;
1477	–	end;
1478	–
2152		function TIBCustomDataSet.GetDeleteSQL: TStrings;
2153		begin
2154		result := FQDelete.SQL;
#	Line 1486 \| Line 2159 \| begin
2159		result := FQInsert.SQL;
2160		end;
2161
2162	<	function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2162	>	function TIBCustomDataSet.GetSQLParams: ISQLParams;
2163		begin
2164		if not FInternalPrepared then
2165		InternalPrepare;
#	Line 1503 \| Line 2176 \| begin
2176		result := FQSelect.SQL;
2177		end;
2178
2179	<	function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2179	>	function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2180		begin
2181	<	result := FQSelect.SQLType;
2181	>	result := FQSelect.SQLStatementType;
2182		end;
2183
2184		function TIBCustomDataSet.GetModifySQL: TStrings;
#	Line 1518 \| Line 2191 \| begin
2191		result := FBase.Transaction;
2192		end;
2193
1521	–	function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1522	–	begin
1523	–	result := FBase.TRHandle;
1524	–	end;
1525	–
2194		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2195		begin
2196		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2197	<	FUpdateObject.Apply(ukDelete)
2197	>	FUpdateObject.Apply(ukDelete,Buff)
2198		else
2199		begin
2200		SetInternalSQLParams(FQDelete, Buff);
#	Line 1543 \| Line 2211 \| end;
2211		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2212		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2213		var
2214	<	fl: TList;
2215	<	CurBookmark: string;
2216	<	fld, val: Variant;
2217	<	i, fld_cnt: Integer;
2214	>	keyFieldList: TList;
2215	>	CurBookmark: TBookmark;
2216	>	fieldValue: Variant;
2217	>	lookupValues: array of variant;
2218	>	i, fieldCount: Integer;
2219	>	fieldValueAsString: string;
2220	>	lookupValueAsString: string;
2221		begin
2222	<	fl := TList.Create;
2222	>	keyFieldList := TList.Create;
2223		try
2224	<	GetFieldList(fl, KeyFields);
2225	<	fld_cnt := fl.Count;
2224	>	GetFieldList(keyFieldList, KeyFields);
2225	>	fieldCount := keyFieldList.Count;
2226		CurBookmark := Bookmark;
2227	<	result := False;
2228	<	while ((not result) and (not EOF)) do
2227	>	result := false;
2228	>	SetLength(lookupValues, fieldCount);
2229	>	if not EOF then
2230		begin
2231	<	i := 0;
1560	<	result := True;
1561	<	while (result and (i < fld_cnt)) do
2231	>	for i := 0 to fieldCount - 1 do {expand key values into lookupValues array}
2232		begin
2233	<	if fld_cnt > 1 then
2234	<	val := KeyValues[i]
2233	>	if VarIsArray(KeyValues) then
2234	>	lookupValues[i] := KeyValues[i]
2235	>	else
2236	>	if i > 0 then
2237	>	lookupValues[i] := NULL
2238		else
2239	<	val := KeyValues;
2240	<	fld := TField(fl[i]).Value;
2241	<	result := not (VarIsNull(val) xor VarIsNull(fld));
2242	<	if result and not VarIsNull(val) then
2239	>	lookupValues[0] := KeyValues;
2240	>
2241	>	{convert to upper case is case insensitive search}
2242	>	if (TField(keyFieldList[i]).DataType = ftString) and
2243	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2244	>	lookupValues[i] := UpperCase(lookupValues[i]);
2245	>	end;
2246	>	end;
2247	>	while not result and not EOF do {search for a matching record}
2248	>	begin
2249	>	i := 0;
2250	>	result := true;
2251	>	while result and (i < fieldCount) do
2252	>	{see if all of the key fields matches}
2253	>	begin
2254	>	fieldValue := TField(keyFieldList[i]).Value;
2255	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2256	>	if result and not VarIsNull(fieldValue) then
2257		begin
2258		try
2259	<	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
2259	>	if TField(keyFieldList[i]).DataType = ftString then
2260		begin
2261	+	{strings need special handling because of the locate options that
2262	+	apply to them}
2263	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
2264	+	lookupValueAsString := lookupValues[i];
2265		if (loCaseInsensitive in Options) then
2266	<	begin
2267	<	fld := AnsiUpperCase(fld);
1582	<	val := AnsiUpperCase(val);
1583	<	end;
1584	<	fld := TrimRight(fld);
1585	<	val := TrimRight(val);
2266	>	fieldValueAsString := UpperCase(fieldValueAsString);
2267	>
2268		if (loPartialKey in Options) then
2269	<	result := result and (AnsiPos(val, fld) = 1)
2269	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2270		else
2271	<	result := result and (val = fld);
2272	<	end else
2273	<	result := result and (val = fld);
2271	>	result := result and (fieldValueAsString = lookupValueAsString);
2272	>	end
2273	>	else
2274	>	result := result and (lookupValues[i] =
2275	>	VarAsType(fieldValue, VarType(lookupValues[i])));
2276	>	except on EVariantError do
2277	>	result := False;
2278	>	end;
2279		end;
2280		Inc(i);
2281		end;
2282		if not result then
2283	<	Next;
2283	>	Next;
2284		end;
2285		if not result then
2286		Bookmark := CurBookmark
2287		else
2288		CursorPosChanged;
2289		finally
2290	<	fl.Free;
2290	>	keyFieldList.Free;
2291	>	SetLength(lookupValues,0)
2292		end;
2293		end;
2294
2295		procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2296		var
2297	<	i, j, k: Integer;
2297	>	i, j, k, arr: Integer;
2298		pbd: PBlobDataArray;
2299	+	pda: PArrayDataArray;
2300		begin
2301		pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2302	<	j := 0;
2302	>	pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2303	>	j := 0; arr := 0;
2304		for i := 0 to FieldCount - 1 do
2305		if Fields[i].IsBlob then
2306		begin
#	Line 1619 \| Line 2309 \| begin
2309		begin
2310		pbd^[j].Finalize;
2311		PISC_QUAD(
2312	<	PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2312	>	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2313		pbd^[j].BlobID;
2314		PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2315	+	end
2316	+	else
2317	+	begin
2318	+	PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2319	+	with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2320	+	begin
2321	+	gds_quad_high := 0;
2322	+	gds_quad_low := 0;
2323	+	end;
2324		end;
2325		Inc(j);
2326	+	end
2327	+	else
2328	+	if Fields[i] is TIBArrayField then
2329	+	begin
2330	+	if pda^[arr] <> nil then
2331	+	begin
2332	+	k := FMappedFieldPosition[Fields[i].FieldNo -1];
2333	+	PISC_QUAD(
2334	+	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ := pda^[arr].ArrayIntf.GetArrayID;
2335	+	PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2336	+	end;
2337	+	Inc(arr);
2338		end;
2339		if Assigned(FUpdateObject) then
2340		begin
2341		if (Qry = FQDelete) then
2342	<	FUpdateObject.Apply(ukDelete)
2342	>	FUpdateObject.Apply(ukDelete,Buff)
2343		else if (Qry = FQInsert) then
2344	<	FUpdateObject.Apply(ukInsert)
2344	>	FUpdateObject.Apply(ukInsert,Buff)
2345		else
2346	<	FUpdateObject.Apply(ukModify);
2346	>	FUpdateObject.Apply(ukModify,Buff);
2347		end
2348		else begin
2349		SetInternalSQLParams(Qry, Buff);
#	Line 1649 \| Line 2360 \| end;
2360		procedure TIBCustomDataSet.InternalRefreshRow;
2361		var
2362		Buff: PChar;
1652	–	SetCursor: Boolean;
2363		ofs: DWORD;
2364		Qry: TIBSQL;
2365		begin
2366	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657	<	if SetCursor then
1658	<	Screen.Cursor := crHourGlass;
2366	>	FBase.SetCursor;
2367		try
2368		Buff := GetActiveBuf;
2369		if CanRefresh then
#	Line 1675 \| Line 2383 \| begin
2383		SetInternalSQLParams(Qry, Buff);
2384		Qry.ExecQuery;
2385		try
2386	<	if (Qry.SQLType = SQLExecProcedure) or
1679	<	(Qry.Next <> nil) then
2386	>	if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2387		begin
2388		ofs := PRecordData(Buff)^.rdSavedOffset;
2389		FetchCurrentRecordToBuffer(Qry,
#	Line 1699 \| Line 2406 \| begin
2406		else
2407		IBError(ibxeCannotRefresh, [nil]);
2408		finally
2409	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1703	<	Screen.Cursor := crDefault;
2409	>	FBase.RestoreCursor;
2410		end;
2411		end;
2412
#	Line 1770 \| Line 2476 \| begin
2476		end;
2477
2478		procedure TIBCustomDataSet.InternalPrepare;
1773	–	var
1774	–	SetCursor: Boolean;
1775	–	DidActivate: Boolean;
2479		begin
2480		if FInternalPrepared then
2481		Exit;
2482	<	DidActivate := False;
1780	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781	<	if SetCursor then
1782	<	Screen.Cursor := crHourGlass;
2482	>	FBase.SetCursor;
2483		try
2484		ActivateConnection;
2485	<	DidActivate := ActivateTransaction;
2485	>	ActivateTransaction;
2486		FBase.CheckDatabase;
2487		FBase.CheckTransaction;
2488	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2489	+	begin
2490	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2491	+	try
2492	+	FQSelect.SQL.Text := FParser.SQLText;
2493	+	finally
2494	+	FQSelect.OnSQLChanged := SQLChanged;
2495	+	end;
2496	+	end;
2497	+	// writeln( FQSelect.SQL.Text);
2498		if FQSelect.SQL.Text <> '' then
2499		begin
2500		if not FQSelect.Prepared then
2501		begin
2502	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2503		FQSelect.ParamCheck := ParamCheck;
2504		FQSelect.Prepare;
2505		end;
2506	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2506	>	FQDelete.GenerateParamNames := FGenerateParamNames;
2507	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2508		FQDelete.Prepare;
2509	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2509	>	FQInsert.GenerateParamNames := FGenerateParamNames;
2510	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2511		FQInsert.Prepare;
2512	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2512	>	FQRefresh.GenerateParamNames := FGenerateParamNames;
2513	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2514		FQRefresh.Prepare;
2515	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2515	>	FQModify.GenerateParamNames := FGenerateParamNames;
2516	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2517		FQModify.Prepare;
2518		FInternalPrepared := True;
2519		InternalInitFieldDefs;
2520		end else
2521		IBError(ibxeEmptyQuery, [nil]);
2522		finally
2523	<	if DidActivate then
1809	<	DeactivateTransaction;
1810	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1811	<	Screen.Cursor := crDefault;
2523	>	FBase.RestoreCursor;
2524		end;
2525		end;
2526
#	Line 1837 \| Line 2549 \| var
2549		begin
2550		CopyRecordBuffer(Buffer, OldBuffer);
2551		if BlobFieldCount > 0 then
2552	<	FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2552	>	FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2553	>	BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2554		0);
2555		end;
2556
#	Line 1910 \| Line 2623 \| procedure TIBCustomDataSet.SetInternalSQ
2623		var
2624		i, j: Integer;
2625		cr, data: PChar;
2626	<	fn, st: string;
2626	>	fn: string;
2627	>	st: RawByteString;
2628		OldBuffer: Pointer;
2629		ts: TTimeStamp;
2630	+	Param: ISQLParam;
2631		begin
2632		if (Buffer = nil) then
2633		IBError(ibxeBufferNotSet, [nil]);
#	Line 1920 \| Line 2635 \| begin
2635		InternalPrepare;
2636		OldBuffer := nil;
2637		try
2638	<	for i := 0 to Qry.Params.Count - 1 do
2638	>	for i := 0 to Qry.Params.GetCount - 1 do
2639		begin
2640	<	fn := Qry.Params[i].Name;
2640	>	Param := Qry.Params[i];
2641	>	fn := Param.Name;
2642		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2643		begin
2644		fn := Copy(fn, 5, Length(fn));
#	Line 1942 \| Line 2658 \| begin
2658		cr := Buffer;
2659		j := FQSelect.FieldIndex[fn] + 1;
2660		if (j > 0) then
2661	<	with PRecordData(cr)^ do
2661	>	with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2662		begin
2663	<	if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2663	>	if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2664		begin
2665	<	PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2665	>	PIBDBKey(Param.AsPointer)^ := rdDBKey;
2666		continue;
2667		end;
2668	<	if rdFields[j].fdIsNull then
2669	<	Qry.Params[i].IsNull := True
2668	>	if fdIsNull then
2669	>	Param.IsNull := True
2670		else begin
2671	<	Qry.Params[i].IsNull := False;
2672	<	data := cr + rdFields[j].fdDataOfs;
2673	<	case rdFields[j].fdDataType of
2671	>	Param.IsNull := False;
2672	>	data := cr + fdDataOfs;
2673	>	case fdDataType of
2674		SQL_TEXT, SQL_VARYING:
2675		begin
2676	<	SetString(st, data, rdFields[j].fdDataLength);
2677	<	Qry.Params[i].AsString := st;
2676	>	SetString(st, data, fdDataLength);
2677	>	SetCodePage(st,fdCodePage,false);
2678	>	Param.AsString := st;
2679		end;
2680		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2681	<	Qry.Params[i].AsDouble := PDouble(data)^;
2681	>	Param.AsDouble := PDouble(data)^;
2682		SQL_SHORT, SQL_LONG:
2683		begin
2684	<	if rdFields[j].fdDataScale = 0 then
2685	<	Qry.Params[i].AsLong := PLong(data)^
2686	<	else if rdFields[j].fdDataScale >= (-4) then
2687	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2684	>	if fdDataScale = 0 then
2685	>	Param.AsLong := PLong(data)^
2686	>	else
2687	>	if fdDataScale >= (-4) then
2688	>	Param.AsCurrency := PCurrency(data)^
2689		else
2690	<	Qry.Params[i].AsDouble := PDouble(data)^;
2690	>	Param.AsDouble := PDouble(data)^;
2691		end;
2692		SQL_INT64:
2693		begin
2694	<	if rdFields[j].fdDataScale = 0 then
2695	<	Qry.Params[i].AsInt64 := PInt64(data)^
1978	<	else if rdFields[j].fdDataScale >= (-4) then
1979	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2694	>	if fdDataScale = 0 then
2695	>	Param.AsInt64 := PInt64(data)^
2696		else
2697	<	Qry.Params[i].AsDouble := PDouble(data)^;
2697	>	if fdDataScale >= (-4) then
2698	>	Param.AsCurrency := PCurrency(data)^
2699	>	else
2700	>	Param.AsDouble := PDouble(data)^;
2701		end;
2702		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2703	<	Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2703	>	Param.AsQuad := PISC_QUAD(data)^;
2704		SQL_TYPE_DATE:
2705		begin
2706		ts.Date := PInt(data)^;
2707		ts.Time := 0;
2708	<	Qry.Params[i].AsDate :=
1990	<	TimeStampToDateTime(ts);
2708	>	Param.AsDate := TimeStampToDateTime(ts);
2709		end;
2710		SQL_TYPE_TIME:
2711		begin
2712		ts.Date := 0;
2713		ts.Time := PInt(data)^;
2714	<	Qry.Params[i].AsTime :=
1997	<	TimeStampToDateTime(ts);
2714	>	Param.AsTime := TimeStampToDateTime(ts);
2715		end;
2716		SQL_TIMESTAMP:
2717	<	Qry.Params[i].AsDateTime :=
2718	<	TimeStampToDateTime(
2719	<	MSecsToTimeStamp(PDouble(data)^));
2717	>	Param.AsDateTime :=
2718	>	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2719	>	SQL_BOOLEAN:
2720	>	Param.AsBoolean := PWordBool(data)^;
2721		end;
2722		end;
2723		end;
#	Line 2085 \| Line 2803 \| begin
2803		end;
2804		end;
2805
2806	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2807	+	begin
2808	+	if FIBLinks.IndexOf(Sender) = -1 then
2809	+	FIBLinks.Add(Sender);
2810	+	end;
2811	+
2812
2813		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2814		begin
2815	<	if FOpen then
2816	<	InternalClose;
2815	>	Active := false;
2816	>	{ if FOpen then
2817	>	InternalClose;}
2818		if FInternalPrepared then
2819		InternalUnPrepare;
2820	+	FieldDefs.Clear;
2821	+	FieldDefs.Updated := false;
2822	+	end;
2823	+
2824	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2825	+	begin
2826	+	FBaseSQLSelect.assign(FQSelect.SQL);
2827		end;
2828
2829		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2120 \| Line 2852 \| begin
2852		end;
2853		end;
2854
2855	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2856	+	begin
2857	+	FIBLinks.Remove(Sender);
2858	+	end;
2859	+
2860		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2861		begin
2862		if Active then
#	Line 2136 \| Line 2873 \| begin
2873		Result := Assigned( FQSelect ) and FQSelect.EOF;
2874		end;
2875
2876	+	function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2877	+	begin
2878	+	ActivateConnection;
2879	+	ActivateTransaction;
2880	+	if not FInternalPrepared then
2881	+	InternalPrepare;
2882	+	Result := Params.ByName(ParamName);
2883	+	end;
2884	+
2885	+	{Beware: the parameter FCache is used as an identifier to determine which
2886	+	cache is being operated on and is not referenced in the computation.
2887	+	The result is an adjusted offset into the identified cache, either the
2888	+	Buffer Cache or the old Buffer Cache.}
2889	+
2890		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2891	<	Origin: Integer): Integer;
2891	>	Origin: Integer): DWORD;
2892		var
2893		OldCacheSize: Integer;
2894		begin
#	Line 2174 \| Line 2925 \| procedure TIBCustomDataSet.ReadCache(FCa
2925		Buffer: PChar);
2926		var
2927		pCache: PChar;
2928	+	AdjustedOffset: DWORD;
2929		bOld: Boolean;
2930		begin
2931		bOld := (FCache = FOldBufferCache);
2932	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2932	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2933		if not bOld then
2934	<	pCache := FBufferCache + Integer(pCache)
2934	>	pCache := FBufferCache + AdjustedOffset
2935		else
2936	<	pCache := FOldBufferCache + Integer(pCache);
2936	>	pCache := FOldBufferCache + AdjustedOffset;
2937		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2938		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2939		end;
#	Line 2211 \| Line 2963 \| procedure TIBCustomDataSet.WriteCache(FC
2963		Buffer: PChar);
2964		var
2965		pCache: PChar;
2966	+	AdjustedOffset: DWORD;
2967		bOld: Boolean;
2968		dwEnd: DWORD;
2969		begin
2970		bOld := (FCache = FOldBufferCache);
2971	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2971	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2972		if not bOld then
2973	<	pCache := FBufferCache + Integer(pCache)
2973	>	pCache := FBufferCache + AdjustedOffset
2974		else
2975	<	pCache := FOldBufferCache + Integer(pCache);
2975	>	pCache := FOldBufferCache + AdjustedOffset;
2976		Move(Buffer^, pCache^, FRecordBufferSize);
2977		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2978		if not bOld then
#	Line 2257 \| Line 3010 \| var
3010		Buff: PChar;
3011		bTr, bDB: Boolean;
3012		begin
3013	+	if (Field = nil) or (Field.DataSet <> self) then
3014	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3015		Buff := GetActiveBuf;
3016		if Buff = nil then
3017		begin
3018		fs := TIBBlobStream.Create;
3019		fs.Mode := bmReadWrite;
3020	+	fs.Database := Database;
3021	+	fs.Transaction := Transaction;
3022	+	fs.SetField(Field);
3023		FBlobStreamList.Add(Pointer(fs));
3024		result := TIBDSBlobStream.Create(Field, fs, Mode);
3025		exit;
#	Line 2276 \| Line 3034 \| begin
3034		fs.Mode := bmReadWrite;
3035		fs.Database := Database;
3036		fs.Transaction := Transaction;
3037	+	fs.SetField(Field);
3038		fs.BlobID :=
3039	<	PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3039	>	PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3040		if (CachedUpdates) then
3041		begin
3042		bTr := not Transaction.InTransaction;
#	Line 2298 \| Line 3057 \| begin
3057		result := TIBDSBlobStream.Create(Field, fs, Mode);
3058		end;
3059
3060	+	function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3061	+	var Buff: PChar;
3062	+	pda: PArrayDataArray;
3063	+	bTr, bDB: Boolean;
3064	+	begin
3065	+	if (Field = nil) or (Field.DataSet <> self) then
3066	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3067	+	Buff := GetActiveBuf;
3068	+	if Buff = nil then
3069	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3070	+	Field.FRelationName,Field.FieldName)
3071	+	else
3072	+	begin
3073	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3074	+	if pda^[Field.FCacheOffset] = nil then
3075	+	begin
3076	+	AdjustRecordOnInsert(Buff);
3077	+	if Field.IsNull then
3078	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3079	+	Field.FRelationName,Field.FieldName)
3080	+	else
3081	+	Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3082	+	Field.FRelationName,Field.FieldName,Field.ArrayID);
3083	+	pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3084	+	FArrayList.Add(pda^[Field.FCacheOffset]);
3085	+	if (CachedUpdates) then
3086	+	begin
3087	+	bTr := not Transaction.InTransaction;
3088	+	bDB := not Database.Connected;
3089	+	if bDB then
3090	+	Database.Open;
3091	+	if bTr then
3092	+	Transaction.StartTransaction;
3093	+	pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3094	+	if bTr then
3095	+	Transaction.Commit;
3096	+	if bDB then
3097	+	Database.Close;
3098	+	end;
3099	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3100	+	end
3101	+	else
3102	+	Result := pda^[Field.FCacheOffset].ArrayIntf;
3103	+	end;
3104	+	end;
3105	+
3106	+	procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3107	+	var Buff: PChar;
3108	+	pda: PArrayDataArray;
3109	+	begin
3110	+	if (Field = nil) or (Field.DataSet <> self) then
3111	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3112	+	Buff := GetActiveBuf;
3113	+	if Buff <> nil then
3114	+	begin
3115	+	AdjustRecordOnInsert(Buff);
3116	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3117	+	pda^[Field.FCacheOffset].FArray := AnArray;
3118	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3119	+	end;
3120	+	end;
3121	+
3122		function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3123		const
3124		CMPLess = -1;
#	Line 2330 \| Line 3151 \| begin
3151		if FCachedUpdates and
3152		(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
3153		SaveOldBuffer(PChar(Buff));
3154	<	inherited;
3154	>	inherited DoBeforeDelete;
3155	>	end;
3156	>
3157	>	procedure TIBCustomDataSet.DoAfterDelete;
3158	>	begin
3159	>	inherited DoAfterDelete;
3160	>	FBase.DoAfterDelete(self);
3161	>	InternalAutoCommit;
3162		end;
3163
3164		procedure TIBCustomDataSet.DoBeforeEdit;
#	Line 2344 \| Line 3172 \| begin
3172		if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
3173		SaveOldBuffer(PChar(Buff));
3174		CopyRecordBuffer(GetActiveBuf, FOldBuffer);
3175	<	inherited;
3175	>	inherited DoBeforeEdit;
3176	>	end;
3177	>
3178	>	procedure TIBCustomDataSet.DoAfterEdit;
3179	>	begin
3180	>	inherited DoAfterEdit;
3181	>	FBase.DoAfterEdit(self);
3182		end;
3183
3184		procedure TIBCustomDataSet.DoBeforeInsert;
3185		begin
3186		if not CanInsert then
3187		IBError(ibxeCannotInsert, [nil]);
3188	<	inherited;
3188	>	inherited DoBeforeInsert;
3189	>	end;
3190	>
3191	>	procedure TIBCustomDataSet.DoAfterInsert;
3192	>	begin
3193	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
3194	>	GeneratorField.Apply;
3195	>	inherited DoAfterInsert;
3196	>	FBase.DoAfterInsert(self);
3197	>	end;
3198	>
3199	>	procedure TIBCustomDataSet.DoBeforeClose;
3200	>	begin
3201	>	inherited DoBeforeClose;
3202	>	if FInTransactionEnd and (FCloseAction = TARollback) then
3203	>	Exit;
3204	>	if State in [dsInsert,dsEdit] then
3205	>	begin
3206	>	if DataSetCloseAction = dcSaveChanges then
3207	>	Post;
3208	>	{Note this can fail with an exception e.g. due to
3209	>	database validation error. In which case the dataset remains open }
3210	>	end;
3211	>	if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3212	>	ApplyUpdates;
3213	>	end;
3214	>
3215	>	procedure TIBCustomDataSet.DoBeforeOpen;
3216	>	var i: integer;
3217	>	begin
3218	>	if assigned(FParser) then
3219	>	FParser.Reset;
3220	>	for i := 0 to FIBLinks.Count - 1 do
3221	>	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3222	>	inherited DoBeforeOpen;
3223	>	for i := 0 to FIBLinks.Count - 1 do
3224	>	TIBControlLink(FIBLinks[i]).UpdateParams(self);
3225	>	end;
3226	>
3227	>	procedure TIBCustomDataSet.DoBeforePost;
3228	>	begin
3229	>	inherited DoBeforePost;
3230	>	if (State = dsInsert) and
3231	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
3232	>	GeneratorField.Apply
3233	>	end;
3234	>
3235	>	procedure TIBCustomDataSet.DoAfterPost;
3236	>	begin
3237	>	inherited DoAfterPost;
3238	>	FBase.DoAfterPost(self);
3239	>	InternalAutoCommit;
3240		end;
3241
3242		procedure TIBCustomDataSet.FetchAll;
3243		var
3244	<	SetCursor: Boolean;
2360	<	CurBookmark: string;
3244	>	CurBookmark: TBookmark;
3245		begin
3246	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3247	<	if SetCursor then
2364	<	Screen.Cursor := crHourGlass;
2365	<	try
3246	>	FBase.SetCursor;
3247	>	try
3248		if FQSelect.EOF or not FQSelect.Open then
3249		exit;
3250		DisableControls;
#	Line 2374 \| Line 3256 \| begin
3256		EnableControls;
3257		end;
3258		finally
3259	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2378	<	Screen.Cursor := crDefault;
3259	>	FBase.RestoreCursor;
3260		end;
3261		end;
3262
#	Line 2423 \| Line 3304 \| begin
3304		result := FDataLink.DataSource;
3305		end;
3306
3307	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3308	+	begin
3309	+	Result := FAliasNameMap[FieldNo-1]
3310	+	end;
3311	+
3312	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3313	+	var
3314	+	i: integer;
3315	+	begin
3316	+	Result := nil;
3317	+	for i := 0 to Length(FAliasNameMap) - 1 do
3318	+	if FAliasNameMap[i] = aliasName then
3319	+	begin
3320	+	Result := FieldDefs[i];
3321	+	Exit
3322	+	end;
3323	+	end;
3324	+
3325		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3326		begin
3327		Result := DefaultFieldClasses[FieldType];
#	Line 2441 \| Line 3340 \| begin
3340		result := False;
3341		Buff := GetActiveBuf;
3342		if (Buff = nil) or
3343	<	(not IsVisible(Buff)) then
3343	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
3344		exit;
3345		{ The intention here is to stuff the buffer with the data for the
3346		referenced field for the current record }
#	Line 2453 \| Line 3352 \| begin
3352		if result and (Buffer <> nil) then
3353		Move(Buff[1], Buffer^, Field.DataSize);
3354		end
3355	<	else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3355	>	else
3356	>	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3357		(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3358	+	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3359	+	FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3360		begin
3361	<	result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3361	>	result := not fdIsNull;
3362		if result and (Buffer <> nil) then
2461	–	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3363		begin
3364	<	Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3364	>	Data := Buff + fdDataOfs;
3365		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3366		begin
3367	<	Move(Data^, Buffer^, fdDataLength);
3368	<	PChar(Buffer)[fdDataLength] := #0;
3367	>	if fdDataLength < Field.DataSize then
3368	>	begin
3369	>	Move(Data^, Buffer^, fdDataLength);
3370	>	PChar(Buffer)[fdDataLength] := #0;
3371	>	end
3372	>	else
3373	>	IBError(ibxeFieldSizeError,[Field.FieldName])
3374		end
3375		else
3376		Move(Data^, Buffer^, Field.DataSize);
#	Line 2507 \| Line 3413 \| begin
3413		if not Accept and (GetMode = gmCurrent) then
3414		GetMode := gmPrior;
3415		except
3416	<	// Application.HandleException(Self);
3416	>	// FBase.HandleException(Self);
3417		end;
3418		end;
3419		RestoreState(SaveState);
#	Line 2526 \| Line 3432 \| begin
3432		if FCurrentRecord < FRecordCount then
3433		ReadRecordCache(FCurrentRecord, Buffer, False)
3434		else begin
3435	<	while (not FQSelect.EOF) and
2530	<	(FQSelect.Next <> nil) and
3435	>	while (not FQSelect.EOF) and FQSelect.Next and
3436		(FCurrentRecord >= FRecordCount) do begin
3437		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3438		Inc(FRecordCount);
#	Line 2601 \| Line 3506 \| begin
3506		result := FRecordBufferSize;
3507		end;
3508
3509	+	procedure TIBCustomDataSet.InternalAutoCommit;
3510	+	begin
3511	+	with Transaction do
3512	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3513	+	begin
3514	+	if CachedUpdates then ApplyUpdates;
3515	+	CommitRetaining;
3516	+	end;
3517	+	end;
3518	+
3519		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3520		begin
3521		CheckEditState;
#	Line 2628 \| Line 3543 \| procedure TIBCustomDataSet.InternalCance
3543		var
3544		Buff: PChar;
3545		CurRec: Integer;
3546	+	pda: PArrayDataArray;
3547	+	i: integer;
3548		begin
3549	<	inherited;
3549	>	inherited InternalCancel;
3550		Buff := GetActiveBuf;
3551	<	if Buff <> nil then begin
3551	>	if Buff <> nil then
3552	>	begin
3553	>	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3554	>	for i := 0 to ArrayFieldCount - 1 do
3555	>	pda^[i].ArrayIntf.CancelChanges;
3556		CurRec := FCurrentRecord;
3557		AdjustRecordOnInsert(Buff);
3558		if (State = dsEdit) then begin
#	Line 2654 \| Line 3575 \| begin
3575		DeactivateTransaction;
3576		FQSelect.Close;
3577		ClearBlobCache;
3578	+	ClearArrayCache;
3579		FreeRecordBuffer(FModelBuffer);
3580		FreeRecordBuffer(FOldBuffer);
3581		FCurrentRecord := -1;
#	Line 2669 \| Line 3591 \| begin
3591		FOBEnd := 0;
3592		FreeMem(FBufferCache);
3593		FBufferCache := nil;
3594	+	FreeMem(FFieldColumns);
3595	+	FFieldColumns := nil;
3596		FreeMem(FOldBufferCache);
3597		FOldBufferCache := nil;
3598		BindFields(False);
3599	+	ResetParser;
3600		if DefaultFields then DestroyFields;
3601		end;
3602
3603		procedure TIBCustomDataSet.InternalDelete;
3604		var
3605		Buff: PChar;
2681	–	SetCursor: Boolean;
3606		begin
3607	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684	<	if SetCursor then
2685	<	Screen.Cursor := crHourGlass;
3607	>	FBase.SetCursor;
3608		try
3609		Buff := GetActiveBuf;
3610		if CanDelete then
#	Line 2707 \| Line 3629 \| begin
3629		end else
3630		IBError(ibxeCannotDelete, [nil]);
3631		finally
3632	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2711	<	Screen.Cursor := crDefault;
3632	>	FBase.RestoreCursor;
3633		end;
3634		end;
3635
#	Line 2724 \| Line 3645 \| end;
3645
3646		procedure TIBCustomDataSet.InternalHandleException;
3647		begin
3648	<	Application.HandleException(Self)
3648	>	FBase.HandleException(Self)
3649		end;
3650
3651		procedure TIBCustomDataSet.InternalInitFieldDefs;
3652	+	begin
3653	+	if not InternalPrepared then
3654	+	begin
3655	+	InternalPrepare;
3656	+	exit;
3657	+	end;
3658	+	FieldDefsFromQuery(FQSelect);
3659	+	end;
3660	+
3661	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3662		const
3663		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3664		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2739 \| Line 3670 \| const
3670		var
3671		FieldType: TFieldType;
3672		FieldSize: Word;
3673	+	charSetID: short;
3674	+	CharSetSize: integer;
3675	+	CharSetName: RawByteString;
3676	+	FieldCodePage: TSystemCodePage;
3677		FieldNullable : Boolean;
3678		i, FieldPosition, FieldPrecision: Integer;
3679	<	FieldAliasName: string;
3680	<	RelationName, FieldName: string;
3679	>	FieldAliasName, DBAliasName: string;
3680	>	aRelationName, FieldName: string;
3681		Query : TIBSQL;
3682		FieldIndex: Integer;
3683		FRelationNodes : TRelationNode;
3684	+	aArrayDimensions: integer;
3685	+	aArrayBounds: TArrayBounds;
3686	+	ArrayMetaData: IArrayMetaData;
3687
3688		function Add_Node(Relation, Field : String) : TRelationNode;
3689		var
#	Line 2841 \| Line 3779 \| var
3779		end;
3780
3781		begin
2844	–	if not InternalPrepared then
2845	–	begin
2846	–	InternalPrepare;
2847	–	exit;
2848	–	end;
3782		FRelationNodes := TRelationNode.Create;
3783		FNeedsRefresh := False;
3784	<	Database.InternalTransaction.StartTransaction;
3784	>	if not Database.InternalTransaction.InTransaction then
3785	>	Database.InternalTransaction.StartTransaction;
3786		Query := TIBSQL.Create(self);
3787		try
3788		Query.Database := DataBase;
#	Line 2856 \| Line 3790 \| begin
3790		FieldDefs.BeginUpdate;
3791		FieldDefs.Clear;
3792		FieldIndex := 0;
3793	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3794	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3793	>	if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3794	>	SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3795		Query.SQL.Text := DefaultSQL;
3796		Query.Prepare;
3797	<	for i := 0 to FQSelect.Current.Count - 1 do
3798	<	with FQSelect.Current[i].Data^ do
3797	>	SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3798	>	SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3799	>	for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3800	>	with SourceQuery.MetaData[i] do
3801		begin
3802		{ Get the field name }
3803	<	SetString(FieldAliasName, aliasname, aliasname_length);
3804	<	SetString(RelationName, relname, relname_length);
3805	<	SetString(FieldName, sqlname, sqlname_length);
3803	>	FieldAliasName := GetName;
3804	>	DBAliasName := GetAliasname;
3805	>	aRelationName := getRelationName;
3806	>	FieldName := getSQLName;
3807	>	FAliasNameList[i] := DBAliasName;
3808		FieldSize := 0;
3809		FieldPrecision := 0;
3810	<	FieldNullable := FQSelect.Current[i].IsNullable;
3811	<	case sqltype and not 1 of
3810	>	FieldNullable := IsNullable;
3811	>	CharSetSize := 0;
3812	>	CharSetName := '';
3813	>	FieldCodePage := CP_NONE;
3814	>	aArrayDimensions := 0;
3815	>	SetLength(aArrayBounds,0);
3816	>	case SQLType of
3817		{ All VARCHAR's must be converted to strings before recording
3818		their values }
3819		SQL_VARYING, SQL_TEXT:
3820		begin
3821	<	FieldSize := sqllen;
3821	>	FirebirdAPI.CharSetWidth(getCharSetID,CharSetSize);
3822	>	CharSetName := FirebirdAPI.GetCharsetName(getCharSetID);
3823	>	FirebirdAPI.CharSetID2CodePage(getCharSetID,FieldCodePage);
3824	>	FieldSize := GetSize div CharSetSize;
3825		FieldType := ftString;
3826		end;
3827		{ All Doubles/Floats should be cast to doubles }
#	Line 2883 \| Line 3829 \| begin
3829		FieldType := ftFloat;
3830		SQL_SHORT:
3831		begin
3832	<	if (sqlscale = 0) then
3832	>	if (getScale = 0) then
3833		FieldType := ftSmallInt
3834		else begin
3835		FieldType := ftBCD;
3836		FieldPrecision := 4;
3837	<	FieldSize := -sqlscale;
3837	>	FieldSize := -getScale;
3838		end;
3839		end;
3840		SQL_LONG:
3841		begin
3842	<	if (sqlscale = 0) then
3842	>	if (getScale = 0) then
3843		FieldType := ftInteger
3844	<	else if (sqlscale >= (-4)) then
3844	>	else if (getScale >= (-4)) then
3845		begin
3846		FieldType := ftBCD;
3847		FieldPrecision := 9;
3848	<	FieldSize := -sqlscale;
3848	>	FieldSize := -getScale;
3849		end
3850		else
3851	<	FieldType := ftFloat;
3851	>	if Database.SQLDialect = 1 then
3852	>	FieldType := ftFloat
3853	>	else
3854	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
3855	>	FieldType := ftFloat
3856	>	else
3857	>	begin
3858	>	FieldType := ftFMTBCD;
3859	>	FieldPrecision := 9;
3860	>	FieldSize := -getScale;
3861		end;
3862	+	end;
3863	+
3864		SQL_INT64:
3865		begin
3866	<	if (sqlscale = 0) then
3866	>	if (getScale = 0) then
3867		FieldType := ftLargeInt
3868	<	else if (sqlscale >= (-4)) then
3868	>	else if (getScale >= (-4)) then
3869		begin
3870		FieldType := ftBCD;
3871		FieldPrecision := 18;
3872	<	FieldSize := -sqlscale;
3872	>	FieldSize := -getScale;
3873		end
3874		else
3875	<	FieldType := ftFloat;
3876	<	end;
3875	>	FieldType := ftFloat
3876	>	end;
3877		SQL_TIMESTAMP: FieldType := ftDateTime;
3878		SQL_TYPE_TIME: FieldType := ftTime;
3879		SQL_TYPE_DATE: FieldType := ftDate;
3880		SQL_BLOB:
3881		begin
3882		FieldSize := sizeof (TISC_QUAD);
3883	<	if (sqlsubtype = 1) then
3884	<	FieldType := ftmemo
3883	>	if (getSubtype = 1) then
3884	>	begin
3885	>	FirebirdAPI.CharSetWidth(getCharSetID,CharSetSize);
3886	>	CharSetName := FirebirdAPI.GetCharsetName(getCharSetID);
3887	>	FirebirdAPI.CharSetID2CodePage(getCharSetID,FieldCodePage);
3888	>	FieldType := ftMemo;
3889	>	end
3890		else
3891		FieldType := ftBlob;
3892		end;
3893		SQL_ARRAY:
3894		begin
3895		FieldSize := sizeof (TISC_QUAD);
3896	<	FieldType := ftUnknown;
3896	>	FieldType := ftArray;
3897	>	ArrayMetaData := GetArrayMetaData;
3898	>	if ArrayMetaData <> nil then
3899	>	begin
3900	>	aArrayDimensions := ArrayMetaData.GetDimensions;
3901	>	aArrayBounds := ArrayMetaData.GetBounds;
3902	>	end;
3903		end;
3904	+	SQL_BOOLEAN:
3905	+	FieldType:= ftBoolean;
3906		else
3907		FieldType := ftUnknown;
3908		end;
#	Line 2941 \| Line 3911 \| begin
3911		begin
3912		FMappedFieldPosition[FieldIndex] := FieldPosition;
3913		Inc(FieldIndex);
3914	<	with FieldDefs.AddFieldDef do
3914	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3915		begin
3916	<	Name := string( FieldAliasName );
3917	<	FieldNo := FieldPosition;
2948	<	DataType := FieldType;
3916	>	Name := FieldAliasName;
3917	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3918		Size := FieldSize;
3919		Precision := FieldPrecision;
3920	<	Required := False;
3920	>	Required := not FieldNullable;
3921	>	RelationName := aRelationName;
3922		InternalCalcField := False;
3923	+	CharacterSetSize := CharSetSize;
3924	+	CharacterSetName := CharSetName;
3925	+	CodePage := FieldCodePage;
3926	+	ArrayDimensions := aArrayDimensions;
3927	+	ArrayBounds := aArrayBounds;
3928		if (FieldName <> '') and (RelationName <> '') then
3929		begin
3930		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 2977 \| Line 3952 \| begin
3952		FreeNodes;
3953		Database.InternalTransaction.Commit;
3954		FieldDefs.EndUpdate;
3955	+	FieldDefs.Updated := true;
3956		end;
3957		end;
3958
#	Line 2994 \| Line 3970 \| begin
3970		else begin
3971		Buffer := AllocRecordBuffer;
3972		try
3973	<	while FQSelect.Next <> nil do
3973	>	while FQSelect.Next do
3974		begin
3975		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3976		Inc(FRecordCount);
#	Line 3009 \| Line 3985 \| end;
3985		procedure TIBCustomDataSet.InternalSetParamsFromCursor;
3986		var
3987		i: Integer;
3988	<	cur_param: TIBXSQLVAR;
3988	>	cur_param: ISQLParam;
3989		cur_field: TField;
3990		s: TStream;
3991		begin
#	Line 3017 \| Line 3993 \| begin
3993		IBError(ibxeEmptyQuery, [nil]);
3994		if not FInternalPrepared then
3995		InternalPrepare;
3996	<	if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
3996	>	if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
3997		begin
3998	<	for i := 0 to SQLParams.Count - 1 do
3998	>	for i := 0 to SQLParams.GetCount - 1 do
3999		begin
4000		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4001		cur_param := SQLParams[i];
#	Line 3029 \| Line 4005 \| begin
4005		else case cur_field.DataType of
4006		ftString:
4007		cur_param.AsString := cur_field.AsString;
4008	<	ftBoolean, ftSmallint, ftWord:
4008	>	ftBoolean:
4009	>	cur_param.AsBoolean := cur_field.AsBoolean;
4010	>	ftSmallint, ftWord:
4011		cur_param.AsShort := cur_field.AsInteger;
4012		ftInteger:
4013		cur_param.AsLong := cur_field.AsInteger;
#	Line 3051 \| Line 4029 \| begin
4029		try
4030		s := DataSource.DataSet.
4031		CreateBlobStream(cur_field, bmRead);
4032	<	cur_param.LoadFromStream(s);
4032	>	cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4033		finally
4034		s.free;
4035		end;
4036		end;
4037	+	ftArray:
4038	+	cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4039		else
4040		IBError(ibxeNotSupported, [nil]);
4041		end;
#	Line 3082 \| Line 4062 \| begin
4062		end;
4063
4064		procedure TIBCustomDataSet.InternalOpen;
3085	–	var
3086	–	SetCursor: Boolean;
4065
4066		function RecordDataLength(n: Integer): Long;
4067		begin
#	Line 3091 \| Line 4069 \| var
4069		end;
4070
4071		begin
4072	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095	<	if SetCursor then
3096	<	Screen.Cursor := crHourGlass;
4072	>	FBase.SetCursor;
4073		try
4074		ActivateConnection;
4075		ActivateTransaction;
#	Line 3101 \| Line 4077 \| begin
4077		IBError(ibxeEmptyQuery, [nil]);
4078		if not FInternalPrepared then
4079		InternalPrepare;
4080	<	if FQSelect.SQLType = SQLSelect then
4080	>	if FQSelect.SQLStatementType = SQLSelect then
4081		begin
4082		if DefaultFields then
4083		CreateFields;
4084	+	FArrayFieldCount := 0;
4085		BindFields(True);
4086		FCurrentRecord := -1;
4087		FQSelect.ExecQuery;
#	Line 3116 \| Line 4093 \| begin
4093		3. After the dummy fetch, FRecordSize will be appropriately
4094		adjusted to reflect the additional "weight" of the field
4095		data.
4096	<	4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4096	>	4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4097		5. Now, with the BufferSize available, allocate memory for chunks of records
4098		6. Re-allocate the model buffer, accounting for the new
4099		FRecordBufferSize.
4100		7. Finally, calls to AllocRecordBuffer will work!.
4101		}
4102		{Step 1}
4103	<	FRecordSize := RecordDataLength(FQSelect.Current.Count);
4103	>	FRecordSize := RecordDataLength(FQSelect.FieldCount);
4104		{Step 2, 3}
4105	+	GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4106		IBAlloc(FModelBuffer, 0, FRecordSize);
4107	<	FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4107	>	InitModelBuffer(FQSelect, FModelBuffer);
4108		{Step 4}
4109		FCalcFieldsOffset := FRecordSize;
4110		FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4111	<	FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4111	>	FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4112	>	FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4113		{Step 5}
4114		if UniDirectional then
4115		FBufferChunkSize := FRecordBufferSize * UniCache
#	Line 3146 \| Line 4125 \| begin
4125		FCacheSize := FBufferChunkSize;
4126		FOldCacheSize := FBufferChunkSize;
4127		{Step 6}
4128	<	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4128	>	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4129		FRecordBufferSize);
4130		{Step 7}
4131		FOldBuffer := AllocRecordBuffer;
#	Line 3154 \| Line 4133 \| begin
4133		else
4134		FQSelect.ExecQuery;
4135		finally
4136	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3158	<	Screen.Cursor := crDefault;
4136	>	FBase.RestoreCursor;
4137		end;
4138		end;
4139
#	Line 3163 \| Line 4141 \| procedure TIBCustomDataSet.InternalPost;
4141		var
4142		Qry: TIBSQL;
4143		Buff: PChar;
3166	–	SetCursor: Boolean;
4144		bInserting: Boolean;
4145		begin
4146	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170	<	if SetCursor then
3171	<	Screen.Cursor := crHourGlass;
4146	>	FBase.SetCursor;
4147		try
4148		Buff := GetActiveBuf;
4149		CheckEditState;
#	Line 3206 \| Line 4181 \| begin
4181		if bInserting then
4182		Inc(FRecordCount);
4183		finally
4184	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3210	<	Screen.Cursor := crDefault;
4184	>	FBase.RestoreCursor;
4185		end;
4186		end;
4187
4188		procedure TIBCustomDataSet.InternalRefresh;
4189		begin
4190	<	inherited;
4190	>	inherited InternalRefresh;
4191		InternalRefreshRow;
4192		end;
4193
#	Line 3227 \| Line 4201 \| begin
4201		result := FOpen;
4202		end;
4203
4204	+	procedure TIBCustomDataSet.Loaded;
4205	+	begin
4206	+	if assigned(FQSelect) then
4207	+	FBaseSQLSelect.assign(FQSelect.SQL);
4208	+	inherited Loaded;
4209	+	end;
4210	+
4211	+	procedure TIBCustomDataSet.Post;
4212	+	var CancelPost: boolean;
4213	+	begin
4214	+	CancelPost := false;
4215	+	if assigned(FOnValidatePost) then
4216	+	OnValidatePost(self,CancelPost);
4217	+	if CancelPost then
4218	+	Cancel
4219	+	else
4220	+	inherited Post;
4221	+	end;
4222	+
4223		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4224		Options: TLocateOptions): Boolean;
4225		var
4226	<	CurBookmark: string;
4226	>	CurBookmark: TBookmark;
4227		begin
4228		DisableControls;
4229		try
#	Line 3248 \| Line 4241 \| function TIBCustomDataSet.Lookup(const K
4241		const ResultFields: string): Variant;
4242		var
4243		fl: TList;
4244	<	CurBookmark: string;
4244	>	CurBookmark: TBookmark;
4245		begin
4246		DisableControls;
4247		fl := TList.Create;
#	Line 3301 \| Line 4294 \| end;
4294		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4295		var
4296		Buff, TmpBuff: PChar;
4297	+	MappedFieldPos: integer;
4298		begin
4299		Buff := GetActiveBuf;
4300		if Field.FieldNo < 0 then
#	Line 3317 \| Line 4311 \| begin
4311		begin
4312		{ If inserting, Adjust record position }
4313		AdjustRecordOnInsert(Buff);
4314	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4315	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4314	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4315	>	if (MappedFieldPos > 0) and
4316	>	(MappedFieldPos <= rdFieldCount) then
4317	>	with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4318		begin
4319		Field.Validate(Buffer);
4320		if (Buffer = nil) or
4321		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4322	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4323	<	else begin
4324	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4325	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4326	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4327	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4328	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3333	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4322	>	fdIsNull := True
4323	>	else
4324	>	begin
4325	>	Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4326	>	if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4327	>	fdDataLength := StrLen(PChar(Buffer));
4328	>	fdIsNull := False;
4329		if rdUpdateStatus = usUnmodified then
4330		begin
4331		if CachedUpdates then
#	Line 3354 \| Line 4349 \| begin
4349		end;
4350		end;
4351		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4352	<	DataEvent(deFieldChange, Longint(Field));
4352	>	DataEvent(deFieldChange, PtrInt(Field));
4353		end;
4354
4355		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3418 \| Line 4413 \| begin
4413		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4414		end;
4415
4416	+	procedure TIBCustomDataSet.ClearIBLinks;
4417	+	var i: integer;
4418	+	begin
4419	+	for i := FIBLinks.Count - 1 downto 0 do
4420	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4421	+	end;
4422	+
4423
4424		procedure TIBCustomDataSet.InternalUnPrepare;
4425		begin
4426		if FInternalPrepared then
4427		begin
4428		CheckDatasetClosed;
4429	+	if FDidActivate then
4430	+	DeactivateTransaction;
4431		FieldDefs.Clear;
4432	+	FieldDefs.Updated := false;
4433		FInternalPrepared := False;
4434	+	Setlength(FAliasNameList,0);
4435		end;
4436		end;
4437
4438		procedure TIBCustomDataSet.InternalExecQuery;
4439		var
4440		DidActivate: Boolean;
3435	–	SetCursor: Boolean;
4441		begin
4442		DidActivate := False;
4443	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439	<	if SetCursor then
3440	<	Screen.Cursor := crHourGlass;
4443	>	FBase.SetCursor;
4444		try
4445		ActivateConnection;
4446		DidActivate := ActivateTransaction;
#	Line 3445 \| Line 4448 \| begin
4448		IBError(ibxeEmptyQuery, [nil]);
4449		if not FInternalPrepared then
4450		InternalPrepare;
4451	<	if FQSelect.SQLType = SQLSelect then
4451	>	if FQSelect.SQLStatementType = SQLSelect then
4452		begin
4453		IBError(ibxeIsASelectStatement, [nil]);
4454		end
#	Line 3454 \| Line 4457 \| begin
4457		finally
4458		if DidActivate then
4459		DeactivateTransaction;
4460	<	if SetCursor and (Screen.Cursor = crHourGlass) then
4461	<	Screen.Cursor := crDefault;
4460	>	FBase.RestoreCursor;
4461	>	end;
4462	>	end;
4463	>
4464	>	function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4465	>	begin
4466	>	Result := FQSelect.Statement;
4467	>	end;
4468	>
4469	>	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4470	>	begin
4471	>	if not assigned(FParser) then
4472	>	FParser := CreateParser;
4473	>	Result := FParser
4474	>	end;
4475	>
4476	>	procedure TIBCustomDataSet.ResetParser;
4477	>	begin
4478	>	if assigned(FParser) then
4479	>	begin
4480	>	FParser.Free;
4481	>	FParser := nil;
4482	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
4483	>	try
4484	>	FQSelect.SQL.Assign(FBaseSQLSelect);
4485	>	finally
4486	>	FQSelect.OnSQLChanged := SQLChanged;
4487	>	end;
4488		end;
4489		end;
4490
4491	<	function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4491	>	function TIBCustomDataSet.HasParser: boolean;
4492	>	begin
4493	>	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4494	>	end;
4495	>
4496	>	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4497		begin
4498	<	Result := FQSelect.Handle;
4498	>	if FGenerateParamNames = AValue then Exit;
4499	>	FGenerateParamNames := AValue;
4500	>	Disconnect
4501		end;
4502
4503		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
#	Line 3682 \| Line 4718 \| begin
4718		ActivateConnection;
4719		ActivateTransaction;
4720		InternalSetParamsFromCursor;
4721	<	Inherited;
4721	>	Inherited InternalOpen;
4722		end;
4723
4724		procedure TIBDataSet.SetFiltered(Value: Boolean);
#	Line 3710 \| Line 4746 \| end;
4746
4747		function TIBCustomDataSet.GetFieldData(Field: TField;
4748		Buffer: Pointer): Boolean;
4749	+	{$IFDEF TBCDFIELD_IS_BCD}
4750		var
4751		lTempCurr : System.Currency;
4752		begin
#	Line 3720 \| Line 4757 \| begin
4757		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4758		end
4759		else
4760	+	{$ELSE}
4761	+	begin
4762	+	{$ENDIF}
4763		Result := InternalGetFieldData(Field, Buffer);
4764		end;
4765
#	Line 3733 \| Line 4773 \| begin
4773		end;
4774
4775		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4776	+	{$IFDEF TDBDFIELD_IS_BCD}
4777		var
4778		lTempCurr : System.Currency;
4779		begin
4780	<	if Field.DataType = ftBCD then
4780	>	if (Field.DataType = ftBCD) and (Buffer <> nil) then
4781		begin
4782		BCDToCurr(TBCD(Buffer^), lTempCurr);
4783		InternalSetFieldData(Field, @lTempCurr);
4784		end
4785		else
4786	+	{$ELSE}
4787	+	begin
4788	+	{$ENDIF}
4789		InternalSetFieldData(Field, Buffer);
4790		end;
4791
#	Line 3765 \| Line 4809 \| end;
4809		destructor TIBDataSetUpdateObject.Destroy;
4810		begin
4811		FRefreshSQL.Free;
4812	<	inherited destroy;
4812	>	inherited Destroy;
4813		end;
4814
4815		procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
#	Line 3773 \| Line 4817 \| begin
4817		FRefreshSQL.Assign(Value);
4818		end;
4819
4820	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4821	+	begin
4822	+	if not Assigned(DataSet) then Exit;
4823	+	DataSet.SetInternalSQLParams(Query, buff);
4824	+	end;
4825	+
4826	+	function TIBDSBlobStream.GetSize: Int64;
4827	+	begin
4828	+	Result := FBlobStream.BlobSize;
4829	+	end;
4830	+
4831		{ TIBDSBlobStream }
4832		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4833		Mode: TBlobStreamMode);
#	Line 3781 \| Line 4836 \| begin
4836		FBlobStream := ABlobStream;
4837		FBlobStream.Seek(0, soFromBeginning);
4838		if (Mode = bmWrite) then
4839	+	begin
4840		FBlobStream.Truncate;
4841	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
4842	+	TBlobField(FField).Modified := true;
4843	+	FHasWritten := true;
4844	+	end;
4845	+	end;
4846	+
4847	+	destructor TIBDSBlobStream.Destroy;
4848	+	begin
4849	+	if FHasWritten then
4850	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4851	+	inherited Destroy;
4852		end;
4853
4854		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
#	Line 3804 \| Line 4871 \| begin
4871		if not (FField.DataSet.State in [dsEdit, dsInsert]) then
4872		IBError(ibxeNotEditing, [nil]);
4873		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4874	+	TBlobField(FField).Modified := true;
4875		result := FBlobStream.Write(Buffer, Count);
4876	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
4876	>	FHasWritten := true;
4877	>	{ TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4878	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4879	>	the blob stream. Moved to the destructor i.e. called after blob written}
4880	>	end;
4881	>
4882	>	{ TIBGenerator }
4883	>
4884	>	procedure TIBGenerator.SetIncrement(const AValue: integer);
4885	>	begin
4886	>	if AValue < 0 then
4887	>	raise Exception.Create('A Generator Increment cannot be negative');
4888	>	FIncrement := AValue
4889	>	end;
4890	>
4891	>	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4892	>	ATransaction: TIBTransaction): integer;
4893	>	begin
4894	>	with TIBSQL.Create(nil) do
4895	>	try
4896	>	Database := ADatabase;
4897	>	Transaction := ATransaction;
4898	>	if not assigned(Database) then
4899	>	IBError(ibxeCannotSetDatabase,[]);
4900	>	if not assigned(Transaction) then
4901	>	IBError(ibxeCannotSetTransaction,[]);
4902	>	with Transaction do
4903	>	if not InTransaction then StartTransaction;
4904	>	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4905	>	Prepare;
4906	>	ExecQuery;
4907	>	try
4908	>	Result := FieldByName('ID').AsInteger
4909	>	finally
4910	>	Close
4911	>	end;
4912	>	finally
4913	>	Free
4914	>	end;
4915		end;
4916
4917	+	constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
4918	+	begin
4919	+	FOwner := Owner;
4920	+	FIncrement := 1;
4921	+	end;
4922	+
4923	+
4924	+	procedure TIBGenerator.Apply;
4925	+	begin
4926	+	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4927	+	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4928	+	end;
4929	+
4930	+
4931		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 45 by tony, Tue Dec 6 10:33:46 2016 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 45 by tony, Tue Dec 6 10:33:46 2016 UTC