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

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC

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

Diff Legend

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

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents): Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs. Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC

Diff Legend

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC