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 43 by tony, Thu Sep 22 17:10:15 2016 UTC vs.
Revision 101 by tony, Thu Jan 18 14:37:18 2018 UTC

#	Line 33 | Line 33
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(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 256 | Line 346 | type
346		TIBAutoCommit = (acDisabled, acCommitRetaining);
347
348		{ TIBCustomDataSet }
349	+
350		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
351
352		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
#	Line 272 | Line 363 | type
363
364		TIBCustomDataSet = class(TDataset)
365		private
366	+	FAllowAutoActivateTransaction: Boolean;
367	+	FArrayFieldCount: integer;
368	+	FArrayCacheOffset: integer;
369		FAutoCommit: TIBAutoCommit;
370		FGenerateParamNames: Boolean;
371		FGeneratorField: TIBGenerator;
372		FNeedsRefresh: Boolean;
373		FForcedRefresh: Boolean;
374		FDidActivate: Boolean;
281	–	FIBLoaded: Boolean;
375		FBase: TIBBase;
376		FBlobCacheOffset: Integer;
377		FBlobStreamList: TList;
378	+	FArrayList: TList;
379		FBufferChunks: Integer;
380		FBufferCache,
381		FOldBufferCache: PChar;
#	Line 307 | Line 401 | type
401		FQRefresh,
402		FQSelect,
403		FQModify: TIBSQL;
404	+	FDatabaseInfo: TIBDatabaseInfo;
405		FRecordBufferSize: Integer;
406		FRecordCount: Integer;
407		FRecordSize: Integer;
#	Line 335 | Line 430 | type
430		FCloseAction: TTransactionAction;
431		FInTransactionEnd: boolean;
432		FIBLinks: TList;
433	<	function GetSelectStmtHandle: TISC_STMT_HANDLE;
433	>	FFieldColumns: PFieldColumns;
434	>	procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
435	>	FieldIndex: integer; Buffer: PChar);
436	>	procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
437	>	function GetSelectStmtIntf: IStatement;
438		procedure SetUpdateMode(const Value: TUpdateMode);
439		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
440
#	Line 347 | Line 446 | type
446		function CanRefresh: Boolean;
447		procedure CheckEditState;
448		procedure ClearBlobCache;
449	+	procedure ClearArrayCache;
450		procedure ClearIBLinks;
451		procedure CopyRecordBuffer(Source, Dest: Pointer);
452		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
#	Line 358 | Line 458 | type
458		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
459		Buffer: PChar);
460		function GetDatabase: TIBDatabase;
361	–	function GetDBHandle: PISC_DB_HANDLE;
461		function GetDeleteSQL: TStrings;
462		function GetInsertSQL: TStrings;
463	<	function GetSQLParams: TIBXSQLDA;
463	>	function GetSQLParams: ISQLParams;
464		function GetRefreshSQL: TStrings;
465		function GetSelectSQL: TStrings;
466	<	function GetStatementType: TIBSQLTypes;
466	>	function GetStatementType: TIBSQLStatementTypes;
467		function GetModifySQL: TStrings;
468		function GetTransaction: TIBTransaction;
370	–	function GetTRHandle: PISC_TR_HANDLE;
469		function GetParser: TSelectSQLParser;
470		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
471		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
#	Line 382 | Line 480 | type
480		procedure SetDatabase(Value: TIBDatabase);
481		procedure SetDeleteSQL(Value: TStrings);
482		procedure SetInsertSQL(Value: TStrings);
483	<	procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
483	>	procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
484		procedure SetRefreshSQL(Value: TStrings);
485		procedure SetSelectSQL(Value: TStrings);
486		procedure SetModifySQL(Value: TStrings);
487		procedure SetTransaction(Value: TIBTransaction);
488		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
489		procedure SetUniDirectional(Value: Boolean);
490	+	procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
491		procedure RefreshParams;
492		function AdjustPosition(FCache: PChar; Offset: DWORD;
493		Origin: Integer): DWORD;
#	Line 422 | Line 521 | type
521		procedure SQLChanging(Sender: TObject); virtual;
522		procedure SQLChanged(Sender: TObject); virtual;
523
524	<	(*    { IProviderSupport }
524	>	{ IProviderSupport }
525		procedure PSEndTransaction(Commit: Boolean); override;
526		function PSExecuteStatement(const ASQL: string; AParams: TParams;
527		ResultSet: Pointer = nil): Integer; override;
#	Line 435 | Line 534 | type
534		procedure PSStartTransaction; override;
535		procedure PSReset; override;
536		function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
537	<	*)
537	>
538		{ TDataSet support }
539		procedure InternalInsert; override;
540		procedure InitRecord(Buffer: PChar); override;
#	Line 499 | Line 598 | type
598		protected
599		{Likely to be made public by descendant classes}
600		property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
601	<	property SQLParams: TIBXSQLDA read GetSQLParams;
602	<	property Params: TIBXSQLDA read GetSQLParams;
601	>	property SQLParams: ISQLParams read GetSQLParams;
602	>	property Params: ISQLParams read GetSQLParams;
603		property InternalPrepared: Boolean read FInternalPrepared;
604		property QDelete: TIBSQL read FQDelete;
605		property QInsert: TIBSQL read FQInsert;
606		property QRefresh: TIBSQL read FQRefresh;
607		property QSelect: TIBSQL read FQSelect;
608		property QModify: TIBSQL read FQModify;
609	<	property StatementType: TIBSQLTypes read GetStatementType;
610	<	property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
609	>	property StatementType: TIBSQLStatementTypes read GetStatementType;
610	>	property SelectStmtHandle: IStatement read GetSelectStmtIntf;
611
612		{Likely to be made published by descendant classes}
613		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
#	Line 559 | Line 658 | type
658		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
659		function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
660		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
661	+	function GetArray(Field: TIBArrayField): IArray;
662	+	procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
663		function GetCurrentRecord(Buffer: PChar): Boolean; override;
664		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
665		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
#	Line 572 | Line 673 | type
673		function UpdateStatus: TUpdateStatus; override;
674		function IsSequenced: Boolean; override;
675		procedure Post; override;
676	<	function ParamByName(ParamName: String): TIBXSQLVAR;
677	<	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
577	<	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
676	>	function ParamByName(ParamName: String): ISQLParam;
677	>	property ArrayFieldCount: integer read FArrayFieldCount;
678		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
679		property UpdatesPending: Boolean read FUpdatesPending;
680		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
#	Line 583 | Line 683 | type
683		read FDataSetCloseAction write FDataSetCloseAction;
684
685		published
686	+	property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
687	+	write FAllowAutoActivateTransaction;
688		property Database: TIBDatabase read GetDatabase write SetDatabase;
689		property Transaction: TIBTransaction read GetTransaction
690		write SetTransaction;
#	Line 723 | Line 825 | type
825		function Write(const Buffer; Count: Longint): Longint; override;
826		end;
827
828	+	{Extended Field Def for character set info}
829	+
830	+	{ TIBFieldDef }
831	+
832	+	TIBFieldDef = class(TFieldDef)
833	+	private
834	+	FArrayBounds: TArrayBounds;
835	+	FArrayDimensions: integer;
836	+	FCharacterSetName: RawByteString;
837	+	FCharacterSetSize: integer;
838	+	FCodePage: TSystemCodePage;
839	+	FIdentityColumn: boolean;
840	+	FRelationName: string;
841	+	FDataSize: integer;
842	+	published
843	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
844	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
845	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
846	+	property DataSize: integer read FDataSize write FDataSize;
847	+	property RelationName: string read FRelationName write FRelationName;
848	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
849	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
850	+	property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
851	+	end;
852	+
853		const
854		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
855		nil,                { ftUnknown }
856		TIBStringField,     { ftString }
857	<	TSmallintField,     { ftSmallint }
858	<	TIntegerField,      { ftInteger }
857	>	TIBSmallintField,   { ftSmallint }
858	>	TIBIntegerField,      { ftInteger }
859		TWordField,         { ftWord }
860		TBooleanField,      { ftBoolean }
861		TFloatField,        { ftFloat }
#	Line 750 | Line 877 | DefaultFieldClasses: array[TFieldType] o
877		nil,                { ftCursor }
878		TStringField,       { ftFixedChar }
879		nil,    { ftWideString }
880	<	TLargeIntField,     { ftLargeInt }
880	>	TIBLargeIntField,     { ftLargeInt }
881		nil,          { ftADT }
882	<	nil,        { ftArray }
882	>	TIBArrayField,        { ftArray }
883		nil,    { ftReference }
884		nil,     { ftDataSet }
885		TBlobField,         { ftOraBlob }
#	Line 781 | Line 908 | DefaultFieldClasses: array[TFieldType] o
908
909		implementation
910
911	<	uses IBIntf, Variants, FmtBCD, LazUTF8, IBCodePage;
911	>	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
912
913		const FILE_BEGIN = 0;
914		FILE_CURRENT = 1;
#	Line 794 | Line 921 | type
921		FieldName : String;
922		COMPUTED_BLR : Boolean;
923		DEFAULT_VALUE : boolean;
924	+	IDENTITY_COLUMN : boolean;
925		NextField : TFieldNode;
926		end;
927
#	Line 804 | Line 932 | type
932		NextRelation : TRelationNode;
933		end;
934
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	–
935
936		{  Copied from LCLProc in order to avoid LCL dependency
937
#	Line 865 | Line 974 | type
974		Result := str;
975		end;
976
977	+	{ TIBLargeIntField }
978	+
979	+	procedure TIBLargeIntField.Bind(Binding: Boolean);
980	+	begin
981	+	inherited Bind(Binding);
982	+	if Binding and (FieldDef <> nil) then
983	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
984	+	end;
985	+
986	+	{ TIBIntegerField }
987	+
988	+	procedure TIBIntegerField.Bind(Binding: Boolean);
989	+	begin
990	+	inherited Bind(Binding);
991	+	if Binding and (FieldDef <> nil) then
992	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
993	+	end;
994	+
995	+	{ TIBSmallintField }
996	+
997	+	procedure TIBSmallintField.Bind(Binding: Boolean);
998	+	begin
999	+	inherited Bind(Binding);
1000	+	if Binding and (FieldDef <> nil) then
1001	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1002	+	end;
1003	+
1004	+	{ TIBArray }
1005	+
1006	+	procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
1007	+	begin
1008	+	case Reason of
1009	+	arChanging:
1010	+	if FRecNo <> FField.Dataset.RecNo then
1011	+	IBError(ibxeNotCurrentArray,[nil]);
1012	+
1013	+	arChanged:
1014	+	FField.DataChanged;
1015	+	end;
1016	+	end;
1017	+
1018	+	constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
1019	+	begin
1020	+	inherited Create;
1021	+	FField := aField;
1022	+	FArray := anArray;
1023	+	FRecNo := FField.Dataset.RecNo;
1024	+	FArray.AddEventHandler(EventHandler);
1025	+	end;
1026	+
1027	+	destructor TIBArray.Destroy;
1028	+	begin
1029	+	FArray.RemoveEventHandler(EventHandler);
1030	+	inherited Destroy;
1031	+	end;
1032	+
1033	+	{ TIBArrayField }
1034	+
1035	+	function TIBArrayField.GetArrayIntf: IArray;
1036	+	begin
1037	+	Result := TIBCustomDataSet(DataSet).GetArray(self);
1038	+	end;
1039	+
1040	+	function TIBArrayField.GetArrayID: TISC_QUAD;
1041	+	begin
1042	+	GetData(@Result);
1043	+	end;
1044	+
1045	+	procedure TIBArrayField.SetArrayIntf(AValue: IArray);
1046	+	begin
1047	+	TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
1048	+	DataChanged;
1049	+	end;
1050	+
1051	+	class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
1052	+	begin
1053	+	//Ignore
1054	+	end;
1055	+
1056	+	function TIBArrayField.GetAsString: string;
1057	+	begin
1058	+	Result := '(Array)';
1059	+	end;
1060	+
1061	+	function TIBArrayField.GetDataSize: Integer;
1062	+	begin
1063	+	Result := sizeof(TISC_QUAD);
1064	+	end;
1065	+
1066	+	procedure TIBArrayField.Bind(Binding: Boolean);
1067	+	begin
1068	+	inherited Bind(Binding);
1069	+	if Binding then
1070	+	begin
1071	+	FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
1072	+	Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
1073	+	if FieldDef <> nil then
1074	+	begin
1075	+	FRelationName := TIBFieldDef(FieldDef).FRelationName;
1076	+	FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1077	+	FArrayBounds :=  TIBFieldDef(FieldDef).ArrayBounds;
1078	+	end;
1079	+	end;
1080	+	end;
1081	+
1082	+	constructor TIBArrayField.Create(AOwner: TComponent);
1083	+	begin
1084	+	inherited Create(AOwner);
1085	+	SetDataType(ftArray);
1086	+	end;
1087	+
1088	+	function TIBArrayField.CreateArray: IArray;
1089	+	begin
1090	+	with DataSet as TIBCustomDataSet do
1091	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1092	+	end;
1093	+
1094		{ TIBMemoField }
1095
1096		function TIBMemoField.GetTruncatedText: string;
#	Line 884 | Line 1110 | begin
1110		{2: case 2 ignored. This should be handled by TIBWideMemo}
1111
1112		3, {Assume UNICODE_FSS is really UTF8}
1113	<	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1113	>	4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1114		if DisplayWidth = 0 then
1115		Result := ValidUTF8String(TextToSingleLine(Result))
1116		else
#	Line 894 | Line 1120 | begin
1120		end
1121		end;
1122
1123	+	procedure TIBMemoField.Bind(Binding: Boolean);
1124	+	var IBFieldDef: TIBFieldDef;
1125	+	begin
1126	+	inherited Bind(Binding);
1127	+	if Binding and (FieldDef <> nil) then
1128	+	begin
1129	+	IBFieldDef := FieldDef as TIBFieldDef;
1130	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
1131	+	CharacterSetName := IBFieldDef.CharacterSetName;
1132	+	CodePage := IBFieldDef.CodePage;
1133	+	end;
1134	+	end;
1135	+
1136		function TIBMemoField.GetAsString: string;
1137		var s: RawByteString;
1138		begin
1139		s := inherited GetAsString;
901	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1140		SetCodePage(s,CodePage,false);
1141		if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1142		SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
905	–	{$ENDIF}
1143		Result := s;
1144		end;
1145
#	Line 931 | Line 1168 | procedure TIBMemoField.SetAsString(const
1168		var s: RawByteString;
1169		begin
1170		s := AValue;
1171	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
935	<	if StringCodePage(Value) <> CodePage then
1171	>	if StringCodePage(s) <> CodePage then
1172		SetCodePage(s,CodePage,CodePage<>CP_NONE);
937	–	{$ENDIF}
1173		inherited SetAsString(s);
1174		end;
1175
#	Line 942 | Line 1177 | constructor TIBMemoField.Create(AOwner:
1177		begin
1178		inherited Create(AOwner);
1179		BlobType := ftMemo;
945	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1180		FCodePage := CP_NONE;
947	–	{$ENDIF}
1181		end;
1182
1183		{ TIBControlLink }
#	Line 978 | Line 1211 | end;
1211
1212		{ TIBStringField}
1213
1214	<	function TIBStringField.GetDefaultWidth: Longint;
1214	>	procedure TIBStringField.Bind(Binding: Boolean);
1215	>	var IBFieldDef: TIBFieldDef;
1216		begin
1217	<	Result := Size div CharacterSetSize;
1217	>	inherited Bind(Binding);
1218	>	if Binding and (FieldDef <> nil) then
1219	>	begin
1220	>	IBFieldDef := FieldDef as TIBFieldDef;
1221	>	CharacterSetSize := IBFieldDef.CharacterSetSize;
1222	>	CharacterSetName := IBFieldDef.CharacterSetName;
1223	>	FDataSize := IBFieldDef.DataSize + 1;
1224	>	if AutoFieldSize then
1225	>	Size := IBFieldDef.Size;
1226	>	CodePage := IBFieldDef.CodePage;
1227	>	end;
1228	>	end;
1229	>
1230	>	function TIBStringField.GetDataSize: Integer;
1231	>	begin
1232	>	Result := FDataSize;
1233		end;
1234
1235		constructor TIBStringField.Create(aOwner: TComponent);
1236		begin
1237		inherited Create(aOwner);
1238		FCharacterSetSize := 1;
990	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1239		FCodePage := CP_NONE;
1240	<	{$ENDIF}
1240	>	FAutoFieldSize := true;
1241		end;
1242
1243		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 1013 | Line 1261 | function TIBStringField.GetValue(var Val
1261		var
1262		Buffer: PChar;
1263		s: RawByteString;
1016	–	//  i: integer;
1264		begin
1265		Buffer := nil;
1266	<	IBAlloc(Buffer, 0, Size + 1);
1266	>	IBAlloc(Buffer, 0, DataSize);
1267		try
1268		Result := GetData(Buffer);
1269		if Result then
1270		begin
1271	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1025	<	s := string(Buffer);
1271	>	s := strpas(Buffer);
1272		SetCodePage(s,CodePage,false);
1273		if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1274		SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1275		Value := s;
1276	<	(*      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}
1276	>	//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1277		if Transliterate and (Value <> '') then
1278		DataSet.Translate(PChar(Value), PChar(Value), False);
1279		end
#	Line 1048 | Line 1288 | var
1288		s: RawByteString;
1289		begin
1290		Buffer := nil;
1291	<	IBAlloc(Buffer, 0, Size + 1);
1291	>	IBAlloc(Buffer, 0, DataSize);
1292		try
1293		s := Value;
1054	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1294		if StringCodePage(s) <> CodePage then
1295		SetCodePage(s,CodePage,CodePage<>CP_NONE);
1296	<	{$ENDIF}
1058	<	StrLCopy(Buffer, PChar(s), Size);
1296	>	StrLCopy(Buffer, PChar(s), DataSize-1);
1297		if Transliterate then
1298		DataSet.Translate(Buffer, Buffer, True);
1299		SetData(Buffer);
#	Line 1074 | Line 1312 | begin
1312		Size := 8;
1313		end;
1314
1315	+	procedure TIBBCDField.Bind(Binding: Boolean);
1316	+	begin
1317	+	inherited Bind(Binding);
1318	+	if Binding and (FieldDef <> nil) then
1319	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1320	+	end;
1321	+
1322		class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1323		begin
1324		{ No need to check as the base type is currency, not BCD }
#	Line 1158 | Line 1403 | end;
1403		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1404		begin
1405		inherited Create(AOwner);
1161	–	FIBLoaded := False;
1162	–	CheckIBLoaded;
1163	–	FIBLoaded := True;
1406		FBase := TIBBase.Create(Self);
1407	+	FDatabaseInfo := TIBDatabaseInfo.Create(self);
1408		FIBLinks := TList.Create;
1409		FCurrentRecord := -1;
1410		FDeletedRecords := 0;
1411		FUniDirectional := False;
1412		FBufferChunks := BufferCacheSize;
1413		FBlobStreamList := TList.Create;
1414	+	FArrayList := TList.Create;
1415		FGeneratorField := TIBGenerator.Create(self);
1416		FDataLink := TIBDataLink.Create(Self);
1417		FQDelete := TIBSQL.Create(Self);
#	Line 1211 | Line 1455 | end;
1455		destructor TIBCustomDataSet.Destroy;
1456		begin
1457		if Active then Active := false;
1458	<	if FIBLoaded then
1459	<	begin
1460	<	if assigned(FGeneratorField) then FGeneratorField.Free;
1461	<	FDataLink.Free;
1462	<	FBase.Free;
1463	<	ClearBlobCache;
1464	<	ClearIBLinks;
1465	<	FIBLinks.Free;
1466	<	FBlobStreamList.Free;
1467	<	FreeMem(FBufferCache);
1468	<	FBufferCache := nil;
1469	<	FreeMem(FOldBufferCache);
1470	<	FOldBufferCache := nil;
1471	<	FCacheSize := 0;
1472	<	FOldCacheSize := 0;
1229	<	FMappedFieldPosition := nil;
1230	<	end;
1458	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1459	>	FDataLink.Free;
1460	>	FBase.Free;
1461	>	ClearBlobCache;
1462	>	ClearIBLinks;
1463	>	FIBLinks.Free;
1464	>	FBlobStreamList.Free;
1465	>	FArrayList.Free;
1466	>	FreeMem(FBufferCache);
1467	>	FBufferCache := nil;
1468	>	FreeMem(FOldBufferCache);
1469	>	FOldBufferCache := nil;
1470	>	FCacheSize := 0;
1471	>	FOldCacheSize := 0;
1472	>	FMappedFieldPosition := nil;
1473		if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1474		if assigned(FParser) then FParser.Free;
1475		inherited Destroy;
#	Line 1252 | Line 1494 | begin
1494		Inc(FCurrentRecord);
1495		if (FCurrentRecord = FRecordCount) then
1496		begin
1497	<	if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1497	>	if (not FQSelect.EOF) and FQSelect.Next  then
1498		begin
1499		FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1500		Inc(FRecordCount);
#	Line 1271 | Line 1513 | end;
1513
1514		procedure TIBCustomDataSet.ApplyUpdates;
1515		var
1274	–	{$IFDEF NEW_TBOOKMARK }
1516		CurBookmark: TBookmark;
1276	–	{$ELSE}
1277	–	CurBookmark: string;
1278	–	{$ENDIF}
1517		Buffer: PRecordData;
1518		CurUpdateTypes: TIBUpdateRecordTypes;
1519		UpdateAction: TIBUpdateAction;
#	Line 1506 | Line 1744 | end;
1744		function TIBCustomDataSet.ActivateTransaction: Boolean;
1745		begin
1746		Result := False;
1747	<	if not Assigned(Transaction) then
1510	<	IBError(ibxeTransactionNotAssigned, [nil]);
1511	<	if not Transaction.Active then
1747	>	if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1748		begin
1749	<	Result := True;
1750	<	Transaction.StartTransaction;
1751	<	FDidActivate := True;
1749	>	if not Assigned(Transaction) then
1750	>	IBError(ibxeTransactionNotAssigned, [nil]);
1751	>	if not Transaction.Active then
1752	>	begin
1753	>	Result := True;
1754	>	Transaction.StartTransaction;
1755	>	FDidActivate := True;
1756	>	end;
1757		end;
1758		end;
1759
#	Line 1637 | Line 1878 | begin
1878		FBlobStreamList.Pack;
1879		end;
1880
1881	+	procedure TIBCustomDataSet.ClearArrayCache;
1882	+	var
1883	+	i: Integer;
1884	+	begin
1885	+	for i := 0 to FArrayList.Count - 1 do
1886	+	begin
1887	+	TIBArray(FArrayList[i]).Free;
1888	+	FArrayList[i] := nil;
1889	+	end;
1890	+	FArrayList.Pack;
1891	+	end;
1892	+
1893		procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1894		begin
1895		Move(Source^, Dest^, FRecordBufferSize);
#	Line 1646 | Line 1899 | procedure TIBCustomDataSet.DoBeforeDatab
1899		begin
1900		if Active then
1901		Active := False;
1902	<	FInternalPrepared := False;
1902	>	InternalUnPrepare;
1903		if Assigned(FBeforeDatabaseDisconnect) then
1904		FBeforeDatabaseDisconnect(Sender);
1905		end;
#	Line 1684 | Line 1937 | begin
1937		FQModify.FreeHandle;
1938		if FQRefresh <> nil then
1939		FQRefresh.FreeHandle;
1940	+	InternalUnPrepare;
1941		if Assigned(FBeforeTransactionEnd) then
1942		FBeforeTransactionEnd(Sender);
1943		end;
#	Line 1700 | Line 1954 | begin
1954		FTransactionFree(Sender);
1955		end;
1956
1957	<	{ Read the record from FQSelect.Current into the record buffer
1958	<	Then write the buffer to in memory cache }
1959	<	procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1960	<	RecordNumber: Integer; Buffer: PChar);
1961	<	var
1708	<	p: PRecordData;
1709	<	pbd: PBlobDataArray;
1710	<	i, j: Integer;
1711	<	LocalData: Pointer;
1712	<	LocalDate, LocalDouble: Double;
1713	<	LocalInt: Integer;
1714	<	LocalBool: wordBool;
1715	<	LocalInt64: Int64;
1716	<	LocalCurrency: Currency;
1717	<	FieldsLoaded: Integer;
1957	>	procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1958	>	var i, j: Integer;
1959	>	FieldsLoaded: integer;
1960	>	p: PRecordData;
1961	>	colMetadata: IColumnMetaData;
1962		begin
1963		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;
1964		{ Get record information }
1965		p^.rdBookmarkFlag := bfCurrent;
1966	<	p^.rdFieldCount := Qry.Current.Count;
1967	<	p^.rdRecordNumber := RecordNumber;
1966	>	p^.rdFieldCount := Qry.FieldCount;
1967	>	p^.rdRecordNumber := -1;
1968		p^.rdUpdateStatus := usUnmodified;
1969		p^.rdCachedUpdateStatus := cusUnmodified;
1970		p^.rdSavedOffset := $FFFFFFFF;
1971
1972		{ Load up the fields }
1973	<	FieldsLoaded := FQSelect.Current.Count;
1973	>	FieldsLoaded := FQSelect.MetaData.Count;
1974		j := 1;
1975	<	for i := 0 to Qry.Current.Count - 1 do
1975	>	for i := 0 to Qry.MetaData.Count - 1 do
1976		begin
1977		if (Qry = FQSelect) then
1978		j := i + 1
1979	<	else begin
1979	>	else
1980	>	begin
1981		if FieldsLoaded = 0 then
1982		break;
1983	<	j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
1983	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1984		if j < 1 then
1985		continue
1986		else
1987		Dec(FieldsLoaded);
1988		end;
1989	<	with FQSelect.Current[j - 1].Data^ do
1990	<	if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
1989	>	if j > 0 then
1990	>	begin
1991	>	colMetadata := Qry.MetaData[i];
1992	>	with p^.rdFields[j], FFieldColumns^[j] do
1993		begin
1994	<	if sqllen <= 8 then
1995	<	p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
1996	<	continue;
1994	>	fdDataType := colMetadata.GetSQLType;
1995	>	if fdDataType = SQL_BLOB then
1996	>	fdDataScale := 0
1997	>	else
1998	>	fdDataScale := colMetadata.getScale;
1999	>	fdNullable := colMetadata.getIsNullable;
2000	>	fdIsNull := true;
2001	>	fdDataSize := colMetadata.GetSize;
2002	>	fdDataLength := 0;
2003	>	fdCodePage := CP_NONE;
2004	>
2005	>	case fdDataType of
2006	>	SQL_TIMESTAMP,
2007	>	SQL_TYPE_DATE,
2008	>	SQL_TYPE_TIME:
2009	>	fdDataSize := SizeOf(TDateTime);
2010	>	SQL_SHORT, SQL_LONG:
2011	>	begin
2012	>	if (fdDataScale = 0) then
2013	>	fdDataSize := SizeOf(Integer)
2014	>	else
2015	>	if (fdDataScale >= (-4)) then
2016	>	fdDataSize := SizeOf(Currency)
2017	>	else
2018	>	fdDataSize := SizeOf(Double);
2019	>	end;
2020	>	SQL_INT64:
2021	>	begin
2022	>	if (fdDataScale = 0) then
2023	>	fdDataSize := SizeOf(Int64)
2024	>	else
2025	>	if (fdDataScale >= (-4)) then
2026	>	fdDataSize := SizeOf(Currency)
2027	>	else
2028	>	fdDataSize := SizeOf(Double);
2029	>	end;
2030	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2031	>	fdDataSize := SizeOf(Double);
2032	>	SQL_BOOLEAN:
2033	>	fdDataSize := SizeOf(wordBool);
2034	>	SQL_VARYING,
2035	>	SQL_TEXT,
2036	>	SQL_BLOB:
2037	>	fdCodePage := Qry.Metadata[i].getCodePage;
2038	>	end;
2039	>	fdDataOfs := FRecordSize;
2040	>	Inc(FRecordSize, fdDataSize);
2041		end;
2042	<	if j > 0 then with p^ do
2042	>	end;
2043	>	end;
2044	>	end;
2045	>
2046	>	{Update Buffer Fields from Query Results}
2047	>
2048	>	procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2049	>	Buffer: PChar);
2050	>	var i, j: integer;
2051	>	begin
2052	>	for i := 0 to QryResults.Count - 1 do
2053	>	begin
2054	>	j := GetFieldPosition(QryResults[i].GetAliasName);
2055	>	if j > 0 then
2056	>	ColumnDataToBuffer(QryResults,i,j,Buffer);
2057	>	end;
2058	>	end;
2059	>
2060	>
2061	>	{Move column data returned from query to row buffer}
2062	>
2063	>	procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2064	>	ColumnIndex, FieldIndex: integer; Buffer: PChar);
2065	>	var
2066	>	LocalData: PByte;
2067	>	LocalDate, LocalDouble: Double;
2068	>	LocalInt: Integer;
2069	>	LocalBool: wordBool;
2070	>	LocalInt64: Int64;
2071	>	LocalCurrency: Currency;
2072	>	p: PRecordData;
2073	>	ColData: ISQLData;
2074	>	begin
2075	>	p := PRecordData(Buffer);
2076	>	LocalData := nil;
2077	>	with p^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2078	>	begin
2079	>	QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2080	>	if not fdIsNull then
2081		begin
2082	<	rdFields[j].fdDataType :=
2083	<	Qry.Current[i].Data^.sqltype and (not 1);
1760	<	rdFields[j].fdDataScale :=
1761	<	Qry.Current[i].Data^.sqlscale;
1762	<	rdFields[j].fdNullable :=
1763	<	(Qry.Current[i].Data^.sqltype and 1 = 1);
1764	<	rdFields[j].fdIsNull :=
1765	<	(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1766	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1767	<	rdFields[j].fdCodePage := 0;
1768	<	{$ENDIF}
1769	<	LocalData := Qry.Current[i].Data^.sqldata;
1770	<	case rdFields[j].fdDataType of
2082	>	ColData := QryResults[ColumnIndex];
2083	>	case fdDataType of  {Get Formatted data for column types that need formatting}
2084		SQL_TIMESTAMP:
2085		begin
2086	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2087	<	if RecordNumber >= 0 then
1775	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1776	<	LocalData := PChar(@LocalDate);
2086	>	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(ColData.AsDateTime));
2087	>	LocalData := PByte(@LocalDate);
2088		end;
2089		SQL_TYPE_DATE:
2090		begin
2091	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2092	<	if RecordNumber >= 0 then
1782	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1783	<	LocalData := PChar(@LocalInt);
2091	>	LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Date;
2092	>	LocalData := PByte(@LocalInt);
2093		end;
2094		SQL_TYPE_TIME:
2095		begin
2096	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
2097	<	if RecordNumber >= 0 then
1789	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1790	<	LocalData := PChar(@LocalInt);
2096	>	LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Time;
2097	>	LocalData := PByte(@LocalInt);
2098		end;
2099		SQL_SHORT, SQL_LONG:
2100		begin
2101	<	if (rdFields[j].fdDataScale = 0) then
2101	>	if (fdDataScale = 0) then
2102		begin
2103	<	rdFields[j].fdDataSize := SizeOf(Integer);
2104	<	if RecordNumber >= 0 then
1798	<	LocalInt := Qry.Current[i].AsLong;
1799	<	LocalData := PChar(@LocalInt);
2103	>	LocalInt := ColData.AsLong;
2104	>	LocalData := PByte(@LocalInt);
2105		end
2106	<	else if (rdFields[j].fdDataScale >= (-4)) then
2107	<	begin
2108	<	rdFields[j].fdDataSize := SizeOf(Currency);
2109	<	if RecordNumber >= 0 then
2110	<	LocalCurrency := Qry.Current[i].AsCurrency;
2111	<	LocalData := PChar(@LocalCurrency);
2112	<	end
2113	<	else begin
2114	<	rdFields[j].fdDataSize := SizeOf(Double);
2115	<	if RecordNumber >= 0 then
2116	<	LocalDouble := Qry.Current[i].AsDouble;
1812	<	LocalData := PChar(@LocalDouble);
1813	<	end;
2106	>	else
2107	>	if (fdDataScale >= (-4)) then
2108	>	begin
2109	>	LocalCurrency := ColData.AsCurrency;
2110	>	LocalData := PByte(@LocalCurrency);
2111	>	end
2112	>	else
2113	>	begin
2114	>	LocalDouble := ColData.AsDouble;
2115	>	LocalData := PByte(@LocalDouble);
2116	>	end;
2117		end;
2118		SQL_INT64:
2119		begin
2120	<	if (rdFields[j].fdDataScale = 0) then
2120	>	if (fdDataScale = 0) then
2121		begin
2122	<	rdFields[j].fdDataSize := SizeOf(Int64);
2123	<	if RecordNumber >= 0 then
1821	<	LocalInt64 := Qry.Current[i].AsInt64;
1822	<	LocalData := PChar(@LocalInt64);
2122	>	LocalInt64 := ColData.AsInt64;
2123	>	LocalData := PByte(@LocalInt64);
2124		end
2125	<	else if (rdFields[j].fdDataScale >= (-4)) then
2126	<	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
2125	>	else
2126	>	if (fdDataScale >= (-4)) then
2127		begin
2128	<	if (rdFields[j].fdDataLength = 0) then
2129	<	LocalData := nil
2128	>	LocalCurrency := ColData.AsCurrency;
2129	>	LocalData := PByte(@LocalCurrency);
2130	>	end
2131		else
2132	<	Inc(LocalData,2);
2133	<	end;
2132	>	begin
2133	>	LocalDouble := ColData.AsDouble;
2134	>	LocalData := PByte(@LocalDouble);
2135	>	end
2136		end;
2137	<	SQL_BOOLEAN:
2137	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2138		begin
2139	<	LocalBool:= false;
2140	<	rdFields[j].fdDataSize := SizeOf(wordBool);
1865	<	if RecordNumber >= 0 then
1866	<	LocalBool := Qry.Current[i].AsBoolean;
1867	<	LocalData := PChar(@LocalBool);
2139	>	LocalDouble := ColData.AsDouble;
2140	>	LocalData := PByte(@LocalDouble);
2141		end;
2142	<	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 }
2142	>	SQL_BOOLEAN:
2143		begin
2144	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
2144	>	LocalBool := ColData.AsBoolean;
2145	>	LocalData := PByte(@LocalBool);
2146		end;
2147		end;
2148	<	if RecordNumber < 0 then
2148	>
2149	>	if fdDataType = SQL_VARYING then
2150	>	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2151	>	else
2152	>	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2153	>	end
2154	>	else {Null column}
2155	>	if fdDataType = SQL_VARYING then
2156	>	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2157	>	else
2158	>	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2159	>	end;
2160	>	end;
2161	>
2162	>	{ Read the record from FQSelect.Current into the record buffer
2163	>	Then write the buffer to in memory cache }
2164	>	procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
2165	>	RecordNumber: Integer; Buffer: PChar);
2166	>	var
2167	>	pbd: PBlobDataArray;
2168	>	pda: PArrayDataArray;
2169	>	i, j: Integer;
2170	>	FieldsLoaded: Integer;
2171	>	p: PRecordData;
2172	>	begin
2173	>	if RecordNumber = -1 then
2174	>	begin
2175	>	InitModelBuffer(Qry,Buffer);
2176	>	Exit;
2177	>	end;
2178	>	p := PRecordData(Buffer);
2179	>	{ Make sure blob cache is empty }
2180	>	pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
2181	>	pda := PArrayDataArray(Buffer + FArrayCacheOffset);
2182	>	for i := 0 to BlobFieldCount - 1 do
2183	>	pbd^[i] := nil;
2184	>	for i := 0 to ArrayFieldCount - 1 do
2185	>	pda^[i] := nil;
2186	>
2187	>	{ Get record information }
2188	>	p^.rdBookmarkFlag := bfCurrent;
2189	>	p^.rdFieldCount := Qry.FieldCount;
2190	>	p^.rdRecordNumber := RecordNumber;
2191	>	p^.rdUpdateStatus := usUnmodified;
2192	>	p^.rdCachedUpdateStatus := cusUnmodified;
2193	>	p^.rdSavedOffset := $FFFFFFFF;
2194	>
2195	>	{ Load up the fields }
2196	>	FieldsLoaded := FQSelect.MetaData.Count;
2197	>	j := 1;
2198	>	for i := 0 to Qry.FieldCount - 1 do
2199	>	begin
2200	>	if (Qry = FQSelect) then
2201	>	j := i + 1
2202	>	else
2203	>	begin
2204	>	if FieldsLoaded = 0 then
2205	>	break;
2206	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2207	>	if j < 1 then
2208	>	continue
2209	>	else
2210	>	Dec(FieldsLoaded);
2211	>	end;
2212	>	with FQSelect.MetaData[j - 1] do
2213	>	if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2214		begin
2215	<	rdFields[j].fdIsNull := True;
2216	<	rdFields[j].fdDataOfs := FRecordSize;
2217	<	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)
2215	>	if (GetSize <= 8) then
2216	>	p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2217	>	continue;
2218		end;
2219	<	end;
2219	>	if j > 0 then
2220	>	ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2221		end;
2222	<	WriteRecordCache(RecordNumber, PChar(p));
2222	>	WriteRecordCache(RecordNumber, Buffer);
2223		end;
2224
2225		function TIBCustomDataSet.GetActiveBuf: PChar;
#	Line 1942 | Line 2264 | begin
2264		result := FBase.Database;
2265		end;
2266
1945	–	function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1946	–	begin
1947	–	result := FBase.DBHandle;
1948	–	end;
1949	–
2267		function TIBCustomDataSet.GetDeleteSQL: TStrings;
2268		begin
2269		result := FQDelete.SQL;
#	Line 1957 | Line 2274 | begin
2274		result := FQInsert.SQL;
2275		end;
2276
2277	<	function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2277	>	function TIBCustomDataSet.GetSQLParams: ISQLParams;
2278		begin
2279		if not FInternalPrepared then
2280		InternalPrepare;
#	Line 1974 | Line 2291 | begin
2291		result := FQSelect.SQL;
2292		end;
2293
2294	<	function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2294	>	function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2295		begin
2296	<	result := FQSelect.SQLType;
2296	>	result := FQSelect.SQLStatementType;
2297		end;
2298
2299		function TIBCustomDataSet.GetModifySQL: TStrings;
#	Line 1989 | Line 2306 | begin
2306		result := FBase.Transaction;
2307		end;
2308
1992	–	function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1993	–	begin
1994	–	result := FBase.TRHandle;
1995	–	end;
1996	–
2309		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2310		begin
2311		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
2312		FUpdateObject.Apply(ukDelete,Buff)
2313		else
2314		begin
2315	<	SetInternalSQLParams(FQDelete, Buff);
2315	>	SetInternalSQLParams(FQDelete.Params, Buff);
2316		FQDelete.ExecQuery;
2317		end;
2318		with PRecordData(Buff)^ do
#	Line 2015 | Line 2327 | function TIBCustomDataSet.InternalLocate
2327		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2328		var
2329		keyFieldList: TList;
2018	–	{$IFDEF NEW_TBOOKMARK }
2330		CurBookmark: TBookmark;
2020	–	{$ELSE}
2021	–	CurBookmark: string;
2022	–	{$ENDIF}
2331		fieldValue: Variant;
2332		lookupValues: array of variant;
2333		i, fieldCount: Integer;
#	Line 2101 | Line 2409 | end;
2409
2410		procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2411		var
2412	<	i, j, k: Integer;
2412	>	i, j, k, arr: Integer;
2413		pbd: PBlobDataArray;
2414	+	pda: PArrayDataArray;
2415		begin
2416		pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2417	<	j := 0;
2417	>	pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2418	>	j := 0; arr := 0;
2419		for i := 0 to FieldCount - 1 do
2420		if Fields[i].IsBlob then
2421		begin
#	Line 2114 | Line 2424 | begin
2424		begin
2425		pbd^[j].Finalize;
2426		PISC_QUAD(
2427	<	PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2427	>	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2428		pbd^[j].BlobID;
2429		PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2430	+	end
2431	+	else
2432	+	begin
2433	+	PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2434	+	with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2435	+	begin
2436	+	gds_quad_high := 0;
2437	+	gds_quad_low := 0;
2438	+	end;
2439		end;
2440		Inc(j);
2441	+	end
2442	+	else
2443	+	if Fields[i] is TIBArrayField then
2444	+	begin
2445	+	if pda^[arr] <> nil then
2446	+	begin
2447	+	k := FMappedFieldPosition[Fields[i].FieldNo -1];
2448	+	PISC_QUAD(
2449	+	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=  pda^[arr].ArrayIntf.GetArrayID;
2450	+	PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2451	+	end;
2452	+	Inc(arr);
2453		end;
2454		if Assigned(FUpdateObject) then
2455		begin
#	Line 2130 | Line 2461 | begin
2461		FUpdateObject.Apply(ukModify,Buff);
2462		end
2463		else begin
2464	<	SetInternalSQLParams(Qry, Buff);
2464	>	SetInternalSQLParams(Qry.Params, Buff);
2465		Qry.ExecQuery;
2466		end;
2467	+	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2468	+	UpdateRecordFromQuery(Qry.Current,Buff);
2469		PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2470		PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2471		SetModified(False);
#	Line 2164 | Line 2497 | begin
2497		end
2498		else
2499		Qry := FQRefresh;
2500	<	SetInternalSQLParams(Qry, Buff);
2500	>	SetInternalSQLParams(Qry.Params, Buff);
2501		Qry.ExecQuery;
2502		try
2503	<	if (Qry.SQLType = SQLExecProcedure) or
2171	<	(Qry.Next <> nil) then
2503	>	if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2504		begin
2505		ofs := PRecordData(Buff)^.rdSavedOffset;
2506		FetchCurrentRecordToBuffer(Qry,
#	Line 2261 | Line 2593 | begin
2593		end;
2594
2595		procedure TIBCustomDataSet.InternalPrepare;
2264	–	var
2265	–	DidActivate: Boolean;
2596		begin
2597		if FInternalPrepared then
2598		Exit;
2269	–	DidActivate := False;
2599		FBase.SetCursor;
2600		try
2601		ActivateConnection;
2602	<	DidActivate := ActivateTransaction;
2602	>	ActivateTransaction;
2603		FBase.CheckDatabase;
2604		FBase.CheckTransaction;
2605		if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
#	Line 2308 | Line 2637 | begin
2637		end else
2638		IBError(ibxeEmptyQuery, [nil]);
2639		finally
2311	–	if DidActivate then
2312	–	DeactivateTransaction;
2640		FBase.RestoreCursor;
2641		end;
2642		end;
#	Line 2339 | Line 2666 | var
2666		begin
2667		CopyRecordBuffer(Buffer, OldBuffer);
2668		if BlobFieldCount > 0 then
2669	<	FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2669	>	FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2670	>	BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2671		0);
2672		end;
2673
#	Line 2381 | Line 2709 | begin
2709		if (FBase.Database <> Value) then
2710		begin
2711		CheckDatasetClosed;
2712	+	InternalUnPrepare;
2713		FBase.Database := Value;
2714		FQDelete.Database := Value;
2715		FQInsert.Database := Value;
2716		FQRefresh.Database := Value;
2717		FQSelect.Database := Value;
2718		FQModify.Database := Value;
2719	+	FDatabaseInfo.Database := Value;
2720		end;
2721		end;
2722
#	Line 2408 | Line 2738 | begin
2738		end;
2739		end;
2740
2741	<	procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2741	>	procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2742		var
2743		i, j: Integer;
2744		cr, data: PChar;
#	Line 2416 | Line 2746 | var
2746		st: RawByteString;
2747		OldBuffer: Pointer;
2748		ts: TTimeStamp;
2749	+	Param: ISQLParam;
2750		begin
2751		if (Buffer = nil) then
2752		IBError(ibxeBufferNotSet, [nil]);
#	Line 2423 | Line 2754 | begin
2754		InternalPrepare;
2755		OldBuffer := nil;
2756		try
2757	<	for i := 0 to Qry.Params.Count - 1 do
2757	>	for i := 0 to Params.GetCount - 1 do
2758		begin
2759	<	fn := Qry.Params[i].Name;
2759	>	Param := Params[i];
2760	>	fn := Param.Name;
2761		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2762		begin
2763		fn := Copy(fn, 5, Length(fn));
#	Line 2445 | Line 2777 | begin
2777		cr := Buffer;
2778		j := FQSelect.FieldIndex[fn] + 1;
2779		if (j > 0) then
2780	<	with PRecordData(cr)^ do
2780	>	with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2781		begin
2782	<	if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2782	>	if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2783		begin
2784	<	PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2784	>	PIBDBKey(Param.AsPointer)^ := rdDBKey;
2785		continue;
2786		end;
2787	<	if rdFields[j].fdIsNull then
2788	<	Qry.Params[i].IsNull := True
2787	>	if fdIsNull then
2788	>	Param.IsNull := True
2789		else begin
2790	<	Qry.Params[i].IsNull := False;
2791	<	data := cr + rdFields[j].fdDataOfs;
2792	<	case rdFields[j].fdDataType of
2790	>	Param.IsNull := False;
2791	>	data := cr + fdDataOfs;
2792	>	case fdDataType of
2793		SQL_TEXT, SQL_VARYING:
2794		begin
2795	<	SetString(st, data, rdFields[j].fdDataLength);
2796	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
2797	<	SetCodePage(st,rdFields[j].fdCodePage,false);
2466	<	{$ENDIF}
2467	<	Qry.Params[i].AsString := st;
2795	>	SetString(st, data, fdDataLength);
2796	>	SetCodePage(st,fdCodePage,false);
2797	>	Param.AsString := st;
2798		end;
2799		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2800	<	Qry.Params[i].AsDouble := PDouble(data)^;
2800	>	Param.AsDouble := PDouble(data)^;
2801		SQL_SHORT, SQL_LONG:
2802		begin
2803	<	if rdFields[j].fdDataScale = 0 then
2804	<	Qry.Params[i].AsLong := PLong(data)^
2475	<	else if rdFields[j].fdDataScale >= (-4) then
2476	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2803	>	if fdDataScale = 0 then
2804	>	Param.AsLong := PLong(data)^
2805		else
2806	<	Qry.Params[i].AsDouble := PDouble(data)^;
2806	>	if fdDataScale >= (-4) then
2807	>	Param.AsCurrency := PCurrency(data)^
2808	>	else
2809	>	Param.AsDouble := PDouble(data)^;
2810		end;
2811		SQL_INT64:
2812		begin
2813	<	if rdFields[j].fdDataScale = 0 then
2814	<	Qry.Params[i].AsInt64 := PInt64(data)^
2815	<	else if rdFields[j].fdDataScale >= (-4) then
2816	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2813	>	if fdDataScale = 0 then
2814	>	Param.AsInt64 := PInt64(data)^
2815	>	else
2816	>	if fdDataScale >= (-4) then
2817	>	Param.AsCurrency := PCurrency(data)^
2818		else
2819	<	Qry.Params[i].AsDouble := PDouble(data)^;
2819	>	Param.AsDouble := PDouble(data)^;
2820		end;
2821		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2822	<	Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2822	>	Param.AsQuad := PISC_QUAD(data)^;
2823		SQL_TYPE_DATE:
2824		begin
2825		ts.Date := PInt(data)^;
2826		ts.Time := 0;
2827	<	Qry.Params[i].AsDate :=
2496	<	TimeStampToDateTime(ts);
2827	>	Param.AsDate := TimeStampToDateTime(ts);
2828		end;
2829		SQL_TYPE_TIME:
2830		begin
2831		ts.Date := 0;
2832		ts.Time := PInt(data)^;
2833	<	Qry.Params[i].AsTime :=
2503	<	TimeStampToDateTime(ts);
2833	>	Param.AsTime := TimeStampToDateTime(ts);
2834		end;
2835		SQL_TIMESTAMP:
2836	<	Qry.Params[i].AsDateTime :=
2836	>	Param.AsDateTime :=
2837		TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2838		SQL_BOOLEAN:
2839	<	Qry.Params[i].AsBoolean := PWordBool(data)^;
2839	>	Param.AsBoolean := PWordBool(data)^;
2840		end;
2841		end;
2842		end;
#	Line 2662 | Line 2992 | begin
2992		Result := Assigned( FQSelect ) and FQSelect.EOF;
2993		end;
2994
2995	<	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2995	>	function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2996		begin
2997		ActivateConnection;
2998		ActivateTransaction;
#	Line 2799 | Line 3129 | var
3129		Buff: PChar;
3130		bTr, bDB: Boolean;
3131		begin
3132	+	if (Field = nil) or (Field.DataSet <> self) then
3133	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3134		Buff := GetActiveBuf;
3135		if Buff = nil then
3136		begin
3137		fs := TIBBlobStream.Create;
3138		fs.Mode := bmReadWrite;
3139	+	fs.Database := Database;
3140	+	fs.Transaction := Transaction;
3141	+	fs.SetField(Field);
3142		FBlobStreamList.Add(Pointer(fs));
3143		result := TIBDSBlobStream.Create(Field, fs, Mode);
3144		exit;
#	Line 2818 | Line 3153 | begin
3153		fs.Mode := bmReadWrite;
3154		fs.Database := Database;
3155		fs.Transaction := Transaction;
3156	+	fs.SetField(Field);
3157		fs.BlobID :=
3158	<	PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3158	>	PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3159		if (CachedUpdates) then
3160		begin
3161		bTr := not Transaction.InTransaction;
#	Line 2840 | Line 3176 | begin
3176		result := TIBDSBlobStream.Create(Field, fs, Mode);
3177		end;
3178
3179	+	function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3180	+	var Buff: PChar;
3181	+	pda: PArrayDataArray;
3182	+	bTr, bDB: Boolean;
3183	+	begin
3184	+	if (Field = nil) or (Field.DataSet <> self) then
3185	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3186	+	Buff := GetActiveBuf;
3187	+	if Buff = nil then
3188	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3189	+	Field.FRelationName,Field.FieldName)
3190	+	else
3191	+	begin
3192	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3193	+	if pda^[Field.FCacheOffset] = nil then
3194	+	begin
3195	+	AdjustRecordOnInsert(Buff);
3196	+	if Field.IsNull then
3197	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3198	+	Field.FRelationName,Field.FieldName)
3199	+	else
3200	+	Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3201	+	Field.FRelationName,Field.FieldName,Field.ArrayID);
3202	+	pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3203	+	FArrayList.Add(pda^[Field.FCacheOffset]);
3204	+	if (CachedUpdates) then
3205	+	begin
3206	+	bTr := not Transaction.InTransaction;
3207	+	bDB := not Database.Connected;
3208	+	if bDB then
3209	+	Database.Open;
3210	+	if bTr then
3211	+	Transaction.StartTransaction;
3212	+	pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3213	+	if bTr then
3214	+	Transaction.Commit;
3215	+	if bDB then
3216	+	Database.Close;
3217	+	end;
3218	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3219	+	end
3220	+	else
3221	+	Result := pda^[Field.FCacheOffset].ArrayIntf;
3222	+	end;
3223	+	end;
3224	+
3225	+	procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3226	+	var Buff: PChar;
3227	+	pda: PArrayDataArray;
3228	+	begin
3229	+	if (Field = nil) or (Field.DataSet <> self) then
3230	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3231	+	Buff := GetActiveBuf;
3232	+	if Buff <> nil then
3233	+	begin
3234	+	AdjustRecordOnInsert(Buff);
3235	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3236	+	pda^[Field.FCacheOffset].FArray := AnArray;
3237	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3238	+	end;
3239	+	end;
3240	+
3241		function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3242		const
3243		CMPLess = -1;
#	Line 2920 | Line 3318 | end;
3318		procedure TIBCustomDataSet.DoBeforeClose;
3319		begin
3320		inherited DoBeforeClose;
3321	+	if FInTransactionEnd and (FCloseAction = TARollback) then
3322	+	Exit;
3323		if State in [dsInsert,dsEdit] then
3324		begin
2925	–	if FInTransactionEnd and (FCloseAction = TARollback) then
2926	–	Exit;
2927	–
3325		if DataSetCloseAction = dcSaveChanges then
3326		Post;
3327		{Note this can fail with an exception e.g. due to
3328		database validation error. In which case the dataset remains open }
3329		end;
3330	+	if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3331	+	ApplyUpdates;
3332		end;
3333
3334		procedure TIBCustomDataSet.DoBeforeOpen;
#	Line 2961 | Line 3360 | end;
3360
3361		procedure TIBCustomDataSet.FetchAll;
3362		var
2964	–	{$IFDEF NEW_TBOOKMARK }
3363		CurBookmark: TBookmark;
2966	–	{$ELSE}
2967	–	CurBookmark: string;
2968	–	{$ENDIF}
3364		begin
3365		FBase.SetCursor;
3366		try
#	Line 3076 | Line 3471 | begin
3471		if result and (Buffer <> nil) then
3472		Move(Buff[1], Buffer^, Field.DataSize);
3473		end
3474	<	else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3474	>	else
3475	>	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3476		(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3477	+	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3478	+	FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3479		begin
3480	<	result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3480	>	result := not fdIsNull;
3481		if result and (Buffer <> nil) then
3084	–	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3482		begin
3483	<	Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3483	>	Data := Buff + fdDataOfs;
3484		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3485		begin
3486		if fdDataLength < Field.DataSize then
#	Line 3154 | Line 3551 | begin
3551		if FCurrentRecord < FRecordCount then
3552		ReadRecordCache(FCurrentRecord, Buffer, False)
3553		else begin
3554	<	while (not FQSelect.EOF) and
3158	<	(FQSelect.Next <> nil) and
3554	>	while (not FQSelect.EOF) and FQSelect.Next  and
3555		(FCurrentRecord >= FRecordCount) do begin
3556		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3557		Inc(FRecordCount);
#	Line 3266 | Line 3662 | procedure TIBCustomDataSet.InternalCance
3662		var
3663		Buff: PChar;
3664		CurRec: Integer;
3665	+	pda: PArrayDataArray;
3666	+	i: integer;
3667		begin
3668		inherited InternalCancel;
3669		Buff := GetActiveBuf;
3670	<	if Buff <> nil then begin
3670	>	if Buff <> nil then
3671	>	begin
3672	>	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3673	>	for i := 0 to ArrayFieldCount - 1 do
3674	>	pda^[i].ArrayIntf.CancelChanges;
3675		CurRec := FCurrentRecord;
3676		AdjustRecordOnInsert(Buff);
3677		if (State = dsEdit) then begin
#	Line 3292 | Line 3694 | begin
3694		DeactivateTransaction;
3695		FQSelect.Close;
3696		ClearBlobCache;
3697	+	ClearArrayCache;
3698		FreeRecordBuffer(FModelBuffer);
3699		FreeRecordBuffer(FOldBuffer);
3700		FCurrentRecord := -1;
#	Line 3307 | Line 3710 | begin
3710		FOBEnd := 0;
3711		FreeMem(FBufferCache);
3712		FBufferCache := nil;
3713	+	FreeMem(FFieldColumns);
3714	+	FFieldColumns := nil;
3715		FreeMem(FOldBufferCache);
3716		FOldBufferCache := nil;
3717		BindFields(False);
#	Line 3381 | Line 3786 | const
3786		'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3787		'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3788		'     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3789	+
3790	+	DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3791	+	'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3792	+	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3793	+	'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3794	+	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3795	+	'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3796	+	'     (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3797	+	'     ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3798	+
3799		var
3800		FieldType: TFieldType;
3801		FieldSize: Word;
3802	<	charSetID: integer;
3802	>	FieldDataSize: integer;
3803	>	charSetID: short;
3804		CharSetSize: integer;
3805		CharSetName: RawByteString;
3390	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3806		FieldCodePage: TSystemCodePage;
3392	–	{$ENDIF}
3807		FieldNullable : Boolean;
3808		i, FieldPosition, FieldPrecision: Integer;
3809		FieldAliasName, DBAliasName: string;
3810	<	RelationName, FieldName: string;
3810	>	aRelationName, FieldName: string;
3811		Query : TIBSQL;
3812		FieldIndex: Integer;
3813		FRelationNodes : TRelationNode;
3814	+	aArrayDimensions: integer;
3815	+	aArrayBounds: TArrayBounds;
3816	+	ArrayMetaData: IArrayMetaData;
3817
3818		function Add_Node(Relation, Field : String) : TRelationNode;
3819		var
#	Line 3419 | Line 3836 | var
3836		FField.FieldName := Query.Fields[2].AsString;
3837		FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3838		FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3839	+	FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3840		FField.NextField := Result.FieldNodes;
3841		Result.FieldNodes := FField;
3842		Query.Next;
#	Line 3472 | Line 3890 | var
3890		FField := Ffield.NextField;
3891		end;
3892
3893	+	function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3894	+	var
3895	+	FRelation : TRelationNode;
3896	+	FField : TFieldNode;
3897	+	begin
3898	+	FRelation := FRelationNodes;
3899	+	while Assigned(FRelation) and
3900	+	(FRelation.RelationName <> Relation) do
3901	+	FRelation := FRelation.NextRelation;
3902	+	if not Assigned(FRelation) then
3903	+	FRelation := Add_Node(Relation, Field);
3904	+	Result := false;
3905	+	FField := FRelation.FieldNodes;
3906	+	while Assigned(FField) do
3907	+	if FField.FieldName = Field then
3908	+	begin
3909	+	Result := Ffield.IDENTITY_COLUMN;
3910	+	Exit;
3911	+	end
3912	+	else
3913	+	FField := Ffield.NextField;
3914	+	end;
3915	+
3916		Procedure FreeNodes;
3917		var
3918		FRelation : TRelationNode;
#	Line 3494 | Line 3935 | var
3935		begin
3936		FRelationNodes := TRelationNode.Create;
3937		FNeedsRefresh := False;
3938	<	Database.InternalTransaction.StartTransaction;
3938	>	if not Database.InternalTransaction.InTransaction then
3939	>	Database.InternalTransaction.StartTransaction;
3940		Query := TIBSQL.Create(self);
3941		try
3942		Query.Database := DataBase;
#	Line 3502 | Line 3944 | begin
3944		FieldDefs.BeginUpdate;
3945		FieldDefs.Clear;
3946		FieldIndex := 0;
3947	<	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3948	<	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3949	<	Query.SQL.Text := DefaultSQL;
3947	>	if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3948	>	SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3949	>	if FDatabaseInfo.ODSMajorVersion >= 12 then
3950	>	Query.SQL.Text := DefaultSQLODS12
3951	>	else
3952	>	Query.SQL.Text := DefaultSQL;
3953		Query.Prepare;
3954	<	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3955	<	SetLength(FAliasNameList, SourceQuery.Current.Count);
3956	<	for i := 0 to SourceQuery.Current.Count - 1 do
3957	<	with SourceQuery.Current[i].Data^ do
3954	>	SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3955	>	SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3956	>	for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3957	>	with SourceQuery.MetaData[i] do
3958		begin
3959		{ Get the field name }
3960	<	FieldAliasName := SourceQuery.Current[i].Name;
3961	<	SetString(DBAliasName, aliasname, aliasname_length);
3962	<	SetString(RelationName, relname, relname_length);
3963	<	SetString(FieldName, sqlname, sqlname_length);
3960	>	FieldAliasName := GetName;
3961	>	DBAliasName := GetAliasname;
3962	>	aRelationName := getRelationName;
3963	>	FieldName := getSQLName;
3964		FAliasNameList[i] := DBAliasName;
3965		FieldSize := 0;
3966	+	FieldDataSize := GetSize;
3967		FieldPrecision := 0;
3968	<	FieldNullable := SourceQuery.Current[i].IsNullable;
3968	>	FieldNullable := IsNullable;
3969		CharSetSize := 0;
3970		CharSetName := '';
3525	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3971		FieldCodePage := CP_NONE;
3972	<	{$ENDIF}
3973	<	case sqltype and not 1 of
3972	>	aArrayDimensions := 0;
3973	>	SetLength(aArrayBounds,0);
3974	>	case SQLType of
3975		{ All VARCHAR's must be converted to strings before recording
3976		their values }
3977		SQL_VARYING, SQL_TEXT:
3978		begin
3979	<	CharSetID := SourceQuery.Current[i].GetCharSetID;
3980	<	TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
3981	<	CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
3982	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3983	<	TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3538	<	{$ENDIF}
3539	<	FieldSize := sqllen;
3979	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3980	>	CharSetSize := 1;
3981	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3982	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3983	>	FieldSize := FieldDataSize div CharSetSize;
3984		FieldType := ftString;
3985		end;
3986		{ All Doubles/Floats should be cast to doubles }
#	Line 3544 | Line 3988 | begin
3988		FieldType := ftFloat;
3989		SQL_SHORT:
3990		begin
3991	<	if (sqlscale = 0) then
3991	>	if (getScale = 0) then
3992		FieldType := ftSmallInt
3993		else begin
3994		FieldType := ftBCD;
3995		FieldPrecision := 4;
3996	<	FieldSize := -sqlscale;
3996	>	FieldSize := -getScale;
3997		end;
3998		end;
3999		SQL_LONG:
4000		begin
4001	<	if (sqlscale = 0) then
4001	>	if (getScale = 0) then
4002		FieldType := ftInteger
4003	<	else if (sqlscale >= (-4)) then
4003	>	else if (getScale >= (-4)) then
4004		begin
4005		FieldType := ftBCD;
4006		FieldPrecision := 9;
4007	<	FieldSize := -sqlscale;
4007	>	FieldSize := -getScale;
4008		end
4009		else
4010		if Database.SQLDialect = 1 then
#	Line 3572 | Line 4016 | begin
4016		begin
4017		FieldType := ftFMTBCD;
4018		FieldPrecision := 9;
4019	<	FieldSize := -sqlscale;
4019	>	FieldSize := -getScale;
4020		end;
4021		end;
4022
4023		SQL_INT64:
4024		begin
4025	<	if (sqlscale = 0) then
4025	>	if (getScale = 0) then
4026		FieldType := ftLargeInt
4027	<	else if (sqlscale >= (-4)) then
4027	>	else if (getScale >= (-4)) then
4028		begin
4029		FieldType := ftBCD;
4030		FieldPrecision := 18;
4031	<	FieldSize := -sqlscale;
4031	>	FieldSize := -getScale;
4032		end
4033		else
4034	<	FieldType := ftFloat
4034	>	FieldType := ftFloat;
4035		end;
4036		SQL_TIMESTAMP: FieldType := ftDateTime;
4037		SQL_TYPE_TIME: FieldType := ftTime;
#	Line 3595 | Line 4039 | begin
4039		SQL_BLOB:
4040		begin
4041		FieldSize := sizeof (TISC_QUAD);
4042	<	if (sqlsubtype = 1) then
4042	>	if (getSubtype = 1) then
4043		begin
4044	<	CharSetID := SourceQuery.Current[i].GetCharSetID;
4045	<	TFirebirdCharacterSets.CharSetWidth(CharSetID,CharSetSize);
4046	<	CharSetName := TFirebirdCharacterSets.GetCharsetName(CharSetID);
4047	<	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3604	<	TFirebirdCharacterSets.CharSetID2CodePage(CharSetID,FieldCodePage);
3605	<	{$ENDIF}
4044	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4045	>	CharSetSize := 1;
4046	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4047	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4048		FieldType := ftMemo;
4049		end
4050		else
#	Line 3611 | Line 4053 | begin
4053		SQL_ARRAY:
4054		begin
4055		FieldSize := sizeof (TISC_QUAD);
4056	<	FieldType := ftUnknown;
4056	>	FieldType := ftArray;
4057	>	ArrayMetaData := GetArrayMetaData;
4058	>	if ArrayMetaData <> nil then
4059	>	begin
4060	>	aArrayDimensions := ArrayMetaData.GetDimensions;
4061	>	aArrayBounds := ArrayMetaData.GetBounds;
4062	>	end;
4063		end;
4064		SQL_BOOLEAN:
4065		FieldType:= ftBoolean;
#	Line 3628 | Line 4076 | begin
4076		Name := FieldAliasName;
4077		FAliasNameMap[FieldNo-1] := DBAliasName;
4078		Size := FieldSize;
4079	+	DataSize := FieldDataSize;
4080		Precision := FieldPrecision;
4081		Required := not FieldNullable;
4082	+	RelationName := aRelationName;
4083		InternalCalcField := False;
4084		CharacterSetSize := CharSetSize;
4085		CharacterSetName := CharSetName;
3636	–	{$IFDEF HAS_ANSISTRING_CODEPAGE}
4086		CodePage := FieldCodePage;
4087	<	{$ENDIF}
4087	>	ArrayDimensions := aArrayDimensions;
4088	>	ArrayBounds := aArrayBounds;
4089		if (FieldName <> '') and (RelationName <> '') then
4090		begin
4091	+	IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4092		if Has_COMPUTED_BLR(RelationName, FieldName) then
4093		begin
4094		Attributes := [faReadOnly];
#	Line 3663 | Line 4114 | begin
4114		FreeNodes;
4115		Database.InternalTransaction.Commit;
4116		FieldDefs.EndUpdate;
4117	+	FieldDefs.Updated := true;
4118		end;
4119		end;
4120
#	Line 3680 | Line 4132 | begin
4132		else begin
4133		Buffer := AllocRecordBuffer;
4134		try
4135	<	while FQSelect.Next <> nil do
4135	>	while FQSelect.Next do
4136		begin
4137		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
4138		Inc(FRecordCount);
#	Line 3695 | Line 4147 | end;
4147		procedure TIBCustomDataSet.InternalSetParamsFromCursor;
4148		var
4149		i: Integer;
4150	<	cur_param: TIBXSQLVAR;
4150	>	cur_param: ISQLParam;
4151		cur_field: TField;
4152		s: TStream;
4153		begin
#	Line 3703 | Line 4155 | begin
4155		IBError(ibxeEmptyQuery, [nil]);
4156		if not FInternalPrepared then
4157		InternalPrepare;
4158	<	if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4158	>	if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4159		begin
4160	<	for i := 0 to SQLParams.Count - 1 do
4160	>	for i := 0 to SQLParams.GetCount - 1 do
4161		begin
4162		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4163		cur_param := SQLParams[i];
#	Line 3739 | Line 4191 | begin
4191		try
4192		s := DataSource.DataSet.
4193		CreateBlobStream(cur_field, bmRead);
4194	<	cur_param.LoadFromStream(s);
4194	>	cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4195		finally
4196		s.free;
4197		end;
4198		end;
4199	+	ftArray:
4200	+	cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4201		else
4202		IBError(ibxeNotSupported, [nil]);
4203		end;
#	Line 3776 | Line 4230 | procedure TIBCustomDataSet.InternalOpen;
4230		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
4231		end;
4232
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	–
4233		begin
4234		FBase.SetCursor;
4235		try
#	Line 3834 | Line 4239 | begin
4239		IBError(ibxeEmptyQuery, [nil]);
4240		if not FInternalPrepared then
4241		InternalPrepare;
4242	<	if FQSelect.SQLType = SQLSelect then
4242	>	if FQSelect.SQLStatementType = SQLSelect then
4243		begin
4244		if DefaultFields then
4245		CreateFields;
4246	+	FArrayFieldCount := 0;
4247		BindFields(True);
3842	–	SetExtendedProperties;
4248		FCurrentRecord := -1;
4249		FQSelect.ExecQuery;
4250		FOpen := FQSelect.Open;
#	Line 3850 | Line 4255 | begin
4255		3. After the dummy fetch, FRecordSize will be appropriately
4256		adjusted to reflect the additional "weight" of the field
4257		data.
4258	<	4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4258	>	4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4259		5. Now, with the BufferSize available, allocate memory for chunks of records
4260		6. Re-allocate the model buffer, accounting for the new
4261		FRecordBufferSize.
4262		7. Finally, calls to AllocRecordBuffer will work!.
4263		}
4264		{Step 1}
4265	<	FRecordSize := RecordDataLength(FQSelect.Current.Count);
4265	>	FRecordSize := RecordDataLength(FQSelect.FieldCount);
4266		{Step 2, 3}
4267	+	GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4268		IBAlloc(FModelBuffer, 0, FRecordSize);
4269	<	FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4269	>	InitModelBuffer(FQSelect, FModelBuffer);
4270		{Step 4}
4271		FCalcFieldsOffset := FRecordSize;
4272		FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4273	<	FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4273	>	FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4274	>	FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4275		{Step 5}
4276		if UniDirectional then
4277		FBufferChunkSize := FRecordBufferSize * UniCache
#	Line 3880 | Line 4287 | begin
4287		FCacheSize := FBufferChunkSize;
4288		FOldCacheSize := FBufferChunkSize;
4289		{Step 6}
4290	<	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4290	>	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4291		FRecordBufferSize);
4292		{Step 7}
4293		FOldBuffer := AllocRecordBuffer;
#	Line 3978 | Line 4385 | end;
4385		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4386		Options: TLocateOptions): Boolean;
4387		var
3981	–	{$IFDEF NEW_TBOOKMARK }
4388		CurBookmark: TBookmark;
3983	–	{$ELSE}
3984	–	CurBookmark: string;
3985	–	{$ENDIF}
4389		begin
4390		DisableControls;
4391		try
#	Line 4000 | Line 4403 | function TIBCustomDataSet.Lookup(const K
4403		const ResultFields: string): Variant;
4404		var
4405		fl: TList;
4003	–	{$IFDEF NEW_TBOOKMARK }
4406		CurBookmark: TBookmark;
4005	–	{$ELSE}
4006	–	CurBookmark: string;
4007	–	{$ENDIF}
4407		begin
4408		DisableControls;
4409		fl := TList.Create;
#	Line 4077 | Line 4476 | begin
4476		MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4477		if (MappedFieldPos > 0) and
4478		(MappedFieldPos <= rdFieldCount) then
4479	+	with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4480		begin
4481		Field.Validate(Buffer);
4482		if (Buffer = nil) or
4483		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4484	<	rdFields[MappedFieldPos].fdIsNull := True
4485	<	else begin
4486	<	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4487	<	rdFields[MappedFieldPos].fdDataSize);
4488	<	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4489	<	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4490	<	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4091	<	rdFields[MappedFieldPos].fdIsNull := False;
4484	>	fdIsNull := True
4485	>	else
4486	>	begin
4487	>	Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4488	>	if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4489	>	fdDataLength := StrLen(PChar(Buffer));
4490	>	fdIsNull := False;
4491		if rdUpdateStatus = usUnmodified then
4492		begin
4493		if CachedUpdates then
#	Line 4189 | Line 4588 | begin
4588		if FInternalPrepared then
4589		begin
4590		CheckDatasetClosed;
4591	+	if FDidActivate then
4592	+	DeactivateTransaction;
4593		FieldDefs.Clear;
4594		FieldDefs.Updated := false;
4595		FInternalPrepared := False;
#	Line 4209 | Line 4610 | begin
4610		IBError(ibxeEmptyQuery, [nil]);
4611		if not FInternalPrepared then
4612		InternalPrepare;
4613	<	if FQSelect.SQLType = SQLSelect then
4613	>	if FQSelect.SQLStatementType = SQLSelect then
4614		begin
4615		IBError(ibxeIsASelectStatement, [nil]);
4616		end
#	Line 4222 | Line 4623 | begin
4623		end;
4624		end;
4625
4626	<	function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4626	>	function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4627		begin
4628	<	Result := FQSelect.Handle;
4628	>	Result := FQSelect.Statement;
4629		end;
4630
4631		function TIBCustomDataSet.GetParser: TSelectSQLParser;
#	Line 4279 | Line 4680 | end;
4680
4681		{ TIBDataSet IProviderSupport }
4682
4683	<	(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4683	>	procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4684		begin
4685		if Commit then
4686		Transaction.Commit else
#	Line 4432 | Line 4833 | begin
4833		Transaction.StartTransaction;
4834		end;
4835
4836	<	function TIBCustomDataSet.PSGetTableName: string;
4836	>	function TIBCustomDataSet.PsGetTableName: string;
4837		begin
4838		//  if not FInternalPrepared then
4839		//    InternalPrepare;
#	Line 4442 | Line 4843 | begin
4843		if not FQSelect.Prepared then
4844		FQSelect.Prepare;
4845		Result := FQSelect.UniqueRelationName;
4846	<	end;*)
4846	>	end;
4847
4848		procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4849		begin
#	Line 4573 | Line 4974 | begin
4974		inherited Destroy;
4975		end;
4976
4977	<	procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4977	>	procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4978		begin
4979		FRefreshSQL.Assign(Value);
4980		end;
4981
4982	+	procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
4983	+	buff: PChar);
4984	+	begin
4985	+	if not Assigned(DataSet) then Exit;
4986	+	DataSet.SetInternalSQLParams(Params, buff);
4987	+	end;
4988	+
4989		procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
4990		begin
4991	+	InternalSetParams(Query.Params,buff);
4992	+	end;
4993	+
4994	+	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
4995	+	Buffer: PChar);
4996	+	begin
4997		if not Assigned(DataSet) then Exit;
4998	<	DataSet.SetInternalSQLParams(Query, buff);
4998	>	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
4999		end;
5000
5001		function TIBDSBlobStream.GetSize: Int64;

Diff Legend

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