[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 67 by tony, Tue Oct 3 14:08:11 2017 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	+	FDataSize: integer;
185	+	protected
186	+	procedure Bind(Binding: Boolean); override;
187	+	function GetDataSize: Integer; override;
188		public
189	<	constructor create(AOwner: TComponent); override;
189	>	constructor Create(aOwner: TComponent); override;
190		class procedure CheckTypeSize(Value: Integer); override;
191		function GetAsString: string; override;
192		function GetAsVariant: Variant; override;
193		function GetValue(var Value: string): Boolean;
194		procedure SetAsString(const Value: string); override;
195	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
196	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
197	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
198	+	published
199	+	property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
200		end;
201
202		{ TIBBCDField }
#	Line 129 \| Line 219 \| type
219		property Size default 8;
220		end;
221
222	+	{TIBMemoField}
223	+	{Allows us to show truncated text in DBGrids and anything else that uses
224	+	DisplayText}
225	+
226	+	TIBMemoField = class(TMemoField)
227	+	private
228	+	FCharacterSetName: RawByteString;
229	+	FCharacterSetSize: integer;
230	+	FDisplayTextAsClassName: boolean;
231	+	function GetTruncatedText: string;
232	+	protected
233	+	procedure Bind(Binding: Boolean); override;
234	+	function GetAsString: string; override;
235	+	function GetDefaultWidth: Longint; override;
236	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
237	+	procedure SetAsString(const AValue: string); override;
238	+	public
239	+	constructor Create(AOwner: TComponent); override;
240	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
241	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
242	+	published
243	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
244	+	write FDisplayTextAsClassName;
245	+	private
246	+	FCodePage: TSystemCodePage;
247	+	FFCodePage: TSystemCodePage;
248	+	public
249	+	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
250	+	end;
251	+
252		TIBDataLink = class(TDetailDataLink)
253		private
254		FDataSet: TIBCustomDataSet;
#	Line 142 \| Line 262 \| type
262		destructor Destroy; override;
263		end;
264
265	+	TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
266	+
267	+	{ TIBGenerator }
268	+
269	+	TIBGenerator = class(TPersistent)
270	+	private
271	+	FOwner: TIBCustomDataSet;
272	+	FApplyOnEvent: TIBGeneratorApplyOnEvent;
273	+	FFieldName: string;
274	+	FGeneratorName: string;
275	+	FIncrement: integer;
276	+	procedure SetIncrement(const AValue: integer);
277	+	protected
278	+	function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
279	+	public
280	+	constructor Create(Owner: TIBCustomDataSet);
281	+	procedure Apply;
282	+	property Owner: TIBCustomDataSet read FOwner;
283	+	published
284	+	property Generator: string read FGeneratorName write FGeneratorName;
285	+	property Field: string read FFieldName write FFieldName;
286	+	property Increment: integer read FIncrement write SetIncrement default 1;
287	+	property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
288	+	end;
289	+
290	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
291	+
292	+	TIBControlLink = class
293	+	private
294	+	FTIBDataSet: TIBCustomDataSet;
295	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
296	+	protected
297	+	procedure UpdateSQL(Sender: TObject); virtual;
298	+	procedure UpdateParams(Sender: TObject); virtual;
299	+	public
300	+	destructor Destroy; override;
301	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
302	+	end;
303	+
304	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
305	+
306		{ TIBCustomDataSet }
307	+
308		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
309
310		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
311	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
311	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
312		of object;
313		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
314		var UpdateAction: TIBUpdateAction) of object;
315
316		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
317
318	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
319	+
320	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
321	+
322		TIBCustomDataSet = class(TDataset)
323		private
324	+	FAllowAutoActivateTransaction: Boolean;
325	+	FArrayFieldCount: integer;
326	+	FArrayCacheOffset: integer;
327	+	FAutoCommit: TIBAutoCommit;
328	+	FGenerateParamNames: Boolean;
329	+	FGeneratorField: TIBGenerator;
330		FNeedsRefresh: Boolean;
331		FForcedRefresh: Boolean;
332		FDidActivate: Boolean;
161	–	FIBLoaded: Boolean;
333		FBase: TIBBase;
334		FBlobCacheOffset: Integer;
335		FBlobStreamList: TList;
336	+	FArrayList: TList;
337		FBufferChunks: Integer;
338		FBufferCache,
339		FOldBufferCache: PChar;
#	Line 179 \| Line 351 \| type
351		FDeletedRecords: Long;
352		FModelBuffer,
353		FOldBuffer: PChar;
354	+	FOnValidatePost: TOnValidatePost;
355		FOpen: Boolean;
356		FInternalPrepared: Boolean;
357		FQDelete,
#	Line 189 \| Line 362 \| type
362		FRecordBufferSize: Integer;
363		FRecordCount: Integer;
364		FRecordSize: Integer;
365	+	FDataSetCloseAction: TDataSetCloseAction;
366		FUniDirectional: Boolean;
367		FUpdateMode: TUpdateMode;
368		FUpdateObject: TIBDataSetUpdateObject;
#	Line 206 \| Line 380 \| type
380		FBeforeTransactionEnd,
381		FAfterTransactionEnd,
382		FTransactionFree: TNotifyEvent;
383	<
384	<	function GetSelectStmtHandle: TISC_STMT_HANDLE;
383	>	FAliasNameMap: array of string;
384	>	FAliasNameList: array of string;
385	>	FBaseSQLSelect: TStrings;
386	>	FParser: TSelectSQLParser;
387	>	FCloseAction: TTransactionAction;
388	>	FInTransactionEnd: boolean;
389	>	FIBLinks: TList;
390	>	FFieldColumns: PFieldColumns;
391	>	procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
392	>	function GetSelectStmtIntf: IStatement;
393		procedure SetUpdateMode(const Value: TUpdateMode);
394		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
395
#	Line 219 \| Line 401 \| type
401		function CanRefresh: Boolean;
402		procedure CheckEditState;
403		procedure ClearBlobCache;
404	+	procedure ClearArrayCache;
405	+	procedure ClearIBLinks;
406		procedure CopyRecordBuffer(Source, Dest: Pointer);
407		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
408		procedure DoAfterDatabaseDisconnect(Sender: TObject);
409		procedure DoDatabaseFree(Sender: TObject);
410	<	procedure DoBeforeTransactionEnd(Sender: TObject);
410	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
411		procedure DoAfterTransactionEnd(Sender: TObject);
412		procedure DoTransactionFree(Sender: TObject);
413		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
414		Buffer: PChar);
415		function GetDatabase: TIBDatabase;
232	–	function GetDBHandle: PISC_DB_HANDLE;
416		function GetDeleteSQL: TStrings;
417		function GetInsertSQL: TStrings;
418	<	function GetSQLParams: TIBXSQLDA;
418	>	function GetSQLParams: ISQLParams;
419		function GetRefreshSQL: TStrings;
420		function GetSelectSQL: TStrings;
421	<	function GetStatementType: TIBSQLTypes;
421	>	function GetStatementType: TIBSQLStatementTypes;
422		function GetModifySQL: TStrings;
423		function GetTransaction: TIBTransaction;
424	<	function GetTRHandle: PISC_TR_HANDLE;
425	<	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
424	>	function GetParser: TSelectSQLParser;
425	>	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
426		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
427		Options: TLocateOptions): Boolean; virtual;
428	<	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
429	<	procedure InternalRevertRecord(RecordNumber: Integer);
428	>	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
429	>	procedure InternalRevertRecord(RecordNumber: Integer); virtual;
430		function IsVisible(Buffer: PChar): Boolean;
431	+	procedure RegisterIBLink(Sender: TIBControlLink);
432	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
433		procedure SaveOldBuffer(Buffer: PChar);
434		procedure SetBufferChunks(Value: Integer);
435		procedure SetDatabase(Value: TIBDatabase);
#	Line 258 \| Line 443 \| type
443		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
444		procedure SetUniDirectional(Value: Boolean);
445		procedure RefreshParams;
261	–	procedure SQLChanging(Sender: TObject); virtual;
446		function AdjustPosition(FCache: PChar; Offset: DWORD;
447	<	Origin: Integer): Integer;
447	>	Origin: Integer): DWORD;
448		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
449		Buffer: PChar);
450		procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
#	Line 269 \| Line 453 \| type
453		Buffer: PChar);
454		procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
455		function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
456	<	DoCheck: Boolean): TGetResult;
456	>	DoCheck: Boolean): TGetResult; virtual;
457
458		protected
459		procedure ActivateConnection;
#	Line 277 \| Line 461 \| type
461		procedure DeactivateTransaction;
462		procedure CheckDatasetClosed;
463		procedure CheckDatasetOpen;
464	+	function CreateParser: TSelectSQLParser; virtual;
465	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
466		function GetActiveBuf: PChar;
467	<	procedure InternalBatchInput(InputObject: TIBBatchInput);
468	<	procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
467	>	procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
468	>	procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
469		procedure InternalPrepare; virtual;
470		procedure InternalUnPrepare; virtual;
471		procedure InternalExecQuery; virtual;
472		procedure InternalRefreshRow; virtual;
473	<	procedure InternalSetParamsFromCursor;
473	>	procedure InternalSetParamsFromCursor; virtual;
474		procedure CheckNotUniDirectional;
475	+	procedure SQLChanging(Sender: TObject); virtual;
476	+	procedure SQLChanged(Sender: TObject); virtual;
477
478		{ IProviderSupport }
479		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 309 \| Line 497 \| type
497		procedure ClearCalcFields(Buffer: PChar); override;
498		function AllocRecordBuffer: PChar; override;
499		procedure DoBeforeDelete; override;
500	+	procedure DoAfterDelete; override;
501		procedure DoBeforeEdit; override;
502	+	procedure DoAfterEdit; override;
503		procedure DoBeforeInsert; override;
504	+	procedure DoAfterInsert; override;
505	+	procedure DoBeforeClose; override;
506	+	procedure DoBeforeOpen; override;
507	+	procedure DoBeforePost; override;
508	+	procedure DoAfterPost; override;
509		procedure FreeRecordBuffer(var Buffer: PChar); override;
510		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
511		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
512		function GetCanModify: Boolean; override;
513		function GetDataSource: TDataSource; override;
514	+	function GetDBAliasName(FieldNo: integer): string;
515	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
516		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
517		function GetRecNo: Integer; override;
518		function GetRecord(Buffer: PChar; GetMode: TGetMode;
519		DoCheck: Boolean): TGetResult; override;
520		function GetRecordCount: Integer; override;
521		function GetRecordSize: Word; override;
522	+	procedure InternalAutoCommit;
523		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
524		procedure InternalCancel; override;
525		procedure InternalClose; override;
526		procedure InternalDelete; override;
527		procedure InternalFirst; override;
528	<	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
528	>	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
529		procedure InternalGotoBookmark(Bookmark: Pointer); override;
530		procedure InternalHandleException; override;
531		procedure InternalInitFieldDefs; override;
#	Line 336 \| Line 534 \| type
534		procedure InternalOpen; override;
535		procedure InternalPost; override;
536		procedure InternalRefresh; override;
537	<	procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
537	>	procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
538		procedure InternalSetToRecord(Buffer: PChar); override;
539		function IsCursorOpen: Boolean; override;
540	+	procedure Loaded; override;
541		procedure ReQuery;
542		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
543		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
544		procedure SetCachedUpdates(Value: Boolean);
545		procedure SetDataSource(Value: TDataSource);
546	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
547		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
548		procedure SetFieldData(Field : TField; Buffer : Pointer;
549		NativeFormat : Boolean); overload; override;
#	Line 351 \| Line 551 \| type
551
552		protected
553		{Likely to be made public by descendant classes}
554	<	property SQLParams: TIBXSQLDA read GetSQLParams;
555	<	property Params: TIBXSQLDA read GetSQLParams;
554	>	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
555	>	property SQLParams: ISQLParams read GetSQLParams;
556	>	property Params: ISQLParams read GetSQLParams;
557		property InternalPrepared: Boolean read FInternalPrepared;
558		property QDelete: TIBSQL read FQDelete;
559		property QInsert: TIBSQL read FQInsert;
560		property QRefresh: TIBSQL read FQRefresh;
561		property QSelect: TIBSQL read FQSelect;
562		property QModify: TIBSQL read FQModify;
563	<	property StatementType: TIBSQLTypes read GetStatementType;
564	<	property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
563	>	property StatementType: TIBSQLStatementTypes read GetStatementType;
564	>	property SelectStmtHandle: IStatement read GetSelectStmtIntf;
565
566		{Likely to be made published by descendant classes}
567		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
568		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
569		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
570	+	property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
571		property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
572		property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
573		property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
#	Line 373 \| Line 575 \| type
575		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
576		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
577		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
578	+	property Parser: TSelectSQLParser read GetParser;
579	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
580
581		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
582		write FBeforeDatabaseDisconnect;
#	Line 386 \| Line 590 \| type
590		write FAfterTransactionEnd;
591		property TransactionFree: TNotifyEvent read FTransactionFree
592		write FTransactionFree;
593	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
594
595		public
596		constructor Create(AOwner: TComponent); override;
#	Line 393 \| Line 598 \| type
598		procedure ApplyUpdates;
599		function CachedUpdateStatus: TCachedUpdateStatus;
600		procedure CancelUpdates;
601	+	function GetFieldPosition(AliasName: string): integer;
602		procedure FetchAll;
603		function LocateNext(const KeyFields: string; const KeyValues: Variant;
604		Options: TLocateOptions): Boolean;
605		procedure RecordModified(Value: Boolean);
606		procedure RevertRecord;
607		procedure Undelete;
608	+	procedure ResetParser; virtual;
609	+	function HasParser: boolean;
610
611		{ TDataSet support methods }
612		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
613		function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
614		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
615	+	function GetArray(Field: TIBArrayField): IArray;
616	+	procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
617		function GetCurrentRecord(Buffer: PChar): Boolean; override;
618		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
619	<	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
619	>	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (override;)
620		function GetFieldData(Field : TField; Buffer : Pointer;
621		NativeFormat : Boolean) : Boolean; overload; override;
622	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
623		function Locate(const KeyFields: string; const KeyValues: Variant;
624		Options: TLocateOptions): Boolean; override;
625		function Lookup(const KeyFields: string; const KeyValues: Variant;
626		const ResultFields: string): Variant; override;
627		function UpdateStatus: TUpdateStatus; override;
628		function IsSequenced: Boolean; override;
629	<
630	<	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
631	<	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
629	>	procedure Post; override;
630	>	function ParamByName(ParamName: String): ISQLParam;
631	>	property ArrayFieldCount: integer read FArrayFieldCount;
632		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
633		property UpdatesPending: Boolean read FUpdatesPending;
634		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
635		write SetUpdateRecordTypes;
636	+	property DataSetCloseAction: TDataSetCloseAction
637	+	read FDataSetCloseAction write FDataSetCloseAction;
638
639		published
640	+	property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
641	+	write FAllowAutoActivateTransaction;
642		property Database: TIBDatabase read GetDatabase write SetDatabase;
643		property Transaction: TIBTransaction read GetTransaction
644		write SetTransaction;
645		property ForcedRefresh: Boolean read FForcedRefresh
646		write FForcedRefresh default False;
647		property AutoCalcFields;
433	–	property ObjectView default False;
648
649		property AfterCancel;
650		property AfterClose;
#	Line 461 \| Line 675 \| type
675		write FOnUpdateRecord;
676		end;
677
678	<	TIBDataSet = class(TIBCustomDataSet)
678	>	TIBParserDataSet = class(TIBCustomDataSet)
679	>	public
680	>	property Parser;
681	>	end;
682	>
683	>	TIBDataSet = class(TIBParserDataSet)
684		private
685		function GetPrepared: Boolean;
686
#	Line 486 \| Line 705 \| type
705		property QModify;
706		property StatementType;
707		property SelectStmtHandle;
708	+	property BaseSQLSelect;
709
710		published
711		{ TIBCustomDataSet }
712	+	property AutoCommit;
713		property BufferChunks;
714		property CachedUpdates;
715		property DeleteSQL;
#	Line 496 \| Line 717 \| type
717		property RefreshSQL;
718		property SelectSQL;
719		property ModifySQL;
720	+	property GeneratorField;
721	+	property GenerateParamNames;
722		property ParamCheck;
723		property UniDirectional;
724		property Filtered;
725	+	property DataSetCloseAction;
726
727		property BeforeDatabaseDisconnect;
728		property AfterDatabaseDisconnect;
#	Line 534 \| Line 758 \| type
758		property OnFilterRecord;
759		property OnNewRecord;
760		property OnPostError;
761	+	property OnValidatePost;
762		end;
763
764		{ TIBDSBlobStream }
765		TIBDSBlobStream = class(TStream)
766	+	private
767	+	FHasWritten: boolean;
768		protected
769		FField: TField;
770		FBlobStream: TIBBlobStream;
771	+	function GetSize: Int64; override;
772		public
773		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
774		Mode: TBlobStreamMode);
775	+	destructor Destroy; override;
776		function Read(var Buffer; Count: Longint): Longint; override;
777		function Seek(Offset: Longint; Origin: Word): Longint; override;
778		procedure SetSize(NewSize: Longint); override;
779		function Write(const Buffer; Count: Longint): Longint; override;
780		end;
781
782	+	{Extended Field Def for character set info}
783	+
784	+	{ TIBFieldDef }
785	+
786	+	TIBFieldDef = class(TFieldDef)
787	+	private
788	+	FArrayBounds: TArrayBounds;
789	+	FArrayDimensions: integer;
790	+	FCharacterSetName: RawByteString;
791	+	FCharacterSetSize: integer;
792	+	FCodePage: TSystemCodePage;
793	+	FRelationName: string;
794	+	FDataSize: integer;
795	+	published
796	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
797	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
798	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
799	+	property DataSize: integer read FDataSize write FDataSize;
800	+	property RelationName: string read FRelationName write FRelationName;
801	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
802	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
803	+	end;
804	+
805		const
806		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
807		nil, { ftUnknown }
#	Line 568 \| Line 820 \| DefaultFieldClasses: array[TFieldType] o
820		TVarBytesField, { ftVarBytes }
821		TAutoIncField, { ftAutoInc }
822		TBlobField, { ftBlob }
823	<	TMemoField, { ftMemo }
823	>	TIBMemoField, { ftMemo }
824		TGraphicField, { ftGraphic }
825		TBlobField, { ftFmtMemo }
826		TBlobField, { ftParadoxOle }
#	Line 576 \| Line 828 \| DefaultFieldClasses: array[TFieldType] o
828		TBlobField, { ftTypedBinary }
829		nil, { ftCursor }
830		TStringField, { ftFixedChar }
831	<	nil, {TWideStringField } { ftWideString }
831	>	nil, { ftWideString }
832		TLargeIntField, { ftLargeInt }
833	+	nil, { ftADT }
834	+	TIBArrayField, { ftArray }
835	+	nil, { ftReference }
836	+	nil, { ftDataSet }
837	+	TBlobField, { ftOraBlob }
838	+	TMemoField, { ftOraClob }
839	+	TVariantField, { ftVariant }
840	+	nil, { ftInterface }
841	+	nil, { ftIDispatch }
842	+	TGuidField, { ftGuid }
843	+	TDateTimeField, {ftTimestamp}
844	+	TIBBCDField, {ftFMTBcd}
845	+	nil, {ftFixedWideChar}
846	+	nil); {ftWideMemo}
847	+	(*
848		TADTField, { ftADT }
849		TArrayField, { ftArray }
850		TReferenceField, { ftReference }
#	Line 587 \| Line 854 \| DefaultFieldClasses: array[TFieldType] o
854		TVariantField, { ftVariant }
855		TInterfaceField, { ftInterface }
856		TIDispatchField, { ftIDispatch }
857	<	TGuidField); { ftGuid }
858	<	var
859	<	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
857	>	TGuidField); { ftGuid } *)
858	>	(*var
859	>	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
860
861		implementation
862
863	<	uses IBIntf, IBQuery;
863	>	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
864	>
865	>	const FILE_BEGIN = 0;
866	>	FILE_CURRENT = 1;
867	>	FILE_END = 2;
868
869		type
870
#	Line 613 \| Line 884 \| type
884		end;
885
886
887	+	{ Copied from LCLProc in order to avoid LCL dependency
888	+
889	+	Ensures the covenient look of multiline string
890	+	when displaying it in the single line
891	+	* Replaces CR and LF with spaces
892	+	* Removes duplicate spaces
893	+	}
894	+	function TextToSingleLine(const AText: string): string;
895	+	var
896	+	str: string;
897	+	i, wstart, wlen: Integer;
898	+	begin
899	+	str := Trim(AText);
900	+	wstart := 0;
901	+	wlen := 0;
902	+	i := 1;
903	+	while i < Length(str) - 1 do
904	+	begin
905	+	if (str[i] in [' ', #13, #10]) then
906	+	begin
907	+	if (wstart = 0) then
908	+	begin
909	+	wstart := i;
910	+	wlen := 1;
911	+	end else
912	+	Inc(wlen);
913	+	end else
914	+	begin
915	+	if wstart > 0 then
916	+	begin
917	+	str[wstart] := ' ';
918	+	Delete(str, wstart+1, wlen-1);
919	+	Dec(i, wlen-1);
920	+	wstart := 0;
921	+	end;
922	+	end;
923	+	Inc(i);
924	+	end;
925	+	Result := str;
926	+	end;
927	+
928	+	{ TIBArray }
929	+
930	+	procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
931	+	begin
932	+	case Reason of
933	+	arChanging:
934	+	if FRecNo <> FField.Dataset.RecNo then
935	+	IBError(ibxeNotCurrentArray,[nil]);
936	+
937	+	arChanged:
938	+	FField.DataChanged;
939	+	end;
940	+	end;
941	+
942	+	constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
943	+	begin
944	+	inherited Create;
945	+	FField := aField;
946	+	FArray := anArray;
947	+	FRecNo := FField.Dataset.RecNo;
948	+	FArray.AddEventHandler(EventHandler);
949	+	end;
950	+
951	+	destructor TIBArray.Destroy;
952	+	begin
953	+	FArray.RemoveEventHandler(EventHandler);
954	+	inherited Destroy;
955	+	end;
956	+
957	+	{ TIBArrayField }
958	+
959	+	function TIBArrayField.GetArrayIntf: IArray;
960	+	begin
961	+	Result := TIBCustomDataSet(DataSet).GetArray(self);
962	+	end;
963	+
964	+	function TIBArrayField.GetArrayID: TISC_QUAD;
965	+	begin
966	+	GetData(@Result);
967	+	end;
968	+
969	+	procedure TIBArrayField.SetArrayIntf(AValue: IArray);
970	+	begin
971	+	TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
972	+	DataChanged;
973	+	end;
974	+
975	+	class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
976	+	begin
977	+	//Ignore
978	+	end;
979	+
980	+	function TIBArrayField.GetAsString: string;
981	+	begin
982	+	Result := '(Array)';
983	+	end;
984	+
985	+	function TIBArrayField.GetDataSize: Integer;
986	+	begin
987	+	Result := sizeof(TISC_QUAD);
988	+	end;
989	+
990	+	procedure TIBArrayField.Bind(Binding: Boolean);
991	+	begin
992	+	inherited Bind(Binding);
993	+	if Binding then
994	+	begin
995	+	FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
996	+	Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
997	+	if FieldDef <> nil then
998	+	begin
999	+	FRelationName := TIBFieldDef(FieldDef).FRelationName;
1000	+	FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1001	+	FArrayBounds := TIBFieldDef(FieldDef).ArrayBounds;
1002	+	end;
1003	+	end;
1004	+	end;
1005	+
1006	+	constructor TIBArrayField.Create(AOwner: TComponent);
1007	+	begin
1008	+	inherited Create(AOwner);
1009	+	SetDataType(ftArray);
1010	+	end;
1011	+
1012	+	function TIBArrayField.CreateArray: IArray;
1013	+	begin
1014	+	with DataSet as TIBCustomDataSet do
1015	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1016	+	end;
1017	+
1018	+	{ TIBMemoField }
1019	+
1020	+	function TIBMemoField.GetTruncatedText: string;
1021	+	begin
1022	+	Result := GetAsString;
1023	+
1024	+	if Result <> '' then
1025	+	begin
1026	+	case CharacterSetSize of
1027	+	1:
1028	+	if DisplayWidth = 0 then
1029	+	Result := TextToSingleLine(Result)
1030	+	else
1031	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
1032	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1033	+
1034	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
1035	+
1036	+	3, {Assume UNICODE_FSS is really UTF8}
1037	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1038	+	if DisplayWidth = 0 then
1039	+	Result := ValidUTF8String(TextToSingleLine(Result))
1040	+	else
1041	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1042	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1043	+	end;
1044	+	end
1045	+	end;
1046	+
1047	+	procedure TIBMemoField.Bind(Binding: Boolean);
1048	+	var IBFieldDef: TIBFieldDef;
1049	+	begin
1050	+	inherited Bind(Binding);
1051	+	if Binding and (FieldDef <> nil) then
1052	+	begin
1053	+	IBFieldDef := FieldDef as TIBFieldDef;
1054	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
1055	+	CharacterSetName := IBFieldDef.CharacterSetName;
1056	+	CodePage := IBFieldDef.CodePage;
1057	+	end;
1058	+	end;
1059	+
1060	+	function TIBMemoField.GetAsString: string;
1061	+	var s: RawByteString;
1062	+	begin
1063	+	s := inherited GetAsString;
1064	+	SetCodePage(s,CodePage,false);
1065	+	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1066	+	SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
1067	+	Result := s;
1068	+	end;
1069	+
1070	+	function TIBMemoField.GetDefaultWidth: Longint;
1071	+	begin
1072	+	if DisplayTextAsClassName then
1073	+	Result := inherited
1074	+	else
1075	+	Result := 128;
1076	+	end;
1077	+
1078	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1079	+	begin
1080	+	if ADisplayText then
1081	+	begin
1082	+	if not DisplayTextAsClassName and (CharacterSetName <> '') then
1083	+	AText := GetTruncatedText
1084	+	else
1085	+	inherited GetText(AText, ADisplayText);
1086	+	end
1087	+	else
1088	+	AText := GetAsString;
1089	+	end;
1090	+
1091	+	procedure TIBMemoField.SetAsString(const AValue: string);
1092	+	var s: RawByteString;
1093	+	begin
1094	+	s := AValue;
1095	+	if StringCodePage(s) <> CodePage then
1096	+	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1097	+	inherited SetAsString(s);
1098	+	end;
1099	+
1100	+	constructor TIBMemoField.Create(AOwner: TComponent);
1101	+	begin
1102	+	inherited Create(AOwner);
1103	+	BlobType := ftMemo;
1104	+	FCodePage := CP_NONE;
1105	+	end;
1106	+
1107	+	{ TIBControlLink }
1108	+
1109	+	destructor TIBControlLink.Destroy;
1110	+	begin
1111	+	IBDataSet := nil;
1112	+	inherited Destroy;
1113	+	end;
1114	+
1115	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
1116	+	begin
1117	+
1118	+	end;
1119	+
1120	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
1121	+	begin
1122	+
1123	+	end;
1124	+
1125	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1126	+	begin
1127	+	if FTIBDataSet = AValue then Exit;
1128	+	if IBDataSet <> nil then
1129	+	IBDataSet.UnRegisterIBLink(self);
1130	+	FTIBDataSet := AValue;
1131	+	if IBDataSet <> nil then
1132	+	IBDataSet.RegisterIBLink(self);
1133	+	end;
1134	+
1135	+
1136		{ TIBStringField}
1137
1138	<	constructor TIBStringField.Create(AOwner: TComponent);
1138	>	procedure TIBStringField.Bind(Binding: Boolean);
1139	>	var IBFieldDef: TIBFieldDef;
1140	>	begin
1141	>	inherited Bind(Binding);
1142	>	if Binding and (FieldDef <> nil) then
1143	>	begin
1144	>	IBFieldDef := FieldDef as TIBFieldDef;
1145	>	CharacterSetSize := IBFieldDef.CharacterSetSize;
1146	>	CharacterSetName := IBFieldDef.CharacterSetName;
1147	>	FDataSize := IBFieldDef.DataSize + 1;
1148	>	if AutoFieldSize then
1149	>	Size := IBFieldDef.Size;
1150	>	CodePage := IBFieldDef.CodePage;
1151	>	end;
1152	>	end;
1153	>
1154	>	function TIBStringField.GetDataSize: Integer;
1155	>	begin
1156	>	Result := FDataSize;
1157	>	end;
1158	>
1159	>	constructor TIBStringField.Create(aOwner: TComponent);
1160		begin
1161	<	inherited;
1161	>	inherited Create(aOwner);
1162	>	FCharacterSetSize := 1;
1163	>	FCodePage := CP_NONE;
1164	>	FAutoFieldSize := true;
1165		end;
1166
1167		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 640 \| Line 1184 \| end;
1184		function TIBStringField.GetValue(var Value: string): Boolean;
1185		var
1186		Buffer: PChar;
1187	+	s: RawByteString;
1188		begin
1189		Buffer := nil;
1190	<	IBAlloc(Buffer, 0, Size + 1);
1190	>	IBAlloc(Buffer, 0, DataSize);
1191		try
1192		Result := GetData(Buffer);
1193		if Result then
1194		begin
1195	<	Value := string(Buffer);
1195	>	s := strpas(Buffer);
1196	>	SetCodePage(s,CodePage,false);
1197	>	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1198	>	SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
1199	>	Value := s;
1200	>	// writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1201		if Transliterate and (Value <> '') then
1202		DataSet.Translate(PChar(Value), PChar(Value), False);
1203		end
#	Line 659 \| Line 1209 \| end;
1209		procedure TIBStringField.SetAsString(const Value: string);
1210		var
1211		Buffer: PChar;
1212	+	s: RawByteString;
1213		begin
1214		Buffer := nil;
1215	<	IBAlloc(Buffer, 0, Size + 1);
1215	>	IBAlloc(Buffer, 0, DataSize);
1216		try
1217	<	StrLCopy(Buffer, PChar(Value), Size);
1217	>	s := Value;
1218	>	if StringCodePage(s) <> CodePage then
1219	>	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1220	>	StrLCopy(Buffer, PChar(s), DataSize-1);
1221		if Transliterate then
1222		DataSet.Translate(Buffer, Buffer, True);
1223		SetData(Buffer);
#	Line 672 \| Line 1226 \| begin
1226		end;
1227		end;
1228
1229	+
1230		{ TIBBCDField }
1231
1232		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 714 \| Line 1269 \| end;
1269
1270		function TIBBCDField.GetDataSize: Integer;
1271		begin
1272	+	{$IFDEF TBCDFIELD_IS_BCD}
1273		Result := 8;
1274	+	{$ELSE}
1275	+	Result := inherited GetDataSize
1276	+	{$ENDIF}
1277		end;
1278
1279		{ TIBDataLink }
#	Line 728 \| Line 1287 \| end;
1287		destructor TIBDataLink.Destroy;
1288		begin
1289		FDataSet.FDataLink := nil;
1290	<	inherited;
1290	>	inherited Destroy;
1291		end;
1292
1293
#	Line 760 \| Line 1319 \| end;
1319
1320		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1321		begin
1322	<	inherited;
764	<	FIBLoaded := False;
765	<	CheckIBLoaded;
766	<	FIBLoaded := True;
1322	>	inherited Create(AOwner);
1323		FBase := TIBBase.Create(Self);
1324	+	FIBLinks := TList.Create;
1325		FCurrentRecord := -1;
1326		FDeletedRecords := 0;
1327		FUniDirectional := False;
1328		FBufferChunks := BufferCacheSize;
1329		FBlobStreamList := TList.Create;
1330	+	FArrayList := TList.Create;
1331	+	FGeneratorField := TIBGenerator.Create(self);
1332		FDataLink := TIBDataLink.Create(Self);
1333		FQDelete := TIBSQL.Create(Self);
1334		FQDelete.OnSQLChanging := SQLChanging;
#	Line 782 \| Line 1341 \| begin
1341		FQRefresh.GoToFirstRecordOnExecute := False;
1342		FQSelect := TIBSQL.Create(Self);
1343		FQSelect.OnSQLChanging := SQLChanging;
1344	+	FQSelect.OnSQLChanged := SQLChanged;
1345		FQSelect.GoToFirstRecordOnExecute := False;
1346		FQModify := TIBSQL.Create(Self);
1347		FQModify.OnSQLChanging := SQLChanging;
1348		FQModify.GoToFirstRecordOnExecute := False;
1349		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1350		FParamCheck := True;
1351	+	FGenerateParamNames := False;
1352		FForcedRefresh := False;
1353	+	FAutoCommit:= acDisabled;
1354	+	FDataSetCloseAction := dcDiscardChanges;
1355		{Bookmark Size is Integer for IBX}
1356		BookmarkSize := SizeOf(Integer);
1357		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 802 \| Line 1365 \| begin
1365		else
1366		if AOwner is TIBTransaction then
1367		Transaction := TIBTransaction(AOwner);
1368	+	FBaseSQLSelect := TStringList.Create;
1369		end;
1370
1371		destructor TIBCustomDataSet.Destroy;
1372		begin
1373	<	inherited;
1374	<	if FIBLoaded then
1375	<	begin
1376	<	FDataLink.Free;
1377	<	FBase.Free;
1378	<	ClearBlobCache;
1379	<	FBlobStreamList.Free;
1380	<	FreeMem(FBufferCache);
1381	<	FBufferCache := nil;
1382	<	FreeMem(FOldBufferCache);
1383	<	FOldBufferCache := nil;
1384	<	FCacheSize := 0;
1385	<	FOldCacheSize := 0;
1386	<	FMappedFieldPosition := nil;
1387	<	end;
1373	>	if Active then Active := false;
1374	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1375	>	FDataLink.Free;
1376	>	FBase.Free;
1377	>	ClearBlobCache;
1378	>	ClearIBLinks;
1379	>	FIBLinks.Free;
1380	>	FBlobStreamList.Free;
1381	>	FArrayList.Free;
1382	>	FreeMem(FBufferCache);
1383	>	FBufferCache := nil;
1384	>	FreeMem(FOldBufferCache);
1385	>	FOldBufferCache := nil;
1386	>	FCacheSize := 0;
1387	>	FOldCacheSize := 0;
1388	>	FMappedFieldPosition := nil;
1389	>	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1390	>	if assigned(FParser) then FParser.Free;
1391	>	inherited Destroy;
1392		end;
1393
1394		function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
#	Line 842 \| Line 1410 \| begin
1410		Inc(FCurrentRecord);
1411		if (FCurrentRecord = FRecordCount) then
1412		begin
1413	<	if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1413	>	if (not FQSelect.EOF) and FQSelect.Next then
1414		begin
1415		FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1416		Inc(FRecordCount);
#	Line 861 \| Line 1429 \| end;
1429
1430		procedure TIBCustomDataSet.ApplyUpdates;
1431		var
1432	<	CurBookmark: string;
1432	>	CurBookmark: TBookmark;
1433		Buffer: PRecordData;
1434		CurUpdateTypes: TIBUpdateRecordTypes;
1435		UpdateAction: TIBUpdateAction;
#	Line 921 \| Line 1489 \| var
1489		procedure UpdateUsingUpdateObject;
1490		begin
1491		try
1492	<	FUpdateObject.Apply(UpdateKind);
1492	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1493		ResetBufferUpdateStatus;
1494		except
1495		on E: Exception do
#	Line 1059 \| Line 1627 \| begin
1627		end;
1628		end;
1629
1630	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1631	+	var i: integer;
1632	+	Prepared: boolean;
1633	+	begin
1634	+	Result := 0;
1635	+	Prepared := FInternalPrepared;
1636	+	if not Prepared then
1637	+	InternalPrepare;
1638	+	try
1639	+	for i := 0 to Length(FAliasNameList) - 1 do
1640	+	if FAliasNameList[i] = AliasName then
1641	+	begin
1642	+	Result := i + 1;
1643	+	Exit
1644	+	end;
1645	+	finally
1646	+	if not Prepared then
1647	+	InternalUnPrepare;
1648	+	end;
1649	+	end;
1650	+
1651		procedure TIBCustomDataSet.ActivateConnection;
1652		begin
1653		if not Assigned(Database) then
#	Line 1071 \| Line 1660 \| end;
1660		function TIBCustomDataSet.ActivateTransaction: Boolean;
1661		begin
1662		Result := False;
1663	<	if not Assigned(Transaction) then
1075	<	IBError(ibxeTransactionNotAssigned, [nil]);
1076	<	if not Transaction.Active then
1663	>	if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1664		begin
1665	<	Result := True;
1666	<	Transaction.StartTransaction;
1667	<	FDidActivate := True;
1665	>	if not Assigned(Transaction) then
1666	>	IBError(ibxeTransactionNotAssigned, [nil]);
1667	>	if not Transaction.Active then
1668	>	begin
1669	>	Result := True;
1670	>	Transaction.StartTransaction;
1671	>	FDidActivate := True;
1672	>	end;
1673		end;
1674		end;
1675
#	Line 1119 \| Line 1711 \| begin
1711		IBError(ibxeDatasetClosed, [nil]);
1712		end;
1713
1714	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1715	+	begin
1716	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1717	+	Result.OnSQLChanging := SQLChanging
1718	+	end;
1719	+
1720		procedure TIBCustomDataSet.CheckNotUniDirectional;
1721		begin
1722		if UniDirectional then
#	Line 1196 \| Line 1794 \| begin
1794		FBlobStreamList.Pack;
1795		end;
1796
1797	+	procedure TIBCustomDataSet.ClearArrayCache;
1798	+	var
1799	+	i: Integer;
1800	+	begin
1801	+	for i := 0 to FArrayList.Count - 1 do
1802	+	begin
1803	+	TIBArray(FArrayList[i]).Free;
1804	+	FArrayList[i] := nil;
1805	+	end;
1806	+	FArrayList.Pack;
1807	+	end;
1808	+
1809		procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1810		begin
1811		Move(Source^, Dest^, FRecordBufferSize);
#	Line 1205 \| Line 1815 \| procedure TIBCustomDataSet.DoBeforeDatab
1815		begin
1816		if Active then
1817		Active := False;
1818	<	FInternalPrepared := False;
1818	>	InternalUnPrepare;
1819		if Assigned(FBeforeDatabaseDisconnect) then
1820		FBeforeDatabaseDisconnect(Sender);
1821		end;
#	Line 1222 \| Line 1832 \| begin
1832		FDatabaseFree(Sender);
1833		end;
1834
1835	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1835	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1836	>	Action: TTransactionAction);
1837		begin
1838	<	if Active then
1839	<	Active := False;
1838	>	FCloseAction := Action;
1839	>	FInTransactionEnd := true;
1840	>	try
1841	>	if Active then
1842	>	Active := False;
1843	>	finally
1844	>	FInTransactionEnd := false;
1845	>	end;
1846		if FQSelect <> nil then
1847		FQSelect.FreeHandle;
1848		if FQDelete <> nil then
#	Line 1236 \| Line 1853 \| begin
1853		FQModify.FreeHandle;
1854		if FQRefresh <> nil then
1855		FQRefresh.FreeHandle;
1856	+	InternalUnPrepare;
1857		if Assigned(FBeforeTransactionEnd) then
1858		FBeforeTransactionEnd(Sender);
1859		end;
#	Line 1252 \| Line 1870 \| begin
1870		FTransactionFree(Sender);
1871		end;
1872
1873	+	procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1874	+	var i, j: Integer;
1875	+	FieldsLoaded: integer;
1876	+	p: PRecordData;
1877	+	colMetadata: IColumnMetaData;
1878	+	begin
1879	+	p := PRecordData(Buffer);
1880	+	{ Get record information }
1881	+	p^.rdBookmarkFlag := bfCurrent;
1882	+	p^.rdFieldCount := Qry.FieldCount;
1883	+	p^.rdRecordNumber := -1;
1884	+	p^.rdUpdateStatus := usUnmodified;
1885	+	p^.rdCachedUpdateStatus := cusUnmodified;
1886	+	p^.rdSavedOffset := $FFFFFFFF;
1887	+
1888	+	{ Load up the fields }
1889	+	FieldsLoaded := FQSelect.MetaData.Count;
1890	+	j := 1;
1891	+	for i := 0 to Qry.MetaData.Count - 1 do
1892	+	begin
1893	+	if (Qry = FQSelect) then
1894	+	j := i + 1
1895	+	else
1896	+	begin
1897	+	if FieldsLoaded = 0 then
1898	+	break;
1899	+	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1900	+	if j < 1 then
1901	+	continue
1902	+	else
1903	+	Dec(FieldsLoaded);
1904	+	end;
1905	+	if j > 0 then
1906	+	begin
1907	+	colMetadata := Qry.MetaData[i];
1908	+	with p^.rdFields[j], FFieldColumns^[j] do
1909	+	begin
1910	+	fdDataType := colMetadata.GetSQLType;
1911	+	if fdDataType = SQL_BLOB then
1912	+	fdDataScale := 0
1913	+	else
1914	+	fdDataScale := colMetadata.getScale;
1915	+	fdNullable := colMetadata.getIsNullable;
1916	+	fdIsNull := true;
1917	+	fdDataSize := colMetadata.GetSize;
1918	+	fdDataLength := 0;
1919	+	fdCodePage := CP_NONE;
1920	+
1921	+	case fdDataType of
1922	+	SQL_TIMESTAMP,
1923	+	SQL_TYPE_DATE,
1924	+	SQL_TYPE_TIME:
1925	+	fdDataSize := SizeOf(TDateTime);
1926	+	SQL_SHORT, SQL_LONG:
1927	+	begin
1928	+	if (fdDataScale = 0) then
1929	+	fdDataSize := SizeOf(Integer)
1930	+	else
1931	+	if (fdDataScale >= (-4)) then
1932	+	fdDataSize := SizeOf(Currency)
1933	+	else
1934	+	fdDataSize := SizeOf(Double);
1935	+	end;
1936	+	SQL_INT64:
1937	+	begin
1938	+	if (fdDataScale = 0) then
1939	+	fdDataSize := SizeOf(Int64)
1940	+	else
1941	+	if (fdDataScale >= (-4)) then
1942	+	fdDataSize := SizeOf(Currency)
1943	+	else
1944	+	fdDataSize := SizeOf(Double);
1945	+	end;
1946	+	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1947	+	fdDataSize := SizeOf(Double);
1948	+	SQL_BOOLEAN:
1949	+	fdDataSize := SizeOf(wordBool);
1950	+	SQL_VARYING,
1951	+	SQL_TEXT,
1952	+	SQL_BLOB:
1953	+	fdCodePage := Qry.Metadata[i].getCodePage;
1954	+	end;
1955	+	fdDataOfs := FRecordSize;
1956	+	Inc(FRecordSize, fdDataSize);
1957	+	end;
1958	+	end;
1959	+	end;
1960	+	end;
1961	+
1962		{ Read the record from FQSelect.Current into the record buffer
1963		Then write the buffer to in memory cache }
1964		procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1965		RecordNumber: Integer; Buffer: PChar);
1966		var
1260	–	p: PRecordData;
1967		pbd: PBlobDataArray;
1968	+	pda: PArrayDataArray;
1969		i, j: Integer;
1970	<	LocalData: Pointer;
1970	>	LocalData: PByte;
1971		LocalDate, LocalDouble: Double;
1972		LocalInt: Integer;
1973	+	LocalBool: wordBool;
1974		LocalInt64: Int64;
1975		LocalCurrency: Currency;
1976		FieldsLoaded: Integer;
1977	+	p: PRecordData;
1978		begin
1979	+	if RecordNumber = -1 then
1980	+	begin
1981	+	InitModelBuffer(Qry,Buffer);
1982	+	Exit;
1983	+	end;
1984		p := PRecordData(Buffer);
1985		{ Make sure blob cache is empty }
1986		pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1987	<	if RecordNumber > -1 then
1988	<	for i := 0 to BlobFieldCount - 1 do
1989	<	pbd^[i] := nil;
1987	>	pda := PArrayDataArray(Buffer + FArrayCacheOffset);
1988	>	for i := 0 to BlobFieldCount - 1 do
1989	>	pbd^[i] := nil;
1990	>	for i := 0 to ArrayFieldCount - 1 do
1991	>	pda^[i] := nil;
1992	>
1993		{ Get record information }
1994		p^.rdBookmarkFlag := bfCurrent;
1995	<	p^.rdFieldCount := Qry.Current.Count;
1995	>	p^.rdFieldCount := Qry.FieldCount;
1996		p^.rdRecordNumber := RecordNumber;
1997		p^.rdUpdateStatus := usUnmodified;
1998		p^.rdCachedUpdateStatus := cusUnmodified;
1999		p^.rdSavedOffset := $FFFFFFFF;
2000
2001		{ Load up the fields }
2002	<	FieldsLoaded := FQSelect.Current.Count;
2002	>	FieldsLoaded := FQSelect.MetaData.Count;
2003		j := 1;
2004	<	for i := 0 to Qry.Current.Count - 1 do
2004	>	for i := 0 to Qry.FieldCount - 1 do
2005		begin
2006		if (Qry = FQSelect) then
2007		j := i + 1
2008	<	else begin
2008	>	else
2009	>	begin
2010		if FieldsLoaded = 0 then
2011		break;
2012	<	j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
2012	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2013		if j < 1 then
2014		continue
2015		else
2016		Dec(FieldsLoaded);
2017		end;
2018	<	with FQSelect.Current[j - 1].Data^ do
2019	<	if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2018	>	with FQSelect.MetaData[j - 1] do
2019	>	if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2020		begin
2021	<	if sqllen <= 8 then
2022	<	p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
2021	>	if (GetSize <= 8) then
2022	>	p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2023		continue;
2024		end;
2025	<	if j > 0 then with p^ do
2025	>	if j > 0 then
2026		begin
2027	<	rdFields[j].fdDataType :=
2028	<	Qry.Current[i].Data^.sqltype and (not 1);
2029	<	rdFields[j].fdDataScale :=
2030	<	Qry.Current[i].Data^.sqlscale;
2031	<	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:
2027	>	LocalData := nil;
2028	>	with p^.rdFields[j], FFieldColumns^[j] do
2029	>	begin
2030	>	Qry.Current.GetData(i,fdIsNull,fdDataLength,LocalData);
2031	>	if not fdIsNull then
2032		begin
2033	<	if (rdFields[j].fdDataScale = 0) then
2034	<	begin
2035	<	rdFields[j].fdDataSize := SizeOf(Integer);
2036	<	if RecordNumber >= 0 then
2037	<	LocalInt := Qry.Current[i].AsLong;
2038	<	LocalData := PChar(@LocalInt);
2039	<	end
2040	<	else if (rdFields[j].fdDataScale >= (-4)) then
2041	<	begin
2042	<	rdFields[j].fdDataSize := SizeOf(Currency);
2043	<	if RecordNumber >= 0 then
2044	<	LocalCurrency := Qry.Current[i].AsCurrency;
2045	<	LocalData := PChar(@LocalCurrency);
2046	<	end
2047	<	else begin
2048	<	rdFields[j].fdDataSize := SizeOf(Double);
2049	<	if RecordNumber >= 0 then
2050	<	LocalDouble := Qry.Current[i].AsDouble;
2051	<	LocalData := PChar(@LocalDouble);
2033	>	case fdDataType of {Get Formatted data for column types that need formatting}
2034	>	SQL_TIMESTAMP:
2035	>	begin
2036	>	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry[i].AsDateTime));
2037	>	LocalData := PByte(@LocalDate);
2038	>	end;
2039	>	SQL_TYPE_DATE:
2040	>	begin
2041	>	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Date;
2042	>	LocalData := PByte(@LocalInt);
2043	>	end;
2044	>	SQL_TYPE_TIME:
2045	>	begin
2046	>	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Time;
2047	>	LocalData := PByte(@LocalInt);
2048	>	end;
2049	>	SQL_SHORT, SQL_LONG:
2050	>	begin
2051	>	if (fdDataScale = 0) then
2052	>	begin
2053	>	LocalInt := Qry[i].AsLong;
2054	>	LocalData := PByte(@LocalInt);
2055	>	end
2056	>	else
2057	>	if (fdDataScale >= (-4)) then
2058	>	begin
2059	>	LocalCurrency := Qry[i].AsCurrency;
2060	>	LocalData := PByte(@LocalCurrency);
2061	>	end
2062	>	else
2063	>	begin
2064	>	LocalDouble := Qry[i].AsDouble;
2065	>	LocalData := PByte(@LocalDouble);
2066		end;
2067	<	end;
2068	<	SQL_INT64:
2069	<	begin
2070	<	if (rdFields[j].fdDataScale = 0) then
2071	<	begin
2072	<	rdFields[j].fdDataSize := SizeOf(Int64);
2073	<	if RecordNumber >= 0 then
2074	<	LocalInt64 := Qry.Current[i].AsInt64;
2075	<	LocalData := PChar(@LocalInt64);
2076	<	end
2077	<	else if (rdFields[j].fdDataScale >= (-4)) then
2078	<	begin
2079	<	rdFields[j].fdDataSize := SizeOf(Currency);
2080	<	if RecordNumber >= 0 then
2081	<	LocalCurrency := Qry.Current[i].AsCurrency;
2082	<	LocalData := PChar(@LocalCurrency);
2083	<	end
2084	<	else begin
2085	<	rdFields[j].fdDataSize := SizeOf(Double);
2086	<	if RecordNumber >= 0 then
2087	<	LocalDouble := Qry.Current[i].AsDouble;
2088	<	LocalData := PChar(@LocalDouble);
2089	<	end
2090	<	end;
2091	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2092	<	begin
2093	<	rdFields[j].fdDataSize := SizeOf(Double);
2094	<	if RecordNumber >= 0 then
2095	<	LocalDouble := Qry.Current[i].AsDouble;
2096	<	LocalData := PChar(@LocalDouble);
1392	<	end;
1393	<	SQL_VARYING:
1394	<	begin
1395	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1396	<	rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1397	<	if RecordNumber >= 0 then
1398	<	begin
1399	<	if (rdFields[j].fdDataLength = 0) then
1400	<	LocalData := nil
1401	<	else
1402	<	LocalData := @Qry.Current[i].Data^.sqldata[2];
2067	>	end;
2068	>	SQL_INT64:
2069	>	begin
2070	>	if (fdDataScale = 0) then
2071	>	begin
2072	>	LocalInt64 := Qry[i].AsInt64;
2073	>	LocalData := PByte(@LocalInt64);
2074	>	end
2075	>	else
2076	>	if (fdDataScale >= (-4)) then
2077	>	begin
2078	>	LocalCurrency := Qry[i].AsCurrency;
2079	>	LocalData := PByte(@LocalCurrency);
2080	>	end
2081	>	else
2082	>	begin
2083	>	LocalDouble := Qry[i].AsDouble;
2084	>	LocalData := PByte(@LocalDouble);
2085	>	end
2086	>	end;
2087	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2088	>	begin
2089	>	LocalDouble := Qry[i].AsDouble;
2090	>	LocalData := PByte(@LocalDouble);
2091	>	end;
2092	>	SQL_BOOLEAN:
2093	>	begin
2094	>	LocalBool := Qry[i].AsBoolean;
2095	>	LocalData := PByte(@LocalBool);
2096	>	end;
2097		end;
2098	<	end;
2099	<	else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2100	<	begin
2101	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2102	<	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)
2098	>
2099	>	if fdDataType = SQL_VARYING then
2100	>	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2101	>	else
2102	>	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2103		end
2104	+	else {Null column}
2105	+	if fdDataType = SQL_VARYING then
2106	+	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2107		else
2108	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2108	>	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2109		end;
2110		end;
2111		end;
2112	<	WriteRecordCache(RecordNumber, PChar(p));
2112	>	WriteRecordCache(RecordNumber, Buffer);
2113		end;
2114
2115		function TIBCustomDataSet.GetActiveBuf: PChar;
#	Line 1471 \| Line 2154 \| begin
2154		result := FBase.Database;
2155		end;
2156
1474	–	function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1475	–	begin
1476	–	result := FBase.DBHandle;
1477	–	end;
1478	–
2157		function TIBCustomDataSet.GetDeleteSQL: TStrings;
2158		begin
2159		result := FQDelete.SQL;
#	Line 1486 \| Line 2164 \| begin
2164		result := FQInsert.SQL;
2165		end;
2166
2167	<	function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2167	>	function TIBCustomDataSet.GetSQLParams: ISQLParams;
2168		begin
2169		if not FInternalPrepared then
2170		InternalPrepare;
#	Line 1503 \| Line 2181 \| begin
2181		result := FQSelect.SQL;
2182		end;
2183
2184	<	function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2184	>	function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2185		begin
2186	<	result := FQSelect.SQLType;
2186	>	result := FQSelect.SQLStatementType;
2187		end;
2188
2189		function TIBCustomDataSet.GetModifySQL: TStrings;
#	Line 1518 \| Line 2196 \| begin
2196		result := FBase.Transaction;
2197		end;
2198
1521	–	function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1522	–	begin
1523	–	result := FBase.TRHandle;
1524	–	end;
1525	–
2199		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2200		begin
2201		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2202	<	FUpdateObject.Apply(ukDelete)
2202	>	FUpdateObject.Apply(ukDelete,Buff)
2203		else
2204		begin
2205		SetInternalSQLParams(FQDelete, Buff);
#	Line 1543 \| Line 2216 \| end;
2216		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
2217		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2218		var
2219	<	fl: TList;
2220	<	CurBookmark: string;
2221	<	fld, val: Variant;
2222	<	i, fld_cnt: Integer;
2219	>	keyFieldList: TList;
2220	>	CurBookmark: TBookmark;
2221	>	fieldValue: Variant;
2222	>	lookupValues: array of variant;
2223	>	i, fieldCount: Integer;
2224	>	fieldValueAsString: string;
2225	>	lookupValueAsString: string;
2226		begin
2227	<	fl := TList.Create;
2227	>	keyFieldList := TList.Create;
2228		try
2229	<	GetFieldList(fl, KeyFields);
2230	<	fld_cnt := fl.Count;
2229	>	GetFieldList(keyFieldList, KeyFields);
2230	>	fieldCount := keyFieldList.Count;
2231		CurBookmark := Bookmark;
2232	<	result := False;
2233	<	while ((not result) and (not EOF)) do
2232	>	result := false;
2233	>	SetLength(lookupValues, fieldCount);
2234	>	if not EOF then
2235		begin
2236	<	i := 0;
1560	<	result := True;
1561	<	while (result and (i < fld_cnt)) do
2236	>	for i := 0 to fieldCount - 1 do {expand key values into lookupValues array}
2237		begin
2238	<	if fld_cnt > 1 then
2239	<	val := KeyValues[i]
2238	>	if VarIsArray(KeyValues) then
2239	>	lookupValues[i] := KeyValues[i]
2240		else
2241	<	val := KeyValues;
2242	<	fld := TField(fl[i]).Value;
2243	<	result := not (VarIsNull(val) xor VarIsNull(fld));
2244	<	if result and not VarIsNull(val) then
2241	>	if i > 0 then
2242	>	lookupValues[i] := NULL
2243	>	else
2244	>	lookupValues[0] := KeyValues;
2245	>
2246	>	{convert to upper case is case insensitive search}
2247	>	if (TField(keyFieldList[i]).DataType = ftString) and
2248	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
2249	>	lookupValues[i] := UpperCase(lookupValues[i]);
2250	>	end;
2251	>	end;
2252	>	while not result and not EOF do {search for a matching record}
2253	>	begin
2254	>	i := 0;
2255	>	result := true;
2256	>	while result and (i < fieldCount) do
2257	>	{see if all of the key fields matches}
2258	>	begin
2259	>	fieldValue := TField(keyFieldList[i]).Value;
2260	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
2261	>	if result and not VarIsNull(fieldValue) then
2262		begin
2263		try
2264	<	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
2264	>	if TField(keyFieldList[i]).DataType = ftString then
2265		begin
2266	+	{strings need special handling because of the locate options that
2267	+	apply to them}
2268	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
2269	+	lookupValueAsString := lookupValues[i];
2270		if (loCaseInsensitive in Options) then
2271	<	begin
2272	<	fld := AnsiUpperCase(fld);
1582	<	val := AnsiUpperCase(val);
1583	<	end;
1584	<	fld := TrimRight(fld);
1585	<	val := TrimRight(val);
2271	>	fieldValueAsString := UpperCase(fieldValueAsString);
2272	>
2273		if (loPartialKey in Options) then
2274	<	result := result and (AnsiPos(val, fld) = 1)
2274	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
2275		else
2276	<	result := result and (val = fld);
2277	<	end else
2278	<	result := result and (val = fld);
2276	>	result := result and (fieldValueAsString = lookupValueAsString);
2277	>	end
2278	>	else
2279	>	result := result and (lookupValues[i] =
2280	>	VarAsType(fieldValue, VarType(lookupValues[i])));
2281	>	except on EVariantError do
2282	>	result := False;
2283	>	end;
2284		end;
2285		Inc(i);
2286		end;
2287		if not result then
2288	<	Next;
2288	>	Next;
2289		end;
2290		if not result then
2291		Bookmark := CurBookmark
2292		else
2293		CursorPosChanged;
2294		finally
2295	<	fl.Free;
2295	>	keyFieldList.Free;
2296	>	SetLength(lookupValues,0)
2297		end;
2298		end;
2299
2300		procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2301		var
2302	<	i, j, k: Integer;
2302	>	i, j, k, arr: Integer;
2303		pbd: PBlobDataArray;
2304	+	pda: PArrayDataArray;
2305		begin
2306		pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2307	<	j := 0;
2307	>	pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2308	>	j := 0; arr := 0;
2309		for i := 0 to FieldCount - 1 do
2310		if Fields[i].IsBlob then
2311		begin
#	Line 1619 \| Line 2314 \| begin
2314		begin
2315		pbd^[j].Finalize;
2316		PISC_QUAD(
2317	<	PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2317	>	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2318		pbd^[j].BlobID;
2319		PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2320	+	end
2321	+	else
2322	+	begin
2323	+	PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2324	+	with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2325	+	begin
2326	+	gds_quad_high := 0;
2327	+	gds_quad_low := 0;
2328	+	end;
2329		end;
2330		Inc(j);
2331	+	end
2332	+	else
2333	+	if Fields[i] is TIBArrayField then
2334	+	begin
2335	+	if pda^[arr] <> nil then
2336	+	begin
2337	+	k := FMappedFieldPosition[Fields[i].FieldNo -1];
2338	+	PISC_QUAD(
2339	+	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ := pda^[arr].ArrayIntf.GetArrayID;
2340	+	PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2341	+	end;
2342	+	Inc(arr);
2343		end;
2344		if Assigned(FUpdateObject) then
2345		begin
2346		if (Qry = FQDelete) then
2347	<	FUpdateObject.Apply(ukDelete)
2347	>	FUpdateObject.Apply(ukDelete,Buff)
2348		else if (Qry = FQInsert) then
2349	<	FUpdateObject.Apply(ukInsert)
2349	>	FUpdateObject.Apply(ukInsert,Buff)
2350		else
2351	<	FUpdateObject.Apply(ukModify);
2351	>	FUpdateObject.Apply(ukModify,Buff);
2352		end
2353		else begin
2354		SetInternalSQLParams(Qry, Buff);
#	Line 1649 \| Line 2365 \| end;
2365		procedure TIBCustomDataSet.InternalRefreshRow;
2366		var
2367		Buff: PChar;
1652	–	SetCursor: Boolean;
2368		ofs: DWORD;
2369		Qry: TIBSQL;
2370		begin
2371	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1657	<	if SetCursor then
1658	<	Screen.Cursor := crHourGlass;
2371	>	FBase.SetCursor;
2372		try
2373		Buff := GetActiveBuf;
2374		if CanRefresh then
#	Line 1675 \| Line 2388 \| begin
2388		SetInternalSQLParams(Qry, Buff);
2389		Qry.ExecQuery;
2390		try
2391	<	if (Qry.SQLType = SQLExecProcedure) or
1679	<	(Qry.Next <> nil) then
2391	>	if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2392		begin
2393		ofs := PRecordData(Buff)^.rdSavedOffset;
2394		FetchCurrentRecordToBuffer(Qry,
#	Line 1699 \| Line 2411 \| begin
2411		else
2412		IBError(ibxeCannotRefresh, [nil]);
2413		finally
2414	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1703	<	Screen.Cursor := crDefault;
2414	>	FBase.RestoreCursor;
2415		end;
2416		end;
2417
#	Line 1770 \| Line 2481 \| begin
2481		end;
2482
2483		procedure TIBCustomDataSet.InternalPrepare;
1773	–	var
1774	–	SetCursor: Boolean;
1775	–	DidActivate: Boolean;
2484		begin
2485		if FInternalPrepared then
2486		Exit;
2487	<	DidActivate := False;
1780	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1781	<	if SetCursor then
1782	<	Screen.Cursor := crHourGlass;
2487	>	FBase.SetCursor;
2488		try
2489		ActivateConnection;
2490	<	DidActivate := ActivateTransaction;
2490	>	ActivateTransaction;
2491		FBase.CheckDatabase;
2492		FBase.CheckTransaction;
2493	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2494	+	begin
2495	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2496	+	try
2497	+	FQSelect.SQL.Text := FParser.SQLText;
2498	+	finally
2499	+	FQSelect.OnSQLChanged := SQLChanged;
2500	+	end;
2501	+	end;
2502	+	// writeln( FQSelect.SQL.Text);
2503		if FQSelect.SQL.Text <> '' then
2504		begin
2505		if not FQSelect.Prepared then
2506		begin
2507	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2508		FQSelect.ParamCheck := ParamCheck;
2509		FQSelect.Prepare;
2510		end;
2511	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
2511	>	FQDelete.GenerateParamNames := FGenerateParamNames;
2512	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2513		FQDelete.Prepare;
2514	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
2514	>	FQInsert.GenerateParamNames := FGenerateParamNames;
2515	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2516		FQInsert.Prepare;
2517	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
2517	>	FQRefresh.GenerateParamNames := FGenerateParamNames;
2518	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2519		FQRefresh.Prepare;
2520	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
2520	>	FQModify.GenerateParamNames := FGenerateParamNames;
2521	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2522		FQModify.Prepare;
2523		FInternalPrepared := True;
2524		InternalInitFieldDefs;
2525		end else
2526		IBError(ibxeEmptyQuery, [nil]);
2527		finally
2528	<	if DidActivate then
1809	<	DeactivateTransaction;
1810	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1811	<	Screen.Cursor := crDefault;
2528	>	FBase.RestoreCursor;
2529		end;
2530		end;
2531
#	Line 1837 \| Line 2554 \| var
2554		begin
2555		CopyRecordBuffer(Buffer, OldBuffer);
2556		if BlobFieldCount > 0 then
2557	<	FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2557	>	FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2558	>	BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2559		0);
2560		end;
2561
#	Line 1910 \| Line 2628 \| procedure TIBCustomDataSet.SetInternalSQ
2628		var
2629		i, j: Integer;
2630		cr, data: PChar;
2631	<	fn, st: string;
2631	>	fn: string;
2632	>	st: RawByteString;
2633		OldBuffer: Pointer;
2634		ts: TTimeStamp;
2635	+	Param: ISQLParam;
2636		begin
2637		if (Buffer = nil) then
2638		IBError(ibxeBufferNotSet, [nil]);
#	Line 1920 \| Line 2640 \| begin
2640		InternalPrepare;
2641		OldBuffer := nil;
2642		try
2643	<	for i := 0 to Qry.Params.Count - 1 do
2643	>	for i := 0 to Qry.Params.GetCount - 1 do
2644		begin
2645	<	fn := Qry.Params[i].Name;
2645	>	Param := Qry.Params[i];
2646	>	fn := Param.Name;
2647		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2648		begin
2649		fn := Copy(fn, 5, Length(fn));
#	Line 1942 \| Line 2663 \| begin
2663		cr := Buffer;
2664		j := FQSelect.FieldIndex[fn] + 1;
2665		if (j > 0) then
2666	<	with PRecordData(cr)^ do
2666	>	with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2667		begin
2668	<	if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2668	>	if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2669		begin
2670	<	PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2670	>	PIBDBKey(Param.AsPointer)^ := rdDBKey;
2671		continue;
2672		end;
2673	<	if rdFields[j].fdIsNull then
2674	<	Qry.Params[i].IsNull := True
2673	>	if fdIsNull then
2674	>	Param.IsNull := True
2675		else begin
2676	<	Qry.Params[i].IsNull := False;
2677	<	data := cr + rdFields[j].fdDataOfs;
2678	<	case rdFields[j].fdDataType of
2676	>	Param.IsNull := False;
2677	>	data := cr + fdDataOfs;
2678	>	case fdDataType of
2679		SQL_TEXT, SQL_VARYING:
2680		begin
2681	<	SetString(st, data, rdFields[j].fdDataLength);
2682	<	Qry.Params[i].AsString := st;
2681	>	SetString(st, data, fdDataLength);
2682	>	SetCodePage(st,fdCodePage,false);
2683	>	Param.AsString := st;
2684		end;
2685		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2686	<	Qry.Params[i].AsDouble := PDouble(data)^;
2686	>	Param.AsDouble := PDouble(data)^;
2687		SQL_SHORT, SQL_LONG:
2688		begin
2689	<	if rdFields[j].fdDataScale = 0 then
2690	<	Qry.Params[i].AsLong := PLong(data)^
1969	<	else if rdFields[j].fdDataScale >= (-4) then
1970	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2689	>	if fdDataScale = 0 then
2690	>	Param.AsLong := PLong(data)^
2691		else
2692	<	Qry.Params[i].AsDouble := PDouble(data)^;
2692	>	if fdDataScale >= (-4) then
2693	>	Param.AsCurrency := PCurrency(data)^
2694	>	else
2695	>	Param.AsDouble := PDouble(data)^;
2696		end;
2697		SQL_INT64:
2698		begin
2699	<	if rdFields[j].fdDataScale = 0 then
2700	<	Qry.Params[i].AsInt64 := PInt64(data)^
2701	<	else if rdFields[j].fdDataScale >= (-4) then
2702	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2699	>	if fdDataScale = 0 then
2700	>	Param.AsInt64 := PInt64(data)^
2701	>	else
2702	>	if fdDataScale >= (-4) then
2703	>	Param.AsCurrency := PCurrency(data)^
2704		else
2705	<	Qry.Params[i].AsDouble := PDouble(data)^;
2705	>	Param.AsDouble := PDouble(data)^;
2706		end;
2707		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2708	<	Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2708	>	Param.AsQuad := PISC_QUAD(data)^;
2709		SQL_TYPE_DATE:
2710		begin
2711		ts.Date := PInt(data)^;
2712		ts.Time := 0;
2713	<	Qry.Params[i].AsDate :=
1990	<	TimeStampToDateTime(ts);
2713	>	Param.AsDate := TimeStampToDateTime(ts);
2714		end;
2715		SQL_TYPE_TIME:
2716		begin
2717		ts.Date := 0;
2718		ts.Time := PInt(data)^;
2719	<	Qry.Params[i].AsTime :=
1997	<	TimeStampToDateTime(ts);
2719	>	Param.AsTime := TimeStampToDateTime(ts);
2720		end;
2721		SQL_TIMESTAMP:
2722	<	Qry.Params[i].AsDateTime :=
2723	<	TimeStampToDateTime(
2724	<	MSecsToTimeStamp(PDouble(data)^));
2722	>	Param.AsDateTime :=
2723	>	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2724	>	SQL_BOOLEAN:
2725	>	Param.AsBoolean := PWordBool(data)^;
2726		end;
2727		end;
2728		end;
#	Line 2085 \| Line 2808 \| begin
2808		end;
2809		end;
2810
2811	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2812	+	begin
2813	+	if FIBLinks.IndexOf(Sender) = -1 then
2814	+	FIBLinks.Add(Sender);
2815	+	end;
2816	+
2817
2818		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2819		begin
2820	<	if FOpen then
2821	<	InternalClose;
2820	>	Active := false;
2821	>	{ if FOpen then
2822	>	InternalClose;}
2823		if FInternalPrepared then
2824		InternalUnPrepare;
2825	+	FieldDefs.Clear;
2826	+	FieldDefs.Updated := false;
2827	+	end;
2828	+
2829	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2830	+	begin
2831	+	FBaseSQLSelect.assign(FQSelect.SQL);
2832		end;
2833
2834		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2120 \| Line 2857 \| begin
2857		end;
2858		end;
2859
2860	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2861	+	begin
2862	+	FIBLinks.Remove(Sender);
2863	+	end;
2864	+
2865		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2866		begin
2867		if Active then
#	Line 2136 \| Line 2878 \| begin
2878		Result := Assigned( FQSelect ) and FQSelect.EOF;
2879		end;
2880
2881	+	function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2882	+	begin
2883	+	ActivateConnection;
2884	+	ActivateTransaction;
2885	+	if not FInternalPrepared then
2886	+	InternalPrepare;
2887	+	Result := Params.ByName(ParamName);
2888	+	end;
2889	+
2890	+	{Beware: the parameter FCache is used as an identifier to determine which
2891	+	cache is being operated on and is not referenced in the computation.
2892	+	The result is an adjusted offset into the identified cache, either the
2893	+	Buffer Cache or the old Buffer Cache.}
2894	+
2895		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2896	<	Origin: Integer): Integer;
2896	>	Origin: Integer): DWORD;
2897		var
2898		OldCacheSize: Integer;
2899		begin
#	Line 2174 \| Line 2930 \| procedure TIBCustomDataSet.ReadCache(FCa
2930		Buffer: PChar);
2931		var
2932		pCache: PChar;
2933	+	AdjustedOffset: DWORD;
2934		bOld: Boolean;
2935		begin
2936		bOld := (FCache = FOldBufferCache);
2937	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2937	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2938		if not bOld then
2939	<	pCache := FBufferCache + Integer(pCache)
2939	>	pCache := FBufferCache + AdjustedOffset
2940		else
2941	<	pCache := FOldBufferCache + Integer(pCache);
2941	>	pCache := FOldBufferCache + AdjustedOffset;
2942		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2943		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2944		end;
#	Line 2211 \| Line 2968 \| procedure TIBCustomDataSet.WriteCache(FC
2968		Buffer: PChar);
2969		var
2970		pCache: PChar;
2971	+	AdjustedOffset: DWORD;
2972		bOld: Boolean;
2973		dwEnd: DWORD;
2974		begin
2975		bOld := (FCache = FOldBufferCache);
2976	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2976	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2977		if not bOld then
2978	<	pCache := FBufferCache + Integer(pCache)
2978	>	pCache := FBufferCache + AdjustedOffset
2979		else
2980	<	pCache := FOldBufferCache + Integer(pCache);
2980	>	pCache := FOldBufferCache + AdjustedOffset;
2981		Move(Buffer^, pCache^, FRecordBufferSize);
2982		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2983		if not bOld then
#	Line 2257 \| Line 3015 \| var
3015		Buff: PChar;
3016		bTr, bDB: Boolean;
3017		begin
3018	+	if (Field = nil) or (Field.DataSet <> self) then
3019	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3020		Buff := GetActiveBuf;
3021		if Buff = nil then
3022		begin
3023		fs := TIBBlobStream.Create;
3024		fs.Mode := bmReadWrite;
3025	+	fs.Database := Database;
3026	+	fs.Transaction := Transaction;
3027	+	fs.SetField(Field);
3028		FBlobStreamList.Add(Pointer(fs));
3029		result := TIBDSBlobStream.Create(Field, fs, Mode);
3030		exit;
#	Line 2276 \| Line 3039 \| begin
3039		fs.Mode := bmReadWrite;
3040		fs.Database := Database;
3041		fs.Transaction := Transaction;
3042	+	fs.SetField(Field);
3043		fs.BlobID :=
3044	<	PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3044	>	PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3045		if (CachedUpdates) then
3046		begin
3047		bTr := not Transaction.InTransaction;
#	Line 2298 \| Line 3062 \| begin
3062		result := TIBDSBlobStream.Create(Field, fs, Mode);
3063		end;
3064
3065	+	function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3066	+	var Buff: PChar;
3067	+	pda: PArrayDataArray;
3068	+	bTr, bDB: Boolean;
3069	+	begin
3070	+	if (Field = nil) or (Field.DataSet <> self) then
3071	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3072	+	Buff := GetActiveBuf;
3073	+	if Buff = nil then
3074	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3075	+	Field.FRelationName,Field.FieldName)
3076	+	else
3077	+	begin
3078	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3079	+	if pda^[Field.FCacheOffset] = nil then
3080	+	begin
3081	+	AdjustRecordOnInsert(Buff);
3082	+	if Field.IsNull then
3083	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3084	+	Field.FRelationName,Field.FieldName)
3085	+	else
3086	+	Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3087	+	Field.FRelationName,Field.FieldName,Field.ArrayID);
3088	+	pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3089	+	FArrayList.Add(pda^[Field.FCacheOffset]);
3090	+	if (CachedUpdates) then
3091	+	begin
3092	+	bTr := not Transaction.InTransaction;
3093	+	bDB := not Database.Connected;
3094	+	if bDB then
3095	+	Database.Open;
3096	+	if bTr then
3097	+	Transaction.StartTransaction;
3098	+	pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3099	+	if bTr then
3100	+	Transaction.Commit;
3101	+	if bDB then
3102	+	Database.Close;
3103	+	end;
3104	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3105	+	end
3106	+	else
3107	+	Result := pda^[Field.FCacheOffset].ArrayIntf;
3108	+	end;
3109	+	end;
3110	+
3111	+	procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3112	+	var Buff: PChar;
3113	+	pda: PArrayDataArray;
3114	+	begin
3115	+	if (Field = nil) or (Field.DataSet <> self) then
3116	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3117	+	Buff := GetActiveBuf;
3118	+	if Buff <> nil then
3119	+	begin
3120	+	AdjustRecordOnInsert(Buff);
3121	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3122	+	pda^[Field.FCacheOffset].FArray := AnArray;
3123	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3124	+	end;
3125	+	end;
3126	+
3127		function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3128		const
3129		CMPLess = -1;
#	Line 2330 \| Line 3156 \| begin
3156		if FCachedUpdates and
3157		(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
3158		SaveOldBuffer(PChar(Buff));
3159	<	inherited;
3159	>	inherited DoBeforeDelete;
3160	>	end;
3161	>
3162	>	procedure TIBCustomDataSet.DoAfterDelete;
3163	>	begin
3164	>	inherited DoAfterDelete;
3165	>	FBase.DoAfterDelete(self);
3166	>	InternalAutoCommit;
3167		end;
3168
3169		procedure TIBCustomDataSet.DoBeforeEdit;
#	Line 2344 \| Line 3177 \| begin
3177		if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
3178		SaveOldBuffer(PChar(Buff));
3179		CopyRecordBuffer(GetActiveBuf, FOldBuffer);
3180	<	inherited;
3180	>	inherited DoBeforeEdit;
3181	>	end;
3182	>
3183	>	procedure TIBCustomDataSet.DoAfterEdit;
3184	>	begin
3185	>	inherited DoAfterEdit;
3186	>	FBase.DoAfterEdit(self);
3187		end;
3188
3189		procedure TIBCustomDataSet.DoBeforeInsert;
3190		begin
3191		if not CanInsert then
3192		IBError(ibxeCannotInsert, [nil]);
3193	<	inherited;
3193	>	inherited DoBeforeInsert;
3194	>	end;
3195	>
3196	>	procedure TIBCustomDataSet.DoAfterInsert;
3197	>	begin
3198	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
3199	>	GeneratorField.Apply;
3200	>	inherited DoAfterInsert;
3201	>	FBase.DoAfterInsert(self);
3202	>	end;
3203	>
3204	>	procedure TIBCustomDataSet.DoBeforeClose;
3205	>	begin
3206	>	inherited DoBeforeClose;
3207	>	if FInTransactionEnd and (FCloseAction = TARollback) then
3208	>	Exit;
3209	>	if State in [dsInsert,dsEdit] then
3210	>	begin
3211	>	if DataSetCloseAction = dcSaveChanges then
3212	>	Post;
3213	>	{Note this can fail with an exception e.g. due to
3214	>	database validation error. In which case the dataset remains open }
3215	>	end;
3216	>	if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3217	>	ApplyUpdates;
3218	>	end;
3219	>
3220	>	procedure TIBCustomDataSet.DoBeforeOpen;
3221	>	var i: integer;
3222	>	begin
3223	>	if assigned(FParser) then
3224	>	FParser.Reset;
3225	>	for i := 0 to FIBLinks.Count - 1 do
3226	>	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3227	>	inherited DoBeforeOpen;
3228	>	for i := 0 to FIBLinks.Count - 1 do
3229	>	TIBControlLink(FIBLinks[i]).UpdateParams(self);
3230	>	end;
3231	>
3232	>	procedure TIBCustomDataSet.DoBeforePost;
3233	>	begin
3234	>	inherited DoBeforePost;
3235	>	if (State = dsInsert) and
3236	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
3237	>	GeneratorField.Apply
3238	>	end;
3239	>
3240	>	procedure TIBCustomDataSet.DoAfterPost;
3241	>	begin
3242	>	inherited DoAfterPost;
3243	>	FBase.DoAfterPost(self);
3244	>	InternalAutoCommit;
3245		end;
3246
3247		procedure TIBCustomDataSet.FetchAll;
3248		var
3249	<	SetCursor: Boolean;
2360	<	CurBookmark: string;
3249	>	CurBookmark: TBookmark;
3250		begin
3251	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3252	<	if SetCursor then
2364	<	Screen.Cursor := crHourGlass;
2365	<	try
3251	>	FBase.SetCursor;
3252	>	try
3253		if FQSelect.EOF or not FQSelect.Open then
3254		exit;
3255		DisableControls;
#	Line 2374 \| Line 3261 \| begin
3261		EnableControls;
3262		end;
3263		finally
3264	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2378	<	Screen.Cursor := crDefault;
3264	>	FBase.RestoreCursor;
3265		end;
3266		end;
3267
#	Line 2423 \| Line 3309 \| begin
3309		result := FDataLink.DataSource;
3310		end;
3311
3312	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3313	+	begin
3314	+	Result := FAliasNameMap[FieldNo-1]
3315	+	end;
3316	+
3317	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3318	+	var
3319	+	i: integer;
3320	+	begin
3321	+	Result := nil;
3322	+	for i := 0 to Length(FAliasNameMap) - 1 do
3323	+	if FAliasNameMap[i] = aliasName then
3324	+	begin
3325	+	Result := FieldDefs[i];
3326	+	Exit
3327	+	end;
3328	+	end;
3329	+
3330		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3331		begin
3332		Result := DefaultFieldClasses[FieldType];
#	Line 2441 \| Line 3345 \| begin
3345		result := False;
3346		Buff := GetActiveBuf;
3347		if (Buff = nil) or
3348	<	(not IsVisible(Buff)) then
3348	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
3349		exit;
3350		{ The intention here is to stuff the buffer with the data for the
3351		referenced field for the current record }
#	Line 2453 \| Line 3357 \| begin
3357		if result and (Buffer <> nil) then
3358		Move(Buff[1], Buffer^, Field.DataSize);
3359		end
3360	<	else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3360	>	else
3361	>	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3362		(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3363	+	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3364	+	FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3365		begin
3366	<	result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3366	>	result := not fdIsNull;
3367		if result and (Buffer <> nil) then
2461	–	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3368		begin
3369	<	Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3369	>	Data := Buff + fdDataOfs;
3370		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3371		begin
3372	<	Move(Data^, Buffer^, fdDataLength);
3373	<	PChar(Buffer)[fdDataLength] := #0;
3372	>	if fdDataLength < Field.DataSize then
3373	>	begin
3374	>	Move(Data^, Buffer^, fdDataLength);
3375	>	PChar(Buffer)[fdDataLength] := #0;
3376	>	end
3377	>	else
3378	>	IBError(ibxeFieldSizeError,[Field.FieldName])
3379		end
3380		else
3381		Move(Data^, Buffer^, Field.DataSize);
#	Line 2507 \| Line 3418 \| begin
3418		if not Accept and (GetMode = gmCurrent) then
3419		GetMode := gmPrior;
3420		except
3421	<	// Application.HandleException(Self);
3421	>	// FBase.HandleException(Self);
3422		end;
3423		end;
3424		RestoreState(SaveState);
#	Line 2526 \| Line 3437 \| begin
3437		if FCurrentRecord < FRecordCount then
3438		ReadRecordCache(FCurrentRecord, Buffer, False)
3439		else begin
3440	<	while (not FQSelect.EOF) and
2530	<	(FQSelect.Next <> nil) and
3440	>	while (not FQSelect.EOF) and FQSelect.Next and
3441		(FCurrentRecord >= FRecordCount) do begin
3442		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3443		Inc(FRecordCount);
#	Line 2601 \| Line 3511 \| begin
3511		result := FRecordBufferSize;
3512		end;
3513
3514	+	procedure TIBCustomDataSet.InternalAutoCommit;
3515	+	begin
3516	+	with Transaction do
3517	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3518	+	begin
3519	+	if CachedUpdates then ApplyUpdates;
3520	+	CommitRetaining;
3521	+	end;
3522	+	end;
3523	+
3524		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3525		begin
3526		CheckEditState;
#	Line 2628 \| Line 3548 \| procedure TIBCustomDataSet.InternalCance
3548		var
3549		Buff: PChar;
3550		CurRec: Integer;
3551	+	pda: PArrayDataArray;
3552	+	i: integer;
3553		begin
3554	<	inherited;
3554	>	inherited InternalCancel;
3555		Buff := GetActiveBuf;
3556	<	if Buff <> nil then begin
3556	>	if Buff <> nil then
3557	>	begin
3558	>	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3559	>	for i := 0 to ArrayFieldCount - 1 do
3560	>	pda^[i].ArrayIntf.CancelChanges;
3561		CurRec := FCurrentRecord;
3562		AdjustRecordOnInsert(Buff);
3563		if (State = dsEdit) then begin
#	Line 2654 \| Line 3580 \| begin
3580		DeactivateTransaction;
3581		FQSelect.Close;
3582		ClearBlobCache;
3583	+	ClearArrayCache;
3584		FreeRecordBuffer(FModelBuffer);
3585		FreeRecordBuffer(FOldBuffer);
3586		FCurrentRecord := -1;
#	Line 2669 \| Line 3596 \| begin
3596		FOBEnd := 0;
3597		FreeMem(FBufferCache);
3598		FBufferCache := nil;
3599	+	FreeMem(FFieldColumns);
3600	+	FFieldColumns := nil;
3601		FreeMem(FOldBufferCache);
3602		FOldBufferCache := nil;
3603		BindFields(False);
3604	+	ResetParser;
3605		if DefaultFields then DestroyFields;
3606		end;
3607
3608		procedure TIBCustomDataSet.InternalDelete;
3609		var
3610		Buff: PChar;
2681	–	SetCursor: Boolean;
3611		begin
3612	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2684	<	if SetCursor then
2685	<	Screen.Cursor := crHourGlass;
3612	>	FBase.SetCursor;
3613		try
3614		Buff := GetActiveBuf;
3615		if CanDelete then
#	Line 2707 \| Line 3634 \| begin
3634		end else
3635		IBError(ibxeCannotDelete, [nil]);
3636		finally
3637	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2711	<	Screen.Cursor := crDefault;
3637	>	FBase.RestoreCursor;
3638		end;
3639		end;
3640
#	Line 2724 \| Line 3650 \| end;
3650
3651		procedure TIBCustomDataSet.InternalHandleException;
3652		begin
3653	<	Application.HandleException(Self)
3653	>	FBase.HandleException(Self)
3654		end;
3655
3656		procedure TIBCustomDataSet.InternalInitFieldDefs;
3657	+	begin
3658	+	if not InternalPrepared then
3659	+	begin
3660	+	InternalPrepare;
3661	+	exit;
3662	+	end;
3663	+	FieldDefsFromQuery(FQSelect);
3664	+	end;
3665	+
3666	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3667		const
3668		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3669		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2739 \| Line 3675 \| const
3675		var
3676		FieldType: TFieldType;
3677		FieldSize: Word;
3678	+	FieldDataSize: integer;
3679	+	charSetID: short;
3680	+	CharSetSize: integer;
3681	+	CharSetName: RawByteString;
3682	+	FieldCodePage: TSystemCodePage;
3683		FieldNullable : Boolean;
3684		i, FieldPosition, FieldPrecision: Integer;
3685	<	FieldAliasName: string;
3686	<	RelationName, FieldName: string;
3685	>	FieldAliasName, DBAliasName: string;
3686	>	aRelationName, FieldName: string;
3687		Query : TIBSQL;
3688		FieldIndex: Integer;
3689		FRelationNodes : TRelationNode;
3690	+	aArrayDimensions: integer;
3691	+	aArrayBounds: TArrayBounds;
3692	+	ArrayMetaData: IArrayMetaData;
3693
3694		function Add_Node(Relation, Field : String) : TRelationNode;
3695		var
#	Line 2841 \| Line 3785 \| var
3785		end;
3786
3787		begin
2844	–	if not InternalPrepared then
2845	–	begin
2846	–	InternalPrepare;
2847	–	exit;
2848	–	end;
3788		FRelationNodes := TRelationNode.Create;
3789		FNeedsRefresh := False;
3790	<	Database.InternalTransaction.StartTransaction;
3790	>	if not Database.InternalTransaction.InTransaction then
3791	>	Database.InternalTransaction.StartTransaction;
3792		Query := TIBSQL.Create(self);
3793		try
3794		Query.Database := DataBase;
#	Line 2856 \| Line 3796 \| begin
3796		FieldDefs.BeginUpdate;
3797		FieldDefs.Clear;
3798		FieldIndex := 0;
3799	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3800	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3799	>	if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3800	>	SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3801		Query.SQL.Text := DefaultSQL;
3802		Query.Prepare;
3803	<	for i := 0 to FQSelect.Current.Count - 1 do
3804	<	with FQSelect.Current[i].Data^ do
3803	>	SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3804	>	SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3805	>	for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3806	>	with SourceQuery.MetaData[i] do
3807		begin
3808		{ Get the field name }
3809	<	SetString(FieldAliasName, aliasname, aliasname_length);
3810	<	SetString(RelationName, relname, relname_length);
3811	<	SetString(FieldName, sqlname, sqlname_length);
3809	>	FieldAliasName := GetName;
3810	>	DBAliasName := GetAliasname;
3811	>	aRelationName := getRelationName;
3812	>	FieldName := getSQLName;
3813	>	FAliasNameList[i] := DBAliasName;
3814		FieldSize := 0;
3815	+	FieldDataSize := GetSize;
3816		FieldPrecision := 0;
3817	<	FieldNullable := FQSelect.Current[i].IsNullable;
3818	<	case sqltype and not 1 of
3817	>	FieldNullable := IsNullable;
3818	>	CharSetSize := 0;
3819	>	CharSetName := '';
3820	>	FieldCodePage := CP_NONE;
3821	>	aArrayDimensions := 0;
3822	>	SetLength(aArrayBounds,0);
3823	>	case SQLType of
3824		{ All VARCHAR's must be converted to strings before recording
3825		their values }
3826		SQL_VARYING, SQL_TEXT:
3827		begin
3828	<	FieldSize := sqllen;
3828	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3829	>	CharSetSize := 1;
3830	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3831	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3832	>	FieldSize := FieldDataSize div CharSetSize;
3833		FieldType := ftString;
3834		end;
3835		{ All Doubles/Floats should be cast to doubles }
#	Line 2883 \| Line 3837 \| begin
3837		FieldType := ftFloat;
3838		SQL_SHORT:
3839		begin
3840	<	if (sqlscale = 0) then
3840	>	if (getScale = 0) then
3841		FieldType := ftSmallInt
3842		else begin
3843		FieldType := ftBCD;
3844		FieldPrecision := 4;
3845	<	FieldSize := -sqlscale;
3845	>	FieldSize := -getScale;
3846		end;
3847		end;
3848		SQL_LONG:
3849		begin
3850	<	if (sqlscale = 0) then
3850	>	if (getScale = 0) then
3851		FieldType := ftInteger
3852	<	else if (sqlscale >= (-4)) then
3852	>	else if (getScale >= (-4)) then
3853		begin
3854		FieldType := ftBCD;
3855		FieldPrecision := 9;
3856	<	FieldSize := -sqlscale;
3856	>	FieldSize := -getScale;
3857		end
3858		else
3859	<	FieldType := ftFloat;
3859	>	if Database.SQLDialect = 1 then
3860	>	FieldType := ftFloat
3861	>	else
3862	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
3863	>	FieldType := ftFloat
3864	>	else
3865	>	begin
3866	>	FieldType := ftFMTBCD;
3867	>	FieldPrecision := 9;
3868	>	FieldSize := -getScale;
3869		end;
3870	+	end;
3871	+
3872		SQL_INT64:
3873		begin
3874	<	if (sqlscale = 0) then
3874	>	if (getScale = 0) then
3875		FieldType := ftLargeInt
3876	<	else if (sqlscale >= (-4)) then
3876	>	else if (getScale >= (-4)) then
3877		begin
3878		FieldType := ftBCD;
3879		FieldPrecision := 18;
3880	<	FieldSize := -sqlscale;
3880	>	FieldSize := -getScale;
3881		end
3882		else
3883		FieldType := ftFloat;
3884	<	end;
3884	>	end;
3885		SQL_TIMESTAMP: FieldType := ftDateTime;
3886		SQL_TYPE_TIME: FieldType := ftTime;
3887		SQL_TYPE_DATE: FieldType := ftDate;
3888		SQL_BLOB:
3889		begin
3890		FieldSize := sizeof (TISC_QUAD);
3891	<	if (sqlsubtype = 1) then
3892	<	FieldType := ftmemo
3891	>	if (getSubtype = 1) then
3892	>	begin
3893	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3894	>	CharSetSize := 1;
3895	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3896	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3897	>	FieldType := ftMemo;
3898	>	end
3899		else
3900		FieldType := ftBlob;
3901		end;
3902		SQL_ARRAY:
3903		begin
3904		FieldSize := sizeof (TISC_QUAD);
3905	<	FieldType := ftUnknown;
3905	>	FieldType := ftArray;
3906	>	ArrayMetaData := GetArrayMetaData;
3907	>	if ArrayMetaData <> nil then
3908	>	begin
3909	>	aArrayDimensions := ArrayMetaData.GetDimensions;
3910	>	aArrayBounds := ArrayMetaData.GetBounds;
3911	>	end;
3912		end;
3913	+	SQL_BOOLEAN:
3914	+	FieldType:= ftBoolean;
3915		else
3916		FieldType := ftUnknown;
3917		end;
#	Line 2941 \| Line 3920 \| begin
3920		begin
3921		FMappedFieldPosition[FieldIndex] := FieldPosition;
3922		Inc(FieldIndex);
3923	<	with FieldDefs.AddFieldDef do
3923	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3924		begin
3925	<	Name := string( FieldAliasName );
3926	<	FieldNo := FieldPosition;
2948	<	DataType := FieldType;
3925	>	Name := FieldAliasName;
3926	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3927		Size := FieldSize;
3928	+	DataSize := FieldDataSize;
3929		Precision := FieldPrecision;
3930	<	Required := False;
3930	>	Required := not FieldNullable;
3931	>	RelationName := aRelationName;
3932		InternalCalcField := False;
3933	+	CharacterSetSize := CharSetSize;
3934	+	CharacterSetName := CharSetName;
3935	+	CodePage := FieldCodePage;
3936	+	ArrayDimensions := aArrayDimensions;
3937	+	ArrayBounds := aArrayBounds;
3938		if (FieldName <> '') and (RelationName <> '') then
3939		begin
3940		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 2977 \| Line 3962 \| begin
3962		FreeNodes;
3963		Database.InternalTransaction.Commit;
3964		FieldDefs.EndUpdate;
3965	+	FieldDefs.Updated := true;
3966		end;
3967		end;
3968
#	Line 2994 \| Line 3980 \| begin
3980		else begin
3981		Buffer := AllocRecordBuffer;
3982		try
3983	<	while FQSelect.Next <> nil do
3983	>	while FQSelect.Next do
3984		begin
3985		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3986		Inc(FRecordCount);
#	Line 3009 \| Line 3995 \| end;
3995		procedure TIBCustomDataSet.InternalSetParamsFromCursor;
3996		var
3997		i: Integer;
3998	<	cur_param: TIBXSQLVAR;
3998	>	cur_param: ISQLParam;
3999		cur_field: TField;
4000		s: TStream;
4001		begin
#	Line 3017 \| Line 4003 \| begin
4003		IBError(ibxeEmptyQuery, [nil]);
4004		if not FInternalPrepared then
4005		InternalPrepare;
4006	<	if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4006	>	if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4007		begin
4008	<	for i := 0 to SQLParams.Count - 1 do
4008	>	for i := 0 to SQLParams.GetCount - 1 do
4009		begin
4010		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4011		cur_param := SQLParams[i];
#	Line 3029 \| Line 4015 \| begin
4015		else case cur_field.DataType of
4016		ftString:
4017		cur_param.AsString := cur_field.AsString;
4018	<	ftBoolean, ftSmallint, ftWord:
4018	>	ftBoolean:
4019	>	cur_param.AsBoolean := cur_field.AsBoolean;
4020	>	ftSmallint, ftWord:
4021		cur_param.AsShort := cur_field.AsInteger;
4022		ftInteger:
4023		cur_param.AsLong := cur_field.AsInteger;
#	Line 3051 \| Line 4039 \| begin
4039		try
4040		s := DataSource.DataSet.
4041		CreateBlobStream(cur_field, bmRead);
4042	<	cur_param.LoadFromStream(s);
4042	>	cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4043		finally
4044		s.free;
4045		end;
4046		end;
4047	+	ftArray:
4048	+	cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4049		else
4050		IBError(ibxeNotSupported, [nil]);
4051		end;
#	Line 3082 \| Line 4072 \| begin
4072		end;
4073
4074		procedure TIBCustomDataSet.InternalOpen;
3085	–	var
3086	–	SetCursor: Boolean;
4075
4076		function RecordDataLength(n: Integer): Long;
4077		begin
#	Line 3091 \| Line 4079 \| var
4079		end;
4080
4081		begin
4082	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3095	<	if SetCursor then
3096	<	Screen.Cursor := crHourGlass;
4082	>	FBase.SetCursor;
4083		try
4084		ActivateConnection;
4085		ActivateTransaction;
#	Line 3101 \| Line 4087 \| begin
4087		IBError(ibxeEmptyQuery, [nil]);
4088		if not FInternalPrepared then
4089		InternalPrepare;
4090	<	if FQSelect.SQLType = SQLSelect then
4090	>	if FQSelect.SQLStatementType = SQLSelect then
4091		begin
4092		if DefaultFields then
4093		CreateFields;
4094	+	FArrayFieldCount := 0;
4095		BindFields(True);
4096		FCurrentRecord := -1;
4097		FQSelect.ExecQuery;
#	Line 3116 \| Line 4103 \| begin
4103		3. After the dummy fetch, FRecordSize will be appropriately
4104		adjusted to reflect the additional "weight" of the field
4105		data.
4106	<	4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4106	>	4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4107		5. Now, with the BufferSize available, allocate memory for chunks of records
4108		6. Re-allocate the model buffer, accounting for the new
4109		FRecordBufferSize.
4110		7. Finally, calls to AllocRecordBuffer will work!.
4111		}
4112		{Step 1}
4113	<	FRecordSize := RecordDataLength(FQSelect.Current.Count);
4113	>	FRecordSize := RecordDataLength(FQSelect.FieldCount);
4114		{Step 2, 3}
4115	+	GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4116		IBAlloc(FModelBuffer, 0, FRecordSize);
4117	<	FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4117	>	InitModelBuffer(FQSelect, FModelBuffer);
4118		{Step 4}
4119		FCalcFieldsOffset := FRecordSize;
4120		FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4121	<	FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4121	>	FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4122	>	FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4123		{Step 5}
4124		if UniDirectional then
4125		FBufferChunkSize := FRecordBufferSize * UniCache
#	Line 3146 \| Line 4135 \| begin
4135		FCacheSize := FBufferChunkSize;
4136		FOldCacheSize := FBufferChunkSize;
4137		{Step 6}
4138	<	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4138	>	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4139		FRecordBufferSize);
4140		{Step 7}
4141		FOldBuffer := AllocRecordBuffer;
#	Line 3154 \| Line 4143 \| begin
4143		else
4144		FQSelect.ExecQuery;
4145		finally
4146	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3158	<	Screen.Cursor := crDefault;
4146	>	FBase.RestoreCursor;
4147		end;
4148		end;
4149
#	Line 3163 \| Line 4151 \| procedure TIBCustomDataSet.InternalPost;
4151		var
4152		Qry: TIBSQL;
4153		Buff: PChar;
3166	–	SetCursor: Boolean;
4154		bInserting: Boolean;
4155		begin
4156	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3170	<	if SetCursor then
3171	<	Screen.Cursor := crHourGlass;
4156	>	FBase.SetCursor;
4157		try
4158		Buff := GetActiveBuf;
4159		CheckEditState;
#	Line 3206 \| Line 4191 \| begin
4191		if bInserting then
4192		Inc(FRecordCount);
4193		finally
4194	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3210	<	Screen.Cursor := crDefault;
4194	>	FBase.RestoreCursor;
4195		end;
4196		end;
4197
4198		procedure TIBCustomDataSet.InternalRefresh;
4199		begin
4200	<	inherited;
4200	>	inherited InternalRefresh;
4201		InternalRefreshRow;
4202		end;
4203
#	Line 3227 \| Line 4211 \| begin
4211		result := FOpen;
4212		end;
4213
4214	+	procedure TIBCustomDataSet.Loaded;
4215	+	begin
4216	+	if assigned(FQSelect) then
4217	+	FBaseSQLSelect.assign(FQSelect.SQL);
4218	+	inherited Loaded;
4219	+	end;
4220	+
4221	+	procedure TIBCustomDataSet.Post;
4222	+	var CancelPost: boolean;
4223	+	begin
4224	+	CancelPost := false;
4225	+	if assigned(FOnValidatePost) then
4226	+	OnValidatePost(self,CancelPost);
4227	+	if CancelPost then
4228	+	Cancel
4229	+	else
4230	+	inherited Post;
4231	+	end;
4232	+
4233		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4234		Options: TLocateOptions): Boolean;
4235		var
4236	<	CurBookmark: string;
4236	>	CurBookmark: TBookmark;
4237		begin
4238		DisableControls;
4239		try
#	Line 3248 \| Line 4251 \| function TIBCustomDataSet.Lookup(const K
4251		const ResultFields: string): Variant;
4252		var
4253		fl: TList;
4254	<	CurBookmark: string;
4254	>	CurBookmark: TBookmark;
4255		begin
4256		DisableControls;
4257		fl := TList.Create;
#	Line 3301 \| Line 4304 \| end;
4304		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4305		var
4306		Buff, TmpBuff: PChar;
4307	+	MappedFieldPos: integer;
4308		begin
4309		Buff := GetActiveBuf;
4310		if Field.FieldNo < 0 then
#	Line 3317 \| Line 4321 \| begin
4321		begin
4322		{ If inserting, Adjust record position }
4323		AdjustRecordOnInsert(Buff);
4324	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4325	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4324	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4325	>	if (MappedFieldPos > 0) and
4326	>	(MappedFieldPos <= rdFieldCount) then
4327	>	with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4328		begin
4329		Field.Validate(Buffer);
4330		if (Buffer = nil) or
4331		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4332	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4333	<	else begin
4334	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4335	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4336	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4337	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4338	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3333	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4332	>	fdIsNull := True
4333	>	else
4334	>	begin
4335	>	Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4336	>	if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4337	>	fdDataLength := StrLen(PChar(Buffer));
4338	>	fdIsNull := False;
4339		if rdUpdateStatus = usUnmodified then
4340		begin
4341		if CachedUpdates then
#	Line 3354 \| Line 4359 \| begin
4359		end;
4360		end;
4361		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
4362	<	DataEvent(deFieldChange, Longint(Field));
4362	>	DataEvent(deFieldChange, PtrInt(Field));
4363		end;
4364
4365		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3418 \| Line 4423 \| begin
4423		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4424		end;
4425
4426	+	procedure TIBCustomDataSet.ClearIBLinks;
4427	+	var i: integer;
4428	+	begin
4429	+	for i := FIBLinks.Count - 1 downto 0 do
4430	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4431	+	end;
4432	+
4433
4434		procedure TIBCustomDataSet.InternalUnPrepare;
4435		begin
4436		if FInternalPrepared then
4437		begin
4438		CheckDatasetClosed;
4439	+	if FDidActivate then
4440	+	DeactivateTransaction;
4441		FieldDefs.Clear;
4442	+	FieldDefs.Updated := false;
4443		FInternalPrepared := False;
4444	+	Setlength(FAliasNameList,0);
4445		end;
4446		end;
4447
4448		procedure TIBCustomDataSet.InternalExecQuery;
4449		var
4450		DidActivate: Boolean;
3435	–	SetCursor: Boolean;
4451		begin
4452		DidActivate := False;
4453	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3439	<	if SetCursor then
3440	<	Screen.Cursor := crHourGlass;
4453	>	FBase.SetCursor;
4454		try
4455		ActivateConnection;
4456		DidActivate := ActivateTransaction;
#	Line 3445 \| Line 4458 \| begin
4458		IBError(ibxeEmptyQuery, [nil]);
4459		if not FInternalPrepared then
4460		InternalPrepare;
4461	<	if FQSelect.SQLType = SQLSelect then
4461	>	if FQSelect.SQLStatementType = SQLSelect then
4462		begin
4463		IBError(ibxeIsASelectStatement, [nil]);
4464		end
#	Line 3454 \| Line 4467 \| begin
4467		finally
4468		if DidActivate then
4469		DeactivateTransaction;
4470	<	if SetCursor and (Screen.Cursor = crHourGlass) then
4471	<	Screen.Cursor := crDefault;
4470	>	FBase.RestoreCursor;
4471	>	end;
4472	>	end;
4473	>
4474	>	function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4475	>	begin
4476	>	Result := FQSelect.Statement;
4477	>	end;
4478	>
4479	>	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4480	>	begin
4481	>	if not assigned(FParser) then
4482	>	FParser := CreateParser;
4483	>	Result := FParser
4484	>	end;
4485	>
4486	>	procedure TIBCustomDataSet.ResetParser;
4487	>	begin
4488	>	if assigned(FParser) then
4489	>	begin
4490	>	FParser.Free;
4491	>	FParser := nil;
4492	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
4493	>	try
4494	>	FQSelect.SQL.Assign(FBaseSQLSelect);
4495	>	finally
4496	>	FQSelect.OnSQLChanged := SQLChanged;
4497	>	end;
4498		end;
4499		end;
4500
4501	<	function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4501	>	function TIBCustomDataSet.HasParser: boolean;
4502	>	begin
4503	>	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4504	>	end;
4505	>
4506	>	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4507		begin
4508	<	Result := FQSelect.Handle;
4508	>	if FGenerateParamNames = AValue then Exit;
4509	>	FGenerateParamNames := AValue;
4510	>	Disconnect
4511		end;
4512
4513		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
#	Line 3682 \| Line 4728 \| begin
4728		ActivateConnection;
4729		ActivateTransaction;
4730		InternalSetParamsFromCursor;
4731	<	Inherited;
4731	>	Inherited InternalOpen;
4732		end;
4733
4734		procedure TIBDataSet.SetFiltered(Value: Boolean);
#	Line 3710 \| Line 4756 \| end;
4756
4757		function TIBCustomDataSet.GetFieldData(Field: TField;
4758		Buffer: Pointer): Boolean;
4759	+	{$IFDEF TBCDFIELD_IS_BCD}
4760		var
4761		lTempCurr : System.Currency;
4762		begin
#	Line 3720 \| Line 4767 \| begin
4767		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
4768		end
4769		else
4770	+	{$ELSE}
4771	+	begin
4772	+	{$ENDIF}
4773		Result := InternalGetFieldData(Field, Buffer);
4774		end;
4775
#	Line 3733 \| Line 4783 \| begin
4783		end;
4784
4785		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
4786	+	{$IFDEF TDBDFIELD_IS_BCD}
4787		var
4788		lTempCurr : System.Currency;
4789		begin
4790	<	if Field.DataType = ftBCD then
4790	>	if (Field.DataType = ftBCD) and (Buffer <> nil) then
4791		begin
4792		BCDToCurr(TBCD(Buffer^), lTempCurr);
4793		InternalSetFieldData(Field, @lTempCurr);
4794		end
4795		else
4796	+	{$ELSE}
4797	+	begin
4798	+	{$ENDIF}
4799		InternalSetFieldData(Field, Buffer);
4800		end;
4801
#	Line 3765 \| Line 4819 \| end;
4819		destructor TIBDataSetUpdateObject.Destroy;
4820		begin
4821		FRefreshSQL.Free;
4822	<	inherited destroy;
4822	>	inherited Destroy;
4823		end;
4824
4825		procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
#	Line 3773 \| Line 4827 \| begin
4827		FRefreshSQL.Assign(Value);
4828		end;
4829
4830	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4831	+	begin
4832	+	if not Assigned(DataSet) then Exit;
4833	+	DataSet.SetInternalSQLParams(Query, buff);
4834	+	end;
4835	+
4836	+	function TIBDSBlobStream.GetSize: Int64;
4837	+	begin
4838	+	Result := FBlobStream.BlobSize;
4839	+	end;
4840	+
4841		{ TIBDSBlobStream }
4842		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4843		Mode: TBlobStreamMode);
#	Line 3781 \| Line 4846 \| begin
4846		FBlobStream := ABlobStream;
4847		FBlobStream.Seek(0, soFromBeginning);
4848		if (Mode = bmWrite) then
4849	+	begin
4850		FBlobStream.Truncate;
4851	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
4852	+	TBlobField(FField).Modified := true;
4853	+	FHasWritten := true;
4854	+	end;
4855	+	end;
4856	+
4857	+	destructor TIBDSBlobStream.Destroy;
4858	+	begin
4859	+	if FHasWritten then
4860	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4861	+	inherited Destroy;
4862		end;
4863
4864		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
#	Line 3804 \| Line 4881 \| begin
4881		if not (FField.DataSet.State in [dsEdit, dsInsert]) then
4882		IBError(ibxeNotEditing, [nil]);
4883		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4884	+	TBlobField(FField).Modified := true;
4885		result := FBlobStream.Write(Buffer, Count);
4886	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
4886	>	FHasWritten := true;
4887	>	{ TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4888	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4889	>	the blob stream. Moved to the destructor i.e. called after blob written}
4890	>	end;
4891	>
4892	>	{ TIBGenerator }
4893	>
4894	>	procedure TIBGenerator.SetIncrement(const AValue: integer);
4895	>	begin
4896	>	if AValue < 0 then
4897	>	raise Exception.Create('A Generator Increment cannot be negative');
4898	>	FIncrement := AValue
4899	>	end;
4900	>
4901	>	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4902	>	ATransaction: TIBTransaction): integer;
4903	>	begin
4904	>	with TIBSQL.Create(nil) do
4905	>	try
4906	>	Database := ADatabase;
4907	>	Transaction := ATransaction;
4908	>	if not assigned(Database) then
4909	>	IBError(ibxeCannotSetDatabase,[]);
4910	>	if not assigned(Transaction) then
4911	>	IBError(ibxeCannotSetTransaction,[]);
4912	>	with Transaction do
4913	>	if not InTransaction then StartTransaction;
4914	>	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4915	>	Prepare;
4916	>	ExecQuery;
4917	>	try
4918	>	Result := FieldByName('ID').AsInteger
4919	>	finally
4920	>	Close
4921	>	end;
4922	>	finally
4923	>	Free
4924	>	end;
4925		end;
4926
4927	+	constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
4928	+	begin
4929	+	FOwner := Owner;
4930	+	FIncrement := 1;
4931	+	end;
4932	+
4933	+
4934	+	procedure TIBGenerator.Apply;
4935	+	begin
4936	+	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4937	+	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4938	+	end;
4939	+
4940	+
4941		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 67 by tony, Tue Oct 3 14:08:11 2017 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 67 by tony, Tue Oct 3 14:08:11 2017 UTC