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 37 by tony, Mon Feb 15 14:44:25 2016 UTC vs.
Revision 106 by tony, Thu Jan 18 14:37:35 2018 UTC

#	Line 35 | Line 35 | 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 49 | Line 52 | uses
52		{$ELSE}
53		unix,
54		{$ENDIF}
55	<	SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
56	<	IBUtils, IBBlob, IBSQLParser;
55	>	SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
56	>	IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo;
57
58		const
59		BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
#	Line 71 | Line 74 | type
74		procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
75		procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
76		function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77	<	procedure InternalSetParams(Query: TIBSQL; buff: PChar);
77	>	procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78	>	procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79	>	procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
80		property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
81		public
82		constructor Create(AOwner: TComponent); override;
#	Line 82 | Line 87 | type
87
88		TBlobDataArray = array[0..0] of TIBBlobStream;
89		PBlobDataArray = ^TBlobDataArray;
90	+	TIBArrayField = class;
91
92	<	{ TIBCustomDataSet }
93	<	TFieldData = record
94	<	fdDataType: Short;
95	<	fdDataScale: Short;
96	<	fdNullable: Boolean;
97	<	fdIsNull: Boolean;
98	<	fdDataSize: Short;
99	<	fdDataLength: Short;
100	<	fdDataOfs: Integer;
92	>	{ TIBArray }
93	>
94	>	{Wrapper class to support array cache in TIBCustomDataset and event handling}
95	>
96	>	TIBArray = class
97	>	private
98	>	FArray: IArray;
99	>	FRecNo: integer;
100	>	FField: TIBArrayField;
101	>	procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
102	>	public
103	>	constructor Create(aField: TIBArrayField; anArray: IArray);
104	>	destructor Destroy; override;
105	>	property ArrayIntf: IArray read FArray;
106		end;
107	<	PFieldData = ^TFieldData;
107	>
108	>	TArrayDataArray = array [0..0] of TIBArray;
109	>	PArrayDataArray = ^TArrayDataArray;
110	>
111	>	{ TIBCustomDataSet }
112
113		TCachedUpdateStatus = (
114		cusUnmodified, cusModified, cusInserted,
#	Line 104 | Line 119 | type
119		end;
120		PIBDBKey = ^TIBDBKey;
121
122	+	PFieldData = ^TFieldData;
123	+	TFieldData = record
124	+	fdIsNull: Boolean;
125	+	fdDataLength: Short;
126	+	end;
127	+
128	+	PColumnData = ^TColumnData;
129	+	TColumnData = record
130	+	fdDataType: Short;
131	+	fdDataScale: Short;
132	+	fdNullable: Boolean;
133	+	fdDataSize: Short;
134	+	fdDataOfs: Integer;
135	+	fdCodePage: TSystemCodePage;
136	+	end;
137	+
138	+	PFieldColumns = ^TFieldColumns;
139	+	TFieldColumns =  array[1..1] of TColumnData;
140	+
141		TRecordData = record
142		rdBookmarkFlag: TBookmarkFlag;
143		rdFieldCount: Short;
#	Line 116 | Line 150 | type
150		end;
151		PRecordData = ^TRecordData;
152
153	+	{ TIBArrayField }
154	+
155	+	TIBArrayField = class(TField)
156	+	private
157	+	FArrayBounds: TArrayBounds;
158	+	FArrayDimensions: integer;
159	+	FRelationName: string;
160	+	FCacheOffset: word;
161	+	function GetArrayID: TISC_QUAD;
162	+	function GetArrayIntf: IArray;
163	+	procedure SetArrayIntf(AValue: IArray);
164	+	protected
165	+	class procedure CheckTypeSize(AValue: Longint); override;
166	+	function GetAsString: string; override;
167	+	function GetDataSize: Integer; override;
168	+	procedure Bind(Binding: Boolean); override;
169	+	public
170	+	constructor Create(AOwner: TComponent); override;
171	+	function CreateArray: IArray;
172	+	property ArrayID: TISC_QUAD read GetArrayID;
173	+	property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
174	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
175	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
176	+	end;
177	+
178		{ TIBStringField allows us to have strings longer than 8196 }
179
180		TIBStringField = class(TStringField)
181		private
182	<	FCharacterSetName: string;
182	>	FCharacterSetName: RawByteString;
183		FCharacterSetSize: integer;
184	+	FAutoFieldSize: boolean;
185	+	FCodePage: TSystemCodePage;
186	+	FDataSize: integer;
187		protected
188	<	function GetDefaultWidth: Longint; override;
188	>	procedure Bind(Binding: Boolean); override;
189	>	function GetDataSize: Integer; override;
190		public
191		constructor Create(aOwner: TComponent); override;
192		class procedure CheckTypeSize(Value: Integer); override;
#	Line 131 | Line 194 | type
194		function GetAsVariant: Variant; override;
195		function GetValue(var Value: string): Boolean;
196		procedure SetAsString(const Value: string); override;
197	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
135	<	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
136	<	end;
137	<
138	<	{ TIBWideStringField }
139	<
140	<	TIBWideStringField = class(TWideStringField)
141	<	private
142	<	FCharacterSetName: string;
143	<	FCharacterSetSize: integer;
144	<	public
145	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
197	>	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
198		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
199	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
200	+	published
201	+	property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
202		end;
203
204		{ TIBBCDField }
#	Line 154 | Line 209 | type
209		Note: y > 4 will default to Floats
210		}
211		TIBBCDField = class(TBCDField)
212	+	private
213	+	FIdentityColumn: boolean;
214		protected
215	+	procedure Bind(Binding: Boolean); override;
216		class procedure CheckTypeSize(Value: Integer); override;
217		function GetAsCurrency: Currency; override;
218		function GetAsString: string; override;
#	Line 162 | Line 220 | type
220		function GetDataSize: Integer; override;
221		public
222		constructor Create(AOwner: TComponent); override;
223	+	property IdentityColumn: boolean read FIdentityColumn;
224		published
225		property Size default 8;
226		end;
227
228	+	{The following integer field types extend the built in versions to enable IBX appplications
229	+	to check for an Identity column}
230	+
231	+	{ TIBSmallintField }
232	+
233	+	TIBSmallintField = class(TSmallintField)
234	+	private
235	+	FIdentityColumn: boolean;
236	+	protected
237	+	procedure Bind(Binding: Boolean); override;
238	+	public
239	+	property IdentityColumn: boolean read FIdentityColumn;
240	+	end;
241	+
242	+	{ TIBIntegerField }
243	+
244	+	TIBIntegerField = class(TIntegerField)
245	+	private
246	+	FIdentityColumn: boolean;
247	+	protected
248	+	procedure Bind(Binding: Boolean); override;
249	+	public
250	+	property IdentityColumn: boolean read FIdentityColumn;
251	+	end;
252	+
253	+	{ TIBLargeIntField }
254	+
255	+	TIBLargeIntField = class(TLargeIntField)
256	+	private
257	+	FIdentityColumn: boolean;
258	+	protected
259	+	procedure Bind(Binding: Boolean); override;
260	+	public
261	+	property IdentityColumn: boolean read FIdentityColumn;
262	+	end;
263	+
264		{TIBMemoField}
265		{Allows us to show truncated text in DBGrids and anything else that uses
266		DisplayText}
267
268		TIBMemoField = class(TMemoField)
269		private
270	<	FCharacterSetName: string;
270	>	FCharacterSetName: RawByteString;
271		FCharacterSetSize: integer;
272		FDisplayTextAsClassName: boolean;
273		function GetTruncatedText: string;
274		protected
275	+	procedure Bind(Binding: Boolean); override;
276	+	function GetAsString: string; override;
277		function GetDefaultWidth: Longint; override;
278		procedure GetText(var AText: string; ADisplayText: Boolean); override;
279	+	procedure SetAsString(const AValue: string); override;
280		public
281		constructor Create(AOwner: TComponent); override;
282	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
282	>	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
283		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
284	<	published
284	>	published
285		property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
286		write FDisplayTextAsClassName;
189	–	end;
190	–
191	–	{ TIBWideMemoField }
192	–
193	–	TIBWideMemoField = class(TWideMemoField)
287		private
288	<	FCharacterSetName: string;
289	<	FCharacterSetSize: integer;
197	<	FDisplayTextAsClassName: boolean;
198	<	function GetTruncatedText: string;
199	<	protected
200	<	function GetDefaultWidth: Longint; override;
201	<	procedure GetText(var AText: string; ADisplayText: Boolean); override;
288	>	FCodePage: TSystemCodePage;
289	>	FFCodePage: TSystemCodePage;
290		public
291	<	constructor Create(AOwner: TComponent); override;
204	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
205	<	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
206	<	published
207	<	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
208	<	write FDisplayTextAsClassName;
291	>	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
292		end;
293
294		TIBDataLink = class(TDetailDataLink)
#	Line 232 | Line 315 | type
315		FFieldName: string;
316		FGeneratorName: string;
317		FIncrement: integer;
318	+	FQuery: TIBSQL;
319	+	function GetDatabase: TIBDatabase;
320	+	function GetTransaction: TIBTransaction;
321	+	procedure SetDatabase(AValue: TIBDatabase);
322	+	procedure SetGeneratorName(AValue: string);
323		procedure SetIncrement(const AValue: integer);
324	+	procedure SetTransaction(AValue: TIBTransaction);
325	+	procedure SetQuerySQL;
326		protected
327	<	function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
327	>	function GetNextValue: integer;
328		public
329		constructor Create(Owner: TIBCustomDataSet);
330	+	destructor Destroy; override;
331		procedure Apply;
332		property Owner: TIBCustomDataSet read FOwner;
333	+	property Database: TIBDatabase read GetDatabase write SetDatabase;
334	+	property Transaction: TIBTransaction read GetTransaction write SetTransaction;
335		published
336	<	property Generator: string read FGeneratorName write FGeneratorName;
336	>	property Generator: string read FGeneratorName write SetGeneratorName;
337		property Field: string read FFieldName write FFieldName;
338		property Increment: integer read FIncrement write SetIncrement default 1;
339		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
#	Line 263 | Line 356 | type
356		TIBAutoCommit = (acDisabled, acCommitRetaining);
357
358		{ TIBCustomDataSet }
359	+
360		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
361
362		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
#	Line 279 | Line 373 | type
373
374		TIBCustomDataSet = class(TDataset)
375		private
376	+	FAllowAutoActivateTransaction: Boolean;
377	+	FArrayFieldCount: integer;
378	+	FArrayCacheOffset: integer;
379		FAutoCommit: TIBAutoCommit;
380		FGenerateParamNames: Boolean;
381		FGeneratorField: TIBGenerator;
382		FNeedsRefresh: Boolean;
383		FForcedRefresh: Boolean;
384		FDidActivate: Boolean;
288	–	FIBLoaded: Boolean;
385		FBase: TIBBase;
386		FBlobCacheOffset: Integer;
387		FBlobStreamList: TList;
388	+	FArrayList: TList;
389		FBufferChunks: Integer;
390		FBufferCache,
391		FOldBufferCache: PChar;
#	Line 314 | Line 411 | type
411		FQRefresh,
412		FQSelect,
413		FQModify: TIBSQL;
414	+	FDatabaseInfo: TIBDatabaseInfo;
415		FRecordBufferSize: Integer;
416		FRecordCount: Integer;
417		FRecordSize: Integer;
#	Line 342 | Line 440 | type
440		FCloseAction: TTransactionAction;
441		FInTransactionEnd: boolean;
442		FIBLinks: TList;
443	<	function GetSelectStmtHandle: TISC_STMT_HANDLE;
443	>	FFieldColumns: PFieldColumns;
444	>	procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
445	>	FieldIndex: integer; Buffer: PChar);
446	>	procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
447	>	function GetSelectStmtIntf: IStatement;
448		procedure SetUpdateMode(const Value: TUpdateMode);
449		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
450
#	Line 354 | Line 456 | type
456		function CanRefresh: Boolean;
457		procedure CheckEditState;
458		procedure ClearBlobCache;
459	+	procedure ClearArrayCache;
460		procedure ClearIBLinks;
461		procedure CopyRecordBuffer(Source, Dest: Pointer);
462		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
#	Line 365 | Line 468 | type
468		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
469		Buffer: PChar);
470		function GetDatabase: TIBDatabase;
368	–	function GetDBHandle: PISC_DB_HANDLE;
471		function GetDeleteSQL: TStrings;
472		function GetInsertSQL: TStrings;
473	<	function GetSQLParams: TIBXSQLDA;
473	>	function GetSQLParams: ISQLParams;
474		function GetRefreshSQL: TStrings;
475		function GetSelectSQL: TStrings;
476	<	function GetStatementType: TIBSQLTypes;
476	>	function GetStatementType: TIBSQLStatementTypes;
477		function GetModifySQL: TStrings;
478		function GetTransaction: TIBTransaction;
377	–	function GetTRHandle: PISC_TR_HANDLE;
479		function GetParser: TSelectSQLParser;
480		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
481		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
#	Line 389 | Line 490 | type
490		procedure SetDatabase(Value: TIBDatabase);
491		procedure SetDeleteSQL(Value: TStrings);
492		procedure SetInsertSQL(Value: TStrings);
493	<	procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
493	>	procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
494		procedure SetRefreshSQL(Value: TStrings);
495		procedure SetSelectSQL(Value: TStrings);
496		procedure SetModifySQL(Value: TStrings);
497		procedure SetTransaction(Value: TIBTransaction);
498		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
499		procedure SetUniDirectional(Value: Boolean);
500	+	procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
501		procedure RefreshParams;
502		function AdjustPosition(FCache: PChar; Offset: DWORD;
503		Origin: Integer): DWORD;
#	Line 429 | Line 531 | type
531		procedure SQLChanging(Sender: TObject); virtual;
532		procedure SQLChanged(Sender: TObject); virtual;
533
534	<	(*    { IProviderSupport }
534	>	{ IProviderSupport }
535		procedure PSEndTransaction(Commit: Boolean); override;
536		function PSExecuteStatement(const ASQL: string; AParams: TParams;
537		ResultSet: Pointer = nil): Integer; override;
#	Line 442 | Line 544 | type
544		procedure PSStartTransaction; override;
545		procedure PSReset; override;
546		function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
547	<	*)
547	>
548		{ TDataSet support }
549		procedure InternalInsert; override;
550		procedure InitRecord(Buffer: PChar); override;
#	Line 506 | Line 608 | type
608		protected
609		{Likely to be made public by descendant classes}
610		property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
611	<	property SQLParams: TIBXSQLDA read GetSQLParams;
612	<	property Params: TIBXSQLDA read GetSQLParams;
611	>	property SQLParams: ISQLParams read GetSQLParams;
612	>	property Params: ISQLParams read GetSQLParams;
613		property InternalPrepared: Boolean read FInternalPrepared;
614		property QDelete: TIBSQL read FQDelete;
615		property QInsert: TIBSQL read FQInsert;
616		property QRefresh: TIBSQL read FQRefresh;
617		property QSelect: TIBSQL read FQSelect;
618		property QModify: TIBSQL read FQModify;
619	<	property StatementType: TIBSQLTypes read GetStatementType;
620	<	property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
619	>	property StatementType: TIBSQLStatementTypes read GetStatementType;
620	>	property SelectStmtHandle: IStatement read GetSelectStmtIntf;
621
622		{Likely to be made published by descendant classes}
623		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
#	Line 566 | Line 668 | type
668		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
669		function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
670		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
671	+	function GetArray(Field: TIBArrayField): IArray;
672	+	procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
673		function GetCurrentRecord(Buffer: PChar): Boolean; override;
674		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
675		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
#	Line 579 | Line 683 | type
683		function UpdateStatus: TUpdateStatus; override;
684		function IsSequenced: Boolean; override;
685		procedure Post; override;
686	<	function ParamByName(ParamName: String): TIBXSQLVAR;
687	<	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
584	<	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
686	>	function ParamByName(ParamName: String): ISQLParam;
687	>	property ArrayFieldCount: integer read FArrayFieldCount;
688		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
689		property UpdatesPending: Boolean read FUpdatesPending;
690		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
#	Line 590 | Line 693 | type
693		read FDataSetCloseAction write FDataSetCloseAction;
694
695		published
696	+	property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
697	+	write FAllowAutoActivateTransaction;
698		property Database: TIBDatabase read GetDatabase write SetDatabase;
699		property Transaction: TIBTransaction read GetTransaction
700		write SetTransaction;
#	Line 719 | Line 824 | type
824		protected
825		FField: TField;
826		FBlobStream: TIBBlobStream;
827	+	function  GetSize: Int64; override;
828		public
829		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
830		Mode: TBlobStreamMode);
#	Line 729 | Line 835 | type
835		function Write(const Buffer; Count: Longint): Longint; override;
836		end;
837
838	+	{Extended Field Def for character set info}
839	+
840	+	{ TIBFieldDef }
841	+
842	+	TIBFieldDef = class(TFieldDef)
843	+	private
844	+	FArrayBounds: TArrayBounds;
845	+	FArrayDimensions: integer;
846	+	FCharacterSetName: RawByteString;
847	+	FCharacterSetSize: integer;
848	+	FCodePage: TSystemCodePage;
849	+	FIdentityColumn: boolean;
850	+	FRelationName: string;
851	+	FDataSize: integer;
852	+	published
853	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
854	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
855	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
856	+	property DataSize: integer read FDataSize write FDataSize;
857	+	property RelationName: string read FRelationName write FRelationName;
858	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
859	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
860	+	property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
861	+	end;
862	+
863		const
864		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
865		nil,                { ftUnknown }
866		TIBStringField,     { ftString }
867	<	TSmallintField,     { ftSmallint }
868	<	TIntegerField,      { ftInteger }
867	>	TIBSmallintField,   { ftSmallint }
868	>	TIBIntegerField,      { ftInteger }
869		TWordField,         { ftWord }
870		TBooleanField,      { ftBoolean }
871		TFloatField,        { ftFloat }
#	Line 755 | Line 886 | DefaultFieldClasses: array[TFieldType] o
886		TBlobField,         { ftTypedBinary }
887		nil,                { ftCursor }
888		TStringField,       { ftFixedChar }
889	<	TIBWideStringField,    { ftWideString }
890	<	TLargeIntField,     { ftLargeInt }
889	>	nil,    { ftWideString }
890	>	TIBLargeIntField,     { ftLargeInt }
891		nil,          { ftADT }
892	<	nil,        { ftArray }
892	>	TIBArrayField,        { ftArray }
893		nil,    { ftReference }
894		nil,     { ftDataSet }
895		TBlobField,         { ftOraBlob }
#	Line 770 | Line 901 | DefaultFieldClasses: array[TFieldType] o
901		TDateTimeField,    {ftTimestamp}
902		TIBBCDField,       {ftFMTBcd}
903		nil,  {ftFixedWideChar}
904	<	TIBWideMemoField);   {ftWideMemo}
904	>	nil);   {ftWideMemo}
905		(*
906		TADTField,          { ftADT }
907		TArrayField,        { ftArray }
#	Line 787 | Line 918 | DefaultFieldClasses: array[TFieldType] o
918
919		implementation
920
921	<	uses IBIntf, Variants, FmtBCD, LazUTF8;
921	>	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
922
923		const FILE_BEGIN = 0;
924		FILE_CURRENT = 1;
#	Line 800 | Line 931 | type
931		FieldName : String;
932		COMPUTED_BLR : Boolean;
933		DEFAULT_VALUE : boolean;
934	+	IDENTITY_COLUMN : boolean;
935		NextField : TFieldNode;
936		end;
937
#	Line 810 | Line 942 | type
942		NextRelation : TRelationNode;
943		end;
944
813	–	{Extended Field Def for character set info}
814	–
815	–	{ TIBFieldDef }
816	–
817	–	TIBFieldDef = class(TFieldDef)
818	–	private
819	–	FCharacterSetName: string;
820	–	FCharacterSetSize: integer;
821	–	published
822	–	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
823	–	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
824	–	end;
825	–
945
946		{  Copied from LCLProc in order to avoid LCL dependency
947
#	Line 865 | Line 984 | type
984		Result := str;
985		end;
986
987	<	{ TIBWideMemoField }
987	>	{ TIBLargeIntField }
988
989	<	function TIBWideMemoField.GetTruncatedText: string;
989	>	procedure TIBLargeIntField.Bind(Binding: Boolean);
990		begin
991	<	Result := GetAsString;
991	>	inherited Bind(Binding);
992	>	if Binding and (FieldDef <> nil) then
993	>	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
994	>	end;
995
996	<	if Result <> '' then
997	<	if DisplayWidth = 0 then
998	<	Result := TextToSingleLine(Result)
999	<	else
1000	<	if Length(Result) > DisplayWidth then {Show truncation with elipses}
1001	<	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
996	>	{ TIBIntegerField }
997	>
998	>	procedure TIBIntegerField.Bind(Binding: Boolean);
999	>	begin
1000	>	inherited Bind(Binding);
1001	>	if Binding and (FieldDef <> nil) then
1002	>	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1003		end;
1004
1005	<	function TIBWideMemoField.GetDefaultWidth: Longint;
1005	>	{ TIBSmallintField }
1006	>
1007	>	procedure TIBSmallintField.Bind(Binding: Boolean);
1008		begin
1009	<	Result := 128;
1009	>	inherited Bind(Binding);
1010	>	if Binding and (FieldDef <> nil) then
1011	>	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1012		end;
1013
1014	<	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
1014	>	{ TIBArray }
1015	>
1016	>	procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
1017		begin
1018	<	if ADisplayText then
1018	>	case Reason of
1019	>	arChanging:
1020	>	if FRecNo <> FField.Dataset.RecNo then
1021	>	IBError(ibxeNotCurrentArray,[nil]);
1022	>
1023	>	arChanged:
1024	>	FField.DataChanged;
1025	>	end;
1026	>	end;
1027	>
1028	>	constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
1029	>	begin
1030	>	inherited Create;
1031	>	FField := aField;
1032	>	FArray := anArray;
1033	>	FRecNo := FField.Dataset.RecNo;
1034	>	FArray.AddEventHandler(EventHandler);
1035	>	end;
1036	>
1037	>	destructor TIBArray.Destroy;
1038	>	begin
1039	>	FArray.RemoveEventHandler(EventHandler);
1040	>	inherited Destroy;
1041	>	end;
1042	>
1043	>	{ TIBArrayField }
1044	>
1045	>	function TIBArrayField.GetArrayIntf: IArray;
1046	>	begin
1047	>	Result := TIBCustomDataSet(DataSet).GetArray(self);
1048	>	end;
1049	>
1050	>	function TIBArrayField.GetArrayID: TISC_QUAD;
1051	>	begin
1052	>	GetData(@Result);
1053	>	end;
1054	>
1055	>	procedure TIBArrayField.SetArrayIntf(AValue: IArray);
1056	>	begin
1057	>	TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
1058	>	DataChanged;
1059	>	end;
1060	>
1061	>	class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
1062	>	begin
1063	>	//Ignore
1064	>	end;
1065	>
1066	>	function TIBArrayField.GetAsString: string;
1067	>	begin
1068	>	Result := '(Array)';
1069	>	end;
1070	>
1071	>	function TIBArrayField.GetDataSize: Integer;
1072	>	begin
1073	>	Result := sizeof(TISC_QUAD);
1074	>	end;
1075	>
1076	>	procedure TIBArrayField.Bind(Binding: Boolean);
1077	>	begin
1078	>	inherited Bind(Binding);
1079	>	if Binding then
1080		begin
1081	<	if not DisplayTextAsClassName then
1082	<	AText := GetTruncatedText
1083	<	else
1084	<	inherited GetText(AText, ADisplayText);
1085	<	end
1086	<	else
1087	<	AText := GetAsString;
1081	>	FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
1082	>	Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
1083	>	if FieldDef <> nil then
1084	>	begin
1085	>	FRelationName := TIBFieldDef(FieldDef).FRelationName;
1086	>	FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1087	>	FArrayBounds :=  TIBFieldDef(FieldDef).ArrayBounds;
1088	>	end;
1089	>	end;
1090		end;
1091
1092	<	constructor TIBWideMemoField.Create(AOwner: TComponent);
1092	>	constructor TIBArrayField.Create(AOwner: TComponent);
1093		begin
1094		inherited Create(AOwner);
1095	<	BlobType := ftWideMemo;
1095	>	SetDataType(ftArray);
1096	>	end;
1097	>
1098	>	function TIBArrayField.CreateArray: IArray;
1099	>	begin
1100	>	with DataSet as TIBCustomDataSet do
1101	>	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1102		end;
1103
1104		{ TIBMemoField }
#	Line 922 | Line 1120 | begin
1120		{2: case 2 ignored. This should be handled by TIBWideMemo}
1121
1122		3, {Assume UNICODE_FSS is really UTF8}
1123	<	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1123	>	4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1124		if DisplayWidth = 0 then
1125		Result := ValidUTF8String(TextToSingleLine(Result))
1126		else
#	Line 932 | Line 1130 | begin
1130		end
1131		end;
1132
1133	+	procedure TIBMemoField.Bind(Binding: Boolean);
1134	+	var IBFieldDef: TIBFieldDef;
1135	+	begin
1136	+	inherited Bind(Binding);
1137	+	if Binding and (FieldDef <> nil) then
1138	+	begin
1139	+	IBFieldDef := FieldDef as TIBFieldDef;
1140	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
1141	+	CharacterSetName := IBFieldDef.CharacterSetName;
1142	+	CodePage := IBFieldDef.CodePage;
1143	+	end;
1144	+	end;
1145	+
1146	+	function TIBMemoField.GetAsString: string;
1147	+	var s: RawByteString;
1148	+	begin
1149	+	s := inherited GetAsString;
1150	+	SetCodePage(s,CodePage,false);
1151	+	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1152	+	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1153	+	Result := s;
1154	+	end;
1155	+
1156		function TIBMemoField.GetDefaultWidth: Longint;
1157		begin
1158		if DisplayTextAsClassName then
#	Line 944 | Line 1165 | procedure TIBMemoField.GetText(var AText
1165		begin
1166		if ADisplayText then
1167		begin
1168	<	if not DisplayTextAsClassName then
1168	>	if not DisplayTextAsClassName and (CharacterSetName <> '') then
1169		AText := GetTruncatedText
1170		else
1171		inherited GetText(AText, ADisplayText);
#	Line 953 | Line 1174 | begin
1174		AText := GetAsString;
1175		end;
1176
1177	+	procedure TIBMemoField.SetAsString(const AValue: string);
1178	+	var s: RawByteString;
1179	+	begin
1180	+	s := AValue;
1181	+	if StringCodePage(s) <> CodePage then
1182	+	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1183	+	inherited SetAsString(s);
1184	+	end;
1185	+
1186		constructor TIBMemoField.Create(AOwner: TComponent);
1187		begin
1188		inherited Create(AOwner);
1189		BlobType := ftMemo;
1190	+	FCodePage := CP_NONE;
1191		end;
1192
1193		{ TIBControlLink }
#	Line 990 | Line 1221 | end;
1221
1222		{ TIBStringField}
1223
1224	<	function TIBStringField.GetDefaultWidth: Longint;
1224	>	procedure TIBStringField.Bind(Binding: Boolean);
1225	>	var IBFieldDef: TIBFieldDef;
1226	>	begin
1227	>	inherited Bind(Binding);
1228	>	if Binding and (FieldDef <> nil) then
1229	>	begin
1230	>	IBFieldDef := FieldDef as TIBFieldDef;
1231	>	CharacterSetSize := IBFieldDef.CharacterSetSize;
1232	>	CharacterSetName := IBFieldDef.CharacterSetName;
1233	>	FDataSize := IBFieldDef.DataSize + 1;
1234	>	if AutoFieldSize then
1235	>	Size := IBFieldDef.Size;
1236	>	CodePage := IBFieldDef.CodePage;
1237	>	end;
1238	>	end;
1239	>
1240	>	function TIBStringField.GetDataSize: Integer;
1241		begin
1242	<	Result := Size div CharacterSetSize;
1242	>	Result := FDataSize;
1243		end;
1244
1245		constructor TIBStringField.Create(aOwner: TComponent);
1246		begin
1247		inherited Create(aOwner);
1248		FCharacterSetSize := 1;
1249	+	FCodePage := CP_NONE;
1250	+	FAutoFieldSize := true;
1251		end;
1252
1253		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 1021 | Line 1270 | end;
1270		function TIBStringField.GetValue(var Value: string): Boolean;
1271		var
1272		Buffer: PChar;
1273	+	s: RawByteString;
1274		begin
1275		Buffer := nil;
1276	<	IBAlloc(Buffer, 0, Size + 1);
1276	>	IBAlloc(Buffer, 0, DataSize);
1277		try
1278		Result := GetData(Buffer);
1279		if Result then
1280		begin
1281	<	Value := string(Buffer);
1281	>	s := strpas(Buffer);
1282	>	SetCodePage(s,CodePage,false);
1283	>	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1284	>	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1285	>	Value := s;
1286	>	//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1287		if Transliterate and (Value <> '') then
1288		DataSet.Translate(PChar(Value), PChar(Value), False);
1289		end
#	Line 1040 | Line 1295 | end;
1295		procedure TIBStringField.SetAsString(const Value: string);
1296		var
1297		Buffer: PChar;
1298	+	s: RawByteString;
1299		begin
1300		Buffer := nil;
1301	<	IBAlloc(Buffer, 0, Size + 1);
1301	>	IBAlloc(Buffer, 0, DataSize);
1302		try
1303	<	StrLCopy(Buffer, PChar(Value), Size);
1303	>	s := Value;
1304	>	if StringCodePage(s) <> CodePage then
1305	>	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1306	>	StrLCopy(Buffer, PChar(s), DataSize-1);
1307		if Transliterate then
1308		DataSet.Translate(Buffer, Buffer, True);
1309		SetData(Buffer);
#	Line 1063 | Line 1322 | begin
1322		Size := 8;
1323		end;
1324
1325	+	procedure TIBBCDField.Bind(Binding: Boolean);
1326	+	begin
1327	+	inherited Bind(Binding);
1328	+	if Binding and (FieldDef <> nil) then
1329	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1330	+	end;
1331	+
1332		class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1333		begin
1334		{ No need to check as the base type is currency, not BCD }
#	Line 1147 | Line 1413 | end;
1413		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1414		begin
1415		inherited Create(AOwner);
1150	–	FIBLoaded := False;
1151	–	CheckIBLoaded;
1152	–	FIBLoaded := True;
1416		FBase := TIBBase.Create(Self);
1417	+	FDatabaseInfo := TIBDatabaseInfo.Create(self);
1418		FIBLinks := TList.Create;
1419		FCurrentRecord := -1;
1420		FDeletedRecords := 0;
1421		FUniDirectional := False;
1422		FBufferChunks := BufferCacheSize;
1423		FBlobStreamList := TList.Create;
1424	+	FArrayList := TList.Create;
1425		FGeneratorField := TIBGenerator.Create(self);
1426		FDataLink := TIBDataLink.Create(Self);
1427		FQDelete := TIBSQL.Create(Self);
#	Line 1200 | Line 1465 | end;
1465		destructor TIBCustomDataSet.Destroy;
1466		begin
1467		if Active then Active := false;
1468	<	if FIBLoaded then
1469	<	begin
1470	<	if assigned(FGeneratorField) then FGeneratorField.Free;
1471	<	FDataLink.Free;
1472	<	FBase.Free;
1473	<	ClearBlobCache;
1474	<	ClearIBLinks;
1475	<	FIBLinks.Free;
1476	<	FBlobStreamList.Free;
1477	<	FreeMem(FBufferCache);
1478	<	FBufferCache := nil;
1479	<	FreeMem(FOldBufferCache);
1480	<	FOldBufferCache := nil;
1481	<	FCacheSize := 0;
1482	<	FOldCacheSize := 0;
1218	<	FMappedFieldPosition := nil;
1219	<	end;
1468	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1469	>	FDataLink.Free;
1470	>	FBase.Free;
1471	>	ClearBlobCache;
1472	>	ClearIBLinks;
1473	>	FIBLinks.Free;
1474	>	FBlobStreamList.Free;
1475	>	FArrayList.Free;
1476	>	FreeMem(FBufferCache);
1477	>	FBufferCache := nil;
1478	>	FreeMem(FOldBufferCache);
1479	>	FOldBufferCache := nil;
1480	>	FCacheSize := 0;
1481	>	FOldCacheSize := 0;
1482	>	FMappedFieldPosition := nil;
1483		if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1484		if assigned(FParser) then FParser.Free;
1485		inherited Destroy;
#	Line 1241 | Line 1504 | begin
1504		Inc(FCurrentRecord);
1505		if (FCurrentRecord = FRecordCount) then
1506		begin
1507	<	if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1507	>	if (not FQSelect.EOF) and FQSelect.Next  then
1508		begin
1509		FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1510		Inc(FRecordCount);
#	Line 1260 | Line 1523 | end;
1523
1524		procedure TIBCustomDataSet.ApplyUpdates;
1525		var
1263	–	{$IF FPC_FULLVERSION >= 20700 }
1526		CurBookmark: TBookmark;
1265	–	{$ELSE}
1266	–	CurBookmark: string;
1267	–	{$ENDIF}
1527		Buffer: PRecordData;
1528		CurUpdateTypes: TIBUpdateRecordTypes;
1529		UpdateAction: TIBUpdateAction;
#	Line 1495 | Line 1754 | end;
1754		function TIBCustomDataSet.ActivateTransaction: Boolean;
1755		begin
1756		Result := False;
1757	<	if not Assigned(Transaction) then
1499	<	IBError(ibxeTransactionNotAssigned, [nil]);
1500	<	if not Transaction.Active then
1757	>	if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1758		begin
1759	<	Result := True;
1760	<	Transaction.StartTransaction;
1761	<	FDidActivate := True;
1759	>	if not Assigned(Transaction) then
1760	>	IBError(ibxeTransactionNotAssigned, [nil]);
1761	>	if not Transaction.Active then
1762	>	begin
1763	>	Result := True;
1764	>	Transaction.StartTransaction;
1765	>	FDidActivate := True;
1766	>	end;
1767		end;
1768		end;
1769
#	Line 1626 | Line 1888 | begin
1888		FBlobStreamList.Pack;
1889		end;
1890
1891	+	procedure TIBCustomDataSet.ClearArrayCache;
1892	+	var
1893	+	i: Integer;
1894	+	begin
1895	+	for i := 0 to FArrayList.Count - 1 do
1896	+	begin
1897	+	TIBArray(FArrayList[i]).Free;
1898	+	FArrayList[i] := nil;
1899	+	end;
1900	+	FArrayList.Pack;
1901	+	end;
1902	+
1903		procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1904		begin
1905		Move(Source^, Dest^, FRecordBufferSize);
#	Line 1635 | Line 1909 | procedure TIBCustomDataSet.DoBeforeDatab
1909		begin
1910		if Active then
1911		Active := False;
1912	<	FInternalPrepared := False;
1912	>	InternalUnPrepare;
1913		if Assigned(FBeforeDatabaseDisconnect) then
1914		FBeforeDatabaseDisconnect(Sender);
1915		end;
#	Line 1673 | Line 1947 | begin
1947		FQModify.FreeHandle;
1948		if FQRefresh <> nil then
1949		FQRefresh.FreeHandle;
1950	+	InternalUnPrepare;
1951		if Assigned(FBeforeTransactionEnd) then
1952		FBeforeTransactionEnd(Sender);
1953		end;
#	Line 1689 | Line 1964 | begin
1964		FTransactionFree(Sender);
1965		end;
1966
1967	<	{ Read the record from FQSelect.Current into the record buffer
1968	<	Then write the buffer to in memory cache }
1969	<	procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1970	<	RecordNumber: Integer; Buffer: PChar);
1971	<	var
1697	<	p: PRecordData;
1698	<	pbd: PBlobDataArray;
1699	<	i, j: Integer;
1700	<	LocalData: Pointer;
1701	<	LocalDate, LocalDouble: Double;
1702	<	LocalInt: Integer;
1703	<	LocalBool: wordBool;
1704	<	LocalInt64: Int64;
1705	<	LocalCurrency: Currency;
1706	<	FieldsLoaded: Integer;
1707	<	temp: TIBXSQLVAR;
1967	>	procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1968	>	var i, j: Integer;
1969	>	FieldsLoaded: integer;
1970	>	p: PRecordData;
1971	>	colMetadata: IColumnMetaData;
1972		begin
1973		p := PRecordData(Buffer);
1710	–	{ Make sure blob cache is empty }
1711	–	pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1712	–	if RecordNumber > -1 then
1713	–	for i := 0 to BlobFieldCount - 1 do
1714	–	pbd^[i] := nil;
1974		{ Get record information }
1975		p^.rdBookmarkFlag := bfCurrent;
1976	<	p^.rdFieldCount := Qry.Current.Count;
1977	<	p^.rdRecordNumber := RecordNumber;
1976	>	p^.rdFieldCount := Qry.FieldCount;
1977	>	p^.rdRecordNumber := -1;
1978		p^.rdUpdateStatus := usUnmodified;
1979		p^.rdCachedUpdateStatus := cusUnmodified;
1980		p^.rdSavedOffset := $FFFFFFFF;
1981
1982		{ Load up the fields }
1983	<	FieldsLoaded := FQSelect.Current.Count;
1983	>	FieldsLoaded := FQSelect.MetaData.Count;
1984		j := 1;
1985	<	for i := 0 to Qry.Current.Count - 1 do
1985	>	for i := 0 to Qry.MetaData.Count - 1 do
1986		begin
1987		if (Qry = FQSelect) then
1988		j := i + 1
1989	<	else begin
1989	>	else
1990	>	begin
1991		if FieldsLoaded = 0 then
1992		break;
1993	<	j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
1993	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1994		if j < 1 then
1995		continue
1996		else
1997		Dec(FieldsLoaded);
1998		end;
1999	<	with FQSelect.Current[j - 1].Data^ do
1740	<	if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
1741	<	begin
1742	<	if sqllen <= 8 then
1743	<	p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
1744	<	continue;
1745	<	end;
1746	<	if j > 0 then with p^ do
1999	>	if j > 0 then
2000		begin
2001	<	rdFields[j].fdDataType :=
2002	<	Qry.Current[i].Data^.sqltype and (not 1);
2003	<	rdFields[j].fdDataScale :=
2004	<	Qry.Current[i].Data^.sqlscale;
2005	<	rdFields[j].fdNullable :=
2006	<	(Qry.Current[i].Data^.sqltype and 1 = 1);
2007	<	rdFields[j].fdIsNull :=
2008	<	(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
2009	<	LocalData := Qry.Current[i].Data^.sqldata;
2010	<	case rdFields[j].fdDataType of
2011	<	SQL_TIMESTAMP:
2001	>	colMetadata := Qry.MetaData[i];
2002	>	with p^.rdFields[j], FFieldColumns^[j] do
2003	>	begin
2004	>	fdDataType := colMetadata.GetSQLType;
2005	>	if fdDataType = SQL_BLOB then
2006	>	fdDataScale := 0
2007	>	else
2008	>	fdDataScale := colMetadata.getScale;
2009	>	fdNullable := colMetadata.getIsNullable;
2010	>	fdIsNull := true;
2011	>	fdDataSize := colMetadata.GetSize;
2012	>	fdDataLength := 0;
2013	>	fdCodePage := CP_NONE;
2014	>
2015	>	case fdDataType of
2016	>	SQL_TIMESTAMP,
2017	>	SQL_TYPE_DATE,
2018	>	SQL_TYPE_TIME:
2019	>	fdDataSize := SizeOf(TDateTime);
2020	>	SQL_SHORT, SQL_LONG:
2021		begin
2022	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2023	<	if RecordNumber >= 0 then
2024	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
2025	<	LocalData := PChar(@LocalDate);
2022	>	if (fdDataScale = 0) then
2023	>	fdDataSize := SizeOf(Integer)
2024	>	else
2025	>	if (fdDataScale >= (-4)) then
2026	>	fdDataSize := SizeOf(Currency)
2027	>	else
2028	>	fdDataSize := SizeOf(Double);
2029		end;
2030	<	SQL_TYPE_DATE:
2030	>	SQL_INT64:
2031		begin
2032	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2033	<	if RecordNumber >= 0 then
2034	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
2035	<	LocalData := PChar(@LocalInt);
2032	>	if (fdDataScale = 0) then
2033	>	fdDataSize := SizeOf(Int64)
2034	>	else
2035	>	if (fdDataScale >= (-4)) then
2036	>	fdDataSize := SizeOf(Currency)
2037	>	else
2038	>	fdDataSize := SizeOf(Double);
2039		end;
2040	<	SQL_TYPE_TIME:
2040	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2041	>	fdDataSize := SizeOf(Double);
2042	>	SQL_BOOLEAN:
2043	>	fdDataSize := SizeOf(wordBool);
2044	>	SQL_VARYING,
2045	>	SQL_TEXT,
2046	>	SQL_BLOB:
2047	>	fdCodePage := Qry.Metadata[i].getCodePage;
2048	>	end;
2049	>	fdDataOfs := FRecordSize;
2050	>	Inc(FRecordSize, fdDataSize);
2051	>	end;
2052	>	end;
2053	>	end;
2054	>	end;
2055	>
2056	>	{Update Buffer Fields from Query Results}
2057	>
2058	>	procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2059	>	Buffer: PChar);
2060	>	var i, j: integer;
2061	>	begin
2062	>	for i := 0 to QryResults.Count - 1 do
2063	>	begin
2064	>	j := GetFieldPosition(QryResults[i].GetAliasName);
2065	>	if j > 0 then
2066	>	ColumnDataToBuffer(QryResults,i,j,Buffer);
2067	>	end;
2068	>	end;
2069	>
2070	>
2071	>	{Move column data returned from query to row buffer}
2072	>
2073	>	procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2074	>	ColumnIndex, FieldIndex: integer; Buffer: PChar);
2075	>	var
2076	>	LocalData: PByte;
2077	>	LocalDate: TDateTime;
2078	>	LocalDouble: Double;
2079	>	LocalInt: Integer;
2080	>	LocalBool: wordBool;
2081	>	LocalInt64: Int64;
2082	>	LocalCurrency: Currency;
2083	>	ColData: ISQLData;
2084	>	begin
2085	>	LocalData := nil;
2086	>	with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2087	>	begin
2088	>	QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2089	>	if not fdIsNull then
2090	>	begin
2091	>	ColData := QryResults[ColumnIndex];
2092	>	case fdDataType of  {Get Formatted data for column types that need formatting}
2093	>	SQL_TYPE_DATE,
2094	>	SQL_TYPE_TIME,
2095	>	SQL_TIMESTAMP:
2096		begin
2097	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2098	<	if RecordNumber >= 0 then
2099	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1777	<	LocalData := PChar(@LocalInt);
2097	>	{This is an IBX native format and not the TDataset approach. See also GetFieldData}
2098	>	LocalDate := ColData.AsDateTime;
2099	>	LocalData := PByte(@LocalDate);
2100		end;
2101		SQL_SHORT, SQL_LONG:
2102		begin
2103	<	if (rdFields[j].fdDataScale = 0) then
2103	>	if (fdDataScale = 0) then
2104		begin
2105	<	rdFields[j].fdDataSize := SizeOf(Integer);
2106	<	if RecordNumber >= 0 then
1785	<	LocalInt := Qry.Current[i].AsLong;
1786	<	LocalData := PChar(@LocalInt);
2105	>	LocalInt := ColData.AsLong;
2106	>	LocalData := PByte(@LocalInt);
2107		end
2108	<	else if (rdFields[j].fdDataScale >= (-4)) then
2109	<	begin
2110	<	rdFields[j].fdDataSize := SizeOf(Currency);
2111	<	if RecordNumber >= 0 then
2112	<	LocalCurrency := Qry.Current[i].AsCurrency;
2113	<	LocalData := PChar(@LocalCurrency);
2114	<	end
2115	<	else begin
2116	<	rdFields[j].fdDataSize := SizeOf(Double);
2117	<	if RecordNumber >= 0 then
2118	<	LocalDouble := Qry.Current[i].AsDouble;
1799	<	LocalData := PChar(@LocalDouble);
1800	<	end;
2108	>	else
2109	>	if (fdDataScale >= (-4)) then
2110	>	begin
2111	>	LocalCurrency := ColData.AsCurrency;
2112	>	LocalData := PByte(@LocalCurrency);
2113	>	end
2114	>	else
2115	>	begin
2116	>	LocalDouble := ColData.AsDouble;
2117	>	LocalData := PByte(@LocalDouble);
2118	>	end;
2119		end;
2120		SQL_INT64:
2121		begin
2122	<	if (rdFields[j].fdDataScale = 0) then
2122	>	if (fdDataScale = 0) then
2123		begin
2124	<	rdFields[j].fdDataSize := SizeOf(Int64);
2125	<	if RecordNumber >= 0 then
1808	<	LocalInt64 := Qry.Current[i].AsInt64;
1809	<	LocalData := PChar(@LocalInt64);
2124	>	LocalInt64 := ColData.AsInt64;
2125	>	LocalData := PByte(@LocalInt64);
2126		end
2127	<	else if (rdFields[j].fdDataScale >= (-4)) then
2128	<	begin
1813	<	rdFields[j].fdDataSize := SizeOf(Currency);
1814	<	if RecordNumber >= 0 then
1815	<	LocalCurrency := Qry.Current[i].AsCurrency;
1816	<	LocalData := PChar(@LocalCurrency);
1817	<	end
1818	<	else begin
1819	<	rdFields[j].fdDataSize := SizeOf(Double);
1820	<	if RecordNumber >= 0 then
1821	<	LocalDouble := Qry.Current[i].AsDouble;
1822	<	LocalData := PChar(@LocalDouble);
1823	<	end
1824	<	end;
1825	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1826	<	begin
1827	<	rdFields[j].fdDataSize := SizeOf(Double);
1828	<	if RecordNumber >= 0 then
1829	<	LocalDouble := Qry.Current[i].AsDouble;
1830	<	LocalData := PChar(@LocalDouble);
1831	<	end;
1832	<	SQL_VARYING:
1833	<	begin
1834	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1835	<	rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1836	<	if RecordNumber >= 0 then
2127	>	else
2128	>	if (fdDataScale >= (-4)) then
2129		begin
2130	<	if (rdFields[j].fdDataLength = 0) then
2131	<	LocalData := nil
2130	>	LocalCurrency := ColData.AsCurrency;
2131	>	LocalData := PByte(@LocalCurrency);
2132	>	end
2133		else
2134		begin
2135	<	temp :=  Qry.Current[i];
2136	<	LocalData := @temp.Data^.sqldata[2];
2137	<	(*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1845	<	end;
1846	<	end;
2135	>	LocalDouble := ColData.AsDouble;
2136	>	LocalData := PByte(@LocalDouble);
2137	>	end
2138		end;
2139	<	SQL_BOOLEAN:
2139	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2140		begin
2141	<	LocalBool:= false;
2142	<	rdFields[j].fdDataSize := SizeOf(wordBool);
1852	<	if RecordNumber >= 0 then
1853	<	LocalBool := Qry.Current[i].AsBoolean;
1854	<	LocalData := PChar(@LocalBool);
2141	>	LocalDouble := ColData.AsDouble;
2142	>	LocalData := PByte(@LocalDouble);
2143		end;
2144	<	else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2144	>	SQL_BOOLEAN:
2145		begin
2146	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2147	<	if (rdFields[j].fdDataType = SQL_TEXT) then
1860	<	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
2146	>	LocalBool := ColData.AsBoolean;
2147	>	LocalData := PByte(@LocalBool);
2148		end;
2149		end;
2150	<	if RecordNumber < 0 then
2150	>
2151	>	if fdDataType = SQL_VARYING then
2152	>	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2153	>	else
2154	>	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2155	>	end
2156	>	else {Null column}
2157	>	if fdDataType = SQL_VARYING then
2158	>	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2159	>	else
2160	>	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2161	>	end;
2162	>	end;
2163	>
2164	>	{ Read the record from FQSelect.Current into the record buffer
2165	>	Then write the buffer to in memory cache }
2166	>	procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
2167	>	RecordNumber: Integer; Buffer: PChar);
2168	>	var
2169	>	pbd: PBlobDataArray;
2170	>	pda: PArrayDataArray;
2171	>	i, j: Integer;
2172	>	FieldsLoaded: Integer;
2173	>	p: PRecordData;
2174	>	begin
2175	>	if RecordNumber = -1 then
2176	>	begin
2177	>	InitModelBuffer(Qry,Buffer);
2178	>	Exit;
2179	>	end;
2180	>	p := PRecordData(Buffer);
2181	>	{ Make sure blob cache is empty }
2182	>	pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
2183	>	pda := PArrayDataArray(Buffer + FArrayCacheOffset);
2184	>	for i := 0 to BlobFieldCount - 1 do
2185	>	pbd^[i] := nil;
2186	>	for i := 0 to ArrayFieldCount - 1 do
2187	>	pda^[i] := nil;
2188	>
2189	>	{ Get record information }
2190	>	p^.rdBookmarkFlag := bfCurrent;
2191	>	p^.rdFieldCount := Qry.FieldCount;
2192	>	p^.rdRecordNumber := RecordNumber;
2193	>	p^.rdUpdateStatus := usUnmodified;
2194	>	p^.rdCachedUpdateStatus := cusUnmodified;
2195	>	p^.rdSavedOffset := $FFFFFFFF;
2196	>
2197	>	{ Load up the fields }
2198	>	FieldsLoaded := FQSelect.MetaData.Count;
2199	>	j := 1;
2200	>	for i := 0 to Qry.FieldCount - 1 do
2201	>	begin
2202	>	if (Qry = FQSelect) then
2203	>	j := i + 1
2204	>	else
2205	>	begin
2206	>	if FieldsLoaded = 0 then
2207	>	break;
2208	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2209	>	if j < 1 then
2210	>	continue
2211	>	else
2212	>	Dec(FieldsLoaded);
2213	>	end;
2214	>	with FQSelect.MetaData[j - 1] do
2215	>	if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2216		begin
2217	<	rdFields[j].fdIsNull := True;
2218	<	rdFields[j].fdDataOfs := FRecordSize;
2219	<	Inc(FRecordSize, rdFields[j].fdDataSize);
1868	<	end
1869	<	else begin
1870	<	if rdFields[j].fdDataType = SQL_VARYING then
1871	<	begin
1872	<	if LocalData <> nil then
1873	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
1874	<	end
1875	<	else
1876	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2217	>	if (GetSize <= 8) then
2218	>	p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2219	>	continue;
2220		end;
2221	<	end;
2221	>	if j > 0 then
2222	>	ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2223		end;
2224	<	WriteRecordCache(RecordNumber, PChar(p));
2224	>	WriteRecordCache(RecordNumber, Buffer);
2225		end;
2226
2227		function TIBCustomDataSet.GetActiveBuf: PChar;
#	Line 1922 | Line 2266 | begin
2266		result := FBase.Database;
2267		end;
2268
1925	–	function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1926	–	begin
1927	–	result := FBase.DBHandle;
1928	–	end;
1929	–
2269		function TIBCustomDataSet.GetDeleteSQL: TStrings;
2270		begin
2271		result := FQDelete.SQL;
#	Line 1937 | Line 2276 | begin
2276		result := FQInsert.SQL;
2277		end;
2278
2279	<	function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2279	>	function TIBCustomDataSet.GetSQLParams: ISQLParams;
2280		begin
2281		if not FInternalPrepared then
2282		InternalPrepare;
#	Line 1954 | Line 2293 | begin
2293		result := FQSelect.SQL;
2294		end;
2295
2296	<	function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2296	>	function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2297		begin
2298	<	result := FQSelect.SQLType;
2298	>	result := FQSelect.SQLStatementType;
2299		end;
2300
2301		function TIBCustomDataSet.GetModifySQL: TStrings;
#	Line 1969 | Line 2308 | begin
2308		result := FBase.Transaction;
2309		end;
2310
1972	–	function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1973	–	begin
1974	–	result := FBase.TRHandle;
1975	–	end;
1976	–
2311		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2312		begin
2313		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2314		FUpdateObject.Apply(ukDelete,Buff)
2315		else
2316		begin
2317	<	SetInternalSQLParams(FQDelete, Buff);
2317	>	SetInternalSQLParams(FQDelete.Params, Buff);
2318		FQDelete.ExecQuery;
2319		end;
2320		with PRecordData(Buff)^ do
#	Line 1995 | Line 2329 | function TIBCustomDataSet.InternalLocate
2329		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2330		var
2331		keyFieldList: TList;
1998	–	{$IF FPC_FULLVERSION >= 20700 }
2332		CurBookmark: TBookmark;
2000	–	{$ELSE}
2001	–	CurBookmark: string;
2002	–	{$ENDIF}
2333		fieldValue: Variant;
2334		lookupValues: array of variant;
2335		i, fieldCount: Integer;
#	Line 2081 | Line 2411 | end;
2411
2412		procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2413		var
2414	<	i, j, k: Integer;
2414	>	i, j, k, arr: Integer;
2415		pbd: PBlobDataArray;
2416	+	pda: PArrayDataArray;
2417		begin
2418		pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2419	<	j := 0;
2419	>	pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2420	>	j := 0; arr := 0;
2421		for i := 0 to FieldCount - 1 do
2422		if Fields[i].IsBlob then
2423		begin
#	Line 2094 | Line 2426 | begin
2426		begin
2427		pbd^[j].Finalize;
2428		PISC_QUAD(
2429	<	PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2429	>	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2430		pbd^[j].BlobID;
2431		PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2432	+	end
2433	+	else
2434	+	begin
2435	+	PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2436	+	with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2437	+	begin
2438	+	gds_quad_high := 0;
2439	+	gds_quad_low := 0;
2440	+	end;
2441		end;
2442		Inc(j);
2443	+	end
2444	+	else
2445	+	if Fields[i] is TIBArrayField then
2446	+	begin
2447	+	if pda^[arr] <> nil then
2448	+	begin
2449	+	k := FMappedFieldPosition[Fields[i].FieldNo -1];
2450	+	PISC_QUAD(
2451	+	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=  pda^[arr].ArrayIntf.GetArrayID;
2452	+	PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2453	+	end;
2454	+	Inc(arr);
2455		end;
2456		if Assigned(FUpdateObject) then
2457		begin
#	Line 2110 | Line 2463 | begin
2463		FUpdateObject.Apply(ukModify,Buff);
2464		end
2465		else begin
2466	<	SetInternalSQLParams(Qry, Buff);
2466	>	SetInternalSQLParams(Qry.Params, Buff);
2467		Qry.ExecQuery;
2468		end;
2469	+	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2470	+	UpdateRecordFromQuery(Qry.Current,Buff);
2471		PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2472		PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2473		SetModified(False);
#	Line 2144 | Line 2499 | begin
2499		end
2500		else
2501		Qry := FQRefresh;
2502	<	SetInternalSQLParams(Qry, Buff);
2502	>	SetInternalSQLParams(Qry.Params, Buff);
2503		Qry.ExecQuery;
2504		try
2505	<	if (Qry.SQLType = SQLExecProcedure) or
2151	<	(Qry.Next <> nil) then
2505	>	if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2506		begin
2507		ofs := PRecordData(Buff)^.rdSavedOffset;
2508		FetchCurrentRecordToBuffer(Qry,
#	Line 2241 | Line 2595 | begin
2595		end;
2596
2597		procedure TIBCustomDataSet.InternalPrepare;
2244	–	var
2245	–	DidActivate: Boolean;
2598		begin
2599		if FInternalPrepared then
2600		Exit;
2249	–	DidActivate := False;
2601		FBase.SetCursor;
2602		try
2603		ActivateConnection;
2604	<	DidActivate := ActivateTransaction;
2604	>	ActivateTransaction;
2605		FBase.CheckDatabase;
2606		FBase.CheckTransaction;
2607		if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
#	Line 2288 | Line 2639 | begin
2639		end else
2640		IBError(ibxeEmptyQuery, [nil]);
2641		finally
2291	–	if DidActivate then
2292	–	DeactivateTransaction;
2642		FBase.RestoreCursor;
2643		end;
2644		end;
#	Line 2319 | Line 2668 | var
2668		begin
2669		CopyRecordBuffer(Buffer, OldBuffer);
2670		if BlobFieldCount > 0 then
2671	<	FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2671	>	FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2672	>	BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2673		0);
2674		end;
2675
#	Line 2361 | Line 2711 | begin
2711		if (FBase.Database <> Value) then
2712		begin
2713		CheckDatasetClosed;
2714	+	InternalUnPrepare;
2715		FBase.Database := Value;
2716		FQDelete.Database := Value;
2717		FQInsert.Database := Value;
2718		FQRefresh.Database := Value;
2719		FQSelect.Database := Value;
2720		FQModify.Database := Value;
2721	+	FDatabaseInfo.Database := Value;
2722	+	FGeneratorField.Database := Value;
2723		end;
2724		end;
2725
#	Line 2388 | Line 2741 | begin
2741		end;
2742		end;
2743
2744	<	procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2744	>	procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2745		var
2746		i, j: Integer;
2747		cr, data: PChar;
2748	<	fn, st: string;
2748	>	fn: string;
2749	>	st: RawByteString;
2750		OldBuffer: Pointer;
2751		ts: TTimeStamp;
2752	+	Param: ISQLParam;
2753		begin
2754		if (Buffer = nil) then
2755		IBError(ibxeBufferNotSet, [nil]);
#	Line 2402 | Line 2757 | begin
2757		InternalPrepare;
2758		OldBuffer := nil;
2759		try
2760	<	for i := 0 to Qry.Params.Count - 1 do
2760	>	for i := 0 to Params.GetCount - 1 do
2761		begin
2762	<	fn := Qry.Params[i].Name;
2762	>	Param := Params[i];
2763	>	fn := Param.Name;
2764		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2765		begin
2766		fn := Copy(fn, 5, Length(fn));
#	Line 2424 | Line 2780 | begin
2780		cr := Buffer;
2781		j := FQSelect.FieldIndex[fn] + 1;
2782		if (j > 0) then
2783	<	with PRecordData(cr)^ do
2783	>	with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2784		begin
2785	<	if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2785	>	if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2786		begin
2787	<	PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2787	>	PIBDBKey(Param.AsPointer)^ := rdDBKey;
2788		continue;
2789		end;
2790	<	if rdFields[j].fdIsNull then
2791	<	Qry.Params[i].IsNull := True
2790	>	if fdIsNull then
2791	>	Param.IsNull := True
2792		else begin
2793	<	Qry.Params[i].IsNull := False;
2794	<	data := cr + rdFields[j].fdDataOfs;
2795	<	case rdFields[j].fdDataType of
2793	>	Param.IsNull := False;
2794	>	data := cr + fdDataOfs;
2795	>	case fdDataType of
2796		SQL_TEXT, SQL_VARYING:
2797		begin
2798	<	SetString(st, data, rdFields[j].fdDataLength);
2799	<	Qry.Params[i].AsString := st;
2798	>	SetString(st, data, fdDataLength);
2799	>	SetCodePage(st,fdCodePage,false);
2800	>	Param.AsString := st;
2801		end;
2802		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2803	<	Qry.Params[i].AsDouble := PDouble(data)^;
2803	>	Param.AsDouble := PDouble(data)^;
2804		SQL_SHORT, SQL_LONG:
2805		begin
2806	<	if rdFields[j].fdDataScale = 0 then
2807	<	Qry.Params[i].AsLong := PLong(data)^
2808	<	else if rdFields[j].fdDataScale >= (-4) then
2809	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2806	>	if fdDataScale = 0 then
2807	>	Param.AsLong := PLong(data)^
2808	>	else
2809	>	if fdDataScale >= (-4) then
2810	>	Param.AsCurrency := PCurrency(data)^
2811		else
2812	<	Qry.Params[i].AsDouble := PDouble(data)^;
2812	>	Param.AsDouble := PDouble(data)^;
2813		end;
2814		SQL_INT64:
2815		begin
2816	<	if rdFields[j].fdDataScale = 0 then
2817	<	Qry.Params[i].AsInt64 := PInt64(data)^
2460	<	else if rdFields[j].fdDataScale >= (-4) then
2461	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2816	>	if fdDataScale = 0 then
2817	>	Param.AsInt64 := PInt64(data)^
2818		else
2819	<	Qry.Params[i].AsDouble := PDouble(data)^;
2819	>	if fdDataScale >= (-4) then
2820	>	Param.AsCurrency := PCurrency(data)^
2821	>	else
2822	>	Param.AsDouble := PDouble(data)^;
2823		end;
2824		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2825	<	Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2826	<	SQL_TYPE_DATE:
2827	<	begin
2469	<	ts.Date := PInt(data)^;
2470	<	ts.Time := 0;
2471	<	Qry.Params[i].AsDate :=
2472	<	TimeStampToDateTime(ts);
2473	<	end;
2474	<	SQL_TYPE_TIME:
2475	<	begin
2476	<	ts.Date := 0;
2477	<	ts.Time := PInt(data)^;
2478	<	Qry.Params[i].AsTime :=
2479	<	TimeStampToDateTime(ts);
2480	<	end;
2825	>	Param.AsQuad := PISC_QUAD(data)^;
2826	>	SQL_TYPE_DATE,
2827	>	SQL_TYPE_TIME,
2828		SQL_TIMESTAMP:
2829	<	Qry.Params[i].AsDateTime :=
2830	<	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2829	>	{This is an IBX native format and not the TDataset approach. See also SetFieldData}
2830	>	Param.AsDateTime := PDateTime(data)^;
2831		SQL_BOOLEAN:
2832	<	Qry.Params[i].AsBoolean := PWordBool(data)^;
2832	>	Param.AsBoolean := PWordBool(data)^;
2833		end;
2834		end;
2835		end;
#	Line 2531 | Line 2878 | begin
2878		FQRefresh.Transaction := Value;
2879		FQSelect.Transaction := Value;
2880		FQModify.Transaction := Value;
2881	+	FGeneratorField.Transaction := Value;
2882		end;
2883		end;
2884
#	Line 2638 | Line 2986 | begin
2986		Result := Assigned( FQSelect ) and FQSelect.EOF;
2987		end;
2988
2989	<	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2989	>	function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2990		begin
2991		ActivateConnection;
2992		ActivateTransaction;
#	Line 2775 | Line 3123 | var
3123		Buff: PChar;
3124		bTr, bDB: Boolean;
3125		begin
3126	+	if (Field = nil) or (Field.DataSet <> self) then
3127	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3128		Buff := GetActiveBuf;
3129		if Buff = nil then
3130		begin
3131		fs := TIBBlobStream.Create;
3132		fs.Mode := bmReadWrite;
3133	+	fs.Database := Database;
3134	+	fs.Transaction := Transaction;
3135	+	fs.SetField(Field);
3136		FBlobStreamList.Add(Pointer(fs));
3137		result := TIBDSBlobStream.Create(Field, fs, Mode);
3138		exit;
#	Line 2794 | Line 3147 | begin
3147		fs.Mode := bmReadWrite;
3148		fs.Database := Database;
3149		fs.Transaction := Transaction;
3150	+	fs.SetField(Field);
3151		fs.BlobID :=
3152	<	PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3152	>	PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3153		if (CachedUpdates) then
3154		begin
3155		bTr := not Transaction.InTransaction;
#	Line 2816 | Line 3170 | begin
3170		result := TIBDSBlobStream.Create(Field, fs, Mode);
3171		end;
3172
3173	+	function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3174	+	var Buff: PChar;
3175	+	pda: PArrayDataArray;
3176	+	bTr, bDB: Boolean;
3177	+	begin
3178	+	if (Field = nil) or (Field.DataSet <> self) then
3179	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3180	+	Buff := GetActiveBuf;
3181	+	if Buff = nil then
3182	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3183	+	Field.FRelationName,Field.FieldName)
3184	+	else
3185	+	begin
3186	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3187	+	if pda^[Field.FCacheOffset] = nil then
3188	+	begin
3189	+	AdjustRecordOnInsert(Buff);
3190	+	if Field.IsNull then
3191	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3192	+	Field.FRelationName,Field.FieldName)
3193	+	else
3194	+	Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3195	+	Field.FRelationName,Field.FieldName,Field.ArrayID);
3196	+	pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3197	+	FArrayList.Add(pda^[Field.FCacheOffset]);
3198	+	if (CachedUpdates) then
3199	+	begin
3200	+	bTr := not Transaction.InTransaction;
3201	+	bDB := not Database.Connected;
3202	+	if bDB then
3203	+	Database.Open;
3204	+	if bTr then
3205	+	Transaction.StartTransaction;
3206	+	pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3207	+	if bTr then
3208	+	Transaction.Commit;
3209	+	if bDB then
3210	+	Database.Close;
3211	+	end;
3212	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3213	+	end
3214	+	else
3215	+	Result := pda^[Field.FCacheOffset].ArrayIntf;
3216	+	end;
3217	+	end;
3218	+
3219	+	procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3220	+	var Buff: PChar;
3221	+	pda: PArrayDataArray;
3222	+	begin
3223	+	if (Field = nil) or (Field.DataSet <> self) then
3224	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3225	+	Buff := GetActiveBuf;
3226	+	if Buff <> nil then
3227	+	begin
3228	+	AdjustRecordOnInsert(Buff);
3229	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3230	+	pda^[Field.FCacheOffset].FArray := AnArray;
3231	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3232	+	end;
3233	+	end;
3234	+
3235		function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3236		const
3237		CMPLess = -1;
#	Line 2896 | Line 3312 | end;
3312		procedure TIBCustomDataSet.DoBeforeClose;
3313		begin
3314		inherited DoBeforeClose;
3315	+	if FInTransactionEnd and (FCloseAction = TARollback) then
3316	+	Exit;
3317		if State in [dsInsert,dsEdit] then
3318		begin
2901	–	if FInTransactionEnd and (FCloseAction = TARollback) then
2902	–	Exit;
2903	–
3319		if DataSetCloseAction = dcSaveChanges then
3320		Post;
3321		{Note this can fail with an exception e.g. due to
3322		database validation error. In which case the dataset remains open }
3323		end;
3324	+	if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3325	+	ApplyUpdates;
3326		end;
3327
3328		procedure TIBCustomDataSet.DoBeforeOpen;
#	Line 2937 | Line 3354 | end;
3354
3355		procedure TIBCustomDataSet.FetchAll;
3356		var
2940	–	{$IF FPC_FULLVERSION >= 20700 }
3357		CurBookmark: TBookmark;
2942	–	{$ELSE}
2943	–	CurBookmark: string;
2944	–	{$ENDIF}
3358		begin
3359		FBase.SetCursor;
3360		try
#	Line 3052 | Line 3465 | begin
3465		if result and (Buffer <> nil) then
3466		Move(Buff[1], Buffer^, Field.DataSize);
3467		end
3468	<	else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3468	>	else
3469	>	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3470		(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3471	+	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3472	+	FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3473		begin
3474	<	result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3474	>	result := not fdIsNull;
3475		if result and (Buffer <> nil) then
3060	–	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3476		begin
3477	<	Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3477	>	Data := Buff + fdDataOfs;
3478		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3479		begin
3480		if fdDataLength < Field.DataSize then
#	Line 3130 | Line 3545 | begin
3545		if FCurrentRecord < FRecordCount then
3546		ReadRecordCache(FCurrentRecord, Buffer, False)
3547		else begin
3548	<	while (not FQSelect.EOF) and
3134	<	(FQSelect.Next <> nil) and
3548	>	while (not FQSelect.EOF) and FQSelect.Next  and
3549		(FCurrentRecord >= FRecordCount) do begin
3550		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3551		Inc(FRecordCount);
#	Line 3242 | Line 3656 | procedure TIBCustomDataSet.InternalCance
3656		var
3657		Buff: PChar;
3658		CurRec: Integer;
3659	+	pda: PArrayDataArray;
3660	+	i: integer;
3661		begin
3662		inherited InternalCancel;
3663		Buff := GetActiveBuf;
3664	<	if Buff <> nil then begin
3664	>	if Buff <> nil then
3665	>	begin
3666	>	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3667	>	for i := 0 to ArrayFieldCount - 1 do
3668	>	pda^[i].ArrayIntf.CancelChanges;
3669		CurRec := FCurrentRecord;
3670		AdjustRecordOnInsert(Buff);
3671		if (State = dsEdit) then begin
#	Line 3268 | Line 3688 | begin
3688		DeactivateTransaction;
3689		FQSelect.Close;
3690		ClearBlobCache;
3691	+	ClearArrayCache;
3692		FreeRecordBuffer(FModelBuffer);
3693		FreeRecordBuffer(FOldBuffer);
3694		FCurrentRecord := -1;
#	Line 3283 | Line 3704 | begin
3704		FOBEnd := 0;
3705		FreeMem(FBufferCache);
3706		FBufferCache := nil;
3707	+	FreeMem(FFieldColumns);
3708	+	FFieldColumns := nil;
3709		FreeMem(FOldBufferCache);
3710		FOldBufferCache := nil;
3711		BindFields(False);
#	Line 3357 | Line 3780 | const
3780		'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3781		'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3782		'     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3783	+
3784	+	DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3785	+	'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3786	+	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3787	+	'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3788	+	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3789	+	'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3790	+	'     (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3791	+	'     ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3792	+
3793		var
3794		FieldType: TFieldType;
3795		FieldSize: Word;
3796	+	FieldDataSize: integer;
3797		charSetID: short;
3798		CharSetSize: integer;
3799	<	CharSetName: string;
3799	>	CharSetName: RawByteString;
3800	>	FieldCodePage: TSystemCodePage;
3801		FieldNullable : Boolean;
3802		i, FieldPosition, FieldPrecision: Integer;
3803		FieldAliasName, DBAliasName: string;
3804	<	RelationName, FieldName: string;
3804	>	aRelationName, FieldName: string;
3805		Query : TIBSQL;
3806		FieldIndex: Integer;
3807		FRelationNodes : TRelationNode;
3808	+	aArrayDimensions: integer;
3809	+	aArrayBounds: TArrayBounds;
3810	+	ArrayMetaData: IArrayMetaData;
3811
3812		function Add_Node(Relation, Field : String) : TRelationNode;
3813		var
#	Line 3392 | Line 3830 | var
3830		FField.FieldName := Query.Fields[2].AsString;
3831		FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3832		FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3833	+	FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3834		FField.NextField := Result.FieldNodes;
3835		Result.FieldNodes := FField;
3836		Query.Next;
#	Line 3445 | Line 3884 | var
3884		FField := Ffield.NextField;
3885		end;
3886
3887	+	function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3888	+	var
3889	+	FRelation : TRelationNode;
3890	+	FField : TFieldNode;
3891	+	begin
3892	+	FRelation := FRelationNodes;
3893	+	while Assigned(FRelation) and
3894	+	(FRelation.RelationName <> Relation) do
3895	+	FRelation := FRelation.NextRelation;
3896	+	if not Assigned(FRelation) then
3897	+	FRelation := Add_Node(Relation, Field);
3898	+	Result := false;
3899	+	FField := FRelation.FieldNodes;
3900	+	while Assigned(FField) do
3901	+	if FField.FieldName = Field then
3902	+	begin
3903	+	Result := Ffield.IDENTITY_COLUMN;
3904	+	Exit;
3905	+	end
3906	+	else
3907	+	FField := Ffield.NextField;
3908	+	end;
3909	+
3910		Procedure FreeNodes;
3911		var
3912		FRelation : TRelationNode;
#	Line 3467 | Line 3929 | var
3929		begin
3930		FRelationNodes := TRelationNode.Create;
3931		FNeedsRefresh := False;
3932	<	Database.InternalTransaction.StartTransaction;
3932	>	if not Database.InternalTransaction.InTransaction then
3933	>	Database.InternalTransaction.StartTransaction;
3934		Query := TIBSQL.Create(self);
3935		try
3936		Query.Database := DataBase;
#	Line 3475 | Line 3938 | begin
3938		FieldDefs.BeginUpdate;
3939		FieldDefs.Clear;
3940		FieldIndex := 0;
3941	<	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3942	<	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3943	<	Query.SQL.Text := DefaultSQL;
3941	>	if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3942	>	SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3943	>	if FDatabaseInfo.ODSMajorVersion >= 12 then
3944	>	Query.SQL.Text := DefaultSQLODS12
3945	>	else
3946	>	Query.SQL.Text := DefaultSQL;
3947		Query.Prepare;
3948	<	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3949	<	SetLength(FAliasNameList, SourceQuery.Current.Count);
3950	<	for i := 0 to SourceQuery.Current.Count - 1 do
3951	<	with SourceQuery.Current[i].Data^ do
3948	>	SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3949	>	SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3950	>	for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3951	>	with SourceQuery.MetaData[i] do
3952		begin
3953		{ Get the field name }
3954	<	FieldAliasName := SourceQuery.Current[i].Name;
3955	<	SetString(DBAliasName, aliasname, aliasname_length);
3956	<	SetString(RelationName, relname, relname_length);
3957	<	SetString(FieldName, sqlname, sqlname_length);
3954	>	FieldAliasName := GetName;
3955	>	DBAliasName := GetAliasname;
3956	>	aRelationName := getRelationName;
3957	>	FieldName := getSQLName;
3958		FAliasNameList[i] := DBAliasName;
3959		FieldSize := 0;
3960	+	FieldDataSize := GetSize;
3961		FieldPrecision := 0;
3962	<	FieldNullable := SourceQuery.Current[i].IsNullable;
3962	>	FieldNullable := IsNullable;
3963		CharSetSize := 0;
3964		CharSetName := '';
3965	<	case sqltype and not 1 of
3965	>	FieldCodePage := CP_NONE;
3966	>	aArrayDimensions := 0;
3967	>	SetLength(aArrayBounds,0);
3968	>	case SQLType of
3969		{ All VARCHAR's must be converted to strings before recording
3970		their values }
3971		SQL_VARYING, SQL_TEXT:
3972		begin
3973	<	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3974	<	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3975	<	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3976	<	FieldSize := sqllen;
3977	<	if CharSetSize = 2 then
3978	<	FieldType := ftWideString
3509	<	else
3510	<	FieldType := ftString;
3973	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3974	>	CharSetSize := 1;
3975	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3976	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3977	>	FieldSize := FieldDataSize div CharSetSize;
3978	>	FieldType := ftString;
3979		end;
3980		{ All Doubles/Floats should be cast to doubles }
3981		SQL_DOUBLE, SQL_FLOAT:
3982		FieldType := ftFloat;
3983		SQL_SHORT:
3984		begin
3985	<	if (sqlscale = 0) then
3985	>	if (getScale = 0) then
3986		FieldType := ftSmallInt
3987		else begin
3988		FieldType := ftBCD;
3989		FieldPrecision := 4;
3990	<	FieldSize := -sqlscale;
3990	>	FieldSize := -getScale;
3991		end;
3992		end;
3993		SQL_LONG:
3994		begin
3995	<	if (sqlscale = 0) then
3995	>	if (getScale = 0) then
3996		FieldType := ftInteger
3997	<	else if (sqlscale >= (-4)) then
3997	>	else if (getScale >= (-4)) then
3998		begin
3999		FieldType := ftBCD;
4000		FieldPrecision := 9;
4001	<	FieldSize := -sqlscale;
4001	>	FieldSize := -getScale;
4002		end
4003		else
4004		if Database.SQLDialect = 1 then
#	Line 3542 | Line 4010 | begin
4010		begin
4011		FieldType := ftFMTBCD;
4012		FieldPrecision := 9;
4013	<	FieldSize := -sqlscale;
4013	>	FieldSize := -getScale;
4014		end;
4015		end;
4016
4017		SQL_INT64:
4018		begin
4019	<	if (sqlscale = 0) then
4019	>	if (getScale = 0) then
4020		FieldType := ftLargeInt
4021	<	else if (sqlscale >= (-4)) then
4021	>	else if (getScale >= (-4)) then
4022		begin
4023		FieldType := ftBCD;
4024		FieldPrecision := 18;
4025	<	FieldSize := -sqlscale;
4025	>	FieldSize := -getScale;
4026		end
4027		else
4028	<	FieldType := ftFloat
4028	>	FieldType := ftFloat;
4029		end;
4030		SQL_TIMESTAMP: FieldType := ftDateTime;
4031		SQL_TYPE_TIME: FieldType := ftTime;
#	Line 3565 | Line 4033 | begin
4033		SQL_BLOB:
4034		begin
4035		FieldSize := sizeof (TISC_QUAD);
4036	<	if (sqlsubtype = 1) then
4036	>	if (getSubtype = 1) then
4037		begin
4038	<	if strpas(sqlname) = '' then {Complex SQL with no identifiable column - use connection default}
4039	<	begin
4040	<	CharSetSize := FBase.GetDefaultCharSetSize;
4041	<	CharSetName := FBase.GetDefaultCharSetName;
4042	<	end
3575	<	else
3576	<	begin
3577	<	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3578	<	@relname,@sqlname);
3579	<	CharSetSize := FBase.GetCharSetSize(charSetID);
3580	<	CharSetName := FBase.GetCharSetName(charSetID);
3581	<	end;
3582	<	if CharSetSize = 2 then
3583	<	FieldType := ftWideMemo
3584	<	else
3585	<	FieldType := ftMemo;
4038	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4039	>	CharSetSize := 1;
4040	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4041	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4042	>	FieldType := ftMemo;
4043		end
4044		else
4045		FieldType := ftBlob;
#	Line 3590 | Line 4047 | begin
4047		SQL_ARRAY:
4048		begin
4049		FieldSize := sizeof (TISC_QUAD);
4050	<	FieldType := ftUnknown;
4050	>	FieldType := ftArray;
4051	>	ArrayMetaData := GetArrayMetaData;
4052	>	if ArrayMetaData <> nil then
4053	>	begin
4054	>	aArrayDimensions := ArrayMetaData.GetDimensions;
4055	>	aArrayBounds := ArrayMetaData.GetBounds;
4056	>	end;
4057		end;
4058		SQL_BOOLEAN:
4059		FieldType:= ftBoolean;
#	Line 3607 | Line 4070 | begin
4070		Name := FieldAliasName;
4071		FAliasNameMap[FieldNo-1] := DBAliasName;
4072		Size := FieldSize;
4073	+	DataSize := FieldDataSize;
4074		Precision := FieldPrecision;
4075		Required := not FieldNullable;
4076	+	RelationName := aRelationName;
4077		InternalCalcField := False;
4078		CharacterSetSize := CharSetSize;
4079		CharacterSetName := CharSetName;
4080	+	CodePage := FieldCodePage;
4081	+	ArrayDimensions := aArrayDimensions;
4082	+	ArrayBounds := aArrayBounds;
4083		if (FieldName <> '') and (RelationName <> '') then
4084		begin
4085	+	IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4086		if Has_COMPUTED_BLR(RelationName, FieldName) then
4087		begin
4088		Attributes := [faReadOnly];
#	Line 3639 | Line 4108 | begin
4108		FreeNodes;
4109		Database.InternalTransaction.Commit;
4110		FieldDefs.EndUpdate;
4111	+	FieldDefs.Updated := true;
4112		end;
4113		end;
4114
#	Line 3656 | Line 4126 | begin
4126		else begin
4127		Buffer := AllocRecordBuffer;
4128		try
4129	<	while FQSelect.Next <> nil do
4129	>	while FQSelect.Next do
4130		begin
4131		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
4132		Inc(FRecordCount);
#	Line 3671 | Line 4141 | end;
4141		procedure TIBCustomDataSet.InternalSetParamsFromCursor;
4142		var
4143		i: Integer;
4144	<	cur_param: TIBXSQLVAR;
4144	>	cur_param: ISQLParam;
4145		cur_field: TField;
4146		s: TStream;
4147		begin
#	Line 3679 | Line 4149 | begin
4149		IBError(ibxeEmptyQuery, [nil]);
4150		if not FInternalPrepared then
4151		InternalPrepare;
4152	<	if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4152	>	if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4153		begin
4154	<	for i := 0 to SQLParams.Count - 1 do
4154	>	for i := 0 to SQLParams.GetCount - 1 do
4155		begin
4156		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4157	<	cur_param := SQLParams[i];
4158	<	if (cur_field <> nil) then begin
4157	>	if (cur_field <> nil) then
4158	>	begin
4159	>	cur_param := SQLParams[i];
4160		if (cur_field.IsNull) then
4161		cur_param.IsNull := True
4162	<	else case cur_field.DataType of
4162	>	else
4163	>	case cur_field.DataType of
4164		ftString:
4165		cur_param.AsString := cur_field.AsString;
4166		ftBoolean:
#	Line 3698 | Line 4170 | begin
4170		ftInteger:
4171		cur_param.AsLong := cur_field.AsInteger;
4172		ftLargeInt:
4173	<	cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4173	>	cur_param.AsInt64 := cur_field.AsLargeInt;
4174		ftFloat, ftCurrency:
4175		cur_param.AsDouble := cur_field.AsFloat;
4176		ftBCD:
#	Line 3715 | Line 4187 | begin
4187		try
4188		s := DataSource.DataSet.
4189		CreateBlobStream(cur_field, bmRead);
4190	<	cur_param.LoadFromStream(s);
4190	>	cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4191		finally
4192		s.free;
4193		end;
4194		end;
4195	+	ftArray:
4196	+	cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4197		else
4198		IBError(ibxeNotSupported, [nil]);
4199		end;
#	Line 3752 | Line 4226 | procedure TIBCustomDataSet.InternalOpen;
4226		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
4227		end;
4228
3755	–	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3756	–	var i: integer;
3757	–	begin
3758	–	Result := nil;
3759	–	for i := 0 to FieldDefs.Count - 1 do
3760	–	if FieldDefs[i].FieldNo = aFieldNo then
3761	–	begin
3762	–	Result := TIBFieldDef(FieldDefs[i]);
3763	–	break;
3764	–	end;
3765	–	end;
3766	–
3767	–	procedure SetExtendedProperties;
3768	–	var i: integer;
3769	–	IBFieldDef: TIBFieldDef;
3770	–	begin
3771	–	for i := 0 to Fields.Count - 1 do
3772	–	if Fields[i].FieldNo > 0 then
3773	–	begin
3774	–	if(Fields[i] is TIBStringField) then
3775	–	with TIBStringField(Fields[i]) do
3776	–	begin
3777	–	IBFieldDef := GetFieldDef(FieldNo);
3778	–	if IBFieldDef <> nil then
3779	–	begin
3780	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3781	–	CharacterSetName := IBFieldDef.CharacterSetName;
3782	–	end;
3783	–	end
3784	–	else
3785	–	if(Fields[i] is TIBWideStringField) then
3786	–	with TIBWideStringField(Fields[i]) do
3787	–	begin
3788	–	IBFieldDef := GetFieldDef(FieldNo);
3789	–	if IBFieldDef <> nil then
3790	–	begin
3791	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3792	–	CharacterSetName := IBFieldDef.CharacterSetName;
3793	–	end;
3794	–	end
3795	–	else
3796	–	if(Fields[i] is TIBMemoField) then
3797	–	with TIBMemoField(Fields[i]) do
3798	–	begin
3799	–	IBFieldDef := GetFieldDef(FieldNo);
3800	–	if IBFieldDef <> nil then
3801	–	begin
3802	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3803	–	CharacterSetName := IBFieldDef.CharacterSetName;
3804	–	end;
3805	–	end
3806	–	else
3807	–	if(Fields[i] is TIBWideMemoField) then
3808	–	with TIBWideMemoField(Fields[i]) do
3809	–	begin
3810	–	IBFieldDef := GetFieldDef(FieldNo);
3811	–	if IBFieldDef <> nil then
3812	–	begin
3813	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3814	–	CharacterSetName := IBFieldDef.CharacterSetName;
3815	–	end;
3816	–	end
3817	–	end
3818	–	end;
3819	–
4229		begin
4230		FBase.SetCursor;
4231		try
#	Line 3826 | Line 4235 | begin
4235		IBError(ibxeEmptyQuery, [nil]);
4236		if not FInternalPrepared then
4237		InternalPrepare;
4238	<	if FQSelect.SQLType = SQLSelect then
4238	>	if FQSelect.SQLStatementType = SQLSelect then
4239		begin
4240		if DefaultFields then
4241		CreateFields;
4242	+	FArrayFieldCount := 0;
4243		BindFields(True);
3834	–	SetExtendedProperties;
4244		FCurrentRecord := -1;
4245		FQSelect.ExecQuery;
4246		FOpen := FQSelect.Open;
#	Line 3842 | Line 4251 | begin
4251		3. After the dummy fetch, FRecordSize will be appropriately
4252		adjusted to reflect the additional "weight" of the field
4253		data.
4254	<	4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4254	>	4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4255		5. Now, with the BufferSize available, allocate memory for chunks of records
4256		6. Re-allocate the model buffer, accounting for the new
4257		FRecordBufferSize.
4258		7. Finally, calls to AllocRecordBuffer will work!.
4259		}
4260		{Step 1}
4261	<	FRecordSize := RecordDataLength(FQSelect.Current.Count);
4261	>	FRecordSize := RecordDataLength(FQSelect.FieldCount);
4262		{Step 2, 3}
4263	+	GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4264		IBAlloc(FModelBuffer, 0, FRecordSize);
4265	<	FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4265	>	InitModelBuffer(FQSelect, FModelBuffer);
4266		{Step 4}
4267		FCalcFieldsOffset := FRecordSize;
4268		FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4269	<	FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4269	>	FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4270	>	FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4271		{Step 5}
4272		if UniDirectional then
4273		FBufferChunkSize := FRecordBufferSize * UniCache
#	Line 3872 | Line 4283 | begin
4283		FCacheSize := FBufferChunkSize;
4284		FOldCacheSize := FBufferChunkSize;
4285		{Step 6}
4286	<	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4286	>	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4287		FRecordBufferSize);
4288		{Step 7}
4289		FOldBuffer := AllocRecordBuffer;
#	Line 3970 | Line 4381 | end;
4381		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4382		Options: TLocateOptions): Boolean;
4383		var
3973	–	{$IF FPC_FULLVERSION >= 20700 }
4384		CurBookmark: TBookmark;
3975	–	{$ELSE}
3976	–	CurBookmark: string;
3977	–	{$ENDIF}
4385		begin
4386		DisableControls;
4387		try
#	Line 3992 | Line 4399 | function TIBCustomDataSet.Lookup(const K
4399		const ResultFields: string): Variant;
4400		var
4401		fl: TList;
3995	–	{$IF FPC_FULLVERSION >= 20700 }
4402		CurBookmark: TBookmark;
3997	–	{$ELSE}
3998	–	CurBookmark: string;
3999	–	{$ENDIF}
4403		begin
4404		DisableControls;
4405		fl := TList.Create;
#	Line 4069 | Line 4472 | begin
4472		MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4473		if (MappedFieldPos > 0) and
4474		(MappedFieldPos <= rdFieldCount) then
4475	+	with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4476		begin
4477		Field.Validate(Buffer);
4478		if (Buffer = nil) or
4479		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4480	<	rdFields[MappedFieldPos].fdIsNull := True
4481	<	else begin
4482	<	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4483	<	rdFields[MappedFieldPos].fdDataSize);
4484	<	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4485	<	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4486	<	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4083	<	rdFields[MappedFieldPos].fdIsNull := False;
4480	>	fdIsNull := True
4481	>	else
4482	>	begin
4483	>	Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4484	>	if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4485	>	fdDataLength := StrLen(PChar(Buffer));
4486	>	fdIsNull := False;
4487		if rdUpdateStatus = usUnmodified then
4488		begin
4489		if CachedUpdates then
#	Line 4181 | Line 4584 | begin
4584		if FInternalPrepared then
4585		begin
4586		CheckDatasetClosed;
4587	+	if FDidActivate then
4588	+	DeactivateTransaction;
4589		FieldDefs.Clear;
4590		FieldDefs.Updated := false;
4591		FInternalPrepared := False;
#	Line 4201 | Line 4606 | begin
4606		IBError(ibxeEmptyQuery, [nil]);
4607		if not FInternalPrepared then
4608		InternalPrepare;
4609	<	if FQSelect.SQLType = SQLSelect then
4609	>	if FQSelect.SQLStatementType = SQLSelect then
4610		begin
4611		IBError(ibxeIsASelectStatement, [nil]);
4612		end
#	Line 4214 | Line 4619 | begin
4619		end;
4620		end;
4621
4622	<	function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4622	>	function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4623		begin
4624	<	Result := FQSelect.Handle;
4624	>	Result := FQSelect.Statement;
4625		end;
4626
4627		function TIBCustomDataSet.GetParser: TSelectSQLParser;
#	Line 4271 | Line 4676 | end;
4676
4677		{ TIBDataSet IProviderSupport }
4678
4679	<	(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4679	>	procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4680		begin
4681		if Commit then
4682		Transaction.Commit else
#	Line 4424 | Line 4829 | begin
4829		Transaction.StartTransaction;
4830		end;
4831
4832	<	function TIBCustomDataSet.PSGetTableName: string;
4832	>	function TIBCustomDataSet.PsGetTableName: string;
4833		begin
4834		//  if not FInternalPrepared then
4835		//    InternalPrepare;
#	Line 4434 | Line 4839 | begin
4839		if not FQSelect.Prepared then
4840		FQSelect.Prepare;
4841		Result := FQSelect.UniqueRelationName;
4842	<	end;*)
4842	>	end;
4843
4844		procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4845		begin
#	Line 4519 | Line 4924 | end;
4924		function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4925		NativeFormat: Boolean): Boolean;
4926		begin
4927	<	if (Field.DataType = ftBCD) and not NativeFormat then
4927	>	{These datatypes use IBX conventions and not TDataset conventions}
4928	>	if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4929		Result := InternalGetFieldData(Field, Buffer)
4930		else
4931		Result := inherited GetFieldData(Field, Buffer, NativeFormat);
#	Line 4545 | Line 4951 | end;
4951		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4952		NativeFormat: Boolean);
4953		begin
4954	<	if (not NativeFormat) and (Field.DataType = ftBCD) then
4954	>	{These datatypes use IBX conventions and not TDataset conventions}
4955	>	if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4956		InternalSetfieldData(Field, Buffer)
4957		else
4958		inherited SetFieldData(Field, buffer, NativeFormat);
#	Line 4565 | Line 4972 | begin
4972		inherited Destroy;
4973		end;
4974
4975	<	procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4975	>	procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4976		begin
4977		FRefreshSQL.Assign(Value);
4978		end;
4979
4980	+	procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
4981	+	buff: PChar);
4982	+	begin
4983	+	if not Assigned(DataSet) then Exit;
4984	+	DataSet.SetInternalSQLParams(Params, buff);
4985	+	end;
4986	+
4987		procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4988		begin
4989	+	InternalSetParams(Query.Params,buff);
4990	+	end;
4991	+
4992	+	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
4993	+	Buffer: PChar);
4994	+	begin
4995		if not Assigned(DataSet) then Exit;
4996	<	DataSet.SetInternalSQLParams(Query, buff);
4996	>	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
4997	>	end;
4998	>
4999	>	function TIBDSBlobStream.GetSize: Int64;
5000	>	begin
5001	>	Result := FBlobStream.BlobSize;
5002		end;
5003
5004		{ TIBDSBlobStream }
#	Line 4584 | Line 5009 | begin
5009		FBlobStream := ABlobStream;
5010		FBlobStream.Seek(0, soFromBeginning);
5011		if (Mode = bmWrite) then
5012	+	begin
5013		FBlobStream.Truncate;
5014	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
5015	+	TBlobField(FField).Modified := true;
5016	+	FHasWritten := true;
5017	+	end;
5018		end;
5019
5020		destructor TIBDSBlobStream.Destroy;
#	Line 4626 | Line 5056 | end;
5056
5057		procedure TIBGenerator.SetIncrement(const AValue: integer);
5058		begin
5059	+	if FIncrement = AValue then Exit;
5060		if AValue < 0 then
5061	<	raise Exception.Create('A Generator Increment cannot be negative');
5062	<	FIncrement := AValue
5061	>	IBError(ibxeNegativeGenerator,[]);
5062	>	FIncrement := AValue;
5063	>	SetQuerySQL;
5064		end;
5065
5066	<	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4635	<	ATransaction: TIBTransaction): integer;
5066	>	procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5067		begin
5068	<	with TIBSQL.Create(nil) do
5069	<	try
5070	<	Database := ADatabase;
5071	<	Transaction := ATransaction;
5072	<	if not assigned(Database) then
5073	<	IBError(ibxeCannotSetDatabase,[]);
5074	<	if not assigned(Transaction) then
5075	<	IBError(ibxeCannotSetTransaction,[]);
5076	<	with Transaction do
5077	<	if not InTransaction then StartTransaction;
5078	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
5079	<	Prepare;
5068	>	FQuery.Transaction := AValue;
5069	>	end;
5070	>
5071	>	procedure TIBGenerator.SetQuerySQL;
5072	>	begin
5073	>	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5074	>	end;
5075	>
5076	>	function TIBGenerator.GetDatabase: TIBDatabase;
5077	>	begin
5078	>	Result := FQuery.Database;
5079	>	end;
5080	>
5081	>	function TIBGenerator.GetTransaction: TIBTransaction;
5082	>	begin
5083	>	Result := FQuery.Transaction;
5084	>	end;
5085	>
5086	>	procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5087	>	begin
5088	>	FQuery.Database := AValue;
5089	>	end;
5090	>
5091	>	procedure TIBGenerator.SetGeneratorName(AValue: string);
5092	>	begin
5093	>	if FGeneratorName = AValue then Exit;
5094	>	FGeneratorName := AValue;
5095	>	SetQuerySQL;
5096	>	end;
5097	>
5098	>	function TIBGenerator.GetNextValue: integer;
5099	>	begin
5100	>	with FQuery do
5101	>	begin
5102	>	Transaction.Active := true;
5103		ExecQuery;
5104		try
5105	<	Result := FieldByName('ID').AsInteger
5105	>	Result := Fields[0].AsInteger
5106		finally
5107		Close
5108		end;
4655	–	finally
4656	–	Free
5109		end;
5110		end;
5111
#	Line 4661 | Line 5113 | constructor TIBGenerator.Create(Owner: T
5113		begin
5114		FOwner := Owner;
5115		FIncrement := 1;
5116	+	FQuery := TIBSQL.Create(nil);
5117	+	end;
5118	+
5119	+	destructor TIBGenerator.Destroy;
5120	+	begin
5121	+	if assigned(FQuery) then FQuery.Free;
5122	+	inherited Destroy;
5123		end;
5124
5125
5126		procedure TIBGenerator.Apply;
5127		begin
5128	<	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5129	<	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5128	>	if assigned(Database) and assigned(Transaction) and
5129	>	(FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5130	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5131		end;
5132
5133

Diff Legend

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