ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 11 by tony, Tue Oct 9 08:10:32 2012 UTC vs.
Revision 57 by tony, Wed Mar 8 11:20:46 2017 UTC

#	Line 27 | Line 27
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                                                 }
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}
#	Line 47 | Line 52 | uses
52		{$ELSE}
53		unix,
54		{$ENDIF}
55	<	SysUtils, Classes, Forms, Controls, IBDatabase,
56	<	IBExternals, IB, IBHeader,  IBSQL, Db,
52	<	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 81 | Line 85 | type
85
86		TBlobDataArray = array[0..0] of TIBBlobStream;
87		PBlobDataArray = ^TBlobDataArray;
88	+	TIBArrayField = class;
89
90	<	{ TIBCustomDataSet }
91	<	TFieldData = record
92	<	fdDataType: Short;
93	<	fdDataScale: Short;
94	<	fdNullable: Boolean;
95	<	fdIsNull: Boolean;
96	<	fdDataSize: Short;
97	<	fdDataLength: Short;
98	<	fdDataOfs: Integer;
90	>	{ TIBArray }
91	>
92	>	{Wrapper class to support array cache in TIBCustomDataset and event handling}
93	>
94	>	TIBArray = class
95	>	private
96	>	FArray: IArray;
97	>	FRecNo: integer;
98	>	FField: TIBArrayField;
99	>	procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
100	>	public
101	>	constructor Create(aField: TIBArrayField; anArray: IArray);
102	>	destructor Destroy; override;
103	>	property ArrayIntf: IArray read FArray;
104		end;
105	<	PFieldData = ^TFieldData;
105	>
106	>	TArrayDataArray = array [0..0] of TIBArray;
107	>	PArrayDataArray = ^TArrayDataArray;
108	>
109	>	{ TIBCustomDataSet }
110
111		TCachedUpdateStatus = (
112		cusUnmodified, cusModified, cusInserted,
#	Line 103 | Line 117 | type
117		end;
118		PIBDBKey = ^TIBDBKey;
119
120	+	PFieldData = ^TFieldData;
121	+	TFieldData = record
122	+	fdIsNull: Boolean;
123	+	fdDataLength: Short;
124	+	end;
125	+
126	+	PColumnData = ^TColumnData;
127	+	TColumnData = record
128	+	fdDataType: Short;
129	+	fdDataScale: Short;
130	+	fdNullable: Boolean;
131	+	fdDataSize: Short;
132	+	fdDataOfs: Integer;
133	+	fdCodePage: TSystemCodePage;
134	+	end;
135	+
136	+	PFieldColumns = ^TFieldColumns;
137	+	TFieldColumns =  array[1..1] of TColumnData;
138	+
139		TRecordData = record
140		rdBookmarkFlag: TBookmarkFlag;
141		rdFieldCount: Short;
#	Line 115 | Line 148 | type
148		end;
149		PRecordData = ^TRecordData;
150
151	+	{ TIBArrayField }
152	+
153	+	TIBArrayField = class(TField)
154	+	private
155	+	FArrayBounds: TArrayBounds;
156	+	FArrayDimensions: integer;
157	+	FRelationName: string;
158	+	FCacheOffset: word;
159	+	function GetArrayID: TISC_QUAD;
160	+	function GetArrayIntf: IArray;
161	+	procedure SetArrayIntf(AValue: IArray);
162	+	protected
163	+	class procedure CheckTypeSize(AValue: Longint); override;
164	+	function GetAsString: string; override;
165	+	function GetDataSize: Integer; override;
166	+	procedure Bind(Binding: Boolean); override;
167	+	public
168	+	constructor Create(AOwner: TComponent); override;
169	+	function CreateArray: IArray;
170	+	property ArrayID: TISC_QUAD read GetArrayID;
171	+	property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
172	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
173	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
174	+	end;
175	+
176		{ TIBStringField allows us to have strings longer than 8196 }
177
178		TIBStringField = class(TStringField)
179	+	private
180	+	FCharacterSetName: RawByteString;
181	+	FCharacterSetSize: integer;
182	+	FAutoFieldSize: boolean;
183	+	FCodePage: TSystemCodePage;
184	+	protected
185	+	procedure Bind(Binding: Boolean); override;
186	+	function GetDataSize: Integer; override;
187		public
188	<	constructor create(AOwner: TComponent); override;
188	>	constructor Create(aOwner: TComponent); override;
189		class procedure CheckTypeSize(Value: Integer); override;
190		function GetAsString: string; override;
191		function GetAsVariant: Variant; override;
192		function GetValue(var Value: string): Boolean;
193		procedure SetAsString(const Value: string); override;
194	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
195	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
196	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
197	+	published
198	+	property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
199		end;
200
201		{ TIBBCDField }
#	Line 147 | Line 218 | type
218		property Size default 8;
219		end;
220
221	+	{TIBMemoField}
222	+	{Allows us to show truncated text in DBGrids and anything else that uses
223	+	DisplayText}
224	+
225	+	TIBMemoField = class(TMemoField)
226	+	private
227	+	FCharacterSetName: RawByteString;
228	+	FCharacterSetSize: integer;
229	+	FDisplayTextAsClassName: boolean;
230	+	function GetTruncatedText: string;
231	+	protected
232	+	procedure Bind(Binding: Boolean); override;
233	+	function GetAsString: string; override;
234	+	function GetDefaultWidth: Longint; override;
235	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
236	+	procedure SetAsString(const AValue: string); override;
237	+	public
238	+	constructor Create(AOwner: TComponent); override;
239	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
240	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
241	+	published
242	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
243	+	write FDisplayTextAsClassName;
244	+	private
245	+	FCodePage: TSystemCodePage;
246	+	FFCodePage: TSystemCodePage;
247	+	public
248	+	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
249	+	end;
250	+
251		TIBDataLink = class(TDetailDataLink)
252		private
253		FDataSet: TIBCustomDataSet;
#	Line 185 | Line 286 | type
286		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
287		end;
288
289	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
290	+
291	+	TIBControlLink = class
292	+	private
293	+	FTIBDataSet: TIBCustomDataSet;
294	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
295	+	protected
296	+	procedure UpdateSQL(Sender: TObject); virtual;
297	+	procedure UpdateParams(Sender: TObject); virtual;
298	+	public
299	+	destructor Destroy; override;
300	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
301	+	end;
302	+
303	+	TIBAutoCommit = (acDisabled, acCommitRetaining);
304	+
305		{ TIBCustomDataSet }
306	+
307		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
308
309		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
310	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
310	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
311		of object;
312		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
313		var UpdateAction: TIBUpdateAction) of object;
314
315		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
316
317	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
318	+
319	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
320	+
321		TIBCustomDataSet = class(TDataset)
322		private
323	+	FAllowAutoActivateTransaction: Boolean;
324	+	FArrayFieldCount: integer;
325	+	FArrayCacheOffset: integer;
326	+	FAutoCommit: TIBAutoCommit;
327	+	FGenerateParamNames: Boolean;
328		FGeneratorField: TIBGenerator;
329		FNeedsRefresh: Boolean;
330		FForcedRefresh: Boolean;
331		FDidActivate: Boolean;
205	–	FIBLoaded: Boolean;
332		FBase: TIBBase;
333		FBlobCacheOffset: Integer;
334		FBlobStreamList: TList;
335	+	FArrayList: TList;
336		FBufferChunks: Integer;
337		FBufferCache,
338		FOldBufferCache: PChar;
#	Line 223 | Line 350 | type
350		FDeletedRecords: Long;
351		FModelBuffer,
352		FOldBuffer: PChar;
353	+	FOnValidatePost: TOnValidatePost;
354		FOpen: Boolean;
355		FInternalPrepared: Boolean;
356		FQDelete,
#	Line 233 | Line 361 | type
361		FRecordBufferSize: Integer;
362		FRecordCount: Integer;
363		FRecordSize: Integer;
364	+	FDataSetCloseAction: TDataSetCloseAction;
365		FUniDirectional: Boolean;
366		FUpdateMode: TUpdateMode;
367		FUpdateObject: TIBDataSetUpdateObject;
#	Line 250 | Line 379 | type
379		FBeforeTransactionEnd,
380		FAfterTransactionEnd,
381		FTransactionFree: TNotifyEvent;
382	<
383	<	function GetSelectStmtHandle: TISC_STMT_HANDLE;
382	>	FAliasNameMap: array of string;
383	>	FAliasNameList: array of string;
384	>	FBaseSQLSelect: TStrings;
385	>	FParser: TSelectSQLParser;
386	>	FCloseAction: TTransactionAction;
387	>	FInTransactionEnd: boolean;
388	>	FIBLinks: TList;
389	>	FFieldColumns: PFieldColumns;
390	>	procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
391	>	function GetSelectStmtIntf: IStatement;
392		procedure SetUpdateMode(const Value: TUpdateMode);
393		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
394
#	Line 263 | Line 400 | type
400		function CanRefresh: Boolean;
401		procedure CheckEditState;
402		procedure ClearBlobCache;
403	+	procedure ClearArrayCache;
404	+	procedure ClearIBLinks;
405		procedure CopyRecordBuffer(Source, Dest: Pointer);
406		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
407		procedure DoAfterDatabaseDisconnect(Sender: TObject);
408		procedure DoDatabaseFree(Sender: TObject);
409	<	procedure DoBeforeTransactionEnd(Sender: TObject);
409	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
410		procedure DoAfterTransactionEnd(Sender: TObject);
411		procedure DoTransactionFree(Sender: TObject);
412		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
413		Buffer: PChar);
414		function GetDatabase: TIBDatabase;
276	–	function GetDBHandle: PISC_DB_HANDLE;
415		function GetDeleteSQL: TStrings;
416		function GetInsertSQL: TStrings;
417	<	function GetSQLParams: TIBXSQLDA;
417	>	function GetSQLParams: ISQLParams;
418		function GetRefreshSQL: TStrings;
419		function GetSelectSQL: TStrings;
420	<	function GetStatementType: TIBSQLTypes;
420	>	function GetStatementType: TIBSQLStatementTypes;
421		function GetModifySQL: TStrings;
422		function GetTransaction: TIBTransaction;
423	<	function GetTRHandle: PISC_TR_HANDLE;
423	>	function GetParser: TSelectSQLParser;
424		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
425		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
426		Options: TLocateOptions): Boolean; virtual;
427		procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
428		procedure InternalRevertRecord(RecordNumber: Integer); virtual;
429		function IsVisible(Buffer: PChar): Boolean;
430	+	procedure RegisterIBLink(Sender: TIBControlLink);
431	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
432		procedure SaveOldBuffer(Buffer: PChar);
433		procedure SetBufferChunks(Value: Integer);
434		procedure SetDatabase(Value: TIBDatabase);
#	Line 302 | Line 442 | type
442		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
443		procedure SetUniDirectional(Value: Boolean);
444		procedure RefreshParams;
305	–	procedure SQLChanging(Sender: TObject); virtual;
445		function AdjustPosition(FCache: PChar; Offset: DWORD;
446		Origin: Integer): DWORD;
447		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
#	Line 321 | Line 460 | type
460		procedure DeactivateTransaction;
461		procedure CheckDatasetClosed;
462		procedure CheckDatasetOpen;
463	+	function CreateParser: TSelectSQLParser; virtual;
464	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
465		function GetActiveBuf: PChar;
466		procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
467		procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
#	Line 330 | Line 471 | type
471		procedure InternalRefreshRow; virtual;
472		procedure InternalSetParamsFromCursor; virtual;
473		procedure CheckNotUniDirectional;
474	+	procedure SQLChanging(Sender: TObject); virtual;
475	+	procedure SQLChanged(Sender: TObject); virtual;
476
477	<	(*    { IProviderSupport }
477	>	{ IProviderSupport }
478		procedure PSEndTransaction(Commit: Boolean); override;
479		function PSExecuteStatement(const ASQL: string; AParams: TParams;
480		ResultSet: Pointer = nil): Integer; override;
#	Line 344 | Line 487 | type
487		procedure PSStartTransaction; override;
488		procedure PSReset; override;
489		function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
490	<	*)
490	>
491		{ TDataSet support }
492		procedure InternalInsert; override;
493		procedure InitRecord(Buffer: PChar); override;
#	Line 353 | Line 496 | type
496		procedure ClearCalcFields(Buffer: PChar); override;
497		function AllocRecordBuffer: PChar; override;
498		procedure DoBeforeDelete; override;
499	+	procedure DoAfterDelete; override;
500		procedure DoBeforeEdit; override;
501	+	procedure DoAfterEdit; override;
502		procedure DoBeforeInsert; override;
503		procedure DoAfterInsert; override;
504	+	procedure DoBeforeClose; override;
505	+	procedure DoBeforeOpen; override;
506		procedure DoBeforePost; override;
507	+	procedure DoAfterPost; override;
508		procedure FreeRecordBuffer(var Buffer: PChar); override;
509		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
510		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
511		function GetCanModify: Boolean; override;
512		function GetDataSource: TDataSource; override;
513	+	function GetDBAliasName(FieldNo: integer): string;
514	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
515		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
516		function GetRecNo: Integer; override;
517		function GetRecord(Buffer: PChar; GetMode: TGetMode;
518		DoCheck: Boolean): TGetResult; override;
519		function GetRecordCount: Integer; override;
520		function GetRecordSize: Word; override;
521	+	procedure InternalAutoCommit;
522		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
523		procedure InternalCancel; override;
524		procedure InternalClose; override;
#	Line 385 | Line 536 | type
536		procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
537		procedure InternalSetToRecord(Buffer: PChar); override;
538		function IsCursorOpen: Boolean; override;
539	+	procedure Loaded; override;
540		procedure ReQuery;
541		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
542		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
543		procedure SetCachedUpdates(Value: Boolean);
544		procedure SetDataSource(Value: TDataSource);
545	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
546		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
547		procedure SetFieldData(Field : TField; Buffer : Pointer;
548		NativeFormat : Boolean); overload; override;
#	Line 397 | Line 550 | type
550
551		protected
552		{Likely to be made public by descendant classes}
553	<	property SQLParams: TIBXSQLDA read GetSQLParams;
554	<	property Params: TIBXSQLDA read GetSQLParams;
553	>	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
554	>	property SQLParams: ISQLParams read GetSQLParams;
555	>	property Params: ISQLParams read GetSQLParams;
556		property InternalPrepared: Boolean read FInternalPrepared;
557		property QDelete: TIBSQL read FQDelete;
558		property QInsert: TIBSQL read FQInsert;
559		property QRefresh: TIBSQL read FQRefresh;
560		property QSelect: TIBSQL read FQSelect;
561		property QModify: TIBSQL read FQModify;
562	<	property StatementType: TIBSQLTypes read GetStatementType;
563	<	property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
562	>	property StatementType: TIBSQLStatementTypes read GetStatementType;
563	>	property SelectStmtHandle: IStatement read GetSelectStmtIntf;
564
565		{Likely to be made published by descendant classes}
566		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
#	Line 420 | Line 574 | type
574		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
575		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
576		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
577	+	property Parser: TSelectSQLParser read GetParser;
578	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
579
580		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
581		write FBeforeDatabaseDisconnect;
#	Line 433 | Line 589 | type
589		write FAfterTransactionEnd;
590		property TransactionFree: TNotifyEvent read FTransactionFree
591		write FTransactionFree;
592	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
593
594		public
595		constructor Create(AOwner: TComponent); override;
#	Line 440 | Line 597 | type
597		procedure ApplyUpdates;
598		function CachedUpdateStatus: TCachedUpdateStatus;
599		procedure CancelUpdates;
600	+	function GetFieldPosition(AliasName: string): integer;
601		procedure FetchAll;
602		function LocateNext(const KeyFields: string; const KeyValues: Variant;
603		Options: TLocateOptions): Boolean;
604		procedure RecordModified(Value: Boolean);
605		procedure RevertRecord;
606		procedure Undelete;
607	+	procedure ResetParser; virtual;
608	+	function HasParser: boolean;
609
610		{ TDataSet support methods }
611		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
612		function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
613		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
614	+	function GetArray(Field: TIBArrayField): IArray;
615	+	procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
616		function GetCurrentRecord(Buffer: PChar): Boolean; override;
617		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
618		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
619		function GetFieldData(Field : TField; Buffer : Pointer;
620		NativeFormat : Boolean) : Boolean; overload; override;
621	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
622		function Locate(const KeyFields: string; const KeyValues: Variant;
623		Options: TLocateOptions): Boolean; override;
624		function Lookup(const KeyFields: string; const KeyValues: Variant;
625		const ResultFields: string): Variant; override;
626		function UpdateStatus: TUpdateStatus; override;
627		function IsSequenced: Boolean; override;
628	<	function ParamByName(ParamName: String): TIBXSQLVAR;
629	<	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
630	<	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
628	>	procedure Post; override;
629	>	function ParamByName(ParamName: String): ISQLParam;
630	>	property ArrayFieldCount: integer read FArrayFieldCount;
631		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
632		property UpdatesPending: Boolean read FUpdatesPending;
633		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
634		write SetUpdateRecordTypes;
635	+	property DataSetCloseAction: TDataSetCloseAction
636	+	read FDataSetCloseAction write FDataSetCloseAction;
637
638		published
639	+	property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
640	+	write FAllowAutoActivateTransaction;
641		property Database: TIBDatabase read GetDatabase write SetDatabase;
642		property Transaction: TIBTransaction read GetTransaction
643		write SetTransaction;
#	Line 507 | Line 674 | type
674		write FOnUpdateRecord;
675		end;
676
677	<	TIBDataSet = class(TIBCustomDataSet)
677	>	TIBParserDataSet = class(TIBCustomDataSet)
678	>	public
679	>	property Parser;
680	>	end;
681	>
682	>	TIBDataSet = class(TIBParserDataSet)
683		private
684		function GetPrepared: Boolean;
685
#	Line 532 | Line 704 | type
704		property QModify;
705		property StatementType;
706		property SelectStmtHandle;
707	+	property BaseSQLSelect;
708
709		published
710		{ TIBCustomDataSet }
711	+	property AutoCommit;
712		property BufferChunks;
713		property CachedUpdates;
714		property DeleteSQL;
#	Line 543 | Line 717 | type
717		property SelectSQL;
718		property ModifySQL;
719		property GeneratorField;
720	+	property GenerateParamNames;
721		property ParamCheck;
722		property UniDirectional;
723		property Filtered;
724	+	property DataSetCloseAction;
725
726		property BeforeDatabaseDisconnect;
727		property AfterDatabaseDisconnect;
#	Line 581 | Line 757 | type
757		property OnFilterRecord;
758		property OnNewRecord;
759		property OnPostError;
760	+	property OnValidatePost;
761		end;
762
763		{ TIBDSBlobStream }
764		TIBDSBlobStream = class(TStream)
765	+	private
766	+	FHasWritten: boolean;
767		protected
768		FField: TField;
769		FBlobStream: TIBBlobStream;
770	+	function  GetSize: Int64; override;
771		public
772		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
773		Mode: TBlobStreamMode);
774	+	destructor Destroy; override;
775		function Read(var Buffer; Count: Longint): Longint; override;
776		function Seek(Offset: Longint; Origin: Word): Longint; override;
777		procedure SetSize(NewSize: Longint); override;
778		function Write(const Buffer; Count: Longint): Longint; override;
779		end;
780
781	+	{Extended Field Def for character set info}
782	+
783	+	{ TIBFieldDef }
784	+
785	+	TIBFieldDef = class(TFieldDef)
786	+	private
787	+	FArrayBounds: TArrayBounds;
788	+	FArrayDimensions: integer;
789	+	FCharacterSetName: RawByteString;
790	+	FCharacterSetSize: integer;
791	+	FCodePage: TSystemCodePage;
792	+	FRelationName: string;
793	+	published
794	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
795	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
796	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
797	+	property RelationName: string read FRelationName write FRelationName;
798	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
799	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
800	+	end;
801	+
802		const
803		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
804		nil,                { ftUnknown }
#	Line 615 | Line 817 | DefaultFieldClasses: array[TFieldType] o
817		TVarBytesField,     { ftVarBytes }
818		TAutoIncField,      { ftAutoInc }
819		TBlobField,         { ftBlob }
820	<	TMemoField,         { ftMemo }
820	>	TIBMemoField,       { ftMemo }
821		TGraphicField,      { ftGraphic }
822		TBlobField,         { ftFmtMemo }
823		TBlobField,         { ftParadoxOle }
#	Line 623 | Line 825 | DefaultFieldClasses: array[TFieldType] o
825		TBlobField,         { ftTypedBinary }
826		nil,                { ftCursor }
827		TStringField,       { ftFixedChar }
828	<	TWideStringField,    { ftWideString }
828	>	nil,    { ftWideString }
829		TLargeIntField,     { ftLargeInt }
830		nil,          { ftADT }
831	<	nil,        { ftArray }
831	>	TIBArrayField,        { ftArray }
832		nil,    { ftReference }
833		nil,     { ftDataSet }
834		TBlobField,         { ftOraBlob }
#	Line 638 | Line 840 | DefaultFieldClasses: array[TFieldType] o
840		TDateTimeField,    {ftTimestamp}
841		TIBBCDField,       {ftFMTBcd}
842		nil,  {ftFixedWideChar}
843	<	TWideMemoField);   {ftWideMemo}
843	>	nil);   {ftWideMemo}
844		(*
845		TADTField,          { ftADT }
846		TArrayField,        { ftArray }
#	Line 655 | Line 857 | DefaultFieldClasses: array[TFieldType] o
857
858		implementation
859
860	<	uses IBIntf, Variants, FmtBCD;
860	>	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
861
862		const FILE_BEGIN = 0;
863		FILE_CURRENT = 1;
#	Line 679 | Line 881 | type
881		end;
882
883
884	<	{ TIBStringField}
884	>	{  Copied from LCLProc in order to avoid LCL dependency
885	>
886	>	Ensures the covenient look of multiline string
887	>	when displaying it in the single line
888	>	* Replaces CR and LF with spaces
889	>	* Removes duplicate spaces
890	>	}
891	>	function TextToSingleLine(const AText: string): string;
892	>	var
893	>	str: string;
894	>	i, wstart, wlen: Integer;
895	>	begin
896	>	str := Trim(AText);
897	>	wstart := 0;
898	>	wlen := 0;
899	>	i := 1;
900	>	while i < Length(str) - 1 do
901	>	begin
902	>	if (str[i] in [' ', #13, #10]) then
903	>	begin
904	>	if (wstart = 0) then
905	>	begin
906	>	wstart := i;
907	>	wlen := 1;
908	>	end else
909	>	Inc(wlen);
910	>	end else
911	>	begin
912	>	if wstart > 0 then
913	>	begin
914	>	str[wstart] := ' ';
915	>	Delete(str, wstart+1, wlen-1);
916	>	Dec(i, wlen-1);
917	>	wstart := 0;
918	>	end;
919	>	end;
920	>	Inc(i);
921	>	end;
922	>	Result := str;
923	>	end;
924	>
925	>	{ TIBArray }
926	>
927	>	procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
928	>	begin
929	>	case Reason of
930	>	arChanging:
931	>	if FRecNo <> FField.Dataset.RecNo then
932	>	IBError(ibxeNotCurrentArray,[nil]);
933	>
934	>	arChanged:
935	>	FField.DataChanged;
936	>	end;
937	>	end;
938	>
939	>	constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
940	>	begin
941	>	inherited Create;
942	>	FField := aField;
943	>	FArray := anArray;
944	>	FRecNo := FField.Dataset.RecNo;
945	>	FArray.AddEventHandler(EventHandler);
946	>	end;
947	>
948	>	destructor TIBArray.Destroy;
949	>	begin
950	>	FArray.RemoveEventHandler(EventHandler);
951	>	inherited Destroy;
952	>	end;
953	>
954	>	{ TIBArrayField }
955	>
956	>	function TIBArrayField.GetArrayIntf: IArray;
957	>	begin
958	>	Result := TIBCustomDataSet(DataSet).GetArray(self);
959	>	end;
960	>
961	>	function TIBArrayField.GetArrayID: TISC_QUAD;
962	>	begin
963	>	GetData(@Result);
964	>	end;
965	>
966	>	procedure TIBArrayField.SetArrayIntf(AValue: IArray);
967	>	begin
968	>	TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
969	>	DataChanged;
970	>	end;
971	>
972	>	class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
973	>	begin
974	>	//Ignore
975	>	end;
976	>
977	>	function TIBArrayField.GetAsString: string;
978	>	begin
979	>	Result := '(Array)';
980	>	end;
981	>
982	>	function TIBArrayField.GetDataSize: Integer;
983	>	begin
984	>	Result := sizeof(TISC_QUAD);
985	>	end;
986	>
987	>	procedure TIBArrayField.Bind(Binding: Boolean);
988	>	begin
989	>	inherited Bind(Binding);
990	>	if Binding then
991	>	begin
992	>	FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
993	>	Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
994	>	if FieldDef <> nil then
995	>	begin
996	>	FRelationName := TIBFieldDef(FieldDef).FRelationName;
997	>	FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
998	>	FArrayBounds :=  TIBFieldDef(FieldDef).ArrayBounds;
999	>	end;
1000	>	end;
1001	>	end;
1002	>
1003	>	constructor TIBArrayField.Create(AOwner: TComponent);
1004	>	begin
1005	>	inherited Create(AOwner);
1006	>	SetDataType(ftArray);
1007	>	end;
1008	>
1009	>	function TIBArrayField.CreateArray: IArray;
1010	>	begin
1011	>	with DataSet as TIBCustomDataSet do
1012	>	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1013	>	end;
1014	>
1015	>	{ TIBMemoField }
1016	>
1017	>	function TIBMemoField.GetTruncatedText: string;
1018	>	begin
1019	>	Result := GetAsString;
1020	>
1021	>	if Result <> '' then
1022	>	begin
1023	>	case CharacterSetSize of
1024	>	1:
1025	>	if DisplayWidth = 0 then
1026	>	Result := TextToSingleLine(Result)
1027	>	else
1028	>	if Length(Result) > DisplayWidth then {Show truncation with elipses}
1029	>	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
1030
1031	<	constructor TIBStringField.Create(AOwner: TComponent);
1031	>	{2: case 2 ignored. This should be handled by TIBWideMemo}
1032	>
1033	>	3, {Assume UNICODE_FSS is really UTF8}
1034	>	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1035	>	if DisplayWidth = 0 then
1036	>	Result := ValidUTF8String(TextToSingleLine(Result))
1037	>	else
1038	>	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1039	>	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1040	>	end;
1041	>	end
1042	>	end;
1043	>
1044	>	procedure TIBMemoField.Bind(Binding: Boolean);
1045	>	var IBFieldDef: TIBFieldDef;
1046	>	begin
1047	>	inherited Bind(Binding);
1048	>	if Binding and (FieldDef <> nil) then
1049	>	begin
1050	>	IBFieldDef := FieldDef as TIBFieldDef;
1051	>	CharacterSetSize := IBFieldDef.CharacterSetSize;
1052	>	CharacterSetName := IBFieldDef.CharacterSetName;
1053	>	CodePage := IBFieldDef.CodePage;
1054	>	end;
1055	>	end;
1056	>
1057	>	function TIBMemoField.GetAsString: string;
1058	>	var s: RawByteString;
1059	>	begin
1060	>	s := inherited GetAsString;
1061	>	SetCodePage(s,CodePage,false);
1062	>	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1063	>	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1064	>	Result := s;
1065	>	end;
1066	>
1067	>	function TIBMemoField.GetDefaultWidth: Longint;
1068	>	begin
1069	>	if DisplayTextAsClassName then
1070	>	Result := inherited
1071	>	else
1072	>	Result := 128;
1073	>	end;
1074	>
1075	>	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1076	>	begin
1077	>	if ADisplayText then
1078	>	begin
1079	>	if not DisplayTextAsClassName and (CharacterSetName <> '') then
1080	>	AText := GetTruncatedText
1081	>	else
1082	>	inherited GetText(AText, ADisplayText);
1083	>	end
1084	>	else
1085	>	AText := GetAsString;
1086	>	end;
1087	>
1088	>	procedure TIBMemoField.SetAsString(const AValue: string);
1089	>	var s: RawByteString;
1090	>	begin
1091	>	s := AValue;
1092	>	if StringCodePage(s) <> CodePage then
1093	>	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1094	>	inherited SetAsString(s);
1095	>	end;
1096	>
1097	>	constructor TIBMemoField.Create(AOwner: TComponent);
1098		begin
1099		inherited Create(AOwner);
1100	+	BlobType := ftMemo;
1101	+	FCodePage := CP_NONE;
1102	+	end;
1103	+
1104	+	{ TIBControlLink }
1105	+
1106	+	destructor TIBControlLink.Destroy;
1107	+	begin
1108	+	IBDataSet := nil;
1109	+	inherited Destroy;
1110	+	end;
1111	+
1112	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
1113	+	begin
1114	+
1115	+	end;
1116	+
1117	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
1118	+	begin
1119	+
1120	+	end;
1121	+
1122	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
1123	+	begin
1124	+	if FTIBDataSet = AValue then Exit;
1125	+	if IBDataSet <> nil then
1126	+	IBDataSet.UnRegisterIBLink(self);
1127	+	FTIBDataSet := AValue;
1128	+	if IBDataSet <> nil then
1129	+	IBDataSet.RegisterIBLink(self);
1130	+	end;
1131	+
1132	+
1133	+	{ TIBStringField}
1134	+
1135	+	procedure TIBStringField.Bind(Binding: Boolean);
1136	+	var IBFieldDef: TIBFieldDef;
1137	+	begin
1138	+	inherited Bind(Binding);
1139	+	if Binding and (FieldDef <> nil) then
1140	+	begin
1141	+	IBFieldDef := FieldDef as TIBFieldDef;
1142	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
1143	+	CharacterSetName := IBFieldDef.CharacterSetName;
1144	+	if AutoFieldSize then
1145	+	Size := IBFieldDef.Size;
1146	+	CodePage := IBFieldDef.CodePage;
1147	+	end;
1148	+	end;
1149	+
1150	+	function TIBStringField.GetDataSize: Integer;
1151	+	begin
1152	+	Result := Size * CharacterSetSize + 1;
1153	+	end;
1154	+
1155	+	constructor TIBStringField.Create(aOwner: TComponent);
1156	+	begin
1157	+	inherited Create(aOwner);
1158	+	FCharacterSetSize := 1;
1159	+	FCodePage := CP_NONE;
1160	+	FAutoFieldSize := true;
1161		end;
1162
1163		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 706 | Line 1180 | end;
1180		function TIBStringField.GetValue(var Value: string): Boolean;
1181		var
1182		Buffer: PChar;
1183	+	s: RawByteString;
1184		begin
1185		Buffer := nil;
1186	<	IBAlloc(Buffer, 0, Size + 1);
1186	>	IBAlloc(Buffer, 0, DataSize);
1187		try
1188		Result := GetData(Buffer);
1189		if Result then
1190		begin
1191	<	Value := string(Buffer);
1191	>	s := strpas(Buffer);
1192	>	SetCodePage(s,CodePage,false);
1193	>	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1194	>	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1195	>	Value := s;
1196	>	//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1197		if Transliterate and (Value <> '') then
1198		DataSet.Translate(PChar(Value), PChar(Value), False);
1199		end
#	Line 725 | Line 1205 | end;
1205		procedure TIBStringField.SetAsString(const Value: string);
1206		var
1207		Buffer: PChar;
1208	+	s: RawByteString;
1209		begin
1210		Buffer := nil;
1211		IBAlloc(Buffer, 0, Size + 1);
1212		try
1213	<	StrLCopy(Buffer, PChar(Value), Size);
1213	>	s := Value;
1214	>	if StringCodePage(s) <> CodePage then
1215	>	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1216	>	StrLCopy(Buffer, PChar(s), Size);
1217		if Transliterate then
1218		DataSet.Translate(Buffer, Buffer, True);
1219		SetData(Buffer);
#	Line 738 | Line 1222 | begin
1222		end;
1223		end;
1224
1225	+
1226		{ TIBBCDField }
1227
1228		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 831 | Line 1316 | end;
1316		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1317		begin
1318		inherited Create(AOwner);
834	–	FIBLoaded := False;
835	–	CheckIBLoaded;
836	–	FIBLoaded := True;
1319		FBase := TIBBase.Create(Self);
1320	+	FIBLinks := TList.Create;
1321		FCurrentRecord := -1;
1322		FDeletedRecords := 0;
1323		FUniDirectional := False;
1324		FBufferChunks := BufferCacheSize;
1325		FBlobStreamList := TList.Create;
1326	+	FArrayList := TList.Create;
1327		FGeneratorField := TIBGenerator.Create(self);
1328		FDataLink := TIBDataLink.Create(Self);
1329		FQDelete := TIBSQL.Create(Self);
#	Line 853 | Line 1337 | begin
1337		FQRefresh.GoToFirstRecordOnExecute := False;
1338		FQSelect := TIBSQL.Create(Self);
1339		FQSelect.OnSQLChanging := SQLChanging;
1340	+	FQSelect.OnSQLChanged := SQLChanged;
1341		FQSelect.GoToFirstRecordOnExecute := False;
1342		FQModify := TIBSQL.Create(Self);
1343		FQModify.OnSQLChanging := SQLChanging;
1344		FQModify.GoToFirstRecordOnExecute := False;
1345		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
1346		FParamCheck := True;
1347	+	FGenerateParamNames := False;
1348		FForcedRefresh := False;
1349	+	FAutoCommit:= acDisabled;
1350	+	FDataSetCloseAction := dcDiscardChanges;
1351		{Bookmark Size is Integer for IBX}
1352		BookmarkSize := SizeOf(Integer);
1353		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 873 | Line 1361 | begin
1361		else
1362		if AOwner is TIBTransaction then
1363		Transaction := TIBTransaction(AOwner);
1364	+	FBaseSQLSelect := TStringList.Create;
1365		end;
1366
1367		destructor TIBCustomDataSet.Destroy;
1368		begin
1369		if Active then Active := false;
1370	<	if FIBLoaded then
1371	<	begin
1372	<	if assigned(FGeneratorField) then FGeneratorField.Free;
1373	<	FDataLink.Free;
1374	<	FBase.Free;
1375	<	ClearBlobCache;
1376	<	FBlobStreamList.Free;
1377	<	FreeMem(FBufferCache);
1378	<	FBufferCache := nil;
1379	<	FreeMem(FOldBufferCache);
1380	<	FOldBufferCache := nil;
1381	<	FCacheSize := 0;
1382	<	FOldCacheSize := 0;
1383	<	FMappedFieldPosition := nil;
1384	<	end;
1370	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1371	>	FDataLink.Free;
1372	>	FBase.Free;
1373	>	ClearBlobCache;
1374	>	ClearIBLinks;
1375	>	FIBLinks.Free;
1376	>	FBlobStreamList.Free;
1377	>	FArrayList.Free;
1378	>	FreeMem(FBufferCache);
1379	>	FBufferCache := nil;
1380	>	FreeMem(FOldBufferCache);
1381	>	FOldBufferCache := nil;
1382	>	FCacheSize := 0;
1383	>	FOldCacheSize := 0;
1384	>	FMappedFieldPosition := nil;
1385	>	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1386	>	if assigned(FParser) then FParser.Free;
1387		inherited Destroy;
1388		end;
1389
#	Line 915 | Line 1406 | begin
1406		Inc(FCurrentRecord);
1407		if (FCurrentRecord = FRecordCount) then
1408		begin
1409	<	if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1409	>	if (not FQSelect.EOF) and FQSelect.Next  then
1410		begin
1411		FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1412		Inc(FRecordCount);
#	Line 934 | Line 1425 | end;
1425
1426		procedure TIBCustomDataSet.ApplyUpdates;
1427		var
937	–	{$IF FPC_FULLVERSION > 20602 }
1428		CurBookmark: TBookmark;
939	–	{$ELSE}
940	–	CurBookmark: string;
941	–	{$ENDIF}
1429		Buffer: PRecordData;
1430		CurUpdateTypes: TIBUpdateRecordTypes;
1431		UpdateAction: TIBUpdateAction;
#	Line 1136 | Line 1623 | begin
1623		end;
1624		end;
1625
1626	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1627	+	var i: integer;
1628	+	Prepared: boolean;
1629	+	begin
1630	+	Result := 0;
1631	+	Prepared := FInternalPrepared;
1632	+	if not Prepared then
1633	+	InternalPrepare;
1634	+	try
1635	+	for i := 0 to Length(FAliasNameList) - 1 do
1636	+	if FAliasNameList[i] = AliasName then
1637	+	begin
1638	+	Result := i + 1;
1639	+	Exit
1640	+	end;
1641	+	finally
1642	+	if not Prepared then
1643	+	InternalUnPrepare;
1644	+	end;
1645	+	end;
1646	+
1647		procedure TIBCustomDataSet.ActivateConnection;
1648		begin
1649		if not Assigned(Database) then
#	Line 1148 | Line 1656 | end;
1656		function TIBCustomDataSet.ActivateTransaction: Boolean;
1657		begin
1658		Result := False;
1659	<	if not Assigned(Transaction) then
1152	<	IBError(ibxeTransactionNotAssigned, [nil]);
1153	<	if not Transaction.Active then
1659	>	if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1660		begin
1661	<	Result := True;
1662	<	Transaction.StartTransaction;
1663	<	FDidActivate := True;
1661	>	if not Assigned(Transaction) then
1662	>	IBError(ibxeTransactionNotAssigned, [nil]);
1663	>	if not Transaction.Active then
1664	>	begin
1665	>	Result := True;
1666	>	Transaction.StartTransaction;
1667	>	FDidActivate := True;
1668	>	end;
1669		end;
1670		end;
1671
#	Line 1196 | Line 1707 | begin
1707		IBError(ibxeDatasetClosed, [nil]);
1708		end;
1709
1710	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1711	+	begin
1712	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1713	+	Result.OnSQLChanging := SQLChanging
1714	+	end;
1715	+
1716		procedure TIBCustomDataSet.CheckNotUniDirectional;
1717		begin
1718		if UniDirectional then
#	Line 1273 | Line 1790 | begin
1790		FBlobStreamList.Pack;
1791		end;
1792
1793	+	procedure TIBCustomDataSet.ClearArrayCache;
1794	+	var
1795	+	i: Integer;
1796	+	begin
1797	+	for i := 0 to FArrayList.Count - 1 do
1798	+	begin
1799	+	TIBArray(FArrayList[i]).Free;
1800	+	FArrayList[i] := nil;
1801	+	end;
1802	+	FArrayList.Pack;
1803	+	end;
1804	+
1805		procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1806		begin
1807		Move(Source^, Dest^, FRecordBufferSize);
#	Line 1282 | Line 1811 | procedure TIBCustomDataSet.DoBeforeDatab
1811		begin
1812		if Active then
1813		Active := False;
1814	<	FInternalPrepared := False;
1814	>	InternalUnPrepare;
1815		if Assigned(FBeforeDatabaseDisconnect) then
1816		FBeforeDatabaseDisconnect(Sender);
1817		end;
#	Line 1299 | Line 1828 | begin
1828		FDatabaseFree(Sender);
1829		end;
1830
1831	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1831	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1832	>	Action: TTransactionAction);
1833		begin
1834	<	if Active then
1835	<	Active := False;
1834	>	FCloseAction := Action;
1835	>	FInTransactionEnd := true;
1836	>	try
1837	>	if Active then
1838	>	Active := False;
1839	>	finally
1840	>	FInTransactionEnd := false;
1841	>	end;
1842		if FQSelect <> nil then
1843		FQSelect.FreeHandle;
1844		if FQDelete <> nil then
#	Line 1313 | Line 1849 | begin
1849		FQModify.FreeHandle;
1850		if FQRefresh <> nil then
1851		FQRefresh.FreeHandle;
1852	+	InternalUnPrepare;
1853		if Assigned(FBeforeTransactionEnd) then
1854		FBeforeTransactionEnd(Sender);
1855		end;
#	Line 1329 | Line 1866 | begin
1866		FTransactionFree(Sender);
1867		end;
1868
1869	+	procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1870	+	var i, j: Integer;
1871	+	FieldsLoaded: integer;
1872	+	p: PRecordData;
1873	+	colMetadata: IColumnMetaData;
1874	+	begin
1875	+	p := PRecordData(Buffer);
1876	+	{ Get record information }
1877	+	p^.rdBookmarkFlag := bfCurrent;
1878	+	p^.rdFieldCount := Qry.FieldCount;
1879	+	p^.rdRecordNumber := -1;
1880	+	p^.rdUpdateStatus := usUnmodified;
1881	+	p^.rdCachedUpdateStatus := cusUnmodified;
1882	+	p^.rdSavedOffset := $FFFFFFFF;
1883	+
1884	+	{ Load up the fields }
1885	+	FieldsLoaded := FQSelect.MetaData.Count;
1886	+	j := 1;
1887	+	for i := 0 to Qry.MetaData.Count - 1 do
1888	+	begin
1889	+	if (Qry = FQSelect) then
1890	+	j := i + 1
1891	+	else
1892	+	begin
1893	+	if FieldsLoaded = 0 then
1894	+	break;
1895	+	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1896	+	if j < 1 then
1897	+	continue
1898	+	else
1899	+	Dec(FieldsLoaded);
1900	+	end;
1901	+	if j > 0 then
1902	+	begin
1903	+	colMetadata := Qry.MetaData[i];
1904	+	with p^.rdFields[j], FFieldColumns^[j] do
1905	+	begin
1906	+	fdDataType := colMetadata.GetSQLType;
1907	+	if fdDataType = SQL_BLOB then
1908	+	fdDataScale := 0
1909	+	else
1910	+	fdDataScale := colMetadata.getScale;
1911	+	fdNullable := colMetadata.getIsNullable;
1912	+	fdIsNull := true;
1913	+	fdDataSize := colMetadata.GetSize;
1914	+	fdDataLength := 0;
1915	+	fdCodePage := CP_NONE;
1916	+
1917	+	case fdDataType of
1918	+	SQL_TIMESTAMP,
1919	+	SQL_TYPE_DATE,
1920	+	SQL_TYPE_TIME:
1921	+	fdDataSize := SizeOf(TDateTime);
1922	+	SQL_SHORT, SQL_LONG:
1923	+	begin
1924	+	if (fdDataScale = 0) then
1925	+	fdDataSize := SizeOf(Integer)
1926	+	else
1927	+	if (fdDataScale >= (-4)) then
1928	+	fdDataSize := SizeOf(Currency)
1929	+	else
1930	+	fdDataSize := SizeOf(Double);
1931	+	end;
1932	+	SQL_INT64:
1933	+	begin
1934	+	if (fdDataScale = 0) then
1935	+	fdDataSize := SizeOf(Int64)
1936	+	else
1937	+	if (fdDataScale >= (-4)) then
1938	+	fdDataSize := SizeOf(Currency)
1939	+	else
1940	+	fdDataSize := SizeOf(Double);
1941	+	end;
1942	+	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1943	+	fdDataSize := SizeOf(Double);
1944	+	SQL_BOOLEAN:
1945	+	fdDataSize := SizeOf(wordBool);
1946	+	SQL_VARYING,
1947	+	SQL_TEXT,
1948	+	SQL_BLOB:
1949	+	fdCodePage := Qry.Metadata[i].getCodePage;
1950	+	end;
1951	+	fdDataOfs := FRecordSize;
1952	+	Inc(FRecordSize, fdDataSize);
1953	+	end;
1954	+	end;
1955	+	end;
1956	+	end;
1957	+
1958		{ Read the record from FQSelect.Current into the record buffer
1959		Then write the buffer to in memory cache }
1960		procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1961		RecordNumber: Integer; Buffer: PChar);
1962		var
1337	–	p: PRecordData;
1963		pbd: PBlobDataArray;
1964	+	pda: PArrayDataArray;
1965		i, j: Integer;
1966	<	LocalData: Pointer;
1966	>	LocalData: PByte;
1967		LocalDate, LocalDouble: Double;
1968		LocalInt: Integer;
1969	+	LocalBool: wordBool;
1970		LocalInt64: Int64;
1971		LocalCurrency: Currency;
1972		FieldsLoaded: Integer;
1973	<	temp: TIBXSQLVAR;
1973	>	p: PRecordData;
1974		begin
1975	+	if RecordNumber = -1 then
1976	+	begin
1977	+	InitModelBuffer(Qry,Buffer);
1978	+	Exit;
1979	+	end;
1980		p := PRecordData(Buffer);
1981		{ Make sure blob cache is empty }
1982		pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1983	<	if RecordNumber > -1 then
1984	<	for i := 0 to BlobFieldCount - 1 do
1985	<	pbd^[i] := nil;
1983	>	pda := PArrayDataArray(Buffer + FArrayCacheOffset);
1984	>	for i := 0 to BlobFieldCount - 1 do
1985	>	pbd^[i] := nil;
1986	>	for i := 0 to ArrayFieldCount - 1 do
1987	>	pda^[i] := nil;
1988	>
1989		{ Get record information }
1990		p^.rdBookmarkFlag := bfCurrent;
1991	<	p^.rdFieldCount := Qry.Current.Count;
1991	>	p^.rdFieldCount := Qry.FieldCount;
1992		p^.rdRecordNumber := RecordNumber;
1993		p^.rdUpdateStatus := usUnmodified;
1994		p^.rdCachedUpdateStatus := cusUnmodified;
1995		p^.rdSavedOffset := $FFFFFFFF;
1996
1997		{ Load up the fields }
1998	<	FieldsLoaded := FQSelect.Current.Count;
1998	>	FieldsLoaded := FQSelect.MetaData.Count;
1999		j := 1;
2000	<	for i := 0 to Qry.Current.Count - 1 do
2000	>	for i := 0 to Qry.FieldCount - 1 do
2001		begin
2002		if (Qry = FQSelect) then
2003		j := i + 1
2004	<	else begin
2004	>	else
2005	>	begin
2006		if FieldsLoaded = 0 then
2007		break;
2008	<	j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
2008	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2009		if j < 1 then
2010		continue
2011		else
2012		Dec(FieldsLoaded);
2013		end;
2014	<	with FQSelect.Current[j - 1].Data^ do
2015	<	if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2014	>	with FQSelect.MetaData[j - 1] do
2015	>	if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2016		begin
2017	<	if sqllen <= 8 then
2018	<	p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
2017	>	if (GetSize <= 8) then
2018	>	p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2019		continue;
2020		end;
2021	<	if j > 0 then with p^ do
2021	>	if j > 0 then
2022		begin
2023	<	rdFields[j].fdDataType :=
2024	<	Qry.Current[i].Data^.sqltype and (not 1);
2025	<	rdFields[j].fdDataScale :=
2026	<	Qry.Current[i].Data^.sqlscale;
2027	<	rdFields[j].fdNullable :=
1392	<	(Qry.Current[i].Data^.sqltype and 1 = 1);
1393	<	rdFields[j].fdIsNull :=
1394	<	(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1395	<	LocalData := Qry.Current[i].Data^.sqldata;
1396	<	case rdFields[j].fdDataType of
1397	<	SQL_TIMESTAMP:
1398	<	begin
1399	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
1400	<	if RecordNumber >= 0 then
1401	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1402	<	LocalData := PChar(@LocalDate);
1403	<	end;
1404	<	SQL_TYPE_DATE:
1405	<	begin
1406	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
1407	<	if RecordNumber >= 0 then
1408	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1409	<	LocalData := PChar(@LocalInt);
1410	<	end;
1411	<	SQL_TYPE_TIME:
1412	<	begin
1413	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
1414	<	if RecordNumber >= 0 then
1415	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1416	<	LocalData := PChar(@LocalInt);
1417	<	end;
1418	<	SQL_SHORT, SQL_LONG:
2023	>	LocalData := nil;
2024	>	with p^.rdFields[j], FFieldColumns^[j] do
2025	>	begin
2026	>	Qry.Current.GetData(i,fdIsNull,fdDataLength,LocalData);
2027	>	if not fdIsNull then
2028		begin
2029	<	if (rdFields[j].fdDataScale = 0) then
2030	<	begin
2031	<	rdFields[j].fdDataSize := SizeOf(Integer);
2032	<	if RecordNumber >= 0 then
2033	<	LocalInt := Qry.Current[i].AsLong;
2034	<	LocalData := PChar(@LocalInt);
2035	<	end
2036	<	else if (rdFields[j].fdDataScale >= (-4)) then
2037	<	begin
2038	<	rdFields[j].fdDataSize := SizeOf(Currency);
2039	<	if RecordNumber >= 0 then
2040	<	LocalCurrency := Qry.Current[i].AsCurrency;
2041	<	LocalData := PChar(@LocalCurrency);
2042	<	end
2043	<	else begin
2044	<	rdFields[j].fdDataSize := SizeOf(Double);
2045	<	if RecordNumber >= 0 then
2046	<	LocalDouble := Qry.Current[i].AsDouble;
2047	<	LocalData := PChar(@LocalDouble);
2029	>	case fdDataType of  {Get Formatted data for column types that need formatting}
2030	>	SQL_TIMESTAMP:
2031	>	begin
2032	>	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry[i].AsDateTime));
2033	>	LocalData := PByte(@LocalDate);
2034	>	end;
2035	>	SQL_TYPE_DATE:
2036	>	begin
2037	>	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Date;
2038	>	LocalData := PByte(@LocalInt);
2039	>	end;
2040	>	SQL_TYPE_TIME:
2041	>	begin
2042	>	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Time;
2043	>	LocalData := PByte(@LocalInt);
2044	>	end;
2045	>	SQL_SHORT, SQL_LONG:
2046	>	begin
2047	>	if (fdDataScale = 0) then
2048	>	begin
2049	>	LocalInt := Qry[i].AsLong;
2050	>	LocalData := PByte(@LocalInt);
2051	>	end
2052	>	else
2053	>	if (fdDataScale >= (-4)) then
2054	>	begin
2055	>	LocalCurrency := Qry[i].AsCurrency;
2056	>	LocalData := PByte(@LocalCurrency);
2057	>	end
2058	>	else
2059	>	begin
2060	>	LocalDouble := Qry[i].AsDouble;
2061	>	LocalData := PByte(@LocalDouble);
2062		end;
2063	<	end;
2064	<	SQL_INT64:
2065	<	begin
2066	<	if (rdFields[j].fdDataScale = 0) then
2067	<	begin
2068	<	rdFields[j].fdDataSize := SizeOf(Int64);
2069	<	if RecordNumber >= 0 then
2070	<	LocalInt64 := Qry.Current[i].AsInt64;
2071	<	LocalData := PChar(@LocalInt64);
2072	<	end
2073	<	else if (rdFields[j].fdDataScale >= (-4)) then
2074	<	begin
2075	<	rdFields[j].fdDataSize := SizeOf(Currency);
2076	<	if RecordNumber >= 0 then
2077	<	LocalCurrency := Qry.Current[i].AsCurrency;
2078	<	LocalData := PChar(@LocalCurrency);
2079	<	end
2080	<	else begin
2081	<	rdFields[j].fdDataSize := SizeOf(Double);
2082	<	if RecordNumber >= 0 then
2083	<	LocalDouble := Qry.Current[i].AsDouble;
1461	<	LocalData := PChar(@LocalDouble);
1462	<	end
1463	<	end;
1464	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1465	<	begin
1466	<	rdFields[j].fdDataSize := SizeOf(Double);
1467	<	if RecordNumber >= 0 then
1468	<	LocalDouble := Qry.Current[i].AsDouble;
1469	<	LocalData := PChar(@LocalDouble);
1470	<	end;
1471	<	SQL_VARYING:
1472	<	begin
1473	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1474	<	rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1475	<	if RecordNumber >= 0 then
1476	<	begin
1477	<	if (rdFields[j].fdDataLength = 0) then
1478	<	LocalData := nil
1479	<	else
2063	>	end;
2064	>	SQL_INT64:
2065	>	begin
2066	>	if (fdDataScale = 0) then
2067	>	begin
2068	>	LocalInt64 := Qry[i].AsInt64;
2069	>	LocalData := PByte(@LocalInt64);
2070	>	end
2071	>	else
2072	>	if (fdDataScale >= (-4)) then
2073	>	begin
2074	>	LocalCurrency := Qry[i].AsCurrency;
2075	>	LocalData := PByte(@LocalCurrency);
2076	>	end
2077	>	else
2078	>	begin
2079	>	LocalDouble := Qry[i].AsDouble;
2080	>	LocalData := PByte(@LocalDouble);
2081	>	end
2082	>	end;
2083	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2084		begin
2085	<	temp :=  Qry.Current[i];
2086	<	LocalData := @temp.Data^.sqldata[2];
2087	<	(*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
2085	>	LocalDouble := Qry[i].AsDouble;
2086	>	LocalData := PByte(@LocalDouble);
2087	>	end;
2088	>	SQL_BOOLEAN:
2089	>	begin
2090	>	LocalBool := Qry[i].AsBoolean;
2091	>	LocalData := PByte(@LocalBool);
2092		end;
2093		end;
2094	<	end;
2095	<	else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2096	<	begin
2097	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2098	<	if (rdFields[j].fdDataType = SQL_TEXT) then
1491	<	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1492	<	end;
1493	<	end;
1494	<	if RecordNumber < 0 then
1495	<	begin
1496	<	rdFields[j].fdIsNull := True;
1497	<	rdFields[j].fdDataOfs := FRecordSize;
1498	<	Inc(FRecordSize, rdFields[j].fdDataSize);
1499	<	end
1500	<	else begin
1501	<	if rdFields[j].fdDataType = SQL_VARYING then
1502	<	begin
1503	<	if LocalData <> nil then
1504	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
2094	>
2095	>	if fdDataType = SQL_VARYING then
2096	>	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2097	>	else
2098	>	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2099		end
2100	+	else {Null column}
2101	+	if fdDataType = SQL_VARYING then
2102	+	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2103		else
2104	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2104	>	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2105		end;
2106		end;
2107		end;
2108	<	WriteRecordCache(RecordNumber, PChar(p));
2108	>	WriteRecordCache(RecordNumber, Buffer);
2109		end;
2110
2111		function TIBCustomDataSet.GetActiveBuf: PChar;
#	Line 1553 | Line 2150 | begin
2150		result := FBase.Database;
2151		end;
2152
1556	–	function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1557	–	begin
1558	–	result := FBase.DBHandle;
1559	–	end;
1560	–
2153		function TIBCustomDataSet.GetDeleteSQL: TStrings;
2154		begin
2155		result := FQDelete.SQL;
#	Line 1568 | Line 2160 | begin
2160		result := FQInsert.SQL;
2161		end;
2162
2163	<	function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2163	>	function TIBCustomDataSet.GetSQLParams: ISQLParams;
2164		begin
2165		if not FInternalPrepared then
2166		InternalPrepare;
#	Line 1585 | Line 2177 | begin
2177		result := FQSelect.SQL;
2178		end;
2179
2180	<	function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2180	>	function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2181		begin
2182	<	result := FQSelect.SQLType;
2182	>	result := FQSelect.SQLStatementType;
2183		end;
2184
2185		function TIBCustomDataSet.GetModifySQL: TStrings;
#	Line 1600 | Line 2192 | begin
2192		result := FBase.Transaction;
2193		end;
2194
1603	–	function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1604	–	begin
1605	–	result := FBase.TRHandle;
1606	–	end;
1607	–
2195		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2196		begin
2197		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
#	Line 1626 | Line 2213 | function TIBCustomDataSet.InternalLocate
2213		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2214		var
2215		keyFieldList: TList;
1629	–	{$IF FPC_FULLVERSION >  20602 }
2216		CurBookmark: TBookmark;
1631	–	{$ELSE}
1632	–	CurBookmark: string;
1633	–	{$ENDIF}
2217		fieldValue: Variant;
2218		lookupValues: array of variant;
2219		i, fieldCount: Integer;
#	Line 1712 | Line 2295 | end;
2295
2296		procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2297		var
2298	<	i, j, k: Integer;
2298	>	i, j, k, arr: Integer;
2299		pbd: PBlobDataArray;
2300	+	pda: PArrayDataArray;
2301		begin
2302		pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2303	<	j := 0;
2303	>	pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2304	>	j := 0; arr := 0;
2305		for i := 0 to FieldCount - 1 do
2306		if Fields[i].IsBlob then
2307		begin
#	Line 1725 | Line 2310 | begin
2310		begin
2311		pbd^[j].Finalize;
2312		PISC_QUAD(
2313	<	PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2313	>	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2314		pbd^[j].BlobID;
2315		PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2316	+	end
2317	+	else
2318	+	begin
2319	+	PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2320	+	with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2321	+	begin
2322	+	gds_quad_high := 0;
2323	+	gds_quad_low := 0;
2324	+	end;
2325		end;
2326		Inc(j);
2327	+	end
2328	+	else
2329	+	if Fields[i] is TIBArrayField then
2330	+	begin
2331	+	if pda^[arr] <> nil then
2332	+	begin
2333	+	k := FMappedFieldPosition[Fields[i].FieldNo -1];
2334	+	PISC_QUAD(
2335	+	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=  pda^[arr].ArrayIntf.GetArrayID;
2336	+	PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2337	+	end;
2338	+	Inc(arr);
2339		end;
2340		if Assigned(FUpdateObject) then
2341		begin
#	Line 1755 | Line 2361 | end;
2361		procedure TIBCustomDataSet.InternalRefreshRow;
2362		var
2363		Buff: PChar;
1758	–	SetCursor: Boolean;
2364		ofs: DWORD;
2365		Qry: TIBSQL;
2366		begin
2367	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1763	<	if SetCursor then
1764	<	Screen.Cursor := crHourGlass;
2367	>	FBase.SetCursor;
2368		try
2369		Buff := GetActiveBuf;
2370		if CanRefresh then
#	Line 1781 | Line 2384 | begin
2384		SetInternalSQLParams(Qry, Buff);
2385		Qry.ExecQuery;
2386		try
2387	<	if (Qry.SQLType = SQLExecProcedure) or
1785	<	(Qry.Next <> nil) then
2387	>	if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2388		begin
2389		ofs := PRecordData(Buff)^.rdSavedOffset;
2390		FetchCurrentRecordToBuffer(Qry,
#	Line 1805 | Line 2407 | begin
2407		else
2408		IBError(ibxeCannotRefresh, [nil]);
2409		finally
2410	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1809	<	Screen.Cursor := crDefault;
2410	>	FBase.RestoreCursor;
2411		end;
2412		end;
2413
#	Line 1876 | Line 2477 | begin
2477		end;
2478
2479		procedure TIBCustomDataSet.InternalPrepare;
1879	–	var
1880	–	SetCursor: Boolean;
1881	–	DidActivate: Boolean;
2480		begin
2481		if FInternalPrepared then
2482		Exit;
2483	<	DidActivate := False;
1886	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1887	<	if SetCursor then
1888	<	Screen.Cursor := crHourGlass;
2483	>	FBase.SetCursor;
2484		try
2485		ActivateConnection;
2486	<	DidActivate := ActivateTransaction;
2486	>	ActivateTransaction;
2487		FBase.CheckDatabase;
2488		FBase.CheckTransaction;
2489	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2490	+	begin
2491	+	FQSelect.OnSQLChanged := nil; {Do not react to change}
2492	+	try
2493	+	FQSelect.SQL.Text := FParser.SQLText;
2494	+	finally
2495	+	FQSelect.OnSQLChanged := SQLChanged;
2496	+	end;
2497	+	end;
2498	+	//   writeln( FQSelect.SQL.Text);
2499		if FQSelect.SQL.Text <> '' then
2500		begin
2501		if not FQSelect.Prepared then
2502		begin
2503	+	FQSelect.GenerateParamNames := FGenerateParamNames;
2504		FQSelect.ParamCheck := ParamCheck;
2505		FQSelect.Prepare;
2506		end;
2507	+	FQDelete.GenerateParamNames := FGenerateParamNames;
2508		if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
2509		FQDelete.Prepare;
2510	+	FQInsert.GenerateParamNames := FGenerateParamNames;
2511		if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
2512		FQInsert.Prepare;
2513	+	FQRefresh.GenerateParamNames := FGenerateParamNames;
2514		if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
2515		FQRefresh.Prepare;
2516	+	FQModify.GenerateParamNames := FGenerateParamNames;
2517		if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
2518		FQModify.Prepare;
2519		FInternalPrepared := True;
#	Line 1911 | Line 2521 | begin
2521		end else
2522		IBError(ibxeEmptyQuery, [nil]);
2523		finally
2524	<	if DidActivate then
1915	<	DeactivateTransaction;
1916	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1917	<	Screen.Cursor := crDefault;
2524	>	FBase.RestoreCursor;
2525		end;
2526		end;
2527
#	Line 1943 | Line 2550 | var
2550		begin
2551		CopyRecordBuffer(Buffer, OldBuffer);
2552		if BlobFieldCount > 0 then
2553	<	FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2553	>	FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2554	>	BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2555		0);
2556		end;
2557
#	Line 2016 | Line 2624 | procedure TIBCustomDataSet.SetInternalSQ
2624		var
2625		i, j: Integer;
2626		cr, data: PChar;
2627	<	fn, st: string;
2627	>	fn: string;
2628	>	st: RawByteString;
2629		OldBuffer: Pointer;
2630		ts: TTimeStamp;
2631	+	Param: ISQLParam;
2632		begin
2633		if (Buffer = nil) then
2634		IBError(ibxeBufferNotSet, [nil]);
#	Line 2026 | Line 2636 | begin
2636		InternalPrepare;
2637		OldBuffer := nil;
2638		try
2639	<	for i := 0 to Qry.Params.Count - 1 do
2639	>	for i := 0 to Qry.Params.GetCount - 1 do
2640		begin
2641	<	fn := Qry.Params[i].Name;
2641	>	Param := Qry.Params[i];
2642	>	fn := Param.Name;
2643		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2644		begin
2645		fn := Copy(fn, 5, Length(fn));
#	Line 2048 | Line 2659 | begin
2659		cr := Buffer;
2660		j := FQSelect.FieldIndex[fn] + 1;
2661		if (j > 0) then
2662	<	with PRecordData(cr)^ do
2662	>	with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2663		begin
2664	<	if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2664	>	if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2665		begin
2666	<	PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2666	>	PIBDBKey(Param.AsPointer)^ := rdDBKey;
2667		continue;
2668		end;
2669	<	if rdFields[j].fdIsNull then
2670	<	Qry.Params[i].IsNull := True
2669	>	if fdIsNull then
2670	>	Param.IsNull := True
2671		else begin
2672	<	Qry.Params[i].IsNull := False;
2673	<	data := cr + rdFields[j].fdDataOfs;
2674	<	case rdFields[j].fdDataType of
2672	>	Param.IsNull := False;
2673	>	data := cr + fdDataOfs;
2674	>	case fdDataType of
2675		SQL_TEXT, SQL_VARYING:
2676		begin
2677	<	SetString(st, data, rdFields[j].fdDataLength);
2678	<	Qry.Params[i].AsString := st;
2677	>	SetString(st, data, fdDataLength);
2678	>	SetCodePage(st,fdCodePage,false);
2679	>	Param.AsString := st;
2680		end;
2681		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2682	<	Qry.Params[i].AsDouble := PDouble(data)^;
2682	>	Param.AsDouble := PDouble(data)^;
2683		SQL_SHORT, SQL_LONG:
2684		begin
2685	<	if rdFields[j].fdDataScale = 0 then
2686	<	Qry.Params[i].AsLong := PLong(data)^
2075	<	else if rdFields[j].fdDataScale >= (-4) then
2076	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2685	>	if fdDataScale = 0 then
2686	>	Param.AsLong := PLong(data)^
2687		else
2688	<	Qry.Params[i].AsDouble := PDouble(data)^;
2688	>	if fdDataScale >= (-4) then
2689	>	Param.AsCurrency := PCurrency(data)^
2690	>	else
2691	>	Param.AsDouble := PDouble(data)^;
2692		end;
2693		SQL_INT64:
2694		begin
2695	<	if rdFields[j].fdDataScale = 0 then
2696	<	Qry.Params[i].AsInt64 := PInt64(data)^
2697	<	else if rdFields[j].fdDataScale >= (-4) then
2698	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2695	>	if fdDataScale = 0 then
2696	>	Param.AsInt64 := PInt64(data)^
2697	>	else
2698	>	if fdDataScale >= (-4) then
2699	>	Param.AsCurrency := PCurrency(data)^
2700		else
2701	<	Qry.Params[i].AsDouble := PDouble(data)^;
2701	>	Param.AsDouble := PDouble(data)^;
2702		end;
2703		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2704	<	Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2704	>	Param.AsQuad := PISC_QUAD(data)^;
2705		SQL_TYPE_DATE:
2706		begin
2707		ts.Date := PInt(data)^;
2708		ts.Time := 0;
2709	<	Qry.Params[i].AsDate :=
2096	<	TimeStampToDateTime(ts);
2709	>	Param.AsDate := TimeStampToDateTime(ts);
2710		end;
2711		SQL_TYPE_TIME:
2712		begin
2713		ts.Date := 0;
2714		ts.Time := PInt(data)^;
2715	<	Qry.Params[i].AsTime :=
2103	<	TimeStampToDateTime(ts);
2715	>	Param.AsTime := TimeStampToDateTime(ts);
2716		end;
2717		SQL_TIMESTAMP:
2718	<	Qry.Params[i].AsDateTime :=
2718	>	Param.AsDateTime :=
2719		TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2720	+	SQL_BOOLEAN:
2721	+	Param.AsBoolean := PWordBool(data)^;
2722		end;
2723		end;
2724		end;
#	Line 2190 | Line 2804 | begin
2804		end;
2805		end;
2806
2807	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2808	+	begin
2809	+	if FIBLinks.IndexOf(Sender) = -1 then
2810	+	FIBLinks.Add(Sender);
2811	+	end;
2812	+
2813
2814		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2815		begin
2816	<	if FOpen then
2817	<	InternalClose;
2816	>	Active := false;
2817	>	{  if FOpen then
2818	>	InternalClose;}
2819		if FInternalPrepared then
2820		InternalUnPrepare;
2821	+	FieldDefs.Clear;
2822	+	FieldDefs.Updated := false;
2823	+	end;
2824	+
2825	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2826	+	begin
2827	+	FBaseSQLSelect.assign(FQSelect.SQL);
2828		end;
2829
2830		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2225 | Line 2853 | begin
2853		end;
2854		end;
2855
2856	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2857	+	begin
2858	+	FIBLinks.Remove(Sender);
2859	+	end;
2860	+
2861		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2862		begin
2863		if Active then
#	Line 2241 | Line 2874 | begin
2874		Result := Assigned( FQSelect ) and FQSelect.EOF;
2875		end;
2876
2877	<	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2877	>	function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2878		begin
2879		ActivateConnection;
2880		ActivateTransaction;
#	Line 2378 | Line 3011 | var
3011		Buff: PChar;
3012		bTr, bDB: Boolean;
3013		begin
3014	+	if (Field = nil) or (Field.DataSet <> self) then
3015	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3016		Buff := GetActiveBuf;
3017		if Buff = nil then
3018		begin
3019		fs := TIBBlobStream.Create;
3020		fs.Mode := bmReadWrite;
3021	+	fs.Database := Database;
3022	+	fs.Transaction := Transaction;
3023	+	fs.SetField(Field);
3024		FBlobStreamList.Add(Pointer(fs));
3025		result := TIBDSBlobStream.Create(Field, fs, Mode);
3026		exit;
#	Line 2397 | Line 3035 | begin
3035		fs.Mode := bmReadWrite;
3036		fs.Database := Database;
3037		fs.Transaction := Transaction;
3038	+	fs.SetField(Field);
3039		fs.BlobID :=
3040	<	PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3040	>	PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3041		if (CachedUpdates) then
3042		begin
3043		bTr := not Transaction.InTransaction;
#	Line 2419 | Line 3058 | begin
3058		result := TIBDSBlobStream.Create(Field, fs, Mode);
3059		end;
3060
3061	+	function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3062	+	var Buff: PChar;
3063	+	pda: PArrayDataArray;
3064	+	bTr, bDB: Boolean;
3065	+	begin
3066	+	if (Field = nil) or (Field.DataSet <> self) then
3067	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3068	+	Buff := GetActiveBuf;
3069	+	if Buff = nil then
3070	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3071	+	Field.FRelationName,Field.FieldName)
3072	+	else
3073	+	begin
3074	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3075	+	if pda^[Field.FCacheOffset] = nil then
3076	+	begin
3077	+	AdjustRecordOnInsert(Buff);
3078	+	if Field.IsNull then
3079	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3080	+	Field.FRelationName,Field.FieldName)
3081	+	else
3082	+	Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3083	+	Field.FRelationName,Field.FieldName,Field.ArrayID);
3084	+	pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3085	+	FArrayList.Add(pda^[Field.FCacheOffset]);
3086	+	if (CachedUpdates) then
3087	+	begin
3088	+	bTr := not Transaction.InTransaction;
3089	+	bDB := not Database.Connected;
3090	+	if bDB then
3091	+	Database.Open;
3092	+	if bTr then
3093	+	Transaction.StartTransaction;
3094	+	pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3095	+	if bTr then
3096	+	Transaction.Commit;
3097	+	if bDB then
3098	+	Database.Close;
3099	+	end;
3100	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3101	+	end
3102	+	else
3103	+	Result := pda^[Field.FCacheOffset].ArrayIntf;
3104	+	end;
3105	+	end;
3106	+
3107	+	procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3108	+	var Buff: PChar;
3109	+	pda: PArrayDataArray;
3110	+	begin
3111	+	if (Field = nil) or (Field.DataSet <> self) then
3112	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3113	+	Buff := GetActiveBuf;
3114	+	if Buff <> nil then
3115	+	begin
3116	+	AdjustRecordOnInsert(Buff);
3117	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3118	+	pda^[Field.FCacheOffset].FArray := AnArray;
3119	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3120	+	end;
3121	+	end;
3122	+
3123		function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3124		const
3125		CMPLess = -1;
#	Line 2454 | Line 3155 | begin
3155		inherited DoBeforeDelete;
3156		end;
3157
3158	+	procedure TIBCustomDataSet.DoAfterDelete;
3159	+	begin
3160	+	inherited DoAfterDelete;
3161	+	FBase.DoAfterDelete(self);
3162	+	InternalAutoCommit;
3163	+	end;
3164	+
3165		procedure TIBCustomDataSet.DoBeforeEdit;
3166		var
3167		Buff: PRecordData;
#	Line 2468 | Line 3176 | begin
3176		inherited DoBeforeEdit;
3177		end;
3178
3179	+	procedure TIBCustomDataSet.DoAfterEdit;
3180	+	begin
3181	+	inherited DoAfterEdit;
3182	+	FBase.DoAfterEdit(self);
3183	+	end;
3184	+
3185		procedure TIBCustomDataSet.DoBeforeInsert;
3186		begin
3187		if not CanInsert then
#	Line 2480 | Line 3194 | begin
3194		if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
3195		GeneratorField.Apply;
3196		inherited DoAfterInsert;
3197	+	FBase.DoAfterInsert(self);
3198	+	end;
3199	+
3200	+	procedure TIBCustomDataSet.DoBeforeClose;
3201	+	begin
3202	+	inherited DoBeforeClose;
3203	+	if FInTransactionEnd and (FCloseAction = TARollback) then
3204	+	Exit;
3205	+	if State in [dsInsert,dsEdit] then
3206	+	begin
3207	+	if DataSetCloseAction = dcSaveChanges then
3208	+	Post;
3209	+	{Note this can fail with an exception e.g. due to
3210	+	database validation error. In which case the dataset remains open }
3211	+	end;
3212	+	if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3213	+	ApplyUpdates;
3214	+	end;
3215	+
3216	+	procedure TIBCustomDataSet.DoBeforeOpen;
3217	+	var i: integer;
3218	+	begin
3219	+	if assigned(FParser) then
3220	+	FParser.Reset;
3221	+	for i := 0 to FIBLinks.Count - 1 do
3222	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3223	+	inherited DoBeforeOpen;
3224	+	for i := 0 to FIBLinks.Count - 1 do
3225	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
3226		end;
3227
3228		procedure TIBCustomDataSet.DoBeforePost;
#	Line 2490 | Line 3233 | begin
3233		GeneratorField.Apply
3234		end;
3235
3236	+	procedure TIBCustomDataSet.DoAfterPost;
3237	+	begin
3238	+	inherited DoAfterPost;
3239	+	FBase.DoAfterPost(self);
3240	+	InternalAutoCommit;
3241	+	end;
3242	+
3243		procedure TIBCustomDataSet.FetchAll;
3244		var
2495	–	SetCursor: Boolean;
2496	–	{$IF FPC_FULLVERSION >  20602 }
3245		CurBookmark: TBookmark;
3246	<	{$ELSE}
3247	<	CurBookmark: string;
3248	<	{$ENDIF}
2501	<	begin
2502	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2503	<	if SetCursor then
2504	<	Screen.Cursor := crHourGlass;
2505	<	try
3246	>	begin
3247	>	FBase.SetCursor;
3248	>	try
3249		if FQSelect.EOF or not FQSelect.Open then
3250		exit;
3251		DisableControls;
#	Line 2514 | Line 3257 | begin
3257		EnableControls;
3258		end;
3259		finally
3260	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2518	<	Screen.Cursor := crDefault;
3260	>	FBase.RestoreCursor;
3261		end;
3262		end;
3263
#	Line 2563 | Line 3305 | begin
3305		result := FDataLink.DataSource;
3306		end;
3307
3308	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
3309	+	begin
3310	+	Result := FAliasNameMap[FieldNo-1]
3311	+	end;
3312	+
3313	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
3314	+	var
3315	+	i: integer;
3316	+	begin
3317	+	Result := nil;
3318	+	for i := 0 to Length(FAliasNameMap) - 1 do
3319	+	if FAliasNameMap[i] = aliasName then
3320	+	begin
3321	+	Result := FieldDefs[i];
3322	+	Exit
3323	+	end;
3324	+	end;
3325	+
3326		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
3327		begin
3328		Result := DefaultFieldClasses[FieldType];
#	Line 2593 | Line 3353 | begin
3353		if result and (Buffer <> nil) then
3354		Move(Buff[1], Buffer^, Field.DataSize);
3355		end
3356	<	else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3356	>	else
3357	>	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3358		(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3359	+	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3360	+	FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3361		begin
3362	<	result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3362	>	result := not fdIsNull;
3363		if result and (Buffer <> nil) then
2601	–	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3364		begin
3365	<	Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3365	>	Data := Buff + fdDataOfs;
3366		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3367		begin
3368	<	if fdDataLength <= Field.Size then
3368	>	if fdDataLength < Field.DataSize then
3369		begin
3370		Move(Data^, Buffer^, fdDataLength);
3371		PChar(Buffer)[fdDataLength] := #0;
#	Line 2652 | Line 3414 | begin
3414		if not Accept and (GetMode = gmCurrent) then
3415		GetMode := gmPrior;
3416		except
3417	<	//        Application.HandleException(Self);
3417	>	//        FBase.HandleException(Self);
3418		end;
3419		end;
3420		RestoreState(SaveState);
#	Line 2671 | Line 3433 | begin
3433		if FCurrentRecord < FRecordCount then
3434		ReadRecordCache(FCurrentRecord, Buffer, False)
3435		else begin
3436	<	while (not FQSelect.EOF) and
2675	<	(FQSelect.Next <> nil) and
3436	>	while (not FQSelect.EOF) and FQSelect.Next  and
3437		(FCurrentRecord >= FRecordCount) do begin
3438		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3439		Inc(FRecordCount);
#	Line 2746 | Line 3507 | begin
3507		result := FRecordBufferSize;
3508		end;
3509
3510	+	procedure TIBCustomDataSet.InternalAutoCommit;
3511	+	begin
3512	+	with Transaction do
3513	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3514	+	begin
3515	+	if CachedUpdates then ApplyUpdates;
3516	+	CommitRetaining;
3517	+	end;
3518	+	end;
3519	+
3520		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3521		begin
3522		CheckEditState;
#	Line 2773 | Line 3544 | procedure TIBCustomDataSet.InternalCance
3544		var
3545		Buff: PChar;
3546		CurRec: Integer;
3547	+	pda: PArrayDataArray;
3548	+	i: integer;
3549		begin
3550		inherited InternalCancel;
3551		Buff := GetActiveBuf;
3552	<	if Buff <> nil then begin
3552	>	if Buff <> nil then
3553	>	begin
3554	>	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3555	>	for i := 0 to ArrayFieldCount - 1 do
3556	>	pda^[i].ArrayIntf.CancelChanges;
3557		CurRec := FCurrentRecord;
3558		AdjustRecordOnInsert(Buff);
3559		if (State = dsEdit) then begin
#	Line 2799 | Line 3576 | begin
3576		DeactivateTransaction;
3577		FQSelect.Close;
3578		ClearBlobCache;
3579	+	ClearArrayCache;
3580		FreeRecordBuffer(FModelBuffer);
3581		FreeRecordBuffer(FOldBuffer);
3582		FCurrentRecord := -1;
#	Line 2814 | Line 3592 | begin
3592		FOBEnd := 0;
3593		FreeMem(FBufferCache);
3594		FBufferCache := nil;
3595	+	FreeMem(FFieldColumns);
3596	+	FFieldColumns := nil;
3597		FreeMem(FOldBufferCache);
3598		FOldBufferCache := nil;
3599		BindFields(False);
3600	+	ResetParser;
3601		if DefaultFields then DestroyFields;
3602		end;
3603
3604		procedure TIBCustomDataSet.InternalDelete;
3605		var
3606		Buff: PChar;
2826	–	SetCursor: Boolean;
3607		begin
3608	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2829	<	if SetCursor then
2830	<	Screen.Cursor := crHourGlass;
3608	>	FBase.SetCursor;
3609		try
3610		Buff := GetActiveBuf;
3611		if CanDelete then
#	Line 2852 | Line 3630 | begin
3630		end else
3631		IBError(ibxeCannotDelete, [nil]);
3632		finally
3633	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2856	<	Screen.Cursor := crDefault;
3633	>	FBase.RestoreCursor;
3634		end;
3635		end;
3636
#	Line 2869 | Line 3646 | end;
3646
3647		procedure TIBCustomDataSet.InternalHandleException;
3648		begin
3649	<	Application.HandleException(Self)
3649	>	FBase.HandleException(Self)
3650		end;
3651
3652		procedure TIBCustomDataSet.InternalInitFieldDefs;
3653	+	begin
3654	+	if not InternalPrepared then
3655	+	begin
3656	+	InternalPrepare;
3657	+	exit;
3658	+	end;
3659	+	FieldDefsFromQuery(FQSelect);
3660	+	end;
3661	+
3662	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3663		const
3664		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3665		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2884 | Line 3671 | const
3671		var
3672		FieldType: TFieldType;
3673		FieldSize: Word;
3674	+	charSetID: short;
3675	+	CharSetSize: integer;
3676	+	CharSetName: RawByteString;
3677	+	FieldCodePage: TSystemCodePage;
3678		FieldNullable : Boolean;
3679		i, FieldPosition, FieldPrecision: Integer;
3680	<	FieldAliasName: string;
3681	<	RelationName, FieldName: string;
3680	>	FieldAliasName, DBAliasName: string;
3681	>	aRelationName, FieldName: string;
3682		Query : TIBSQL;
3683		FieldIndex: Integer;
3684		FRelationNodes : TRelationNode;
3685	+	aArrayDimensions: integer;
3686	+	aArrayBounds: TArrayBounds;
3687	+	ArrayMetaData: IArrayMetaData;
3688
3689		function Add_Node(Relation, Field : String) : TRelationNode;
3690		var
#	Line 2986 | Line 3780 | var
3780		end;
3781
3782		begin
2989	–	if not InternalPrepared then
2990	–	begin
2991	–	InternalPrepare;
2992	–	exit;
2993	–	end;
3783		FRelationNodes := TRelationNode.Create;
3784		FNeedsRefresh := False;
3785	<	Database.InternalTransaction.StartTransaction;
3785	>	if not Database.InternalTransaction.InTransaction then
3786	>	Database.InternalTransaction.StartTransaction;
3787		Query := TIBSQL.Create(self);
3788		try
3789		Query.Database := DataBase;
#	Line 3001 | Line 3791 | begin
3791		FieldDefs.BeginUpdate;
3792		FieldDefs.Clear;
3793		FieldIndex := 0;
3794	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3795	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3794	>	if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3795	>	SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3796		Query.SQL.Text := DefaultSQL;
3797		Query.Prepare;
3798	<	for i := 0 to FQSelect.Current.Count - 1 do
3799	<	with FQSelect.Current[i].Data^ do
3798	>	SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3799	>	SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3800	>	for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3801	>	with SourceQuery.MetaData[i] do
3802		begin
3803		{ Get the field name }
3804	<	SetString(FieldAliasName, aliasname, aliasname_length);
3805	<	SetString(RelationName, relname, relname_length);
3806	<	SetString(FieldName, sqlname, sqlname_length);
3804	>	FieldAliasName := GetName;
3805	>	DBAliasName := GetAliasname;
3806	>	aRelationName := getRelationName;
3807	>	FieldName := getSQLName;
3808	>	FAliasNameList[i] := DBAliasName;
3809		FieldSize := 0;
3810		FieldPrecision := 0;
3811	<	FieldNullable := FQSelect.Current[i].IsNullable;
3812	<	case sqltype and not 1 of
3811	>	FieldNullable := IsNullable;
3812	>	CharSetSize := 0;
3813	>	CharSetName := '';
3814	>	FieldCodePage := CP_NONE;
3815	>	aArrayDimensions := 0;
3816	>	SetLength(aArrayBounds,0);
3817	>	case SQLType of
3818		{ All VARCHAR's must be converted to strings before recording
3819		their values }
3820		SQL_VARYING, SQL_TEXT:
3821		begin
3822	<	FieldSize := sqllen;
3822	>	FirebirdAPI.CharSetWidth(getCharSetID,CharSetSize);
3823	>	CharSetName := FirebirdAPI.GetCharsetName(getCharSetID);
3824	>	FirebirdAPI.CharSetID2CodePage(getCharSetID,FieldCodePage);
3825	>	FieldSize := GetSize div CharSetSize;
3826		FieldType := ftString;
3827		end;
3828		{ All Doubles/Floats should be cast to doubles }
#	Line 3028 | Line 3830 | begin
3830		FieldType := ftFloat;
3831		SQL_SHORT:
3832		begin
3833	<	if (sqlscale = 0) then
3833	>	if (getScale = 0) then
3834		FieldType := ftSmallInt
3835		else begin
3836		FieldType := ftBCD;
3837		FieldPrecision := 4;
3838	<	FieldSize := -sqlscale;
3838	>	FieldSize := -getScale;
3839		end;
3840		end;
3841		SQL_LONG:
3842		begin
3843	<	if (sqlscale = 0) then
3843	>	if (getScale = 0) then
3844		FieldType := ftInteger
3845	<	else if (sqlscale >= (-4)) then
3845	>	else if (getScale >= (-4)) then
3846		begin
3847		FieldType := ftBCD;
3848		FieldPrecision := 9;
3849	<	FieldSize := -sqlscale;
3849	>	FieldSize := -getScale;
3850		end
3851		else
3852		if Database.SQLDialect = 1 then
#	Line 3056 | Line 3858 | begin
3858		begin
3859		FieldType := ftFMTBCD;
3860		FieldPrecision := 9;
3861	<	FieldSize := -sqlscale;
3861	>	FieldSize := -getScale;
3862		end;
3863		end;
3864
3865		SQL_INT64:
3866		begin
3867	<	if (sqlscale = 0) then
3867	>	if (getScale = 0) then
3868		FieldType := ftLargeInt
3869	<	else if (sqlscale >= (-4)) then
3869	>	else if (getScale >= (-4)) then
3870		begin
3871		FieldType := ftBCD;
3872		FieldPrecision := 18;
3873	<	FieldSize := -sqlscale;
3873	>	FieldSize := -getScale;
3874		end
3875		else
3876		FieldType := ftFloat
#	Line 3079 | Line 3881 | begin
3881		SQL_BLOB:
3882		begin
3883		FieldSize := sizeof (TISC_QUAD);
3884	<	if (sqlsubtype = 1) then
3885	<	FieldType := ftmemo
3884	>	if (getSubtype = 1) then
3885	>	begin
3886	>	FirebirdAPI.CharSetWidth(getCharSetID,CharSetSize);
3887	>	CharSetName := FirebirdAPI.GetCharsetName(getCharSetID);
3888	>	FirebirdAPI.CharSetID2CodePage(getCharSetID,FieldCodePage);
3889	>	FieldType := ftMemo;
3890	>	end
3891		else
3892		FieldType := ftBlob;
3893		end;
3894		SQL_ARRAY:
3895		begin
3896		FieldSize := sizeof (TISC_QUAD);
3897	<	FieldType := ftUnknown;
3897	>	FieldType := ftArray;
3898	>	ArrayMetaData := GetArrayMetaData;
3899	>	if ArrayMetaData <> nil then
3900	>	begin
3901	>	aArrayDimensions := ArrayMetaData.GetDimensions;
3902	>	aArrayBounds := ArrayMetaData.GetBounds;
3903	>	end;
3904		end;
3905	+	SQL_BOOLEAN:
3906	+	FieldType:= ftBoolean;
3907		else
3908		FieldType := ftUnknown;
3909		end;
#	Line 3097 | Line 3912 | begin
3912		begin
3913		FMappedFieldPosition[FieldIndex] := FieldPosition;
3914		Inc(FieldIndex);
3915	<	with FieldDefs.AddFieldDef do
3915	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3916		begin
3917		Name := FieldAliasName;
3918	<	(*           FieldNo := FieldPosition;*)
3104	<	DataType := FieldType;
3918	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3919		Size := FieldSize;
3920		Precision := FieldPrecision;
3921		Required := not FieldNullable;
3922	+	RelationName := aRelationName;
3923		InternalCalcField := False;
3924	+	CharacterSetSize := CharSetSize;
3925	+	CharacterSetName := CharSetName;
3926	+	CodePage := FieldCodePage;
3927	+	ArrayDimensions := aArrayDimensions;
3928	+	ArrayBounds := aArrayBounds;
3929		if (FieldName <> '') and (RelationName <> '') then
3930		begin
3931		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3133 | Line 3953 | begin
3953		FreeNodes;
3954		Database.InternalTransaction.Commit;
3955		FieldDefs.EndUpdate;
3956	+	FieldDefs.Updated := true;
3957		end;
3958		end;
3959
#	Line 3150 | Line 3971 | begin
3971		else begin
3972		Buffer := AllocRecordBuffer;
3973		try
3974	<	while FQSelect.Next <> nil do
3974	>	while FQSelect.Next do
3975		begin
3976		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3977		Inc(FRecordCount);
#	Line 3165 | Line 3986 | end;
3986		procedure TIBCustomDataSet.InternalSetParamsFromCursor;
3987		var
3988		i: Integer;
3989	<	cur_param: TIBXSQLVAR;
3989	>	cur_param: ISQLParam;
3990		cur_field: TField;
3991		s: TStream;
3992		begin
#	Line 3173 | Line 3994 | begin
3994		IBError(ibxeEmptyQuery, [nil]);
3995		if not FInternalPrepared then
3996		InternalPrepare;
3997	<	if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
3997	>	if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
3998		begin
3999	<	for i := 0 to SQLParams.Count - 1 do
3999	>	for i := 0 to SQLParams.GetCount - 1 do
4000		begin
4001		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4002		cur_param := SQLParams[i];
#	Line 3185 | Line 4006 | begin
4006		else case cur_field.DataType of
4007		ftString:
4008		cur_param.AsString := cur_field.AsString;
4009	<	ftBoolean, ftSmallint, ftWord:
4009	>	ftBoolean:
4010	>	cur_param.AsBoolean := cur_field.AsBoolean;
4011	>	ftSmallint, ftWord:
4012		cur_param.AsShort := cur_field.AsInteger;
4013		ftInteger:
4014		cur_param.AsLong := cur_field.AsInteger;
#	Line 3207 | Line 4030 | begin
4030		try
4031		s := DataSource.DataSet.
4032		CreateBlobStream(cur_field, bmRead);
4033	<	cur_param.LoadFromStream(s);
4033	>	cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4034		finally
4035		s.free;
4036		end;
4037		end;
4038	+	ftArray:
4039	+	cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4040		else
4041		IBError(ibxeNotSupported, [nil]);
4042		end;
#	Line 3238 | Line 4063 | begin
4063		end;
4064
4065		procedure TIBCustomDataSet.InternalOpen;
3241	–	var
3242	–	SetCursor: Boolean;
4066
4067		function RecordDataLength(n: Integer): Long;
4068		begin
#	Line 3247 | Line 4070 | var
4070		end;
4071
4072		begin
4073	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3251	<	if SetCursor then
3252	<	Screen.Cursor := crHourGlass;
4073	>	FBase.SetCursor;
4074		try
4075		ActivateConnection;
4076		ActivateTransaction;
#	Line 3257 | Line 4078 | begin
4078		IBError(ibxeEmptyQuery, [nil]);
4079		if not FInternalPrepared then
4080		InternalPrepare;
4081	<	if FQSelect.SQLType = SQLSelect then
4081	>	if FQSelect.SQLStatementType = SQLSelect then
4082		begin
4083		if DefaultFields then
4084		CreateFields;
4085	+	FArrayFieldCount := 0;
4086		BindFields(True);
4087		FCurrentRecord := -1;
4088		FQSelect.ExecQuery;
#	Line 3272 | Line 4094 | begin
4094		3. After the dummy fetch, FRecordSize will be appropriately
4095		adjusted to reflect the additional "weight" of the field
4096		data.
4097	<	4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4097	>	4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4098		5. Now, with the BufferSize available, allocate memory for chunks of records
4099		6. Re-allocate the model buffer, accounting for the new
4100		FRecordBufferSize.
4101		7. Finally, calls to AllocRecordBuffer will work!.
4102		}
4103		{Step 1}
4104	<	FRecordSize := RecordDataLength(FQSelect.Current.Count);
4104	>	FRecordSize := RecordDataLength(FQSelect.FieldCount);
4105		{Step 2, 3}
4106	+	GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4107		IBAlloc(FModelBuffer, 0, FRecordSize);
4108	<	FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4108	>	InitModelBuffer(FQSelect, FModelBuffer);
4109		{Step 4}
4110		FCalcFieldsOffset := FRecordSize;
4111		FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4112	<	FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4112	>	FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4113	>	FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4114		{Step 5}
4115		if UniDirectional then
4116		FBufferChunkSize := FRecordBufferSize * UniCache
#	Line 3302 | Line 4126 | begin
4126		FCacheSize := FBufferChunkSize;
4127		FOldCacheSize := FBufferChunkSize;
4128		{Step 6}
4129	<	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4129	>	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4130		FRecordBufferSize);
4131		{Step 7}
4132		FOldBuffer := AllocRecordBuffer;
#	Line 3310 | Line 4134 | begin
4134		else
4135		FQSelect.ExecQuery;
4136		finally
4137	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3314	<	Screen.Cursor := crDefault;
4137	>	FBase.RestoreCursor;
4138		end;
4139		end;
4140
#	Line 3319 | Line 4142 | procedure TIBCustomDataSet.InternalPost;
4142		var
4143		Qry: TIBSQL;
4144		Buff: PChar;
3322	–	SetCursor: Boolean;
4145		bInserting: Boolean;
4146		begin
4147	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3326	<	if SetCursor then
3327	<	Screen.Cursor := crHourGlass;
4147	>	FBase.SetCursor;
4148		try
4149		Buff := GetActiveBuf;
4150		CheckEditState;
#	Line 3362 | Line 4182 | begin
4182		if bInserting then
4183		Inc(FRecordCount);
4184		finally
4185	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3366	<	Screen.Cursor := crDefault;
4185	>	FBase.RestoreCursor;
4186		end;
4187		end;
4188
#	Line 3383 | Line 4202 | begin
4202		result := FOpen;
4203		end;
4204
4205	+	procedure TIBCustomDataSet.Loaded;
4206	+	begin
4207	+	if assigned(FQSelect) then
4208	+	FBaseSQLSelect.assign(FQSelect.SQL);
4209	+	inherited Loaded;
4210	+	end;
4211	+
4212	+	procedure TIBCustomDataSet.Post;
4213	+	var CancelPost: boolean;
4214	+	begin
4215	+	CancelPost := false;
4216	+	if assigned(FOnValidatePost) then
4217	+	OnValidatePost(self,CancelPost);
4218	+	if CancelPost then
4219	+	Cancel
4220	+	else
4221	+	inherited Post;
4222	+	end;
4223	+
4224		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4225		Options: TLocateOptions): Boolean;
4226		var
3389	–	{$IF FPC_FULLVERSION >  20602 }
4227		CurBookmark: TBookmark;
3391	–	{$ELSE}
3392	–	CurBookmark: string;
3393	–	{$ENDIF}
4228		begin
4229		DisableControls;
4230		try
#	Line 3408 | Line 4242 | function TIBCustomDataSet.Lookup(const K
4242		const ResultFields: string): Variant;
4243		var
4244		fl: TList;
3411	–	{$IF FPC_FULLVERSION >  20602 }
4245		CurBookmark: TBookmark;
3413	–	{$ELSE}
3414	–	CurBookmark: string;
3415	–	{$ENDIF}
4246		begin
4247		DisableControls;
4248		fl := TList.Create;
#	Line 3465 | Line 4295 | end;
4295		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
4296		var
4297		Buff, TmpBuff: PChar;
4298	+	MappedFieldPos: integer;
4299		begin
4300		Buff := GetActiveBuf;
4301		if Field.FieldNo < 0 then
#	Line 3481 | Line 4312 | begin
4312		begin
4313		{ If inserting, Adjust record position }
4314		AdjustRecordOnInsert(Buff);
4315	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
4316	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
4315	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4316	>	if (MappedFieldPos > 0) and
4317	>	(MappedFieldPos <= rdFieldCount) then
4318	>	with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4319		begin
4320		Field.Validate(Buffer);
4321		if (Buffer = nil) or
4322		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4323	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
4324	<	else begin
4325	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
4326	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
4327	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
4328	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
4329	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3497	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
4323	>	fdIsNull := True
4324	>	else
4325	>	begin
4326	>	Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4327	>	if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4328	>	fdDataLength := StrLen(PChar(Buffer));
4329	>	fdIsNull := False;
4330		if rdUpdateStatus = usUnmodified then
4331		begin
4332		if CachedUpdates then
#	Line 3582 | Line 4414 | begin
4414		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
4415		end;
4416
4417	+	procedure TIBCustomDataSet.ClearIBLinks;
4418	+	var i: integer;
4419	+	begin
4420	+	for i := FIBLinks.Count - 1 downto 0 do
4421	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
4422	+	end;
4423	+
4424
4425		procedure TIBCustomDataSet.InternalUnPrepare;
4426		begin
4427		if FInternalPrepared then
4428		begin
4429		CheckDatasetClosed;
4430	+	if FDidActivate then
4431	+	DeactivateTransaction;
4432		FieldDefs.Clear;
4433	+	FieldDefs.Updated := false;
4434		FInternalPrepared := False;
4435	+	Setlength(FAliasNameList,0);
4436		end;
4437		end;
4438
4439		procedure TIBCustomDataSet.InternalExecQuery;
4440		var
4441		DidActivate: Boolean;
3599	–	SetCursor: Boolean;
4442		begin
4443		DidActivate := False;
4444	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3603	<	if SetCursor then
3604	<	Screen.Cursor := crHourGlass;
4444	>	FBase.SetCursor;
4445		try
4446		ActivateConnection;
4447		DidActivate := ActivateTransaction;
#	Line 3609 | Line 4449 | begin
4449		IBError(ibxeEmptyQuery, [nil]);
4450		if not FInternalPrepared then
4451		InternalPrepare;
4452	<	if FQSelect.SQLType = SQLSelect then
4452	>	if FQSelect.SQLStatementType = SQLSelect then
4453		begin
4454		IBError(ibxeIsASelectStatement, [nil]);
4455		end
#	Line 3618 | Line 4458 | begin
4458		finally
4459		if DidActivate then
4460		DeactivateTransaction;
4461	<	if SetCursor and (Screen.Cursor = crHourGlass) then
4462	<	Screen.Cursor := crDefault;
4461	>	FBase.RestoreCursor;
4462	>	end;
4463	>	end;
4464	>
4465	>	function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4466	>	begin
4467	>	Result := FQSelect.Statement;
4468	>	end;
4469	>
4470	>	function TIBCustomDataSet.GetParser: TSelectSQLParser;
4471	>	begin
4472	>	if not assigned(FParser) then
4473	>	FParser := CreateParser;
4474	>	Result := FParser
4475	>	end;
4476	>
4477	>	procedure TIBCustomDataSet.ResetParser;
4478	>	begin
4479	>	if assigned(FParser) then
4480	>	begin
4481	>	FParser.Free;
4482	>	FParser := nil;
4483	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
4484	>	try
4485	>	FQSelect.SQL.Assign(FBaseSQLSelect);
4486	>	finally
4487	>	FQSelect.OnSQLChanged := SQLChanged;
4488	>	end;
4489		end;
4490		end;
4491
4492	<	function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4492	>	function TIBCustomDataSet.HasParser: boolean;
4493	>	begin
4494	>	Result := not (csDesigning in ComponentState) and (FParser <> nil)
4495	>	end;
4496	>
4497	>	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
4498		begin
4499	<	Result := FQSelect.Handle;
4499	>	if FGenerateParamNames = AValue then Exit;
4500	>	FGenerateParamNames := AValue;
4501	>	Disconnect
4502		end;
4503
4504		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
#	Line 3646 | Line 4519 | end;
4519
4520		{ TIBDataSet IProviderSupport }
4521
4522	<	(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4522	>	procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4523		begin
4524		if Commit then
4525		Transaction.Commit else
#	Line 3809 | Line 4682 | begin
4682		if not FQSelect.Prepared then
4683		FQSelect.Prepare;
4684		Result := FQSelect.UniqueRelationName;
4685	<	end;*)
4685	>	end;
4686
4687		procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4688		begin
#	Line 3951 | Line 4824 | begin
4824		DataSet.SetInternalSQLParams(Query, buff);
4825		end;
4826
4827	+	function TIBDSBlobStream.GetSize: Int64;
4828	+	begin
4829	+	Result := FBlobStream.BlobSize;
4830	+	end;
4831	+
4832		{ TIBDSBlobStream }
4833		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4834		Mode: TBlobStreamMode);
#	Line 3959 | Line 4837 | begin
4837		FBlobStream := ABlobStream;
4838		FBlobStream.Seek(0, soFromBeginning);
4839		if (Mode = bmWrite) then
4840	+	begin
4841		FBlobStream.Truncate;
4842	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
4843	+	TBlobField(FField).Modified := true;
4844	+	FHasWritten := true;
4845	+	end;
4846	+	end;
4847	+
4848	+	destructor TIBDSBlobStream.Destroy;
4849	+	begin
4850	+	if FHasWritten then
4851	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4852	+	inherited Destroy;
4853		end;
4854
4855		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
#	Line 3984 | Line 4874 | begin
4874		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4875		TBlobField(FField).Modified := true;
4876		result := FBlobStream.Write(Buffer, Count);
4877	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4877	>	FHasWritten := true;
4878	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4879	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4880	>	the blob stream. Moved to the destructor i.e. called after blob written}
4881		end;
4882
4883		{ TIBGenerator }
#	Line 4031 | Line 4924 | end;
4924
4925		procedure TIBGenerator.Apply;
4926		begin
4927	<	if (FGeneratorName <> '') and (FFieldName <> '')  then
4927	>	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
4928		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4929		end;
4930
4931	+
4932		end.

Diff Legend

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