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

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC vs.
Revision 139 by tony, Wed Jan 24 16:16:29 2018 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 - 2015 }
30	>	{ Associates Ltd 2011 - 2015 }
31		{ }
32		{************************************************************************}
33
34		unit IBCustomDataSet;
35
36	–	{$IF FPC_FULLVERSION >= 20700 }
37	–	{$codepage UTF8}
38	–	{$DEFINE HAS_ANSISTRING_CODEPAGE}
39	–	{$DEFINE NEW_TBOOKMARK}
40	–	{$ENDIF}
41	–
36		{$R-}
37
38	+	{$IFDEF FPC}
39		{$Mode Delphi}
40	+	{$codepage UTF8}
41	+	{$ENDIF}
42
43		{$IFDEF DELPHI}
44		{$DEFINE TDBDFIELD_IS_BCD}
#	Line 55 \| 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 77 \| 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(UpdateKind: TUpdateKind; QryResults: IResults; Buffer: PChar);
80		property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
81		public
82		constructor Create(AOwner: TComponent); override;
#	Line 88 \| 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;
101	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
102	<	fdCodePage: TSystemCodePage;
103	<	{$ENDIF}
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 113 \| 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 125 \| 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: 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 142 \| Line 196 \| type
196		procedure SetAsString(const Value: string); override;
197		property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
198		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
199	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
200	<	private
201	<	FCodePage: TSystemCodePage;
148	<	public
149	<	property CodePage: TSystemCodePage read FCodePage write FCodePage;
150	<	{$ENDIF}
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 158 \| 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 166 \| 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}
#	Line 181 \| Line 272 \| type
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;
#	Line 192 \| Line 284 \| type
284		published
285		property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
286		write FDisplayTextAsClassName;
195	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
287		private
288		FCodePage: TSystemCodePage;
289		FFCodePage: TSystemCodePage;
290		public
291		property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
201	–	{$ENDIF}
292		end;
293
294		TIBDataLink = class(TDetailDataLink)
#	Line 225 \| 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 256 \| 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 270 \| Line 371 \| type
371
372		TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
373
374	+	TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object;
375	+
376		TIBCustomDataSet = class(TDataset)
377		private
378	+	FAllowAutoActivateTransaction: Boolean;
379	+	FArrayFieldCount: integer;
380	+	FArrayCacheOffset: integer;
381		FAutoCommit: TIBAutoCommit;
382		FGenerateParamNames: Boolean;
383		FGeneratorField: TIBGenerator;
384		FNeedsRefresh: Boolean;
385		FForcedRefresh: Boolean;
386		FDidActivate: Boolean;
281	–	FIBLoaded: Boolean;
387		FBase: TIBBase;
388		FBlobCacheOffset: Integer;
389		FBlobStreamList: TList;
390	+	FArrayList: TList;
391		FBufferChunks: Integer;
392		FBufferCache,
393		FOldBufferCache: PChar;
#	Line 299 \| Line 405 \| type
405		FDeletedRecords: Long;
406		FModelBuffer,
407		FOldBuffer: PChar;
408	+	FOnDeleteReturning: TOnDeleteReturning;
409		FOnValidatePost: TOnValidatePost;
410		FOpen: Boolean;
411		FInternalPrepared: Boolean;
#	Line 307 \| Line 414 \| type
414		FQRefresh,
415		FQSelect,
416		FQModify: TIBSQL;
417	+	FDatabaseInfo: TIBDatabaseInfo;
418		FRecordBufferSize: Integer;
419		FRecordCount: Integer;
420		FRecordSize: Integer;
#	Line 335 \| Line 443 \| type
443		FCloseAction: TTransactionAction;
444		FInTransactionEnd: boolean;
445		FIBLinks: TList;
446	<	function GetSelectStmtHandle: TISC_STMT_HANDLE;
446	>	FFieldColumns: PFieldColumns;
447	>	FBufferUpdatedOnQryReturn: boolean;
448	>	procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
449	>	FieldIndex: integer; Buffer: PChar);
450	>	procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
451	>	function GetSelectStmtIntf: IStatement;
452		procedure SetUpdateMode(const Value: TUpdateMode);
453		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
454
#	Line 347 \| Line 460 \| type
460		function CanRefresh: Boolean;
461		procedure CheckEditState;
462		procedure ClearBlobCache;
463	+	procedure ClearArrayCache;
464		procedure ClearIBLinks;
465		procedure CopyRecordBuffer(Source, Dest: Pointer);
466		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
#	Line 355 \| Line 469 \| type
469		procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
470		procedure DoAfterTransactionEnd(Sender: TObject);
471		procedure DoTransactionFree(Sender: TObject);
472	+	procedure DoDeleteReturning(QryResults: IResults);
473		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
474		Buffer: PChar);
475		function GetDatabase: TIBDatabase;
361	–	function GetDBHandle: PISC_DB_HANDLE;
476		function GetDeleteSQL: TStrings;
477		function GetInsertSQL: TStrings;
478	<	function GetSQLParams: TIBXSQLDA;
478	>	function GetSQLParams: ISQLParams;
479		function GetRefreshSQL: TStrings;
480		function GetSelectSQL: TStrings;
481	<	function GetStatementType: TIBSQLTypes;
481	>	function GetStatementType: TIBSQLStatementTypes;
482		function GetModifySQL: TStrings;
483		function GetTransaction: TIBTransaction;
370	–	function GetTRHandle: PISC_TR_HANDLE;
484		function GetParser: TSelectSQLParser;
485		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
486		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
#	Line 382 \| Line 495 \| type
495		procedure SetDatabase(Value: TIBDatabase);
496		procedure SetDeleteSQL(Value: TStrings);
497		procedure SetInsertSQL(Value: TStrings);
498	<	procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
498	>	procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
499		procedure SetRefreshSQL(Value: TStrings);
500		procedure SetSelectSQL(Value: TStrings);
501		procedure SetModifySQL(Value: TStrings);
502		procedure SetTransaction(Value: TIBTransaction);
503		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
504		procedure SetUniDirectional(Value: Boolean);
505	+	procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
506		procedure RefreshParams;
507		function AdjustPosition(FCache: PChar; Offset: DWORD;
508		Origin: Integer): DWORD;
#	Line 422 \| Line 536 \| type
536		procedure SQLChanging(Sender: TObject); virtual;
537		procedure SQLChanged(Sender: TObject); virtual;
538
539	<	(* { IProviderSupport }
539	>	{ IProviderSupport }
540		procedure PSEndTransaction(Commit: Boolean); override;
541		function PSExecuteStatement(const ASQL: string; AParams: TParams;
542		ResultSet: Pointer = nil): Integer; override;
#	Line 435 \| Line 549 \| type
549		procedure PSStartTransaction; override;
550		procedure PSReset; override;
551		function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
552	<	*)
552	>
553		{ TDataSet support }
554		procedure InternalInsert; override;
555		procedure InitRecord(Buffer: PChar); override;
#	Line 499 \| Line 613 \| type
613		protected
614		{Likely to be made public by descendant classes}
615		property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
616	<	property SQLParams: TIBXSQLDA read GetSQLParams;
617	<	property Params: TIBXSQLDA read GetSQLParams;
616	>	property SQLParams: ISQLParams read GetSQLParams;
617	>	property Params: ISQLParams read GetSQLParams;
618		property InternalPrepared: Boolean read FInternalPrepared;
619		property QDelete: TIBSQL read FQDelete;
620		property QInsert: TIBSQL read FQInsert;
621		property QRefresh: TIBSQL read FQRefresh;
622		property QSelect: TIBSQL read FQSelect;
623		property QModify: TIBSQL read FQModify;
624	<	property StatementType: TIBSQLTypes read GetStatementType;
625	<	property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
624	>	property StatementType: TIBSQLStatementTypes read GetStatementType;
625	>	property SelectStmtHandle: IStatement read GetSelectStmtIntf;
626
627		{Likely to be made published by descendant classes}
628		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
#	Line 559 \| Line 673 \| type
673		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
674		function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
675		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
676	+	function GetArray(Field: TIBArrayField): IArray;
677	+	procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
678		function GetCurrentRecord(Buffer: PChar): Boolean; override;
679		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
680		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (override;)
#	Line 572 \| Line 688 \| type
688		function UpdateStatus: TUpdateStatus; override;
689		function IsSequenced: Boolean; override;
690		procedure Post; override;
691	<	function ParamByName(ParamName: String): TIBXSQLVAR;
692	<	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
693	<	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
691	>	function ParamByName(ParamName: String): ISQLParam;
692	>	property ArrayFieldCount: integer read FArrayFieldCount;
693	>	property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
694		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
695		property UpdatesPending: Boolean read FUpdatesPending;
696		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
#	Line 583 \| Line 699 \| type
699		read FDataSetCloseAction write FDataSetCloseAction;
700
701		published
702	+	property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
703	+	write FAllowAutoActivateTransaction;
704		property Database: TIBDatabase read GetDatabase write SetDatabase;
705		property Transaction: TIBTransaction read GetTransaction
706		write SetTransaction;
#	Line 617 \| Line 735 \| type
735		write FOnUpdateError;
736		property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
737		write FOnUpdateRecord;
738	+	property OnDeleteReturning: TOnDeleteReturning read FOnDeleteReturning
739	+	write FOnDeleteReturning;
740		end;
741
742		TIBParserDataSet = class(TIBCustomDataSet)
#	Line 703 \| Line 823 \| type
823		property OnNewRecord;
824		property OnPostError;
825		property OnValidatePost;
826	+	property OnDeleteReturning;
827		end;
828
829		{ TIBDSBlobStream }
#	Line 723 \| Line 844 \| type
844		function Write(const Buffer; Count: Longint): Longint; override;
845		end;
846
847	+	{Extended Field Def for character set info}
848	+
849	+	{ TIBFieldDef }
850	+
851	+	TIBFieldDef = class(TFieldDef)
852	+	private
853	+	FArrayBounds: TArrayBounds;
854	+	FArrayDimensions: integer;
855	+	FCharacterSetName: RawByteString;
856	+	FCharacterSetSize: integer;
857	+	FCodePage: TSystemCodePage;
858	+	FIdentityColumn: boolean;
859	+	FRelationName: string;
860	+	FDataSize: integer;
861	+	published
862	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
863	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
864	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
865	+	property DataSize: integer read FDataSize write FDataSize;
866	+	property RelationName: string read FRelationName write FRelationName;
867	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
868	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
869	+	property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
870	+	end;
871	+
872		const
873		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
874		nil, { ftUnknown }
875		TIBStringField, { ftString }
876	<	TSmallintField, { ftSmallint }
877	<	TIntegerField, { ftInteger }
876	>	TIBSmallintField, { ftSmallint }
877	>	TIBIntegerField, { ftInteger }
878		TWordField, { ftWord }
879		TBooleanField, { ftBoolean }
880		TFloatField, { ftFloat }
#	Line 750 \| Line 896 \| DefaultFieldClasses: array[TFieldType] o
896		nil, { ftCursor }
897		TStringField, { ftFixedChar }
898		nil, { ftWideString }
899	<	TLargeIntField, { ftLargeInt }
899	>	TIBLargeIntField, { ftLargeInt }
900		nil, { ftADT }
901	<	nil, { ftArray }
901	>	TIBArrayField, { ftArray }
902		nil, { ftReference }
903		nil, { ftDataSet }
904		TBlobField, { ftOraBlob }
#	Line 781 \| Line 927 \| DefaultFieldClasses: array[TFieldType] o
927
928		implementation
929
930	<	uses IBIntf, Variants, FmtBCD, LazUTF8, IBCodePage;
930	>	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
931
932		const FILE_BEGIN = 0;
933		FILE_CURRENT = 1;
#	Line 794 \| Line 940 \| type
940		FieldName : String;
941		COMPUTED_BLR : Boolean;
942		DEFAULT_VALUE : boolean;
943	+	IDENTITY_COLUMN : boolean;
944		NextField : TFieldNode;
945		end;
946
#	Line 804 \| Line 951 \| type
951		NextRelation : TRelationNode;
952		end;
953
807	–	{Extended Field Def for character set info}
808	–
809	–	{ TIBFieldDef }
810	–
811	–	TIBFieldDef = class(TFieldDef)
812	–	private
813	–	FCharacterSetName: RawByteString;
814	–	FCharacterSetSize: integer;
815	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
816	–	FCodePage: TSystemCodePage;
817	–	{$ENDIF}
818	–	published
819	–	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
820	–	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
821	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
822	–	property CodePage: TSystemCodePage read FCodePage write FCodePage;
823	–	{$ENDIF}
824	–	end;
825	–
954
955		{ Copied from LCLProc in order to avoid LCL dependency
956
#	Line 865 \| Line 993 \| type
993		Result := str;
994		end;
995
996	+	{ TIBLargeIntField }
997	+
998	+	procedure TIBLargeIntField.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	+	{ TIBIntegerField }
1006	+
1007	+	procedure TIBIntegerField.Bind(Binding: Boolean);
1008	+	begin
1009	+	inherited Bind(Binding);
1010	+	if Binding and (FieldDef <> nil) then
1011	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1012	+	end;
1013	+
1014	+	{ TIBSmallintField }
1015	+
1016	+	procedure TIBSmallintField.Bind(Binding: Boolean);
1017	+	begin
1018	+	inherited Bind(Binding);
1019	+	if Binding and (FieldDef <> nil) then
1020	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1021	+	end;
1022	+
1023	+	{ TIBArray }
1024	+
1025	+	procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
1026	+	begin
1027	+	case Reason of
1028	+	arChanging:
1029	+	if FRecNo <> FField.Dataset.RecNo then
1030	+	IBError(ibxeNotCurrentArray,[nil]);
1031	+
1032	+	arChanged:
1033	+	FField.DataChanged;
1034	+	end;
1035	+	end;
1036	+
1037	+	constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
1038	+	begin
1039	+	inherited Create;
1040	+	FField := aField;
1041	+	FArray := anArray;
1042	+	FRecNo := FField.Dataset.RecNo;
1043	+	FArray.AddEventHandler(EventHandler);
1044	+	end;
1045	+
1046	+	destructor TIBArray.Destroy;
1047	+	begin
1048	+	FArray.RemoveEventHandler(EventHandler);
1049	+	inherited Destroy;
1050	+	end;
1051	+
1052	+	{ TIBArrayField }
1053	+
1054	+	function TIBArrayField.GetArrayIntf: IArray;
1055	+	begin
1056	+	Result := TIBCustomDataSet(DataSet).GetArray(self);
1057	+	end;
1058	+
1059	+	function TIBArrayField.GetArrayID: TISC_QUAD;
1060	+	begin
1061	+	GetData(@Result);
1062	+	end;
1063	+
1064	+	procedure TIBArrayField.SetArrayIntf(AValue: IArray);
1065	+	begin
1066	+	TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
1067	+	DataChanged;
1068	+	end;
1069	+
1070	+	class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
1071	+	begin
1072	+	//Ignore
1073	+	end;
1074	+
1075	+	function TIBArrayField.GetAsString: string;
1076	+	begin
1077	+	Result := '(Array)';
1078	+	end;
1079	+
1080	+	function TIBArrayField.GetDataSize: Integer;
1081	+	begin
1082	+	Result := sizeof(TISC_QUAD);
1083	+	end;
1084	+
1085	+	procedure TIBArrayField.Bind(Binding: Boolean);
1086	+	begin
1087	+	inherited Bind(Binding);
1088	+	if Binding then
1089	+	begin
1090	+	FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
1091	+	Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
1092	+	if FieldDef <> nil then
1093	+	begin
1094	+	FRelationName := TIBFieldDef(FieldDef).FRelationName;
1095	+	FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1096	+	FArrayBounds := TIBFieldDef(FieldDef).ArrayBounds;
1097	+	end;
1098	+	end;
1099	+	end;
1100	+
1101	+	constructor TIBArrayField.Create(AOwner: TComponent);
1102	+	begin
1103	+	inherited Create(AOwner);
1104	+	SetDataType(ftArray);
1105	+	end;
1106	+
1107	+	function TIBArrayField.CreateArray: IArray;
1108	+	begin
1109	+	with DataSet as TIBCustomDataSet do
1110	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1111	+	end;
1112	+
1113		{ TIBMemoField }
1114
1115		function TIBMemoField.GetTruncatedText: string;
#	Line 884 \| Line 1129 \| begin
1129		{2: case 2 ignored. This should be handled by TIBWideMemo}
1130
1131		3, {Assume UNICODE_FSS is really UTF8}
1132	<	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1132	>	4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1133		if DisplayWidth = 0 then
1134	<	Result := ValidUTF8String(TextToSingleLine(Result))
1134	>	Result := Utf8EscapeControlChars(TextToSingleLine(Result))
1135		else
1136		if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1137	<	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1137	>	Result := Utf8EscapeControlChars(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1138		end;
1139		end
1140		end;
1141
1142	+	procedure TIBMemoField.Bind(Binding: Boolean);
1143	+	var IBFieldDef: TIBFieldDef;
1144	+	begin
1145	+	inherited Bind(Binding);
1146	+	if Binding and (FieldDef <> nil) then
1147	+	begin
1148	+	IBFieldDef := FieldDef as TIBFieldDef;
1149	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
1150	+	CharacterSetName := IBFieldDef.CharacterSetName;
1151	+	CodePage := IBFieldDef.CodePage;
1152	+	end;
1153	+	end;
1154	+
1155		function TIBMemoField.GetAsString: string;
1156		var s: RawByteString;
1157		begin
1158		s := inherited GetAsString;
901	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1159		SetCodePage(s,CodePage,false);
1160		if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1161		SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
905	–	{$ENDIF}
1162		Result := s;
1163		end;
1164
#	Line 931 \| Line 1187 \| procedure TIBMemoField.SetAsString(const
1187		var s: RawByteString;
1188		begin
1189		s := AValue;
1190	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
935	<	if StringCodePage(Value) <> CodePage then
1190	>	if StringCodePage(s) <> CodePage then
1191		SetCodePage(s,CodePage,CodePage<>CP_NONE);
937	–	{$ENDIF}
1192		inherited SetAsString(s);
1193		end;
1194
#	Line 942 \| Line 1196 \| constructor TIBMemoField.Create(AOwner:
1196		begin
1197		inherited Create(AOwner);
1198		BlobType := ftMemo;
945	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1199		FCodePage := CP_NONE;
947	–	{$ENDIF}
1200		end;
1201
1202		{ TIBControlLink }
#	Line 978 \| Line 1230 \| end;
1230
1231		{ TIBStringField}
1232
1233	<	function TIBStringField.GetDefaultWidth: Longint;
1233	>	procedure TIBStringField.Bind(Binding: Boolean);
1234	>	var IBFieldDef: TIBFieldDef;
1235		begin
1236	<	Result := Size div CharacterSetSize;
1236	>	inherited Bind(Binding);
1237	>	if Binding and (FieldDef <> nil) then
1238	>	begin
1239	>	IBFieldDef := FieldDef as TIBFieldDef;
1240	>	CharacterSetSize := IBFieldDef.CharacterSetSize;
1241	>	CharacterSetName := IBFieldDef.CharacterSetName;
1242	>	FDataSize := IBFieldDef.DataSize + 1;
1243	>	if AutoFieldSize then
1244	>	Size := IBFieldDef.Size;
1245	>	CodePage := IBFieldDef.CodePage;
1246	>	end;
1247	>	end;
1248	>
1249	>	function TIBStringField.GetDataSize: Integer;
1250	>	begin
1251	>	Result := FDataSize;
1252		end;
1253
1254		constructor TIBStringField.Create(aOwner: TComponent);
1255		begin
1256		inherited Create(aOwner);
1257		FCharacterSetSize := 1;
990	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1258		FCodePage := CP_NONE;
1259	<	{$ENDIF}
1259	>	FAutoFieldSize := true;
1260		end;
1261
1262		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 1013 \| Line 1280 \| function TIBStringField.GetValue(var Val
1280		var
1281		Buffer: PChar;
1282		s: RawByteString;
1016	–	// i: integer;
1283		begin
1284		Buffer := nil;
1285	<	IBAlloc(Buffer, 0, Size + 1);
1285	>	IBAlloc(Buffer, 0, DataSize);
1286		try
1287		Result := GetData(Buffer);
1288		if Result then
1289		begin
1290	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1025	<	s := string(Buffer);
1290	>	s := strpas(Buffer);
1291		SetCodePage(s,CodePage,false);
1292		if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1293		SetCodePage(s,CP_UTF8,true); {LCL only accepts UTF8}
1294		Value := s;
1295	<	(* write(FieldName,': ', StringCodePage(Value),', ',Value,' ');
1031	<	for i := 1 to Length(Value) do
1032	<	write(Format('%x ',[byte(Value[i])]));
1033	<	writeln;*)
1034	<	{$ELSE}
1035	<	Value := string(Buffer);
1036	<	{$ENDIF}
1295	>	// writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1296		if Transliterate and (Value <> '') then
1297		DataSet.Translate(PChar(Value), PChar(Value), False);
1298		end
#	Line 1048 \| Line 1307 \| var
1307		s: RawByteString;
1308		begin
1309		Buffer := nil;
1310	<	IBAlloc(Buffer, 0, Size + 1);
1310	>	IBAlloc(Buffer, 0, DataSize);
1311		try
1312		s := Value;
1054	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1313		if StringCodePage(s) <> CodePage then
1314		SetCodePage(s,CodePage,CodePage<>CP_NONE);
1315	<	{$ENDIF}
1058	<	StrLCopy(Buffer, PChar(s), Size);
1315	>	StrLCopy(Buffer, PChar(s), DataSize-1);
1316		if Transliterate then
1317		DataSet.Translate(Buffer, Buffer, True);
1318		SetData(Buffer);
#	Line 1074 \| Line 1331 \| begin
1331		Size := 8;
1332		end;
1333
1334	+	procedure TIBBCDField.Bind(Binding: Boolean);
1335	+	begin
1336	+	inherited Bind(Binding);
1337	+	if Binding and (FieldDef <> nil) then
1338	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1339	+	end;
1340	+
1341		class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1342		begin
1343		{ No need to check as the base type is currency, not BCD }
#	Line 1158 \| Line 1422 \| end;
1422		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1423		begin
1424		inherited Create(AOwner);
1161	–	FIBLoaded := False;
1162	–	CheckIBLoaded;
1163	–	FIBLoaded := True;
1425		FBase := TIBBase.Create(Self);
1426	+	FDatabaseInfo := TIBDatabaseInfo.Create(self);
1427		FIBLinks := TList.Create;
1428		FCurrentRecord := -1;
1429		FDeletedRecords := 0;
1430		FUniDirectional := False;
1431		FBufferChunks := BufferCacheSize;
1432		FBlobStreamList := TList.Create;
1433	+	FArrayList := TList.Create;
1434		FGeneratorField := TIBGenerator.Create(self);
1435		FDataLink := TIBDataLink.Create(Self);
1436		FQDelete := TIBSQL.Create(Self);
#	Line 1211 \| Line 1474 \| end;
1474		destructor TIBCustomDataSet.Destroy;
1475		begin
1476		if Active then Active := false;
1477	<	if FIBLoaded then
1478	<	begin
1479	<	if assigned(FGeneratorField) then FGeneratorField.Free;
1480	<	FDataLink.Free;
1481	<	FBase.Free;
1482	<	ClearBlobCache;
1483	<	ClearIBLinks;
1484	<	FIBLinks.Free;
1485	<	FBlobStreamList.Free;
1486	<	FreeMem(FBufferCache);
1487	<	FBufferCache := nil;
1488	<	FreeMem(FOldBufferCache);
1489	<	FOldBufferCache := nil;
1490	<	FCacheSize := 0;
1491	<	FOldCacheSize := 0;
1229	<	FMappedFieldPosition := nil;
1230	<	end;
1477	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1478	>	FDataLink.Free;
1479	>	FBase.Free;
1480	>	ClearBlobCache;
1481	>	ClearIBLinks;
1482	>	FIBLinks.Free;
1483	>	FBlobStreamList.Free;
1484	>	FArrayList.Free;
1485	>	FreeMem(FBufferCache);
1486	>	FBufferCache := nil;
1487	>	FreeMem(FOldBufferCache);
1488	>	FOldBufferCache := nil;
1489	>	FCacheSize := 0;
1490	>	FOldCacheSize := 0;
1491	>	FMappedFieldPosition := nil;
1492		if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1493		if assigned(FParser) then FParser.Free;
1494		inherited Destroy;
#	Line 1252 \| Line 1513 \| begin
1513		Inc(FCurrentRecord);
1514		if (FCurrentRecord = FRecordCount) then
1515		begin
1516	<	if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1516	>	if (not FQSelect.EOF) and FQSelect.Next then
1517		begin
1518		FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1519		Inc(FRecordCount);
#	Line 1271 \| Line 1532 \| end;
1532
1533		procedure TIBCustomDataSet.ApplyUpdates;
1534		var
1274	–	{$IFDEF NEW_TBOOKMARK }
1535		CurBookmark: TBookmark;
1276	–	{$ELSE}
1277	–	CurBookmark: string;
1278	–	{$ENDIF}
1536		Buffer: PRecordData;
1537		CurUpdateTypes: TIBUpdateRecordTypes;
1538		UpdateAction: TIBUpdateAction;
#	Line 1506 \| Line 1763 \| end;
1763		function TIBCustomDataSet.ActivateTransaction: Boolean;
1764		begin
1765		Result := False;
1766	<	if not Assigned(Transaction) then
1510	<	IBError(ibxeTransactionNotAssigned, [nil]);
1511	<	if not Transaction.Active then
1766	>	if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1767		begin
1768	<	Result := True;
1769	<	Transaction.StartTransaction;
1770	<	FDidActivate := True;
1768	>	if not Assigned(Transaction) then
1769	>	IBError(ibxeTransactionNotAssigned, [nil]);
1770	>	if not Transaction.Active then
1771	>	begin
1772	>	Result := True;
1773	>	Transaction.StartTransaction;
1774	>	FDidActivate := True;
1775	>	end;
1776		end;
1777		end;
1778
#	Line 1637 \| Line 1897 \| begin
1897		FBlobStreamList.Pack;
1898		end;
1899
1900	+	procedure TIBCustomDataSet.ClearArrayCache;
1901	+	var
1902	+	i: Integer;
1903	+	begin
1904	+	for i := 0 to FArrayList.Count - 1 do
1905	+	begin
1906	+	TIBArray(FArrayList[i]).Free;
1907	+	FArrayList[i] := nil;
1908	+	end;
1909	+	FArrayList.Pack;
1910	+	end;
1911	+
1912		procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1913		begin
1914		Move(Source^, Dest^, FRecordBufferSize);
#	Line 1646 \| Line 1918 \| procedure TIBCustomDataSet.DoBeforeDatab
1918		begin
1919		if Active then
1920		Active := False;
1921	<	FInternalPrepared := False;
1921	>	InternalUnPrepare;
1922		if Assigned(FBeforeDatabaseDisconnect) then
1923		FBeforeDatabaseDisconnect(Sender);
1924		end;
#	Line 1684 \| Line 1956 \| begin
1956		FQModify.FreeHandle;
1957		if FQRefresh <> nil then
1958		FQRefresh.FreeHandle;
1959	+	InternalUnPrepare;
1960		if Assigned(FBeforeTransactionEnd) then
1961		FBeforeTransactionEnd(Sender);
1962		end;
#	Line 1700 \| Line 1973 \| begin
1973		FTransactionFree(Sender);
1974		end;
1975
1976	<	{ Read the record from FQSelect.Current into the record buffer
1977	<	Then write the buffer to in memory cache }
1978	<	procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1979	<	RecordNumber: Integer; Buffer: PChar);
1980	<	var
1981	<	p: PRecordData;
1982	<	pbd: PBlobDataArray;
1983	<	i, j: Integer;
1984	<	LocalData: Pointer;
1985	<	LocalDate, LocalDouble: Double;
1986	<	LocalInt: Integer;
1714	<	LocalBool: wordBool;
1715	<	LocalInt64: Int64;
1716	<	LocalCurrency: Currency;
1717	<	FieldsLoaded: Integer;
1976	>	procedure TIBCustomDataSet.DoDeleteReturning(QryResults: IResults);
1977	>	begin
1978	>	if assigned(FOnDeleteReturning) then
1979	>	OnDeleteReturning(self,QryResults);
1980	>	end;
1981	>
1982	>	procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1983	>	var i, j: Integer;
1984	>	FieldsLoaded: integer;
1985	>	p: PRecordData;
1986	>	colMetadata: IColumnMetaData;
1987		begin
1988		p := PRecordData(Buffer);
1720	–	{ Make sure blob cache is empty }
1721	–	pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1722	–	if RecordNumber > -1 then
1723	–	for i := 0 to BlobFieldCount - 1 do
1724	–	pbd^[i] := nil;
1989		{ Get record information }
1990		p^.rdBookmarkFlag := bfCurrent;
1991	<	p^.rdFieldCount := Qry.Current.Count;
1992	<	p^.rdRecordNumber := RecordNumber;
1991	>	p^.rdFieldCount := Qry.FieldCount;
1992	>	p^.rdRecordNumber := -1;
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.MetaData.Count - 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
1750	<	if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
1751	<	begin
1752	<	if sqllen <= 8 then
1753	<	p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
1754	<	continue;
1755	<	end;
1756	<	if j > 0 then with p^ do
2014	>	if j > 0 then
2015		begin
2016	<	rdFields[j].fdDataType :=
2017	<	Qry.Current[i].Data^.sqltype and (not 1);
2018	<	rdFields[j].fdDataScale :=
2019	<	Qry.Current[i].Data^.sqlscale;
2020	<	rdFields[j].fdNullable :=
2021	<	(Qry.Current[i].Data^.sqltype and 1 = 1);
2022	<	rdFields[j].fdIsNull :=
2023	<	(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
2024	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
2025	<	rdFields[j].fdCodePage := 0;
2026	<	{$ENDIF}
2027	<	LocalData := Qry.Current[i].Data^.sqldata;
2028	<	case rdFields[j].fdDataType of
2029	<	SQL_TIMESTAMP:
2016	>	colMetadata := Qry.MetaData[i];
2017	>	with p^.rdFields[j], FFieldColumns^[j] do
2018	>	begin
2019	>	fdDataType := colMetadata.GetSQLType;
2020	>	if fdDataType = SQL_BLOB then
2021	>	fdDataScale := 0
2022	>	else
2023	>	fdDataScale := colMetadata.getScale;
2024	>	fdNullable := colMetadata.getIsNullable;
2025	>	fdIsNull := true;
2026	>	fdDataSize := colMetadata.GetSize;
2027	>	fdDataLength := 0;
2028	>	fdCodePage := CP_NONE;
2029	>
2030	>	case fdDataType of
2031	>	SQL_TIMESTAMP,
2032	>	SQL_TYPE_DATE,
2033	>	SQL_TYPE_TIME:
2034	>	fdDataSize := SizeOf(TDateTime);
2035	>	SQL_SHORT, SQL_LONG:
2036		begin
2037	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2038	<	if RecordNumber >= 0 then
2039	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
2040	<	LocalData := PChar(@LocalDate);
2037	>	if (fdDataScale = 0) then
2038	>	fdDataSize := SizeOf(Integer)
2039	>	else
2040	>	if (fdDataScale >= (-4)) then
2041	>	fdDataSize := SizeOf(Currency)
2042	>	else
2043	>	fdDataSize := SizeOf(Double);
2044		end;
2045	<	SQL_TYPE_DATE:
2045	>	SQL_INT64:
2046		begin
2047	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2048	<	if RecordNumber >= 0 then
2049	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
2050	<	LocalData := PChar(@LocalInt);
2047	>	if (fdDataScale = 0) then
2048	>	fdDataSize := SizeOf(Int64)
2049	>	else
2050	>	if (fdDataScale >= (-4)) then
2051	>	fdDataSize := SizeOf(Currency)
2052	>	else
2053	>	fdDataSize := SizeOf(Double);
2054		end;
2055	<	SQL_TYPE_TIME:
2055	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2056	>	fdDataSize := SizeOf(Double);
2057	>	SQL_BOOLEAN:
2058	>	fdDataSize := SizeOf(wordBool);
2059	>	SQL_VARYING,
2060	>	SQL_TEXT,
2061	>	SQL_BLOB:
2062	>	fdCodePage := Qry.Metadata[i].getCodePage;
2063	>	end;
2064	>	fdDataOfs := FRecordSize;
2065	>	Inc(FRecordSize, fdDataSize);
2066	>	end;
2067	>	end;
2068	>	end;
2069	>	end;
2070	>
2071	>	{Update Buffer Fields from Query Results}
2072	>
2073	>	procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2074	>	Buffer: PChar);
2075	>	var i, j: integer;
2076	>	begin
2077	>	for i := 0 to QryResults.Count - 1 do
2078	>	begin
2079	>	j := GetFieldPosition(QryResults[i].GetAliasName);
2080	>	if j > 0 then
2081	>	begin
2082	>	ColumnDataToBuffer(QryResults,i,j,Buffer);
2083	>	FBufferUpdatedOnQryReturn := true;
2084	>	end;
2085	>	end;
2086	>	end;
2087	>
2088	>
2089	>	{Move column data returned from query to row buffer}
2090	>
2091	>	procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2092	>	ColumnIndex, FieldIndex: integer; Buffer: PChar);
2093	>	var
2094	>	LocalData: PByte;
2095	>	LocalDate: TDateTime;
2096	>	LocalDouble: Double;
2097	>	LocalInt: Integer;
2098	>	LocalBool: wordBool;
2099	>	LocalInt64: Int64;
2100	>	LocalCurrency: Currency;
2101	>	ColData: ISQLData;
2102	>	begin
2103	>	LocalData := nil;
2104	>	with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2105	>	begin
2106	>	QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2107	>	if not fdIsNull then
2108	>	begin
2109	>	ColData := QryResults[ColumnIndex];
2110	>	case fdDataType of {Get Formatted data for column types that need formatting}
2111	>	SQL_TYPE_DATE,
2112	>	SQL_TYPE_TIME,
2113	>	SQL_TIMESTAMP:
2114		begin
2115	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2116	<	if RecordNumber >= 0 then
2117	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1790	<	LocalData := PChar(@LocalInt);
2115	>	{This is an IBX native format and not the TDataset approach. See also GetFieldData}
2116	>	LocalDate := ColData.AsDateTime;
2117	>	LocalData := PByte(@LocalDate);
2118		end;
2119		SQL_SHORT, SQL_LONG:
2120		begin
2121	<	if (rdFields[j].fdDataScale = 0) then
2121	>	if (fdDataScale = 0) then
2122		begin
2123	<	rdFields[j].fdDataSize := SizeOf(Integer);
2124	<	if RecordNumber >= 0 then
1798	<	LocalInt := Qry.Current[i].AsLong;
1799	<	LocalData := PChar(@LocalInt);
2123	>	LocalInt := ColData.AsLong;
2124	>	LocalData := PByte(@LocalInt);
2125		end
2126	<	else if (rdFields[j].fdDataScale >= (-4)) then
2127	<	begin
2128	<	rdFields[j].fdDataSize := SizeOf(Currency);
2129	<	if RecordNumber >= 0 then
2130	<	LocalCurrency := Qry.Current[i].AsCurrency;
2131	<	LocalData := PChar(@LocalCurrency);
2132	<	end
2133	<	else begin
2134	<	rdFields[j].fdDataSize := SizeOf(Double);
2135	<	if RecordNumber >= 0 then
2136	<	LocalDouble := Qry.Current[i].AsDouble;
1812	<	LocalData := PChar(@LocalDouble);
1813	<	end;
2126	>	else
2127	>	if (fdDataScale >= (-4)) then
2128	>	begin
2129	>	LocalCurrency := ColData.AsCurrency;
2130	>	LocalData := PByte(@LocalCurrency);
2131	>	end
2132	>	else
2133	>	begin
2134	>	LocalDouble := ColData.AsDouble;
2135	>	LocalData := PByte(@LocalDouble);
2136	>	end;
2137		end;
2138		SQL_INT64:
2139		begin
2140	<	if (rdFields[j].fdDataScale = 0) then
2140	>	if (fdDataScale = 0) then
2141		begin
2142	<	rdFields[j].fdDataSize := SizeOf(Int64);
2143	<	if RecordNumber >= 0 then
1821	<	LocalInt64 := Qry.Current[i].AsInt64;
1822	<	LocalData := PChar(@LocalInt64);
2142	>	LocalInt64 := ColData.AsInt64;
2143	>	LocalData := PByte(@LocalInt64);
2144		end
2145	<	else if (rdFields[j].fdDataScale >= (-4)) then
2146	<	begin
1826	<	rdFields[j].fdDataSize := SizeOf(Currency);
1827	<	if RecordNumber >= 0 then
1828	<	LocalCurrency := Qry.Current[i].AsCurrency;
1829	<	LocalData := PChar(@LocalCurrency);
1830	<	end
1831	<	else begin
1832	<	rdFields[j].fdDataSize := SizeOf(Double);
1833	<	if RecordNumber >= 0 then
1834	<	LocalDouble := Qry.Current[i].AsDouble;
1835	<	LocalData := PChar(@LocalDouble);
1836	<	end
1837	<	end;
1838	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1839	<	begin
1840	<	rdFields[j].fdDataSize := SizeOf(Double);
1841	<	if RecordNumber >= 0 then
1842	<	LocalDouble := Qry.Current[i].AsDouble;
1843	<	LocalData := PChar(@LocalDouble);
1844	<	end;
1845	<	SQL_VARYING:
1846	<	begin
1847	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1848	<	rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1849	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1850	<	TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1851	<	rdFields[j].fdCodePage);
1852	<	{$ENDIF}
1853	<	if RecordNumber >= 0 then
2145	>	else
2146	>	if (fdDataScale >= (-4)) then
2147		begin
2148	<	if (rdFields[j].fdDataLength = 0) then
2149	<	LocalData := nil
2148	>	LocalCurrency := ColData.AsCurrency;
2149	>	LocalData := PByte(@LocalCurrency);
2150	>	end
2151		else
2152	<	Inc(LocalData,2);
2153	<	end;
2152	>	begin
2153	>	LocalDouble := ColData.AsDouble;
2154	>	LocalData := PByte(@LocalDouble);
2155	>	end
2156		end;
2157	<	SQL_BOOLEAN:
2157	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2158		begin
2159	<	LocalBool:= false;
2160	<	rdFields[j].fdDataSize := SizeOf(wordBool);
1865	<	if RecordNumber >= 0 then
1866	<	LocalBool := Qry.Current[i].AsBoolean;
1867	<	LocalData := PChar(@LocalBool);
2159	>	LocalDouble := ColData.AsDouble;
2160	>	LocalData := PByte(@LocalDouble);
2161		end;
2162	<	SQL_TEXT:
1870	<	begin
1871	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1872	<	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1873	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1874	<	TFirebirdCharacterSets.CharSetID2CodePage(Qry.Current[i].Data^.sqlsubtype and $FF,
1875	<	rdFields[j].fdCodePage);
1876	<	{$ENDIF}
1877	<	end;
1878	<	else { SQL_BLOB, SQL_ARRAY, SQL_QUAD }
2162	>	SQL_BOOLEAN:
2163		begin
2164	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2164	>	LocalBool := ColData.AsBoolean;
2165	>	LocalData := PByte(@LocalBool);
2166		end;
2167		end;
2168	<	if RecordNumber < 0 then
2168	>
2169	>	if fdDataType = SQL_VARYING then
2170	>	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2171	>	else
2172	>	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2173	>	end
2174	>	else {Null column}
2175	>	if fdDataType = SQL_VARYING then
2176	>	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2177	>	else
2178	>	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2179	>	end;
2180	>	end;
2181	>
2182	>	{ Read the record from FQSelect.Current into the record buffer
2183	>	Then write the buffer to in memory cache }
2184	>	procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
2185	>	RecordNumber: Integer; Buffer: PChar);
2186	>	var
2187	>	pbd: PBlobDataArray;
2188	>	pda: PArrayDataArray;
2189	>	i, j: Integer;
2190	>	FieldsLoaded: Integer;
2191	>	p: PRecordData;
2192	>	begin
2193	>	if RecordNumber = -1 then
2194	>	begin
2195	>	InitModelBuffer(Qry,Buffer);
2196	>	Exit;
2197	>	end;
2198	>	p := PRecordData(Buffer);
2199	>	{ Make sure blob cache is empty }
2200	>	pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
2201	>	pda := PArrayDataArray(Buffer + FArrayCacheOffset);
2202	>	for i := 0 to BlobFieldCount - 1 do
2203	>	pbd^[i] := nil;
2204	>	for i := 0 to ArrayFieldCount - 1 do
2205	>	pda^[i] := nil;
2206	>
2207	>	{ Get record information }
2208	>	p^.rdBookmarkFlag := bfCurrent;
2209	>	p^.rdFieldCount := Qry.FieldCount;
2210	>	p^.rdRecordNumber := RecordNumber;
2211	>	p^.rdUpdateStatus := usUnmodified;
2212	>	p^.rdCachedUpdateStatus := cusUnmodified;
2213	>	p^.rdSavedOffset := $FFFFFFFF;
2214	>
2215	>	{ Load up the fields }
2216	>	FieldsLoaded := FQSelect.MetaData.Count;
2217	>	j := 1;
2218	>	for i := 0 to Qry.FieldCount - 1 do
2219	>	begin
2220	>	if (Qry = FQSelect) then
2221	>	j := i + 1
2222	>	else
2223	>	begin
2224	>	if FieldsLoaded = 0 then
2225	>	break;
2226	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2227	>	if j < 1 then
2228	>	continue
2229	>	else
2230	>	Dec(FieldsLoaded);
2231	>	end;
2232	>	with FQSelect.MetaData[j - 1] do
2233	>	if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2234		begin
2235	<	rdFields[j].fdIsNull := True;
2236	<	rdFields[j].fdDataOfs := FRecordSize;
2237	<	Inc(FRecordSize, rdFields[j].fdDataSize);
1888	<	end
1889	<	else begin
1890	<	if rdFields[j].fdDataType = SQL_VARYING then
1891	<	begin
1892	<	if LocalData <> nil then
1893	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
1894	<	end
1895	<	else
1896	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2235	>	if (GetSize <= 8) then
2236	>	p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2237	>	continue;
2238		end;
2239	<	end;
2239	>	if j > 0 then
2240	>	ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2241		end;
2242	<	WriteRecordCache(RecordNumber, PChar(p));
2242	>	WriteRecordCache(RecordNumber, Buffer);
2243		end;
2244
2245		function TIBCustomDataSet.GetActiveBuf: PChar;
#	Line 1942 \| Line 2284 \| begin
2284		result := FBase.Database;
2285		end;
2286
1945	–	function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1946	–	begin
1947	–	result := FBase.DBHandle;
1948	–	end;
1949	–
2287		function TIBCustomDataSet.GetDeleteSQL: TStrings;
2288		begin
2289		result := FQDelete.SQL;
#	Line 1957 \| Line 2294 \| begin
2294		result := FQInsert.SQL;
2295		end;
2296
2297	<	function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2297	>	function TIBCustomDataSet.GetSQLParams: ISQLParams;
2298		begin
2299		if not FInternalPrepared then
2300		InternalPrepare;
#	Line 1974 \| Line 2311 \| begin
2311		result := FQSelect.SQL;
2312		end;
2313
2314	<	function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2314	>	function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2315		begin
2316	<	result := FQSelect.SQLType;
2316	>	result := FQSelect.SQLStatementType;
2317		end;
2318
2319		function TIBCustomDataSet.GetModifySQL: TStrings;
#	Line 1989 \| Line 2326 \| begin
2326		result := FBase.Transaction;
2327		end;
2328
1992	–	function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1993	–	begin
1994	–	result := FBase.TRHandle;
1995	–	end;
1996	–
2329		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2330		begin
2331		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2332		FUpdateObject.Apply(ukDelete,Buff)
2333		else
2334		begin
2335	<	SetInternalSQLParams(FQDelete, Buff);
2335	>	SetInternalSQLParams(FQDelete.Params, Buff);
2336		FQDelete.ExecQuery;
2337	+	if (FQDelete.FieldCount > 0) then
2338	+	DoDeleteReturning(FQDelete.Current);
2339		end;
2340		with PRecordData(Buff)^ do
2341		begin
#	Line 2015 \| Line 2349 \| function TIBCustomDataSet.InternalLocate
2349		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2350		var
2351		keyFieldList: TList;
2018	–	{$IFDEF NEW_TBOOKMARK }
2352		CurBookmark: TBookmark;
2020	–	{$ELSE}
2021	–	CurBookmark: string;
2022	–	{$ENDIF}
2353		fieldValue: Variant;
2354		lookupValues: array of variant;
2355		i, fieldCount: Integer;
#	Line 2101 \| Line 2431 \| end;
2431
2432		procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2433		var
2434	<	i, j, k: Integer;
2434	>	i, j, k, arr: Integer;
2435		pbd: PBlobDataArray;
2436	+	pda: PArrayDataArray;
2437		begin
2438		pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2439	<	j := 0;
2439	>	pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2440	>	j := 0; arr := 0;
2441		for i := 0 to FieldCount - 1 do
2442		if Fields[i].IsBlob then
2443		begin
#	Line 2114 \| Line 2446 \| begin
2446		begin
2447		pbd^[j].Finalize;
2448		PISC_QUAD(
2449	<	PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2449	>	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2450		pbd^[j].BlobID;
2451		PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2452	+	end
2453	+	else
2454	+	begin
2455	+	PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2456	+	with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2457	+	begin
2458	+	gds_quad_high := 0;
2459	+	gds_quad_low := 0;
2460	+	end;
2461		end;
2462		Inc(j);
2463	+	end
2464	+	else
2465	+	if Fields[i] is TIBArrayField then
2466	+	begin
2467	+	if pda^[arr] <> nil then
2468	+	begin
2469	+	k := FMappedFieldPosition[Fields[i].FieldNo -1];
2470	+	PISC_QUAD(
2471	+	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ := pda^[arr].ArrayIntf.GetArrayID;
2472	+	PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2473	+	end;
2474	+	Inc(arr);
2475		end;
2476	+	FBufferUpdatedOnQryReturn := false;
2477		if Assigned(FUpdateObject) then
2478		begin
2479		if (Qry = FQDelete) then
#	Line 2130 \| Line 2484 \| begin
2484		FUpdateObject.Apply(ukModify,Buff);
2485		end
2486		else begin
2487	<	SetInternalSQLParams(Qry, Buff);
2487	>	SetInternalSQLParams(Qry.Params, Buff);
2488		Qry.ExecQuery;
2489	+	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2490	+	UpdateRecordFromQuery(Qry.Current,Buff);
2491		end;
2492		PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2493		PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2494		SetModified(False);
2495		WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2496	<	if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
2496	>	if (FForcedRefresh or (FNeedsRefresh and not FBufferUpdatedOnQryReturn)) and CanRefresh then
2497		InternalRefreshRow;
2498		end;
2499
#	Line 2164 \| Line 2520 \| begin
2520		end
2521		else
2522		Qry := FQRefresh;
2523	<	SetInternalSQLParams(Qry, Buff);
2523	>	SetInternalSQLParams(Qry.Params, Buff);
2524		Qry.ExecQuery;
2525		try
2526	<	if (Qry.SQLType = SQLExecProcedure) or
2171	<	(Qry.Next <> nil) then
2526	>	if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2527		begin
2528		ofs := PRecordData(Buff)^.rdSavedOffset;
2529		FetchCurrentRecordToBuffer(Qry,
#	Line 2261 \| Line 2616 \| begin
2616		end;
2617
2618		procedure TIBCustomDataSet.InternalPrepare;
2264	–	var
2265	–	DidActivate: Boolean;
2619		begin
2620		if FInternalPrepared then
2621		Exit;
2269	–	DidActivate := False;
2622		FBase.SetCursor;
2623		try
2624		ActivateConnection;
2625	<	DidActivate := ActivateTransaction;
2625	>	ActivateTransaction;
2626		FBase.CheckDatabase;
2627		FBase.CheckTransaction;
2628		if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
#	Line 2308 \| Line 2660 \| begin
2660		end else
2661		IBError(ibxeEmptyQuery, [nil]);
2662		finally
2311	–	if DidActivate then
2312	–	DeactivateTransaction;
2663		FBase.RestoreCursor;
2664		end;
2665		end;
#	Line 2339 \| Line 2689 \| var
2689		begin
2690		CopyRecordBuffer(Buffer, OldBuffer);
2691		if BlobFieldCount > 0 then
2692	<	FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2692	>	FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2693	>	BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2694		0);
2695		end;
2696
#	Line 2378 \| Line 2729 \| end;
2729
2730		procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
2731		begin
2732	<	if (FBase.Database <> Value) then
2732	>	if (csLoading in ComponentState) or (FBase.Database <> Value) then
2733		begin
2734		CheckDatasetClosed;
2735	+	InternalUnPrepare;
2736		FBase.Database := Value;
2737		FQDelete.Database := Value;
2738		FQInsert.Database := Value;
2739		FQRefresh.Database := Value;
2740		FQSelect.Database := Value;
2741		FQModify.Database := Value;
2742	+	FDatabaseInfo.Database := Value;
2743	+	FGeneratorField.Database := Value;
2744		end;
2745		end;
2746
#	Line 2408 \| Line 2762 \| begin
2762		end;
2763		end;
2764
2765	<	procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2765	>	procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2766		var
2767		i, j: Integer;
2768		cr, data: PChar;
2769		fn: string;
2770		st: RawByteString;
2771		OldBuffer: Pointer;
2772	<	ts: TTimeStamp;
2772	>	Param: ISQLParam;
2773		begin
2774		if (Buffer = nil) then
2775		IBError(ibxeBufferNotSet, [nil]);
#	Line 2423 \| Line 2777 \| begin
2777		InternalPrepare;
2778		OldBuffer := nil;
2779		try
2780	<	for i := 0 to Qry.Params.Count - 1 do
2780	>	for i := 0 to Params.GetCount - 1 do
2781		begin
2782	<	fn := Qry.Params[i].Name;
2782	>	Param := Params[i];
2783	>	fn := Param.Name;
2784		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2785		begin
2786		fn := Copy(fn, 5, Length(fn));
#	Line 2445 \| Line 2800 \| begin
2800		cr := Buffer;
2801		j := FQSelect.FieldIndex[fn] + 1;
2802		if (j > 0) then
2803	<	with PRecordData(cr)^ do
2803	>	with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2804		begin
2805	<	if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2805	>	if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2806		begin
2807	<	PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2807	>	PIBDBKey(Param.AsPointer)^ := rdDBKey;
2808		continue;
2809		end;
2810	<	if rdFields[j].fdIsNull then
2811	<	Qry.Params[i].IsNull := True
2810	>	if fdIsNull then
2811	>	Param.IsNull := True
2812		else begin
2813	<	Qry.Params[i].IsNull := False;
2814	<	data := cr + rdFields[j].fdDataOfs;
2815	<	case rdFields[j].fdDataType of
2813	>	Param.IsNull := False;
2814	>	data := cr + fdDataOfs;
2815	>	case fdDataType of
2816		SQL_TEXT, SQL_VARYING:
2817		begin
2818	<	SetString(st, data, rdFields[j].fdDataLength);
2819	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
2820	<	SetCodePage(st,rdFields[j].fdCodePage,false);
2466	<	{$ENDIF}
2467	<	Qry.Params[i].AsString := st;
2818	>	SetString(st, data, fdDataLength);
2819	>	SetCodePage(st,fdCodePage,false);
2820	>	Param.AsString := st;
2821		end;
2822		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2823	<	Qry.Params[i].AsDouble := PDouble(data)^;
2823	>	Param.AsDouble := PDouble(data)^;
2824		SQL_SHORT, SQL_LONG:
2825		begin
2826	<	if rdFields[j].fdDataScale = 0 then
2827	<	Qry.Params[i].AsLong := PLong(data)^
2475	<	else if rdFields[j].fdDataScale >= (-4) then
2476	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2826	>	if fdDataScale = 0 then
2827	>	Param.AsLong := PLong(data)^
2828		else
2829	<	Qry.Params[i].AsDouble := PDouble(data)^;
2829	>	if fdDataScale >= (-4) then
2830	>	Param.AsCurrency := PCurrency(data)^
2831	>	else
2832	>	Param.AsDouble := PDouble(data)^;
2833		end;
2834		SQL_INT64:
2835		begin
2836	<	if rdFields[j].fdDataScale = 0 then
2837	<	Qry.Params[i].AsInt64 := PInt64(data)^
2838	<	else if rdFields[j].fdDataScale >= (-4) then
2839	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2836	>	if fdDataScale = 0 then
2837	>	Param.AsInt64 := PInt64(data)^
2838	>	else
2839	>	if fdDataScale >= (-4) then
2840	>	Param.AsCurrency := PCurrency(data)^
2841		else
2842	<	Qry.Params[i].AsDouble := PDouble(data)^;
2842	>	Param.AsDouble := PDouble(data)^;
2843		end;
2844		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2845	<	Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2846	<	SQL_TYPE_DATE:
2847	<	begin
2493	<	ts.Date := PInt(data)^;
2494	<	ts.Time := 0;
2495	<	Qry.Params[i].AsDate :=
2496	<	TimeStampToDateTime(ts);
2497	<	end;
2498	<	SQL_TYPE_TIME:
2499	<	begin
2500	<	ts.Date := 0;
2501	<	ts.Time := PInt(data)^;
2502	<	Qry.Params[i].AsTime :=
2503	<	TimeStampToDateTime(ts);
2504	<	end;
2845	>	Param.AsQuad := PISC_QUAD(data)^;
2846	>	SQL_TYPE_DATE,
2847	>	SQL_TYPE_TIME,
2848		SQL_TIMESTAMP:
2849	<	Qry.Params[i].AsDateTime :=
2850	<	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2849	>	{This is an IBX native format and not the TDataset approach. See also SetFieldData}
2850	>	Param.AsDateTime := PDateTime(data)^;
2851		SQL_BOOLEAN:
2852	<	Qry.Params[i].AsBoolean := PWordBool(data)^;
2852	>	Param.AsBoolean := PWordBool(data)^;
2853		end;
2854		end;
2855		end;
#	Line 2555 \| Line 2898 \| begin
2898		FQRefresh.Transaction := Value;
2899		FQSelect.Transaction := Value;
2900		FQModify.Transaction := Value;
2901	+	FGeneratorField.Transaction := Value;
2902		end;
2903		end;
2904
#	Line 2662 \| Line 3006 \| begin
3006		Result := Assigned( FQSelect ) and FQSelect.EOF;
3007		end;
3008
3009	<	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
3009	>	function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
3010		begin
3011		ActivateConnection;
3012		ActivateTransaction;
#	Line 2799 \| Line 3143 \| var
3143		Buff: PChar;
3144		bTr, bDB: Boolean;
3145		begin
3146	+	if (Field = nil) or (Field.DataSet <> self) then
3147	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3148		Buff := GetActiveBuf;
3149		if Buff = nil then
3150		begin
3151		fs := TIBBlobStream.Create;
3152		fs.Mode := bmReadWrite;
3153	+	fs.Database := Database;
3154	+	fs.Transaction := Transaction;
3155	+	fs.SetField(Field);
3156		FBlobStreamList.Add(Pointer(fs));
3157		result := TIBDSBlobStream.Create(Field, fs, Mode);
3158		exit;
#	Line 2818 \| Line 3167 \| begin
3167		fs.Mode := bmReadWrite;
3168		fs.Database := Database;
3169		fs.Transaction := Transaction;
3170	+	fs.SetField(Field);
3171		fs.BlobID :=
3172	<	PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3172	>	PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3173		if (CachedUpdates) then
3174		begin
3175		bTr := not Transaction.InTransaction;
#	Line 2840 \| Line 3190 \| begin
3190		result := TIBDSBlobStream.Create(Field, fs, Mode);
3191		end;
3192
3193	+	function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3194	+	var Buff: PChar;
3195	+	pda: PArrayDataArray;
3196	+	bTr, bDB: Boolean;
3197	+	begin
3198	+	if (Field = nil) or (Field.DataSet <> self) then
3199	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3200	+	Buff := GetActiveBuf;
3201	+	if Buff = nil then
3202	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3203	+	Field.FRelationName,Field.FieldName)
3204	+	else
3205	+	begin
3206	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3207	+	if pda^[Field.FCacheOffset] = nil then
3208	+	begin
3209	+	AdjustRecordOnInsert(Buff);
3210	+	if Field.IsNull then
3211	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3212	+	Field.FRelationName,Field.FieldName)
3213	+	else
3214	+	Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3215	+	Field.FRelationName,Field.FieldName,Field.ArrayID);
3216	+	pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3217	+	FArrayList.Add(pda^[Field.FCacheOffset]);
3218	+	if (CachedUpdates) then
3219	+	begin
3220	+	bTr := not Transaction.InTransaction;
3221	+	bDB := not Database.Connected;
3222	+	if bDB then
3223	+	Database.Open;
3224	+	if bTr then
3225	+	Transaction.StartTransaction;
3226	+	pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3227	+	if bTr then
3228	+	Transaction.Commit;
3229	+	if bDB then
3230	+	Database.Close;
3231	+	end;
3232	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3233	+	end
3234	+	else
3235	+	Result := pda^[Field.FCacheOffset].ArrayIntf;
3236	+	end;
3237	+	end;
3238	+
3239	+	procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3240	+	var Buff: PChar;
3241	+	pda: PArrayDataArray;
3242	+	begin
3243	+	if (Field = nil) or (Field.DataSet <> self) then
3244	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3245	+	Buff := GetActiveBuf;
3246	+	if Buff <> nil then
3247	+	begin
3248	+	AdjustRecordOnInsert(Buff);
3249	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3250	+	pda^[Field.FCacheOffset].FArray := AnArray;
3251	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3252	+	end;
3253	+	end;
3254	+
3255		function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3256		const
3257		CMPLess = -1;
#	Line 2920 \| Line 3332 \| end;
3332		procedure TIBCustomDataSet.DoBeforeClose;
3333		begin
3334		inherited DoBeforeClose;
3335	+	if FInTransactionEnd and (FCloseAction = TARollback) then
3336	+	Exit;
3337		if State in [dsInsert,dsEdit] then
3338		begin
2925	–	if FInTransactionEnd and (FCloseAction = TARollback) then
2926	–	Exit;
2927	–
3339		if DataSetCloseAction = dcSaveChanges then
3340		Post;
3341		{Note this can fail with an exception e.g. due to
3342		database validation error. In which case the dataset remains open }
3343		end;
3344	+	if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3345	+	ApplyUpdates;
3346		end;
3347
3348		procedure TIBCustomDataSet.DoBeforeOpen;
#	Line 2961 \| Line 3374 \| end;
3374
3375		procedure TIBCustomDataSet.FetchAll;
3376		var
2964	–	{$IFDEF NEW_TBOOKMARK }
3377		CurBookmark: TBookmark;
2966	–	{$ELSE}
2967	–	CurBookmark: string;
2968	–	{$ENDIF}
3378		begin
3379		FBase.SetCursor;
3380		try
#	Line 3076 \| Line 3485 \| begin
3485		if result and (Buffer <> nil) then
3486		Move(Buff[1], Buffer^, Field.DataSize);
3487		end
3488	<	else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3488	>	else
3489	>	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3490		(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3491	+	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3492	+	FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3493		begin
3494	<	result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3494	>	result := not fdIsNull;
3495		if result and (Buffer <> nil) then
3084	–	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3496		begin
3497	<	Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3497	>	Data := Buff + fdDataOfs;
3498		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3499		begin
3500		if fdDataLength < Field.DataSize then
#	Line 3154 \| Line 3565 \| begin
3565		if FCurrentRecord < FRecordCount then
3566		ReadRecordCache(FCurrentRecord, Buffer, False)
3567		else begin
3568	<	while (not FQSelect.EOF) and
3158	<	(FQSelect.Next <> nil) and
3568	>	while (not FQSelect.EOF) and FQSelect.Next and
3569		(FCurrentRecord >= FRecordCount) do begin
3570		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3571		Inc(FRecordCount);
#	Line 3266 \| Line 3676 \| procedure TIBCustomDataSet.InternalCance
3676		var
3677		Buff: PChar;
3678		CurRec: Integer;
3679	+	pda: PArrayDataArray;
3680	+	i: integer;
3681		begin
3682		inherited InternalCancel;
3683		Buff := GetActiveBuf;
3684	<	if Buff <> nil then begin
3684	>	if Buff <> nil then
3685	>	begin
3686	>	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3687	>	for i := 0 to ArrayFieldCount - 1 do
3688	>	pda^[i].ArrayIntf.CancelChanges;
3689		CurRec := FCurrentRecord;
3690		AdjustRecordOnInsert(Buff);
3691		if (State = dsEdit) then begin
#	Line 3292 \| Line 3708 \| begin
3708		DeactivateTransaction;
3709		FQSelect.Close;
3710		ClearBlobCache;
3711	+	ClearArrayCache;
3712		FreeRecordBuffer(FModelBuffer);
3713		FreeRecordBuffer(FOldBuffer);
3714		FCurrentRecord := -1;
#	Line 3307 \| Line 3724 \| begin
3724		FOBEnd := 0;
3725		FreeMem(FBufferCache);
3726		FBufferCache := nil;
3727	+	FreeMem(FFieldColumns);
3728	+	FFieldColumns := nil;
3729		FreeMem(FOldBufferCache);
3730		FOldBufferCache := nil;
3731		BindFields(False);
#	Line 3381 \| Line 3800 \| const
3800		'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3801		'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3802		' (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3803	+
3804	+	DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3805	+	'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3806	+	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3807	+	'where R.RDB$RELATION_NAME = :RELATION ' + {do not localize}
3808	+	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3809	+	'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3810	+	' (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3811	+	' ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3812	+
3813		var
3814		FieldType: TFieldType;
3815		FieldSize: Word;
3816	<	charSetID: integer;
3816	>	FieldDataSize: integer;
3817		CharSetSize: integer;
3818		CharSetName: RawByteString;
3390	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3819		FieldCodePage: TSystemCodePage;
3392	–	{$ENDIF}
3820		FieldNullable : Boolean;
3821		i, FieldPosition, FieldPrecision: Integer;
3822		FieldAliasName, DBAliasName: string;
3823	<	RelationName, FieldName: string;
3823	>	aRelationName, FieldName: string;
3824		Query : TIBSQL;
3825		FieldIndex: Integer;
3826		FRelationNodes : TRelationNode;
3827	+	aArrayDimensions: integer;
3828	+	aArrayBounds: TArrayBounds;
3829	+	ArrayMetaData: IArrayMetaData;
3830
3831		function Add_Node(Relation, Field : String) : TRelationNode;
3832		var
#	Line 3419 \| Line 3849 \| var
3849		FField.FieldName := Query.Fields[2].AsString;
3850		FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3851		FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3852	+	FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3853		FField.NextField := Result.FieldNodes;
3854		Result.FieldNodes := FField;
3855		Query.Next;
#	Line 3472 \| Line 3903 \| var
3903		FField := Ffield.NextField;
3904		end;
3905
3906	+	function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3907	+	var
3908	+	FRelation : TRelationNode;
3909	+	FField : TFieldNode;
3910	+	begin
3911	+	FRelation := FRelationNodes;
3912	+	while Assigned(FRelation) and
3913	+	(FRelation.RelationName <> Relation) do
3914	+	FRelation := FRelation.NextRelation;
3915	+	if not Assigned(FRelation) then
3916	+	FRelation := Add_Node(Relation, Field);
3917	+	Result := false;
3918	+	FField := FRelation.FieldNodes;
3919	+	while Assigned(FField) do
3920	+	if FField.FieldName = Field then
3921	+	begin
3922	+	Result := Ffield.IDENTITY_COLUMN;
3923	+	Exit;
3924	+	end
3925	+	else
3926	+	FField := Ffield.NextField;
3927	+	end;
3928	+
3929		Procedure FreeNodes;
3930		var
3931		FRelation : TRelationNode;
#	Line 3494 \| Line 3948 \| var
3948		begin
3949		FRelationNodes := TRelationNode.Create;
3950		FNeedsRefresh := False;
3951	<	Database.InternalTransaction.StartTransaction;
3951	>	if not Database.InternalTransaction.InTransaction then
3952	>	Database.InternalTransaction.StartTransaction;
3953		Query := TIBSQL.Create(self);
3954		try
3955		Query.Database := DataBase;
#	Line 3502 \| Line 3957 \| begin
3957		FieldDefs.BeginUpdate;
3958		FieldDefs.Clear;
3959		FieldIndex := 0;
3960	<	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3961	<	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3962	<	Query.SQL.Text := DefaultSQL;
3960	>	if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3961	>	SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3962	>	if FDatabaseInfo.ODSMajorVersion >= 12 then
3963	>	Query.SQL.Text := DefaultSQLODS12
3964	>	else
3965	>	Query.SQL.Text := DefaultSQL;
3966		Query.Prepare;
3967	<	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3968	<	SetLength(FAliasNameList, SourceQuery.Current.Count);
3969	<	for i := 0 to SourceQuery.Current.Count - 1 do
3970	<	with SourceQuery.Current[i].Data^ do
3967	>	SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3968	>	SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3969	>	for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3970	>	with SourceQuery.MetaData[i] do
3971		begin
3972		{ Get the field name }
3973	<	FieldAliasName := SourceQuery.Current[i].Name;
3974	<	SetString(DBAliasName, aliasname, aliasname_length);
3975	<	SetString(RelationName, relname, relname_length);
3976	<	SetString(FieldName, sqlname, sqlname_length);
3973	>	FieldAliasName := GetName;
3974	>	DBAliasName := GetAliasname;
3975	>	aRelationName := getRelationName;
3976	>	FieldName := getSQLName;
3977		FAliasNameList[i] := DBAliasName;
3978		FieldSize := 0;
3979	+	FieldDataSize := GetSize;
3980		FieldPrecision := 0;
3981	<	FieldNullable := SourceQuery.Current[i].IsNullable;
3981	>	FieldNullable := IsNullable;
3982		CharSetSize := 0;
3983		CharSetName := '';
3525	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3984		FieldCodePage := CP_NONE;
3985	<	{$ENDIF}
3986	<	case sqltype and not 1 of
3985	>	aArrayDimensions := 0;
3986	>	SetLength(aArrayBounds,0);
3987	>	case SQLType of
3988		{ All VARCHAR's must be converted to strings before recording
3989		their values }
3990		SQL_VARYING, SQL_TEXT:
3991		begin
3992	<	CharSetID := SourceQuery.Current[i].GetCharSetID;
3993	<	TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3994	<	CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3995	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3996	<	TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3538	<	{$ENDIF}
3539	<	FieldSize := sqllen;
3992	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3993	>	CharSetSize := 1;
3994	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3995	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3996	>	FieldSize := FieldDataSize div CharSetSize;
3997		FieldType := ftString;
3998		end;
3999		{ All Doubles/Floats should be cast to doubles }
#	Line 3544 \| Line 4001 \| begin
4001		FieldType := ftFloat;
4002		SQL_SHORT:
4003		begin
4004	<	if (sqlscale = 0) then
4004	>	if (getScale = 0) then
4005		FieldType := ftSmallInt
4006		else begin
4007		FieldType := ftBCD;
4008		FieldPrecision := 4;
4009	<	FieldSize := -sqlscale;
4009	>	FieldSize := -getScale;
4010		end;
4011		end;
4012		SQL_LONG:
4013		begin
4014	<	if (sqlscale = 0) then
4014	>	if (getScale = 0) then
4015		FieldType := ftInteger
4016	<	else if (sqlscale >= (-4)) then
4016	>	else if (getScale >= (-4)) then
4017		begin
4018		FieldType := ftBCD;
4019		FieldPrecision := 9;
4020	<	FieldSize := -sqlscale;
4020	>	FieldSize := -getScale;
4021		end
4022		else
4023		if Database.SQLDialect = 1 then
#	Line 3572 \| Line 4029 \| begin
4029		begin
4030		FieldType := ftFMTBCD;
4031		FieldPrecision := 9;
4032	<	FieldSize := -sqlscale;
4032	>	FieldSize := -getScale;
4033		end;
4034		end;
4035
4036		SQL_INT64:
4037		begin
4038	<	if (sqlscale = 0) then
4038	>	if (getScale = 0) then
4039		FieldType := ftLargeInt
4040	<	else if (sqlscale >= (-4)) then
4040	>	else if (getScale >= (-4)) then
4041		begin
4042		FieldType := ftBCD;
4043		FieldPrecision := 18;
4044	<	FieldSize := -sqlscale;
4044	>	FieldSize := -getScale;
4045		end
4046		else
4047	<	FieldType := ftFloat
4047	>	FieldType := ftFloat;
4048		end;
4049		SQL_TIMESTAMP: FieldType := ftDateTime;
4050		SQL_TYPE_TIME: FieldType := ftTime;
#	Line 3595 \| Line 4052 \| begin
4052		SQL_BLOB:
4053		begin
4054		FieldSize := sizeof (TISC_QUAD);
4055	<	if (sqlsubtype = 1) then
4055	>	if (getSubtype = 1) then
4056		begin
4057	<	CharSetID := SourceQuery.Current[i].GetCharSetID;
4058	<	TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
4059	<	CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
4060	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3604	<	TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3605	<	{$ENDIF}
4057	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4058	>	CharSetSize := 1;
4059	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4060	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4061		FieldType := ftMemo;
4062		end
4063		else
#	Line 3611 \| Line 4066 \| begin
4066		SQL_ARRAY:
4067		begin
4068		FieldSize := sizeof (TISC_QUAD);
4069	<	FieldType := ftUnknown;
4069	>	FieldType := ftArray;
4070	>	ArrayMetaData := GetArrayMetaData;
4071	>	if ArrayMetaData <> nil then
4072	>	begin
4073	>	aArrayDimensions := ArrayMetaData.GetDimensions;
4074	>	aArrayBounds := ArrayMetaData.GetBounds;
4075	>	end;
4076		end;
4077		SQL_BOOLEAN:
4078		FieldType:= ftBoolean;
#	Line 3628 \| Line 4089 \| begin
4089		Name := FieldAliasName;
4090		FAliasNameMap[FieldNo-1] := DBAliasName;
4091		Size := FieldSize;
4092	+	DataSize := FieldDataSize;
4093		Precision := FieldPrecision;
4094		Required := not FieldNullable;
4095	+	RelationName := aRelationName;
4096		InternalCalcField := False;
4097		CharacterSetSize := CharSetSize;
4098		CharacterSetName := CharSetName;
3636	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
4099		CodePage := FieldCodePage;
4100	<	{$ENDIF}
4100	>	ArrayDimensions := aArrayDimensions;
4101	>	ArrayBounds := aArrayBounds;
4102		if (FieldName <> '') and (RelationName <> '') then
4103		begin
4104	+	IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4105		if Has_COMPUTED_BLR(RelationName, FieldName) then
4106		begin
4107		Attributes := [faReadOnly];
#	Line 3663 \| Line 4127 \| begin
4127		FreeNodes;
4128		Database.InternalTransaction.Commit;
4129		FieldDefs.EndUpdate;
4130	+	FieldDefs.Updated := true;
4131		end;
4132		end;
4133
#	Line 3680 \| Line 4145 \| begin
4145		else begin
4146		Buffer := AllocRecordBuffer;
4147		try
4148	<	while FQSelect.Next <> nil do
4148	>	while FQSelect.Next do
4149		begin
4150		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
4151		Inc(FRecordCount);
#	Line 3695 \| Line 4160 \| end;
4160		procedure TIBCustomDataSet.InternalSetParamsFromCursor;
4161		var
4162		i: Integer;
4163	<	cur_param: TIBXSQLVAR;
4163	>	cur_param: ISQLParam;
4164		cur_field: TField;
4165		s: TStream;
4166		begin
#	Line 3703 \| Line 4168 \| begin
4168		IBError(ibxeEmptyQuery, [nil]);
4169		if not FInternalPrepared then
4170		InternalPrepare;
4171	<	if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4171	>	if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4172		begin
4173	<	for i := 0 to SQLParams.Count - 1 do
4173	>	for i := 0 to SQLParams.GetCount - 1 do
4174		begin
4175		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4176	<	cur_param := SQLParams[i];
4177	<	if (cur_field <> nil) then begin
4176	>	if (cur_field <> nil) then
4177	>	begin
4178	>	cur_param := SQLParams[i];
4179		if (cur_field.IsNull) then
4180		cur_param.IsNull := True
4181	<	else case cur_field.DataType of
4181	>	else
4182	>	case cur_field.DataType of
4183		ftString:
4184		cur_param.AsString := cur_field.AsString;
4185		ftBoolean:
#	Line 3722 \| Line 4189 \| begin
4189		ftInteger:
4190		cur_param.AsLong := cur_field.AsInteger;
4191		ftLargeInt:
4192	<	cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4192	>	cur_param.AsInt64 := cur_field.AsLargeInt;
4193		ftFloat, ftCurrency:
4194		cur_param.AsDouble := cur_field.AsFloat;
4195		ftBCD:
#	Line 3739 \| Line 4206 \| begin
4206		try
4207		s := DataSource.DataSet.
4208		CreateBlobStream(cur_field, bmRead);
4209	<	cur_param.LoadFromStream(s);
4209	>	cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4210		finally
4211		s.free;
4212		end;
4213		end;
4214	+	ftArray:
4215	+	cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4216		else
4217		IBError(ibxeNotSupported, [nil]);
4218		end;
#	Line 3776 \| Line 4245 \| procedure TIBCustomDataSet.InternalOpen;
4245		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
4246		end;
4247
3779	–	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3780	–	var i: integer;
3781	–	begin
3782	–	Result := nil;
3783	–	for i := 0 to FieldDefs.Count - 1 do
3784	–	if FieldDefs[i].FieldNo = aFieldNo then
3785	–	begin
3786	–	Result := TIBFieldDef(FieldDefs[i]);
3787	–	break;
3788	–	end;
3789	–	end;
3790	–
3791	–	procedure SetExtendedProperties;
3792	–	var i: integer;
3793	–	IBFieldDef: TIBFieldDef;
3794	–	begin
3795	–	for i := 0 to Fields.Count - 1 do
3796	–	if Fields[i].FieldNo > 0 then
3797	–	begin
3798	–	if(Fields[i] is TIBStringField) then
3799	–	with TIBStringField(Fields[i]) do
3800	–	begin
3801	–	IBFieldDef := GetFieldDef(FieldNo);
3802	–	if IBFieldDef <> nil then
3803	–	begin
3804	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3805	–	CharacterSetName := IBFieldDef.CharacterSetName;
3806	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3807	–	CodePage := IBFieldDef.CodePage;
3808	–	{$ENDIF}
3809	–	end;
3810	–	end
3811	–	else
3812	–	if(Fields[i] is TIBMemoField) then
3813	–	with TIBMemoField(Fields[i]) do
3814	–	begin
3815	–	IBFieldDef := GetFieldDef(FieldNo);
3816	–	if IBFieldDef <> nil then
3817	–	begin
3818	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3819	–	CharacterSetName := IBFieldDef.CharacterSetName;
3820	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3821	–	CodePage := IBFieldDef.CodePage;
3822	–	{$ENDIF}
3823	–	end;
3824	–	end
3825	–	end
3826	–	end;
3827	–
4248		begin
4249		FBase.SetCursor;
4250		try
#	Line 3834 \| Line 4254 \| begin
4254		IBError(ibxeEmptyQuery, [nil]);
4255		if not FInternalPrepared then
4256		InternalPrepare;
4257	<	if FQSelect.SQLType = SQLSelect then
4257	>	if FQSelect.SQLStatementType = SQLSelect then
4258		begin
4259		if DefaultFields then
4260		CreateFields;
4261	+	FArrayFieldCount := 0;
4262		BindFields(True);
3842	–	SetExtendedProperties;
4263		FCurrentRecord := -1;
4264		FQSelect.ExecQuery;
4265		FOpen := FQSelect.Open;
#	Line 3850 \| Line 4270 \| begin
4270		3. After the dummy fetch, FRecordSize will be appropriately
4271		adjusted to reflect the additional "weight" of the field
4272		data.
4273	<	4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4273	>	4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4274		5. Now, with the BufferSize available, allocate memory for chunks of records
4275		6. Re-allocate the model buffer, accounting for the new
4276		FRecordBufferSize.
4277		7. Finally, calls to AllocRecordBuffer will work!.
4278		}
4279		{Step 1}
4280	<	FRecordSize := RecordDataLength(FQSelect.Current.Count);
4280	>	FRecordSize := RecordDataLength(FQSelect.FieldCount);
4281		{Step 2, 3}
4282	+	GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4283		IBAlloc(FModelBuffer, 0, FRecordSize);
4284	<	FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4284	>	InitModelBuffer(FQSelect, FModelBuffer);
4285		{Step 4}
4286		FCalcFieldsOffset := FRecordSize;
4287		FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4288	<	FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4288	>	FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4289	>	FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4290		{Step 5}
4291		if UniDirectional then
4292		FBufferChunkSize := FRecordBufferSize * UniCache
#	Line 3880 \| Line 4302 \| begin
4302		FCacheSize := FBufferChunkSize;
4303		FOldCacheSize := FBufferChunkSize;
4304		{Step 6}
4305	<	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4305	>	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4306		FRecordBufferSize);
4307		{Step 7}
4308		FOldBuffer := AllocRecordBuffer;
#	Line 3978 \| Line 4400 \| end;
4400		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4401		Options: TLocateOptions): Boolean;
4402		var
3981	–	{$IFDEF NEW_TBOOKMARK }
4403		CurBookmark: TBookmark;
3983	–	{$ELSE}
3984	–	CurBookmark: string;
3985	–	{$ENDIF}
4404		begin
4405		DisableControls;
4406		try
#	Line 4000 \| Line 4418 \| function TIBCustomDataSet.Lookup(const K
4418		const ResultFields: string): Variant;
4419		var
4420		fl: TList;
4003	–	{$IFDEF NEW_TBOOKMARK }
4421		CurBookmark: TBookmark;
4005	–	{$ELSE}
4006	–	CurBookmark: string;
4007	–	{$ENDIF}
4422		begin
4423		DisableControls;
4424		fl := TList.Create;
#	Line 4077 \| Line 4491 \| begin
4491		MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4492		if (MappedFieldPos > 0) and
4493		(MappedFieldPos <= rdFieldCount) then
4494	+	with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4495		begin
4496		Field.Validate(Buffer);
4497		if (Buffer = nil) or
4498		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4499	<	rdFields[MappedFieldPos].fdIsNull := True
4500	<	else begin
4501	<	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4502	<	rdFields[MappedFieldPos].fdDataSize);
4503	<	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4504	<	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4505	<	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4091	<	rdFields[MappedFieldPos].fdIsNull := False;
4499	>	fdIsNull := True
4500	>	else
4501	>	begin
4502	>	Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4503	>	if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4504	>	fdDataLength := StrLen(PChar(Buffer));
4505	>	fdIsNull := False;
4506		if rdUpdateStatus = usUnmodified then
4507		begin
4508		if CachedUpdates then
#	Line 4189 \| Line 4603 \| begin
4603		if FInternalPrepared then
4604		begin
4605		CheckDatasetClosed;
4606	+	if FDidActivate then
4607	+	DeactivateTransaction;
4608		FieldDefs.Clear;
4609		FieldDefs.Updated := false;
4610		FInternalPrepared := False;
#	Line 4209 \| Line 4625 \| begin
4625		IBError(ibxeEmptyQuery, [nil]);
4626		if not FInternalPrepared then
4627		InternalPrepare;
4628	<	if FQSelect.SQLType = SQLSelect then
4628	>	if FQSelect.SQLStatementType = SQLSelect then
4629		begin
4630		IBError(ibxeIsASelectStatement, [nil]);
4631		end
#	Line 4222 \| Line 4638 \| begin
4638		end;
4639		end;
4640
4641	<	function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4641	>	function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4642		begin
4643	<	Result := FQSelect.Handle;
4643	>	Result := FQSelect.Statement;
4644		end;
4645
4646		function TIBCustomDataSet.GetParser: TSelectSQLParser;
#	Line 4279 \| Line 4695 \| end;
4695
4696		{ TIBDataSet IProviderSupport }
4697
4698	<	(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4698	>	procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4699		begin
4700		if Commit then
4701		Transaction.Commit else
#	Line 4432 \| Line 4848 \| begin
4848		Transaction.StartTransaction;
4849		end;
4850
4851	<	function TIBCustomDataSet.PSGetTableName: string;
4851	>	function TIBCustomDataSet.PsGetTableName: string;
4852		begin
4853		// if not FInternalPrepared then
4854		// InternalPrepare;
#	Line 4442 \| Line 4858 \| begin
4858		if not FQSelect.Prepared then
4859		FQSelect.Prepare;
4860		Result := FQSelect.UniqueRelationName;
4861	<	end;*)
4861	>	end;
4862
4863		procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4864		begin
#	Line 4527 \| Line 4943 \| end;
4943		function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4944		NativeFormat: Boolean): Boolean;
4945		begin
4946	<	if (Field.DataType = ftBCD) and not NativeFormat then
4946	>	{These datatypes use IBX conventions and not TDataset conventions}
4947	>	if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4948		Result := InternalGetFieldData(Field, Buffer)
4949		else
4950		Result := inherited GetFieldData(Field, Buffer, NativeFormat);
#	Line 4553 \| Line 4970 \| end;
4970		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4971		NativeFormat: Boolean);
4972		begin
4973	<	if (not NativeFormat) and (Field.DataType = ftBCD) then
4973	>	{These datatypes use IBX conventions and not TDataset conventions}
4974	>	if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4975		InternalSetfieldData(Field, Buffer)
4976		else
4977		inherited SetFieldData(Field, buffer, NativeFormat);
#	Line 4573 \| Line 4991 \| begin
4991		inherited Destroy;
4992		end;
4993
4994	<	procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4994	>	procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4995		begin
4996		FRefreshSQL.Assign(Value);
4997		end;
4998
4999	+	procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
5000	+	buff: PChar);
5001	+	begin
5002	+	if not Assigned(DataSet) then Exit;
5003	+	DataSet.SetInternalSQLParams(Params, buff);
5004	+	end;
5005	+
5006		procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
5007		begin
5008	+	InternalSetParams(Query.Params,buff);
5009	+	end;
5010	+
5011	+	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5012	+	QryResults: IResults; Buffer: PChar);
5013	+	begin
5014		if not Assigned(DataSet) then Exit;
5015	<	DataSet.SetInternalSQLParams(Query, buff);
5015	>	case UpdateKind of
5016	>	ukModify, ukInsert:
5017	>	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5018	>	ukDelete:
5019	>	DataSet.DoDeleteReturning(QryResults);
5020	>	end;
5021		end;
5022
5023		function TIBDSBlobStream.GetSize: Int64;
#	Line 4644 \| Line 5080 \| end;
5080
5081		procedure TIBGenerator.SetIncrement(const AValue: integer);
5082		begin
5083	+	if FIncrement = AValue then Exit;
5084		if AValue < 0 then
5085	<	raise Exception.Create('A Generator Increment cannot be negative');
5086	<	FIncrement := AValue
5085	>	IBError(ibxeNegativeGenerator,[]);
5086	>	FIncrement := AValue;
5087	>	SetQuerySQL;
5088		end;
5089
5090	<	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4653	<	ATransaction: TIBTransaction): integer;
5090	>	procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5091		begin
5092	<	with TIBSQL.Create(nil) do
5093	<	try
5094	<	Database := ADatabase;
5095	<	Transaction := ATransaction;
5096	<	if not assigned(Database) then
5097	<	IBError(ibxeCannotSetDatabase,[]);
5098	<	if not assigned(Transaction) then
5099	<	IBError(ibxeCannotSetTransaction,[]);
5100	<	with Transaction do
5101	<	if not InTransaction then StartTransaction;
5102	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
5103	<	Prepare;
5092	>	FQuery.Transaction := AValue;
5093	>	end;
5094	>
5095	>	procedure TIBGenerator.SetQuerySQL;
5096	>	begin
5097	>	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5098	>	end;
5099	>
5100	>	function TIBGenerator.GetDatabase: TIBDatabase;
5101	>	begin
5102	>	Result := FQuery.Database;
5103	>	end;
5104	>
5105	>	function TIBGenerator.GetTransaction: TIBTransaction;
5106	>	begin
5107	>	Result := FQuery.Transaction;
5108	>	end;
5109	>
5110	>	procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5111	>	begin
5112	>	FQuery.Database := AValue;
5113	>	end;
5114	>
5115	>	procedure TIBGenerator.SetGeneratorName(AValue: string);
5116	>	begin
5117	>	if FGeneratorName = AValue then Exit;
5118	>	FGeneratorName := AValue;
5119	>	SetQuerySQL;
5120	>	end;
5121	>
5122	>	function TIBGenerator.GetNextValue: integer;
5123	>	begin
5124	>	with FQuery do
5125	>	begin
5126	>	Transaction.Active := true;
5127		ExecQuery;
5128		try
5129	<	Result := FieldByName('ID').AsInteger
5129	>	Result := Fields[0].AsInteger
5130		finally
5131		Close
5132		end;
4673	–	finally
4674	–	Free
5133		end;
5134		end;
5135
#	Line 4679 \| Line 5137 \| constructor TIBGenerator.Create(Owner: T
5137		begin
5138		FOwner := Owner;
5139		FIncrement := 1;
5140	+	FQuery := TIBSQL.Create(nil);
5141	+	end;
5142	+
5143	+	destructor TIBGenerator.Destroy;
5144	+	begin
5145	+	if assigned(FQuery) then FQuery.Free;
5146	+	inherited Destroy;
5147		end;
5148
5149
5150		procedure TIBGenerator.Apply;
5151		begin
5152	<	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5153	<	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5152	>	if assigned(Database) and assigned(Transaction) and
5153	>	(FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5154	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5155		end;
5156
5157

Diff Legend

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

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents): Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC vs. Revision 139 by tony, Wed Jan 24 16:16:29 2018 UTC

Diff Legend

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC vs.
Revision 139 by tony, Wed Jan 24 16:16:29 2018 UTC