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 35 by tony, Tue Jan 26 14:38:47 2016 UTC vs.
Revision 66 by tony, Wed Aug 23 08:23:42 2017 UTC

#	Line 35 | Line 35 | unit IBCustomDataSet;
35
36		{$R-}
37
38	+	{$IFDEF FPC}
39		{$Mode Delphi}
40	+	{$codepage UTF8}
41	+	{$ENDIF}
42
43		{$IFDEF DELPHI}
44		{$DEFINE TDBDFIELD_IS_BCD}
#	Line 49 | Line 52 | uses
52		{$ELSE}
53		unix,
54		{$ENDIF}
55	<	SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
55	>	SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
56		IBUtils, IBBlob, IBSQLParser;
57
58		const
#	Line 82 | Line 85 | type
85
86		TBlobDataArray = array[0..0] of TIBBlobStream;
87		PBlobDataArray = ^TBlobDataArray;
88	+	TIBArrayField = class;
89
90	<	{ TIBCustomDataSet }
91	<	TFieldData = record
92	<	fdDataType: Short;
93	<	fdDataScale: Short;
94	<	fdNullable: Boolean;
95	<	fdIsNull: Boolean;
96	<	fdDataSize: Short;
97	<	fdDataLength: Short;
98	<	fdDataOfs: Integer;
90	>	{ TIBArray }
91	>
92	>	{Wrapper class to support array cache in TIBCustomDataset and event handling}
93	>
94	>	TIBArray = class
95	>	private
96	>	FArray: IArray;
97	>	FRecNo: integer;
98	>	FField: TIBArrayField;
99	>	procedure EventHandler(Sender: IArray; Reason: TArrayEventReason);
100	>	public
101	>	constructor Create(aField: TIBArrayField; anArray: IArray);
102	>	destructor Destroy; override;
103	>	property ArrayIntf: IArray read FArray;
104		end;
105	<	PFieldData = ^TFieldData;
105	>
106	>	TArrayDataArray = array [0..0] of TIBArray;
107	>	PArrayDataArray = ^TArrayDataArray;
108	>
109	>	{ TIBCustomDataSet }
110
111		TCachedUpdateStatus = (
112		cusUnmodified, cusModified, cusInserted,
#	Line 104 | Line 117 | type
117		end;
118		PIBDBKey = ^TIBDBKey;
119
120	+	PFieldData = ^TFieldData;
121	+	TFieldData = record
122	+	fdIsNull: Boolean;
123	+	fdDataLength: Short;
124	+	end;
125	+
126	+	PColumnData = ^TColumnData;
127	+	TColumnData = record
128	+	fdDataType: Short;
129	+	fdDataScale: Short;
130	+	fdNullable: Boolean;
131	+	fdDataSize: Short;
132	+	fdDataOfs: Integer;
133	+	fdCodePage: TSystemCodePage;
134	+	end;
135	+
136	+	PFieldColumns = ^TFieldColumns;
137	+	TFieldColumns =  array[1..1] of TColumnData;
138	+
139		TRecordData = record
140		rdBookmarkFlag: TBookmarkFlag;
141		rdFieldCount: Short;
#	Line 116 | Line 148 | type
148		end;
149		PRecordData = ^TRecordData;
150
151	+	{ TIBArrayField }
152	+
153	+	TIBArrayField = class(TField)
154	+	private
155	+	FArrayBounds: TArrayBounds;
156	+	FArrayDimensions: integer;
157	+	FRelationName: string;
158	+	FCacheOffset: word;
159	+	function GetArrayID: TISC_QUAD;
160	+	function GetArrayIntf: IArray;
161	+	procedure SetArrayIntf(AValue: IArray);
162	+	protected
163	+	class procedure CheckTypeSize(AValue: Longint); override;
164	+	function GetAsString: string; override;
165	+	function GetDataSize: Integer; override;
166	+	procedure Bind(Binding: Boolean); override;
167	+	public
168	+	constructor Create(AOwner: TComponent); override;
169	+	function CreateArray: IArray;
170	+	property ArrayID: TISC_QUAD read GetArrayID;
171	+	property ArrayIntf: IArray read GetArrayIntf write SetArrayIntf;
172	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
173	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
174	+	end;
175	+
176		{ TIBStringField allows us to have strings longer than 8196 }
177
178		TIBStringField = class(TStringField)
179		private
180	<	FCharacterSetName: string;
180	>	FCharacterSetName: RawByteString;
181		FCharacterSetSize: integer;
182	+	FAutoFieldSize: boolean;
183	+	FCodePage: TSystemCodePage;
184	+	FDataSize: integer;
185		protected
186	<	function GetDefaultWidth: Longint; override;
186	>	procedure Bind(Binding: Boolean); override;
187	>	function GetDataSize: Integer; override;
188		public
189		constructor Create(aOwner: TComponent); override;
190		class procedure CheckTypeSize(Value: Integer); override;
#	Line 131 | Line 192 | type
192		function GetAsVariant: Variant; override;
193		function GetValue(var Value: string): Boolean;
194		procedure SetAsString(const Value: string); override;
195	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
135	<	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
136	<	end;
137	<
138	<	{ TIBWideStringField }
139	<
140	<	TIBWideStringField = class(TWideStringField)
141	<	private
142	<	FCharacterSetName: string;
143	<	FCharacterSetSize: integer;
144	<	public
145	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
195	>	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
196		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
197	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
198	+	published
199	+	property AutoFieldSize: boolean read FAutoFieldSize write FAutoFieldSize default true;
200		end;
201
202		{ TIBBCDField }
#	Line 172 | Line 225 | type
225
226		TIBMemoField = class(TMemoField)
227		private
228	<	FCharacterSetName: string;
228	>	FCharacterSetName: RawByteString;
229		FCharacterSetSize: integer;
230		FDisplayTextAsClassName: boolean;
231		function GetTruncatedText: string;
232		protected
233	+	procedure Bind(Binding: Boolean); override;
234	+	function GetAsString: string; override;
235		function GetDefaultWidth: Longint; override;
236		procedure GetText(var AText: string; ADisplayText: Boolean); override;
237	+	procedure SetAsString(const AValue: string); override;
238		public
239		constructor Create(AOwner: TComponent); override;
240	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
240	>	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
241		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
242	<	published
242	>	published
243		property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
244		write FDisplayTextAsClassName;
189	–	end;
190	–
191	–	{ TIBWideMemoField }
192	–
193	–	TIBWideMemoField = class(TWideMemoField)
245		private
246	<	FCharacterSetName: string;
247	<	FCharacterSetSize: integer;
197	<	FDisplayTextAsClassName: boolean;
198	<	function GetTruncatedText: string;
199	<	protected
200	<	function GetDefaultWidth: Longint; override;
201	<	procedure GetText(var AText: string; ADisplayText: Boolean); override;
246	>	FCodePage: TSystemCodePage;
247	>	FFCodePage: TSystemCodePage;
248		public
249	<	constructor Create(AOwner: TComponent); override;
204	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
205	<	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
206	<	published
207	<	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
208	<	write FDisplayTextAsClassName;
249	>	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
250		end;
251
252		TIBDataLink = class(TDetailDataLink)
#	Line 263 | Line 304 | type
304		TIBAutoCommit = (acDisabled, acCommitRetaining);
305
306		{ TIBCustomDataSet }
307	+
308		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
309
310		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
#	Line 279 | Line 321 | type
321
322		TIBCustomDataSet = class(TDataset)
323		private
324	+	FAllowAutoActivateTransaction: Boolean;
325	+	FArrayFieldCount: integer;
326	+	FArrayCacheOffset: integer;
327		FAutoCommit: TIBAutoCommit;
328		FGenerateParamNames: Boolean;
329		FGeneratorField: TIBGenerator;
330		FNeedsRefresh: Boolean;
331		FForcedRefresh: Boolean;
332		FDidActivate: Boolean;
288	–	FIBLoaded: Boolean;
333		FBase: TIBBase;
334		FBlobCacheOffset: Integer;
335		FBlobStreamList: TList;
336	+	FArrayList: TList;
337		FBufferChunks: Integer;
338		FBufferCache,
339		FOldBufferCache: PChar;
#	Line 342 | Line 387 | type
387		FCloseAction: TTransactionAction;
388		FInTransactionEnd: boolean;
389		FIBLinks: TList;
390	<	function GetSelectStmtHandle: TISC_STMT_HANDLE;
390	>	FFieldColumns: PFieldColumns;
391	>	procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
392	>	function GetSelectStmtIntf: IStatement;
393		procedure SetUpdateMode(const Value: TUpdateMode);
394		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
395
#	Line 354 | Line 401 | type
401		function CanRefresh: Boolean;
402		procedure CheckEditState;
403		procedure ClearBlobCache;
404	+	procedure ClearArrayCache;
405		procedure ClearIBLinks;
406		procedure CopyRecordBuffer(Source, Dest: Pointer);
407		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
#	Line 365 | Line 413 | type
413		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
414		Buffer: PChar);
415		function GetDatabase: TIBDatabase;
368	–	function GetDBHandle: PISC_DB_HANDLE;
416		function GetDeleteSQL: TStrings;
417		function GetInsertSQL: TStrings;
418	<	function GetSQLParams: TIBXSQLDA;
418	>	function GetSQLParams: ISQLParams;
419		function GetRefreshSQL: TStrings;
420		function GetSelectSQL: TStrings;
421	<	function GetStatementType: TIBSQLTypes;
421	>	function GetStatementType: TIBSQLStatementTypes;
422		function GetModifySQL: TStrings;
423		function GetTransaction: TIBTransaction;
377	–	function GetTRHandle: PISC_TR_HANDLE;
424		function GetParser: TSelectSQLParser;
425		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
426		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
#	Line 429 | Line 475 | type
475		procedure SQLChanging(Sender: TObject); virtual;
476		procedure SQLChanged(Sender: TObject); virtual;
477
478	<	(*    { IProviderSupport }
478	>	{ IProviderSupport }
479		procedure PSEndTransaction(Commit: Boolean); override;
480		function PSExecuteStatement(const ASQL: string; AParams: TParams;
481		ResultSet: Pointer = nil): Integer; override;
#	Line 442 | Line 488 | type
488		procedure PSStartTransaction; override;
489		procedure PSReset; override;
490		function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
491	<	*)
491	>
492		{ TDataSet support }
493		procedure InternalInsert; override;
494		procedure InitRecord(Buffer: PChar); override;
#	Line 506 | Line 552 | type
552		protected
553		{Likely to be made public by descendant classes}
554		property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
555	<	property SQLParams: TIBXSQLDA read GetSQLParams;
556	<	property Params: TIBXSQLDA read GetSQLParams;
555	>	property SQLParams: ISQLParams read GetSQLParams;
556	>	property Params: ISQLParams read GetSQLParams;
557		property InternalPrepared: Boolean read FInternalPrepared;
558		property QDelete: TIBSQL read FQDelete;
559		property QInsert: TIBSQL read FQInsert;
560		property QRefresh: TIBSQL read FQRefresh;
561		property QSelect: TIBSQL read FQSelect;
562		property QModify: TIBSQL read FQModify;
563	<	property StatementType: TIBSQLTypes read GetStatementType;
564	<	property SelectStmtHandle: TISC_STMT_HANDLE read GetSelectStmtHandle;
563	>	property StatementType: TIBSQLStatementTypes read GetStatementType;
564	>	property SelectStmtHandle: IStatement read GetSelectStmtIntf;
565
566		{Likely to be made published by descendant classes}
567		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
#	Line 566 | Line 612 | type
612		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
613		function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
614		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
615	+	function GetArray(Field: TIBArrayField): IArray;
616	+	procedure SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
617		function GetCurrentRecord(Buffer: PChar): Boolean; override;
618		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
619		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
#	Line 579 | Line 627 | type
627		function UpdateStatus: TUpdateStatus; override;
628		function IsSequenced: Boolean; override;
629		procedure Post; override;
630	<	function ParamByName(ParamName: String): TIBXSQLVAR;
631	<	property DBHandle: PISC_DB_HANDLE read GetDBHandle;
584	<	property TRHandle: PISC_TR_HANDLE read GetTRHandle;
630	>	function ParamByName(ParamName: String): ISQLParam;
631	>	property ArrayFieldCount: integer read FArrayFieldCount;
632		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
633		property UpdatesPending: Boolean read FUpdatesPending;
634		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
#	Line 590 | Line 637 | type
637		read FDataSetCloseAction write FDataSetCloseAction;
638
639		published
640	+	property AllowAutoActivateTransaction: Boolean read FAllowAutoActivateTransaction
641	+	write FAllowAutoActivateTransaction;
642		property Database: TIBDatabase read GetDatabase write SetDatabase;
643		property Transaction: TIBTransaction read GetTransaction
644		write SetTransaction;
#	Line 719 | Line 768 | type
768		protected
769		FField: TField;
770		FBlobStream: TIBBlobStream;
771	+	function  GetSize: Int64; override;
772		public
773		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
774		Mode: TBlobStreamMode);
#	Line 729 | Line 779 | type
779		function Write(const Buffer; Count: Longint): Longint; override;
780		end;
781
782	+	{Extended Field Def for character set info}
783	+
784	+	{ TIBFieldDef }
785	+
786	+	TIBFieldDef = class(TFieldDef)
787	+	private
788	+	FArrayBounds: TArrayBounds;
789	+	FArrayDimensions: integer;
790	+	FCharacterSetName: RawByteString;
791	+	FCharacterSetSize: integer;
792	+	FCodePage: TSystemCodePage;
793	+	FRelationName: string;
794	+	FDataSize: integer;
795	+	published
796	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
797	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
798	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
799	+	property DataSize: integer read FDataSize write FDataSize;
800	+	property RelationName: string read FRelationName write FRelationName;
801	+	property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
802	+	property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
803	+	end;
804	+
805		const
806		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
807		nil,                { ftUnknown }
#	Line 755 | Line 828 | DefaultFieldClasses: array[TFieldType] o
828		TBlobField,         { ftTypedBinary }
829		nil,                { ftCursor }
830		TStringField,       { ftFixedChar }
831	<	TIBWideStringField,    { ftWideString }
831	>	nil,    { ftWideString }
832		TLargeIntField,     { ftLargeInt }
833		nil,          { ftADT }
834	<	nil,        { ftArray }
834	>	TIBArrayField,        { ftArray }
835		nil,    { ftReference }
836		nil,     { ftDataSet }
837		TBlobField,         { ftOraBlob }
#	Line 770 | Line 843 | DefaultFieldClasses: array[TFieldType] o
843		TDateTimeField,    {ftTimestamp}
844		TIBBCDField,       {ftFMTBcd}
845		nil,  {ftFixedWideChar}
846	<	TIBWideMemoField);   {ftWideMemo}
846	>	nil);   {ftWideMemo}
847		(*
848		TADTField,          { ftADT }
849		TArrayField,        { ftArray }
#	Line 787 | Line 860 | DefaultFieldClasses: array[TFieldType] o
860
861		implementation
862
863	<	uses IBIntf, Variants, FmtBCD, LCLProc, LazUTF8;
863	>	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
864
865		const FILE_BEGIN = 0;
866		FILE_CURRENT = 1;
#	Line 810 | Line 883 | type
883		NextRelation : TRelationNode;
884		end;
885
813	–	{Extended Field Def for character set info}
886
887	<	{ TIBFieldDef }
887	>	{  Copied from LCLProc in order to avoid LCL dependency
888
889	<	TIBFieldDef = class(TFieldDef)
890	<	private
891	<	FCharacterSetName: string;
892	<	FCharacterSetSize: integer;
893	<	published
894	<	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
895	<	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
889	>	Ensures the covenient look of multiline string
890	>	when displaying it in the single line
891	>	* Replaces CR and LF with spaces
892	>	* Removes duplicate spaces
893	>	}
894	>	function TextToSingleLine(const AText: string): string;
895	>	var
896	>	str: string;
897	>	i, wstart, wlen: Integer;
898	>	begin
899	>	str := Trim(AText);
900	>	wstart := 0;
901	>	wlen := 0;
902	>	i := 1;
903	>	while i < Length(str) - 1 do
904	>	begin
905	>	if (str[i] in [' ', #13, #10]) then
906	>	begin
907	>	if (wstart = 0) then
908	>	begin
909	>	wstart := i;
910	>	wlen := 1;
911	>	end else
912	>	Inc(wlen);
913	>	end else
914	>	begin
915	>	if wstart > 0 then
916	>	begin
917	>	str[wstart] := ' ';
918	>	Delete(str, wstart+1, wlen-1);
919	>	Dec(i, wlen-1);
920	>	wstart := 0;
921	>	end;
922	>	end;
923	>	Inc(i);
924	>	end;
925	>	Result := str;
926		end;
927
928	<	{ TIBWideMemoField }
928	>	{ TIBArray }
929
930	<	function TIBWideMemoField.GetTruncatedText: string;
930	>	procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
931		begin
932	<	Result := GetAsString;
932	>	case Reason of
933	>	arChanging:
934	>	if FRecNo <> FField.Dataset.RecNo then
935	>	IBError(ibxeNotCurrentArray,[nil]);
936
937	<	if Result <> '' then
938	<	if DisplayWidth = 0 then
939	<	Result := TextToSingleLine(Result)
940	<	else
941	<	if Length(Result) > DisplayWidth then {Show truncation with elipses}
942	<	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
937	>	arChanged:
938	>	FField.DataChanged;
939	>	end;
940	>	end;
941	>
942	>	constructor TIBArray.Create(aField: TIBArrayField; anArray: IArray);
943	>	begin
944	>	inherited Create;
945	>	FField := aField;
946	>	FArray := anArray;
947	>	FRecNo := FField.Dataset.RecNo;
948	>	FArray.AddEventHandler(EventHandler);
949		end;
950
951	<	function TIBWideMemoField.GetDefaultWidth: Longint;
951	>	destructor TIBArray.Destroy;
952		begin
953	<	Result := 128;
953	>	FArray.RemoveEventHandler(EventHandler);
954	>	inherited Destroy;
955		end;
956
957	<	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
957	>	{ TIBArrayField }
958	>
959	>	function TIBArrayField.GetArrayIntf: IArray;
960		begin
961	<	if ADisplayText then
961	>	Result := TIBCustomDataSet(DataSet).GetArray(self);
962	>	end;
963	>
964	>	function TIBArrayField.GetArrayID: TISC_QUAD;
965	>	begin
966	>	GetData(@Result);
967	>	end;
968	>
969	>	procedure TIBArrayField.SetArrayIntf(AValue: IArray);
970	>	begin
971	>	TIBCustomDataSet(DataSet).SetArrayIntf(AValue,self);
972	>	DataChanged;
973	>	end;
974	>
975	>	class procedure TIBArrayField.CheckTypeSize(AValue: Longint);
976	>	begin
977	>	//Ignore
978	>	end;
979	>
980	>	function TIBArrayField.GetAsString: string;
981	>	begin
982	>	Result := '(Array)';
983	>	end;
984	>
985	>	function TIBArrayField.GetDataSize: Integer;
986	>	begin
987	>	Result := sizeof(TISC_QUAD);
988	>	end;
989	>
990	>	procedure TIBArrayField.Bind(Binding: Boolean);
991	>	begin
992	>	inherited Bind(Binding);
993	>	if Binding then
994		begin
995	<	if not DisplayTextAsClassName then
996	<	AText := GetTruncatedText
997	<	else
998	<	inherited GetText(AText, ADisplayText);
999	<	end
1000	<	else
1001	<	AText := GetAsString;
995	>	FCacheOffset := TIBCustomDataSet(DataSet).ArrayFieldCount;
996	>	Inc(TIBCustomDataSet(DataSet).FArrayFieldCount);
997	>	if FieldDef <> nil then
998	>	begin
999	>	FRelationName := TIBFieldDef(FieldDef).FRelationName;
1000	>	FArrayDimensions := TIBFieldDef(FieldDef).ArrayDimensions;
1001	>	FArrayBounds :=  TIBFieldDef(FieldDef).ArrayBounds;
1002	>	end;
1003	>	end;
1004		end;
1005
1006	<	constructor TIBWideMemoField.Create(AOwner: TComponent);
1006	>	constructor TIBArrayField.Create(AOwner: TComponent);
1007		begin
1008		inherited Create(AOwner);
1009	<	BlobType := ftWideMemo;
1009	>	SetDataType(ftArray);
1010	>	end;
1011	>
1012	>	function TIBArrayField.CreateArray: IArray;
1013	>	begin
1014	>	with DataSet as TIBCustomDataSet do
1015	>	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,FRelationName,FieldName);
1016		end;
1017
1018		{ TIBMemoField }
#	Line 890 | Line 1044 | begin
1044		end
1045		end;
1046
1047	+	procedure TIBMemoField.Bind(Binding: Boolean);
1048	+	var IBFieldDef: TIBFieldDef;
1049	+	begin
1050	+	inherited Bind(Binding);
1051	+	if Binding and (FieldDef <> nil) then
1052	+	begin
1053	+	IBFieldDef := FieldDef as TIBFieldDef;
1054	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
1055	+	CharacterSetName := IBFieldDef.CharacterSetName;
1056	+	CodePage := IBFieldDef.CodePage;
1057	+	end;
1058	+	end;
1059	+
1060	+	function TIBMemoField.GetAsString: string;
1061	+	var s: RawByteString;
1062	+	begin
1063	+	s := inherited GetAsString;
1064	+	SetCodePage(s,CodePage,false);
1065	+	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1066	+	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1067	+	Result := s;
1068	+	end;
1069	+
1070		function TIBMemoField.GetDefaultWidth: Longint;
1071		begin
1072	<	Result := 128;
1072	>	if DisplayTextAsClassName then
1073	>	Result := inherited
1074	>	else
1075	>	Result := 128;
1076		end;
1077
1078		procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
1079		begin
1080		if ADisplayText then
1081		begin
1082	<	if not DisplayTextAsClassName then
1082	>	if not DisplayTextAsClassName and (CharacterSetName <> '') then
1083		AText := GetTruncatedText
1084		else
1085		inherited GetText(AText, ADisplayText);
#	Line 908 | Line 1088 | begin
1088		AText := GetAsString;
1089		end;
1090
1091	+	procedure TIBMemoField.SetAsString(const AValue: string);
1092	+	var s: RawByteString;
1093	+	begin
1094	+	s := AValue;
1095	+	if StringCodePage(s) <> CodePage then
1096	+	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1097	+	inherited SetAsString(s);
1098	+	end;
1099	+
1100		constructor TIBMemoField.Create(AOwner: TComponent);
1101		begin
1102		inherited Create(AOwner);
1103		BlobType := ftMemo;
1104	+	FCodePage := CP_NONE;
1105		end;
1106
1107		{ TIBControlLink }
#	Line 945 | Line 1135 | end;
1135
1136		{ TIBStringField}
1137
1138	<	function TIBStringField.GetDefaultWidth: Longint;
1138	>	procedure TIBStringField.Bind(Binding: Boolean);
1139	>	var IBFieldDef: TIBFieldDef;
1140	>	begin
1141	>	inherited Bind(Binding);
1142	>	if Binding and (FieldDef <> nil) then
1143	>	begin
1144	>	IBFieldDef := FieldDef as TIBFieldDef;
1145	>	CharacterSetSize := IBFieldDef.CharacterSetSize;
1146	>	CharacterSetName := IBFieldDef.CharacterSetName;
1147	>	FDataSize := IBFieldDef.DataSize + 1;
1148	>	if AutoFieldSize then
1149	>	Size := IBFieldDef.Size;
1150	>	CodePage := IBFieldDef.CodePage;
1151	>	end;
1152	>	end;
1153	>
1154	>	function TIBStringField.GetDataSize: Integer;
1155		begin
1156	<	Result := Size div CharacterSetSize;
1156	>	Result := FDataSize;
1157		end;
1158
1159		constructor TIBStringField.Create(aOwner: TComponent);
1160		begin
1161		inherited Create(aOwner);
1162		FCharacterSetSize := 1;
1163	+	FCodePage := CP_NONE;
1164	+	FAutoFieldSize := true;
1165		end;
1166
1167		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 976 | Line 1184 | end;
1184		function TIBStringField.GetValue(var Value: string): Boolean;
1185		var
1186		Buffer: PChar;
1187	+	s: RawByteString;
1188		begin
1189		Buffer := nil;
1190	<	IBAlloc(Buffer, 0, Size + 1);
1190	>	IBAlloc(Buffer, 0, DataSize);
1191		try
1192		Result := GetData(Buffer);
1193		if Result then
1194		begin
1195	<	Value := string(Buffer);
1195	>	s := strpas(Buffer);
1196	>	SetCodePage(s,CodePage,false);
1197	>	if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1198	>	SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1199	>	Value := s;
1200	>	//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1201		if Transliterate and (Value <> '') then
1202		DataSet.Translate(PChar(Value), PChar(Value), False);
1203		end
#	Line 995 | Line 1209 | end;
1209		procedure TIBStringField.SetAsString(const Value: string);
1210		var
1211		Buffer: PChar;
1212	+	s: RawByteString;
1213		begin
1214		Buffer := nil;
1215	<	IBAlloc(Buffer, 0, Size + 1);
1215	>	IBAlloc(Buffer, 0, DataSize);
1216		try
1217	<	StrLCopy(Buffer, PChar(Value), Size);
1217	>	s := Value;
1218	>	if StringCodePage(s) <> CodePage then
1219	>	SetCodePage(s,CodePage,CodePage<>CP_NONE);
1220	>	StrLCopy(Buffer, PChar(s), DataSize-1);
1221		if Transliterate then
1222		DataSet.Translate(Buffer, Buffer, True);
1223		SetData(Buffer);
#	Line 1102 | Line 1320 | end;
1320		constructor TIBCustomDataSet.Create(AOwner: TComponent);
1321		begin
1322		inherited Create(AOwner);
1105	–	FIBLoaded := False;
1106	–	CheckIBLoaded;
1107	–	FIBLoaded := True;
1323		FBase := TIBBase.Create(Self);
1324		FIBLinks := TList.Create;
1325		FCurrentRecord := -1;
#	Line 1112 | Line 1327 | begin
1327		FUniDirectional := False;
1328		FBufferChunks := BufferCacheSize;
1329		FBlobStreamList := TList.Create;
1330	+	FArrayList := TList.Create;
1331		FGeneratorField := TIBGenerator.Create(self);
1332		FDataLink := TIBDataLink.Create(Self);
1333		FQDelete := TIBSQL.Create(Self);
#	Line 1155 | Line 1371 | end;
1371		destructor TIBCustomDataSet.Destroy;
1372		begin
1373		if Active then Active := false;
1374	<	if FIBLoaded then
1375	<	begin
1376	<	if assigned(FGeneratorField) then FGeneratorField.Free;
1377	<	FDataLink.Free;
1378	<	FBase.Free;
1379	<	ClearBlobCache;
1380	<	ClearIBLinks;
1381	<	FIBLinks.Free;
1382	<	FBlobStreamList.Free;
1383	<	FreeMem(FBufferCache);
1384	<	FBufferCache := nil;
1385	<	FreeMem(FOldBufferCache);
1386	<	FOldBufferCache := nil;
1387	<	FCacheSize := 0;
1388	<	FOldCacheSize := 0;
1173	<	FMappedFieldPosition := nil;
1174	<	end;
1374	>	if assigned(FGeneratorField) then FGeneratorField.Free;
1375	>	FDataLink.Free;
1376	>	FBase.Free;
1377	>	ClearBlobCache;
1378	>	ClearIBLinks;
1379	>	FIBLinks.Free;
1380	>	FBlobStreamList.Free;
1381	>	FArrayList.Free;
1382	>	FreeMem(FBufferCache);
1383	>	FBufferCache := nil;
1384	>	FreeMem(FOldBufferCache);
1385	>	FOldBufferCache := nil;
1386	>	FCacheSize := 0;
1387	>	FOldCacheSize := 0;
1388	>	FMappedFieldPosition := nil;
1389		if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1390		if assigned(FParser) then FParser.Free;
1391		inherited Destroy;
#	Line 1196 | Line 1410 | begin
1410		Inc(FCurrentRecord);
1411		if (FCurrentRecord = FRecordCount) then
1412		begin
1413	<	if (not FQSelect.EOF) and (FQSelect.Next <> nil) then
1413	>	if (not FQSelect.EOF) and FQSelect.Next  then
1414		begin
1415		FetchCurrentRecordToBuffer(FQSelect, FCurrentRecord, Buffer);
1416		Inc(FRecordCount);
#	Line 1215 | Line 1429 | end;
1429
1430		procedure TIBCustomDataSet.ApplyUpdates;
1431		var
1218	–	{$IF FPC_FULLVERSION >= 20700 }
1432		CurBookmark: TBookmark;
1220	–	{$ELSE}
1221	–	CurBookmark: string;
1222	–	{$ENDIF}
1433		Buffer: PRecordData;
1434		CurUpdateTypes: TIBUpdateRecordTypes;
1435		UpdateAction: TIBUpdateAction;
#	Line 1450 | Line 1660 | end;
1660		function TIBCustomDataSet.ActivateTransaction: Boolean;
1661		begin
1662		Result := False;
1663	<	if not Assigned(Transaction) then
1454	<	IBError(ibxeTransactionNotAssigned, [nil]);
1455	<	if not Transaction.Active then
1663	>	if AllowAutoActivateTransaction or (csDesigning in ComponentState) then
1664		begin
1665	<	Result := True;
1666	<	Transaction.StartTransaction;
1667	<	FDidActivate := True;
1665	>	if not Assigned(Transaction) then
1666	>	IBError(ibxeTransactionNotAssigned, [nil]);
1667	>	if not Transaction.Active then
1668	>	begin
1669	>	Result := True;
1670	>	Transaction.StartTransaction;
1671	>	FDidActivate := True;
1672	>	end;
1673		end;
1674		end;
1675
#	Line 1581 | Line 1794 | begin
1794		FBlobStreamList.Pack;
1795		end;
1796
1797	+	procedure TIBCustomDataSet.ClearArrayCache;
1798	+	var
1799	+	i: Integer;
1800	+	begin
1801	+	for i := 0 to FArrayList.Count - 1 do
1802	+	begin
1803	+	TIBArray(FArrayList[i]).Free;
1804	+	FArrayList[i] := nil;
1805	+	end;
1806	+	FArrayList.Pack;
1807	+	end;
1808	+
1809		procedure TIBCustomDataSet.CopyRecordBuffer(Source, Dest: Pointer);
1810		begin
1811		Move(Source^, Dest^, FRecordBufferSize);
#	Line 1590 | Line 1815 | procedure TIBCustomDataSet.DoBeforeDatab
1815		begin
1816		if Active then
1817		Active := False;
1818	<	FInternalPrepared := False;
1818	>	InternalUnPrepare;
1819		if Assigned(FBeforeDatabaseDisconnect) then
1820		FBeforeDatabaseDisconnect(Sender);
1821		end;
#	Line 1628 | Line 1853 | begin
1853		FQModify.FreeHandle;
1854		if FQRefresh <> nil then
1855		FQRefresh.FreeHandle;
1856	+	InternalUnPrepare;
1857		if Assigned(FBeforeTransactionEnd) then
1858		FBeforeTransactionEnd(Sender);
1859		end;
#	Line 1644 | Line 1870 | begin
1870		FTransactionFree(Sender);
1871		end;
1872
1873	+	procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1874	+	var i, j: Integer;
1875	+	FieldsLoaded: integer;
1876	+	p: PRecordData;
1877	+	colMetadata: IColumnMetaData;
1878	+	begin
1879	+	p := PRecordData(Buffer);
1880	+	{ Get record information }
1881	+	p^.rdBookmarkFlag := bfCurrent;
1882	+	p^.rdFieldCount := Qry.FieldCount;
1883	+	p^.rdRecordNumber := -1;
1884	+	p^.rdUpdateStatus := usUnmodified;
1885	+	p^.rdCachedUpdateStatus := cusUnmodified;
1886	+	p^.rdSavedOffset := $FFFFFFFF;
1887	+
1888	+	{ Load up the fields }
1889	+	FieldsLoaded := FQSelect.MetaData.Count;
1890	+	j := 1;
1891	+	for i := 0 to Qry.MetaData.Count - 1 do
1892	+	begin
1893	+	if (Qry = FQSelect) then
1894	+	j := i + 1
1895	+	else
1896	+	begin
1897	+	if FieldsLoaded = 0 then
1898	+	break;
1899	+	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
1900	+	if j < 1 then
1901	+	continue
1902	+	else
1903	+	Dec(FieldsLoaded);
1904	+	end;
1905	+	if j > 0 then
1906	+	begin
1907	+	colMetadata := Qry.MetaData[i];
1908	+	with p^.rdFields[j], FFieldColumns^[j] do
1909	+	begin
1910	+	fdDataType := colMetadata.GetSQLType;
1911	+	if fdDataType = SQL_BLOB then
1912	+	fdDataScale := 0
1913	+	else
1914	+	fdDataScale := colMetadata.getScale;
1915	+	fdNullable := colMetadata.getIsNullable;
1916	+	fdIsNull := true;
1917	+	fdDataSize := colMetadata.GetSize;
1918	+	fdDataLength := 0;
1919	+	fdCodePage := CP_NONE;
1920	+
1921	+	case fdDataType of
1922	+	SQL_TIMESTAMP,
1923	+	SQL_TYPE_DATE,
1924	+	SQL_TYPE_TIME:
1925	+	fdDataSize := SizeOf(TDateTime);
1926	+	SQL_SHORT, SQL_LONG:
1927	+	begin
1928	+	if (fdDataScale = 0) then
1929	+	fdDataSize := SizeOf(Integer)
1930	+	else
1931	+	if (fdDataScale >= (-4)) then
1932	+	fdDataSize := SizeOf(Currency)
1933	+	else
1934	+	fdDataSize := SizeOf(Double);
1935	+	end;
1936	+	SQL_INT64:
1937	+	begin
1938	+	if (fdDataScale = 0) then
1939	+	fdDataSize := SizeOf(Int64)
1940	+	else
1941	+	if (fdDataScale >= (-4)) then
1942	+	fdDataSize := SizeOf(Currency)
1943	+	else
1944	+	fdDataSize := SizeOf(Double);
1945	+	end;
1946	+	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1947	+	fdDataSize := SizeOf(Double);
1948	+	SQL_BOOLEAN:
1949	+	fdDataSize := SizeOf(wordBool);
1950	+	SQL_VARYING,
1951	+	SQL_TEXT,
1952	+	SQL_BLOB:
1953	+	fdCodePage := Qry.Metadata[i].getCodePage;
1954	+	end;
1955	+	fdDataOfs := FRecordSize;
1956	+	Inc(FRecordSize, fdDataSize);
1957	+	end;
1958	+	end;
1959	+	end;
1960	+	end;
1961	+
1962		{ Read the record from FQSelect.Current into the record buffer
1963		Then write the buffer to in memory cache }
1964		procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
1965		RecordNumber: Integer; Buffer: PChar);
1966		var
1652	–	p: PRecordData;
1967		pbd: PBlobDataArray;
1968	+	pda: PArrayDataArray;
1969		i, j: Integer;
1970	<	LocalData: Pointer;
1970	>	LocalData: PByte;
1971		LocalDate, LocalDouble: Double;
1972		LocalInt: Integer;
1973		LocalBool: wordBool;
1974		LocalInt64: Int64;
1975		LocalCurrency: Currency;
1976		FieldsLoaded: Integer;
1977	<	temp: TIBXSQLVAR;
1977	>	p: PRecordData;
1978		begin
1979	+	if RecordNumber = -1 then
1980	+	begin
1981	+	InitModelBuffer(Qry,Buffer);
1982	+	Exit;
1983	+	end;
1984		p := PRecordData(Buffer);
1985		{ Make sure blob cache is empty }
1986		pbd := PBlobDataArray(Buffer + FBlobCacheOffset);
1987	<	if RecordNumber > -1 then
1988	<	for i := 0 to BlobFieldCount - 1 do
1989	<	pbd^[i] := nil;
1987	>	pda := PArrayDataArray(Buffer + FArrayCacheOffset);
1988	>	for i := 0 to BlobFieldCount - 1 do
1989	>	pbd^[i] := nil;
1990	>	for i := 0 to ArrayFieldCount - 1 do
1991	>	pda^[i] := nil;
1992	>
1993		{ Get record information }
1994		p^.rdBookmarkFlag := bfCurrent;
1995	<	p^.rdFieldCount := Qry.Current.Count;
1995	>	p^.rdFieldCount := Qry.FieldCount;
1996		p^.rdRecordNumber := RecordNumber;
1997		p^.rdUpdateStatus := usUnmodified;
1998		p^.rdCachedUpdateStatus := cusUnmodified;
1999		p^.rdSavedOffset := $FFFFFFFF;
2000
2001		{ Load up the fields }
2002	<	FieldsLoaded := FQSelect.Current.Count;
2002	>	FieldsLoaded := FQSelect.MetaData.Count;
2003		j := 1;
2004	<	for i := 0 to Qry.Current.Count - 1 do
2004	>	for i := 0 to Qry.FieldCount - 1 do
2005		begin
2006		if (Qry = FQSelect) then
2007		j := i + 1
2008	<	else begin
2008	>	else
2009	>	begin
2010		if FieldsLoaded = 0 then
2011		break;
2012	<	j := FQSelect.FieldIndex[Qry.Current[i].Name] + 1;
2012	>	j := FQSelect.FieldIndex[Qry[i].Name] + 1;
2013		if j < 1 then
2014		continue
2015		else
2016		Dec(FieldsLoaded);
2017		end;
2018	<	with FQSelect.Current[j - 1].Data^ do
2019	<	if aliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2018	>	with FQSelect.MetaData[j - 1] do
2019	>	if GetAliasname = 'IBX_INTERNAL_DBKEY' then {do not localize}
2020		begin
2021	<	if sqllen <= 8 then
2022	<	p^.rdDBKey := PIBDBKEY(Qry.Current[i].AsPointer)^;
2021	>	if (GetSize <= 8) then
2022	>	p^.rdDBKey := PIBDBKEY(Qry[i].AsPointer)^;
2023		continue;
2024		end;
2025	<	if j > 0 then with p^ do
2025	>	if j > 0 then
2026		begin
2027	<	rdFields[j].fdDataType :=
2028	<	Qry.Current[i].Data^.sqltype and (not 1);
2029	<	rdFields[j].fdDataScale :=
2030	<	Qry.Current[i].Data^.sqlscale;
2031	<	rdFields[j].fdNullable :=
1708	<	(Qry.Current[i].Data^.sqltype and 1 = 1);
1709	<	rdFields[j].fdIsNull :=
1710	<	(rdFields[j].fdNullable and (Qry.Current[i].Data^.sqlind^ = -1));
1711	<	LocalData := Qry.Current[i].Data^.sqldata;
1712	<	case rdFields[j].fdDataType of
1713	<	SQL_TIMESTAMP:
1714	<	begin
1715	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
1716	<	if RecordNumber >= 0 then
1717	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry.Current[i].AsDateTime));
1718	<	LocalData := PChar(@LocalDate);
1719	<	end;
1720	<	SQL_TYPE_DATE:
1721	<	begin
1722	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
1723	<	if RecordNumber >= 0 then
1724	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Date;
1725	<	LocalData := PChar(@LocalInt);
1726	<	end;
1727	<	SQL_TYPE_TIME:
1728	<	begin
1729	<	rdFields[j].fdDataSize := SizeOf(TDateTime);
1730	<	if RecordNumber >= 0 then
1731	<	LocalInt := DateTimeToTimeStamp(Qry.Current[i].AsDateTime).Time;
1732	<	LocalData := PChar(@LocalInt);
1733	<	end;
1734	<	SQL_SHORT, SQL_LONG:
2027	>	LocalData := nil;
2028	>	with p^.rdFields[j], FFieldColumns^[j] do
2029	>	begin
2030	>	Qry.Current.GetData(i,fdIsNull,fdDataLength,LocalData);
2031	>	if not fdIsNull then
2032		begin
2033	<	if (rdFields[j].fdDataScale = 0) then
2034	<	begin
2035	<	rdFields[j].fdDataSize := SizeOf(Integer);
2036	<	if RecordNumber >= 0 then
2037	<	LocalInt := Qry.Current[i].AsLong;
2038	<	LocalData := PChar(@LocalInt);
2039	<	end
2040	<	else if (rdFields[j].fdDataScale >= (-4)) then
2041	<	begin
2042	<	rdFields[j].fdDataSize := SizeOf(Currency);
2043	<	if RecordNumber >= 0 then
2044	<	LocalCurrency := Qry.Current[i].AsCurrency;
2045	<	LocalData := PChar(@LocalCurrency);
2046	<	end
2047	<	else begin
2048	<	rdFields[j].fdDataSize := SizeOf(Double);
2049	<	if RecordNumber >= 0 then
2050	<	LocalDouble := Qry.Current[i].AsDouble;
2051	<	LocalData := PChar(@LocalDouble);
2033	>	case fdDataType of  {Get Formatted data for column types that need formatting}
2034	>	SQL_TIMESTAMP:
2035	>	begin
2036	>	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry[i].AsDateTime));
2037	>	LocalData := PByte(@LocalDate);
2038	>	end;
2039	>	SQL_TYPE_DATE:
2040	>	begin
2041	>	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Date;
2042	>	LocalData := PByte(@LocalInt);
2043	>	end;
2044	>	SQL_TYPE_TIME:
2045	>	begin
2046	>	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Time;
2047	>	LocalData := PByte(@LocalInt);
2048	>	end;
2049	>	SQL_SHORT, SQL_LONG:
2050	>	begin
2051	>	if (fdDataScale = 0) then
2052	>	begin
2053	>	LocalInt := Qry[i].AsLong;
2054	>	LocalData := PByte(@LocalInt);
2055	>	end
2056	>	else
2057	>	if (fdDataScale >= (-4)) then
2058	>	begin
2059	>	LocalCurrency := Qry[i].AsCurrency;
2060	>	LocalData := PByte(@LocalCurrency);
2061	>	end
2062	>	else
2063	>	begin
2064	>	LocalDouble := Qry[i].AsDouble;
2065	>	LocalData := PByte(@LocalDouble);
2066		end;
2067	<	end;
2068	<	SQL_INT64:
2069	<	begin
2070	<	if (rdFields[j].fdDataScale = 0) then
2071	<	begin
2072	<	rdFields[j].fdDataSize := SizeOf(Int64);
2073	<	if RecordNumber >= 0 then
2074	<	LocalInt64 := Qry.Current[i].AsInt64;
2075	<	LocalData := PChar(@LocalInt64);
2076	<	end
2077	<	else if (rdFields[j].fdDataScale >= (-4)) then
2078	<	begin
2079	<	rdFields[j].fdDataSize := SizeOf(Currency);
2080	<	if RecordNumber >= 0 then
2081	<	LocalCurrency := Qry.Current[i].AsCurrency;
2082	<	LocalData := PChar(@LocalCurrency);
2083	<	end
2084	<	else begin
2085	<	rdFields[j].fdDataSize := SizeOf(Double);
2086	<	if RecordNumber >= 0 then
2087	<	LocalDouble := Qry.Current[i].AsDouble;
1777	<	LocalData := PChar(@LocalDouble);
1778	<	end
1779	<	end;
1780	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1781	<	begin
1782	<	rdFields[j].fdDataSize := SizeOf(Double);
1783	<	if RecordNumber >= 0 then
1784	<	LocalDouble := Qry.Current[i].AsDouble;
1785	<	LocalData := PChar(@LocalDouble);
1786	<	end;
1787	<	SQL_VARYING:
1788	<	begin
1789	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1790	<	rdFields[j].fdDataLength := isc_vax_integer(Qry.Current[i].Data^.sqldata, 2);
1791	<	if RecordNumber >= 0 then
1792	<	begin
1793	<	if (rdFields[j].fdDataLength = 0) then
1794	<	LocalData := nil
1795	<	else
2067	>	end;
2068	>	SQL_INT64:
2069	>	begin
2070	>	if (fdDataScale = 0) then
2071	>	begin
2072	>	LocalInt64 := Qry[i].AsInt64;
2073	>	LocalData := PByte(@LocalInt64);
2074	>	end
2075	>	else
2076	>	if (fdDataScale >= (-4)) then
2077	>	begin
2078	>	LocalCurrency := Qry[i].AsCurrency;
2079	>	LocalData := PByte(@LocalCurrency);
2080	>	end
2081	>	else
2082	>	begin
2083	>	LocalDouble := Qry[i].AsDouble;
2084	>	LocalData := PByte(@LocalDouble);
2085	>	end
2086	>	end;
2087	>	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2088		begin
2089	<	temp :=  Qry.Current[i];
2090	<	LocalData := @temp.Data^.sqldata[2];
2091	<	(*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
2089	>	LocalDouble := Qry[i].AsDouble;
2090	>	LocalData := PByte(@LocalDouble);
2091	>	end;
2092	>	SQL_BOOLEAN:
2093	>	begin
2094	>	LocalBool := Qry[i].AsBoolean;
2095	>	LocalData := PByte(@LocalBool);
2096		end;
2097		end;
2098	<	end;
2099	<	SQL_BOOLEAN:
2100	<	begin
2101	<	LocalBool:= false;
2102	<	rdFields[j].fdDataSize := SizeOf(wordBool);
1807	<	if RecordNumber >= 0 then
1808	<	LocalBool := Qry.Current[i].AsBoolean;
1809	<	LocalData := PChar(@LocalBool);
1810	<	end;
1811	<	else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1812	<	begin
1813	<	rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
1814	<	if (rdFields[j].fdDataType = SQL_TEXT) then
1815	<	rdFields[j].fdDataLength := rdFields[j].fdDataSize;
1816	<	end;
1817	<	end;
1818	<	if RecordNumber < 0 then
1819	<	begin
1820	<	rdFields[j].fdIsNull := True;
1821	<	rdFields[j].fdDataOfs := FRecordSize;
1822	<	Inc(FRecordSize, rdFields[j].fdDataSize);
1823	<	end
1824	<	else begin
1825	<	if rdFields[j].fdDataType = SQL_VARYING then
1826	<	begin
1827	<	if LocalData <> nil then
1828	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataLength)
2098	>
2099	>	if fdDataType = SQL_VARYING then
2100	>	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2101	>	else
2102	>	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2103		end
2104	+	else {Null column}
2105	+	if fdDataType = SQL_VARYING then
2106	+	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2107		else
2108	<	Move(LocalData^, Buffer[rdFields[j].fdDataOfs], rdFields[j].fdDataSize)
2108	>	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2109		end;
2110		end;
2111		end;
2112	<	WriteRecordCache(RecordNumber, PChar(p));
2112	>	WriteRecordCache(RecordNumber, Buffer);
2113		end;
2114
2115		function TIBCustomDataSet.GetActiveBuf: PChar;
#	Line 1877 | Line 2154 | begin
2154		result := FBase.Database;
2155		end;
2156
1880	–	function TIBCustomDataSet.GetDBHandle: PISC_DB_HANDLE;
1881	–	begin
1882	–	result := FBase.DBHandle;
1883	–	end;
1884	–
2157		function TIBCustomDataSet.GetDeleteSQL: TStrings;
2158		begin
2159		result := FQDelete.SQL;
#	Line 1892 | Line 2164 | begin
2164		result := FQInsert.SQL;
2165		end;
2166
2167	<	function TIBCustomDataSet.GetSQLParams: TIBXSQLDA;
2167	>	function TIBCustomDataSet.GetSQLParams: ISQLParams;
2168		begin
2169		if not FInternalPrepared then
2170		InternalPrepare;
#	Line 1909 | Line 2181 | begin
2181		result := FQSelect.SQL;
2182		end;
2183
2184	<	function TIBCustomDataSet.GetStatementType: TIBSQLTypes;
2184	>	function TIBCustomDataSet.GetStatementType: TIBSQLStatementTypes;
2185		begin
2186	<	result := FQSelect.SQLType;
2186	>	result := FQSelect.SQLStatementType;
2187		end;
2188
2189		function TIBCustomDataSet.GetModifySQL: TStrings;
#	Line 1924 | Line 2196 | begin
2196		result := FBase.Transaction;
2197		end;
2198
1927	–	function TIBCustomDataSet.GetTRHandle: PISC_TR_HANDLE;
1928	–	begin
1929	–	result := FBase.TRHandle;
1930	–	end;
1931	–
2199		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
2200		begin
2201		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
#	Line 1950 | Line 2217 | function TIBCustomDataSet.InternalLocate
2217		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2218		var
2219		keyFieldList: TList;
1953	–	{$IF FPC_FULLVERSION >= 20700 }
2220		CurBookmark: TBookmark;
1955	–	{$ELSE}
1956	–	CurBookmark: string;
1957	–	{$ENDIF}
2221		fieldValue: Variant;
2222		lookupValues: array of variant;
2223		i, fieldCount: Integer;
#	Line 2036 | Line 2299 | end;
2299
2300		procedure TIBCustomDataSet.InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
2301		var
2302	<	i, j, k: Integer;
2302	>	i, j, k, arr: Integer;
2303		pbd: PBlobDataArray;
2304	+	pda: PArrayDataArray;
2305		begin
2306		pbd := PBlobDataArray(PChar(Buff) + FBlobCacheOffset);
2307	<	j := 0;
2307	>	pda := PArrayDataArray(PChar(Buff) + FArrayCacheOffset);
2308	>	j := 0; arr := 0;
2309		for i := 0 to FieldCount - 1 do
2310		if Fields[i].IsBlob then
2311		begin
#	Line 2049 | Line 2314 | begin
2314		begin
2315		pbd^[j].Finalize;
2316		PISC_QUAD(
2317	<	PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
2317	>	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=
2318		pbd^[j].BlobID;
2319		PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
2320	+	end
2321	+	else
2322	+	begin
2323	+	PRecordData(Buff)^.rdFields[k].fdIsNull := true;
2324	+	with PISC_QUAD(PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ do
2325	+	begin
2326	+	gds_quad_high := 0;
2327	+	gds_quad_low := 0;
2328	+	end;
2329		end;
2330		Inc(j);
2331	+	end
2332	+	else
2333	+	if Fields[i] is TIBArrayField then
2334	+	begin
2335	+	if pda^[arr] <> nil then
2336	+	begin
2337	+	k := FMappedFieldPosition[Fields[i].FieldNo -1];
2338	+	PISC_QUAD(
2339	+	PChar(Buff) + FFieldColumns^[k].fdDataOfs)^ :=  pda^[arr].ArrayIntf.GetArrayID;
2340	+	PRecordData(Buff)^.rdFields[k].fdIsNull := pda^[arr].ArrayIntf.IsEmpty;
2341	+	end;
2342	+	Inc(arr);
2343		end;
2344		if Assigned(FUpdateObject) then
2345		begin
#	Line 2102 | Line 2388 | begin
2388		SetInternalSQLParams(Qry, Buff);
2389		Qry.ExecQuery;
2390		try
2391	<	if (Qry.SQLType = SQLExecProcedure) or
2106	<	(Qry.Next <> nil) then
2391	>	if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
2392		begin
2393		ofs := PRecordData(Buff)^.rdSavedOffset;
2394		FetchCurrentRecordToBuffer(Qry,
#	Line 2196 | Line 2481 | begin
2481		end;
2482
2483		procedure TIBCustomDataSet.InternalPrepare;
2199	–	var
2200	–	DidActivate: Boolean;
2484		begin
2485		if FInternalPrepared then
2486		Exit;
2204	–	DidActivate := False;
2487		FBase.SetCursor;
2488		try
2489		ActivateConnection;
2490	<	DidActivate := ActivateTransaction;
2490	>	ActivateTransaction;
2491		FBase.CheckDatabase;
2492		FBase.CheckTransaction;
2493		if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
#	Line 2243 | Line 2525 | begin
2525		end else
2526		IBError(ibxeEmptyQuery, [nil]);
2527		finally
2246	–	if DidActivate then
2247	–	DeactivateTransaction;
2528		FBase.RestoreCursor;
2529		end;
2530		end;
#	Line 2274 | Line 2554 | var
2554		begin
2555		CopyRecordBuffer(Buffer, OldBuffer);
2556		if BlobFieldCount > 0 then
2557	<	FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
2557	>	FillChar(PChar(OldBuffer)[FBlobCacheOffset],
2558	>	BlobFieldCount * SizeOf(TIBBlobStream) + ArrayFieldCount * SizeOf(IArray),
2559		0);
2560		end;
2561
#	Line 2347 | Line 2628 | procedure TIBCustomDataSet.SetInternalSQ
2628		var
2629		i, j: Integer;
2630		cr, data: PChar;
2631	<	fn, st: string;
2631	>	fn: string;
2632	>	st: RawByteString;
2633		OldBuffer: Pointer;
2634		ts: TTimeStamp;
2635	+	Param: ISQLParam;
2636		begin
2637		if (Buffer = nil) then
2638		IBError(ibxeBufferNotSet, [nil]);
#	Line 2357 | Line 2640 | begin
2640		InternalPrepare;
2641		OldBuffer := nil;
2642		try
2643	<	for i := 0 to Qry.Params.Count - 1 do
2643	>	for i := 0 to Qry.Params.GetCount - 1 do
2644		begin
2645	<	fn := Qry.Params[i].Name;
2645	>	Param := Qry.Params[i];
2646	>	fn := Param.Name;
2647		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2648		begin
2649		fn := Copy(fn, 5, Length(fn));
#	Line 2379 | Line 2663 | begin
2663		cr := Buffer;
2664		j := FQSelect.FieldIndex[fn] + 1;
2665		if (j > 0) then
2666	<	with PRecordData(cr)^ do
2666	>	with PRecordData(cr)^,rdFields[j], FFieldColumns^[j] do
2667		begin
2668	<	if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2668	>	if Param.name = 'IBX_INTERNAL_DBKEY' then {do not localize}
2669		begin
2670	<	PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
2670	>	PIBDBKey(Param.AsPointer)^ := rdDBKey;
2671		continue;
2672		end;
2673	<	if rdFields[j].fdIsNull then
2674	<	Qry.Params[i].IsNull := True
2673	>	if fdIsNull then
2674	>	Param.IsNull := True
2675		else begin
2676	<	Qry.Params[i].IsNull := False;
2677	<	data := cr + rdFields[j].fdDataOfs;
2678	<	case rdFields[j].fdDataType of
2676	>	Param.IsNull := False;
2677	>	data := cr + fdDataOfs;
2678	>	case fdDataType of
2679		SQL_TEXT, SQL_VARYING:
2680		begin
2681	<	SetString(st, data, rdFields[j].fdDataLength);
2682	<	Qry.Params[i].AsString := st;
2681	>	SetString(st, data, fdDataLength);
2682	>	SetCodePage(st,fdCodePage,false);
2683	>	Param.AsString := st;
2684		end;
2685		SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
2686	<	Qry.Params[i].AsDouble := PDouble(data)^;
2686	>	Param.AsDouble := PDouble(data)^;
2687		SQL_SHORT, SQL_LONG:
2688		begin
2689	<	if rdFields[j].fdDataScale = 0 then
2690	<	Qry.Params[i].AsLong := PLong(data)^
2406	<	else if rdFields[j].fdDataScale >= (-4) then
2407	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2689	>	if fdDataScale = 0 then
2690	>	Param.AsLong := PLong(data)^
2691		else
2692	<	Qry.Params[i].AsDouble := PDouble(data)^;
2692	>	if fdDataScale >= (-4) then
2693	>	Param.AsCurrency := PCurrency(data)^
2694	>	else
2695	>	Param.AsDouble := PDouble(data)^;
2696		end;
2697		SQL_INT64:
2698		begin
2699	<	if rdFields[j].fdDataScale = 0 then
2700	<	Qry.Params[i].AsInt64 := PInt64(data)^
2701	<	else if rdFields[j].fdDataScale >= (-4) then
2702	<	Qry.Params[i].AsCurrency := PCurrency(data)^
2699	>	if fdDataScale = 0 then
2700	>	Param.AsInt64 := PInt64(data)^
2701	>	else
2702	>	if fdDataScale >= (-4) then
2703	>	Param.AsCurrency := PCurrency(data)^
2704		else
2705	<	Qry.Params[i].AsDouble := PDouble(data)^;
2705	>	Param.AsDouble := PDouble(data)^;
2706		end;
2707		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2708	<	Qry.Params[i].AsQuad := PISC_QUAD(data)^;
2708	>	Param.AsQuad := PISC_QUAD(data)^;
2709		SQL_TYPE_DATE:
2710		begin
2711		ts.Date := PInt(data)^;
2712		ts.Time := 0;
2713	<	Qry.Params[i].AsDate :=
2427	<	TimeStampToDateTime(ts);
2713	>	Param.AsDate := TimeStampToDateTime(ts);
2714		end;
2715		SQL_TYPE_TIME:
2716		begin
2717		ts.Date := 0;
2718		ts.Time := PInt(data)^;
2719	<	Qry.Params[i].AsTime :=
2434	<	TimeStampToDateTime(ts);
2719	>	Param.AsTime := TimeStampToDateTime(ts);
2720		end;
2721		SQL_TIMESTAMP:
2722	<	Qry.Params[i].AsDateTime :=
2722	>	Param.AsDateTime :=
2723		TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2724		SQL_BOOLEAN:
2725	<	Qry.Params[i].AsBoolean := PWordBool(data)^;
2725	>	Param.AsBoolean := PWordBool(data)^;
2726		end;
2727		end;
2728		end;
#	Line 2593 | Line 2878 | begin
2878		Result := Assigned( FQSelect ) and FQSelect.EOF;
2879		end;
2880
2881	<	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2881	>	function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
2882		begin
2883		ActivateConnection;
2884		ActivateTransaction;
#	Line 2730 | Line 3015 | var
3015		Buff: PChar;
3016		bTr, bDB: Boolean;
3017		begin
3018	+	if (Field = nil) or (Field.DataSet <> self) then
3019	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3020		Buff := GetActiveBuf;
3021		if Buff = nil then
3022		begin
3023		fs := TIBBlobStream.Create;
3024		fs.Mode := bmReadWrite;
3025	+	fs.Database := Database;
3026	+	fs.Transaction := Transaction;
3027	+	fs.SetField(Field);
3028		FBlobStreamList.Add(Pointer(fs));
3029		result := TIBDSBlobStream.Create(Field, fs, Mode);
3030		exit;
#	Line 2749 | Line 3039 | begin
3039		fs.Mode := bmReadWrite;
3040		fs.Database := Database;
3041		fs.Transaction := Transaction;
3042	+	fs.SetField(Field);
3043		fs.BlobID :=
3044	<	PISC_QUAD(@Buff[PRecordData(Buff)^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3044	>	PISC_QUAD(@Buff[FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs])^;
3045		if (CachedUpdates) then
3046		begin
3047		bTr := not Transaction.InTransaction;
#	Line 2771 | Line 3062 | begin
3062		result := TIBDSBlobStream.Create(Field, fs, Mode);
3063		end;
3064
3065	+	function TIBCustomDataSet.GetArray(Field: TIBArrayField): IArray;
3066	+	var Buff: PChar;
3067	+	pda: PArrayDataArray;
3068	+	bTr, bDB: Boolean;
3069	+	begin
3070	+	if (Field = nil) or (Field.DataSet <> self) then
3071	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3072	+	Buff := GetActiveBuf;
3073	+	if Buff = nil then
3074	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3075	+	Field.FRelationName,Field.FieldName)
3076	+	else
3077	+	begin
3078	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3079	+	if pda^[Field.FCacheOffset] = nil then
3080	+	begin
3081	+	AdjustRecordOnInsert(Buff);
3082	+	if Field.IsNull then
3083	+	Result := Database.Attachment.CreateArray(Transaction.TransactionIntf,
3084	+	Field.FRelationName,Field.FieldName)
3085	+	else
3086	+	Result := Database.Attachment.OpenArray(Transaction.TransactionIntf,
3087	+	Field.FRelationName,Field.FieldName,Field.ArrayID);
3088	+	pda^[Field.FCacheOffset] := TIBArray.Create(Field,Result);
3089	+	FArrayList.Add(pda^[Field.FCacheOffset]);
3090	+	if (CachedUpdates) then
3091	+	begin
3092	+	bTr := not Transaction.InTransaction;
3093	+	bDB := not Database.Connected;
3094	+	if bDB then
3095	+	Database.Open;
3096	+	if bTr then
3097	+	Transaction.StartTransaction;
3098	+	pda^[Field.FCacheOffset].ArrayIntf.PreLoad;
3099	+	if bTr then
3100	+	Transaction.Commit;
3101	+	if bDB then
3102	+	Database.Close;
3103	+	end;
3104	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3105	+	end
3106	+	else
3107	+	Result := pda^[Field.FCacheOffset].ArrayIntf;
3108	+	end;
3109	+	end;
3110	+
3111	+	procedure TIBCustomDataSet.SetArrayIntf(AnArray: IArray; Field: TIBArrayField);
3112	+	var Buff: PChar;
3113	+	pda: PArrayDataArray;
3114	+	begin
3115	+	if (Field = nil) or (Field.DataSet <> self) then
3116	+	IBError(ibxFieldNotinDataSet,[Field.Name,Name]);
3117	+	Buff := GetActiveBuf;
3118	+	if Buff <> nil then
3119	+	begin
3120	+	AdjustRecordOnInsert(Buff);
3121	+	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3122	+	pda^[Field.FCacheOffset].FArray := AnArray;
3123	+	WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Pointer(Buff));
3124	+	end;
3125	+	end;
3126	+
3127		function TIBCustomDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
3128		const
3129		CMPLess = -1;
#	Line 2851 | Line 3204 | end;
3204		procedure TIBCustomDataSet.DoBeforeClose;
3205		begin
3206		inherited DoBeforeClose;
3207	+	if FInTransactionEnd and (FCloseAction = TARollback) then
3208	+	Exit;
3209		if State in [dsInsert,dsEdit] then
3210		begin
2856	–	if FInTransactionEnd and (FCloseAction = TARollback) then
2857	–	Exit;
2858	–
3211		if DataSetCloseAction = dcSaveChanges then
3212		Post;
3213		{Note this can fail with an exception e.g. due to
3214		database validation error. In which case the dataset remains open }
3215		end;
3216	+	if FCachedUpdates and FUpdatesPending and (DataSetCloseAction = dcSaveChanges) then
3217	+	ApplyUpdates;
3218		end;
3219
3220		procedure TIBCustomDataSet.DoBeforeOpen;
#	Line 2892 | Line 3246 | end;
3246
3247		procedure TIBCustomDataSet.FetchAll;
3248		var
2895	–	{$IF FPC_FULLVERSION >= 20700 }
3249		CurBookmark: TBookmark;
2897	–	{$ELSE}
2898	–	CurBookmark: string;
2899	–	{$ENDIF}
3250		begin
3251		FBase.SetCursor;
3252		try
#	Line 3007 | Line 3357 | begin
3357		if result and (Buffer <> nil) then
3358		Move(Buff[1], Buffer^, Field.DataSize);
3359		end
3360	<	else if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3360	>	else
3361	>	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3362		(FMappedFieldPosition[Field.FieldNo - 1] <= CurrentRecord^.rdFieldCount) then
3363	+	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]],
3364	+	FFieldColumns^[FMappedFieldPosition[Field.FieldNo - 1]] do
3365		begin
3366	<	result := not CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull;
3366	>	result := not fdIsNull;
3367		if result and (Buffer <> nil) then
3015	–	with CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]] do
3368		begin
3369	<	Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
3369	>	Data := Buff + fdDataOfs;
3370		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3371		begin
3372		if fdDataLength < Field.DataSize then
#	Line 3085 | Line 3437 | begin
3437		if FCurrentRecord < FRecordCount then
3438		ReadRecordCache(FCurrentRecord, Buffer, False)
3439		else begin
3440	<	while (not FQSelect.EOF) and
3089	<	(FQSelect.Next <> nil) and
3440	>	while (not FQSelect.EOF) and FQSelect.Next  and
3441		(FCurrentRecord >= FRecordCount) do begin
3442		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3443		Inc(FRecordCount);
#	Line 3197 | Line 3548 | procedure TIBCustomDataSet.InternalCance
3548		var
3549		Buff: PChar;
3550		CurRec: Integer;
3551	+	pda: PArrayDataArray;
3552	+	i: integer;
3553		begin
3554		inherited InternalCancel;
3555		Buff := GetActiveBuf;
3556	<	if Buff <> nil then begin
3556	>	if Buff <> nil then
3557	>	begin
3558	>	pda := PArrayDataArray(Buff + FArrayCacheOffset);
3559	>	for i := 0 to ArrayFieldCount - 1 do
3560	>	pda^[i].ArrayIntf.CancelChanges;
3561		CurRec := FCurrentRecord;
3562		AdjustRecordOnInsert(Buff);
3563		if (State = dsEdit) then begin
#	Line 3223 | Line 3580 | begin
3580		DeactivateTransaction;
3581		FQSelect.Close;
3582		ClearBlobCache;
3583	+	ClearArrayCache;
3584		FreeRecordBuffer(FModelBuffer);
3585		FreeRecordBuffer(FOldBuffer);
3586		FCurrentRecord := -1;
#	Line 3238 | Line 3596 | begin
3596		FOBEnd := 0;
3597		FreeMem(FBufferCache);
3598		FBufferCache := nil;
3599	+	FreeMem(FFieldColumns);
3600	+	FFieldColumns := nil;
3601		FreeMem(FOldBufferCache);
3602		FOldBufferCache := nil;
3603		BindFields(False);
#	Line 3315 | Line 3675 | const
3675		var
3676		FieldType: TFieldType;
3677		FieldSize: Word;
3678	+	FieldDataSize: integer;
3679		charSetID: short;
3680		CharSetSize: integer;
3681	<	CharSetName: string;
3681	>	CharSetName: RawByteString;
3682	>	FieldCodePage: TSystemCodePage;
3683		FieldNullable : Boolean;
3684		i, FieldPosition, FieldPrecision: Integer;
3685		FieldAliasName, DBAliasName: string;
3686	<	RelationName, FieldName: string;
3686	>	aRelationName, FieldName: string;
3687		Query : TIBSQL;
3688		FieldIndex: Integer;
3689		FRelationNodes : TRelationNode;
3690	+	aArrayDimensions: integer;
3691	+	aArrayBounds: TArrayBounds;
3692	+	ArrayMetaData: IArrayMetaData;
3693
3694		function Add_Node(Relation, Field : String) : TRelationNode;
3695		var
#	Line 3422 | Line 3787 | var
3787		begin
3788		FRelationNodes := TRelationNode.Create;
3789		FNeedsRefresh := False;
3790	<	Database.InternalTransaction.StartTransaction;
3790	>	if not Database.InternalTransaction.InTransaction then
3791	>	Database.InternalTransaction.StartTransaction;
3792		Query := TIBSQL.Create(self);
3793		try
3794		Query.Database := DataBase;
#	Line 3430 | Line 3796 | begin
3796		FieldDefs.BeginUpdate;
3797		FieldDefs.Clear;
3798		FieldIndex := 0;
3799	<	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3800	<	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3799	>	if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3800	>	SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3801		Query.SQL.Text := DefaultSQL;
3802		Query.Prepare;
3803	<	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3804	<	SetLength(FAliasNameList, SourceQuery.Current.Count);
3805	<	for i := 0 to SourceQuery.Current.Count - 1 do
3806	<	with SourceQuery.Current[i].Data^ do
3803	>	SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3804	>	SetLength(FAliasNameList, SourceQuery.MetaData.Count);
3805	>	for i := 0 to SourceQuery.MetaData.GetCount - 1 do
3806	>	with SourceQuery.MetaData[i] do
3807		begin
3808		{ Get the field name }
3809	<	FieldAliasName := SourceQuery.Current[i].Name;
3810	<	SetString(DBAliasName, aliasname, aliasname_length);
3811	<	SetString(RelationName, relname, relname_length);
3812	<	SetString(FieldName, sqlname, sqlname_length);
3809	>	FieldAliasName := GetName;
3810	>	DBAliasName := GetAliasname;
3811	>	aRelationName := getRelationName;
3812	>	FieldName := getSQLName;
3813		FAliasNameList[i] := DBAliasName;
3814		FieldSize := 0;
3815	+	FieldDataSize := 0;
3816		FieldPrecision := 0;
3817	<	FieldNullable := SourceQuery.Current[i].IsNullable;
3817	>	FieldNullable := IsNullable;
3818		CharSetSize := 0;
3819		CharSetName := '';
3820	<	case sqltype and not 1 of
3820	>	FieldCodePage := CP_NONE;
3821	>	aArrayDimensions := 0;
3822	>	SetLength(aArrayBounds,0);
3823	>	case SQLType of
3824		{ All VARCHAR's must be converted to strings before recording
3825		their values }
3826		SQL_VARYING, SQL_TEXT:
3827		begin
3828	<	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3829	<	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3830	<	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3831	<	FieldSize := sqllen;
3832	<	if CharSetSize = 2 then
3833	<	FieldType := ftWideString
3834	<	else
3465	<	FieldType := ftString;
3828	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3829	>	CharSetSize := 1;
3830	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3831	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3832	>	FieldDataSize := GetSize;
3833	>	FieldSize := FieldDataSize div CharSetSize;
3834	>	FieldType := ftString;
3835		end;
3836		{ All Doubles/Floats should be cast to doubles }
3837		SQL_DOUBLE, SQL_FLOAT:
3838		FieldType := ftFloat;
3839		SQL_SHORT:
3840		begin
3841	<	if (sqlscale = 0) then
3841	>	if (getScale = 0) then
3842		FieldType := ftSmallInt
3843		else begin
3844		FieldType := ftBCD;
3845		FieldPrecision := 4;
3846	<	FieldSize := -sqlscale;
3846	>	FieldSize := -getScale;
3847	>	FieldDataSize := FieldSize;
3848		end;
3849		end;
3850		SQL_LONG:
3851		begin
3852	<	if (sqlscale = 0) then
3852	>	if (getScale = 0) then
3853		FieldType := ftInteger
3854	<	else if (sqlscale >= (-4)) then
3854	>	else if (getScale >= (-4)) then
3855		begin
3856		FieldType := ftBCD;
3857		FieldPrecision := 9;
3858	<	FieldSize := -sqlscale;
3858	>	FieldSize := -getScale;
3859		end
3860		else
3861		if Database.SQLDialect = 1 then
#	Line 3497 | Line 3867 | begin
3867		begin
3868		FieldType := ftFMTBCD;
3869		FieldPrecision := 9;
3870	<	FieldSize := -sqlscale;
3870	>	FieldSize := -getScale;
3871		end;
3872	+	FieldDataSize := FieldSize;
3873		end;
3874
3875		SQL_INT64:
3876		begin
3877	<	if (sqlscale = 0) then
3877	>	if (getScale = 0) then
3878		FieldType := ftLargeInt
3879	<	else if (sqlscale >= (-4)) then
3879	>	else if (getScale >= (-4)) then
3880		begin
3881		FieldType := ftBCD;
3882		FieldPrecision := 18;
3883	<	FieldSize := -sqlscale;
3883	>	FieldSize := -getScale;
3884		end
3885		else
3886	<	FieldType := ftFloat
3886	>	FieldType := ftFloat;
3887	>	FieldDataSize := FieldSize;
3888		end;
3889		SQL_TIMESTAMP: FieldType := ftDateTime;
3890		SQL_TYPE_TIME: FieldType := ftTime;
#	Line 3520 | Line 3892 | begin
3892		SQL_BLOB:
3893		begin
3894		FieldSize := sizeof (TISC_QUAD);
3895	<	if (sqlsubtype = 1) then
3895	>	if (getSubtype = 1) then
3896		begin
3897	<	if strpas(sqlname) = '' then {Complex SQL with no identifiable column - use connection default}
3898	<	begin
3899	<	CharSetSize := FBase.GetDefaultCharSetSize;
3900	<	CharSetName := FBase.GetDefaultCharSetName;
3901	<	end
3530	<	else
3531	<	begin
3532	<	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3533	<	@relname,@sqlname);
3534	<	CharSetSize := FBase.GetCharSetSize(charSetID);
3535	<	CharSetName := FBase.GetCharSetName(charSetID);
3536	<	end;
3537	<	if CharSetSize = 2 then
3538	<	FieldType := ftWideMemo
3539	<	else
3540	<	FieldType := ftMemo;
3897	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3898	>	CharSetSize := 1;
3899	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3900	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3901	>	FieldType := ftMemo;
3902		end
3903		else
3904		FieldType := ftBlob;
3905	+	FieldDataSize := FieldSize;
3906		end;
3907		SQL_ARRAY:
3908		begin
3909		FieldSize := sizeof (TISC_QUAD);
3910	<	FieldType := ftUnknown;
3910	>	FieldDataSize := FieldSize;
3911	>	FieldType := ftArray;
3912	>	ArrayMetaData := GetArrayMetaData;
3913	>	if ArrayMetaData <> nil then
3914	>	begin
3915	>	aArrayDimensions := ArrayMetaData.GetDimensions;
3916	>	aArrayBounds := ArrayMetaData.GetBounds;
3917	>	end;
3918		end;
3919		SQL_BOOLEAN:
3920		FieldType:= ftBoolean;
#	Line 3562 | Line 3931 | begin
3931		Name := FieldAliasName;
3932		FAliasNameMap[FieldNo-1] := DBAliasName;
3933		Size := FieldSize;
3934	+	DataSize := FieldDataSize;
3935		Precision := FieldPrecision;
3936		Required := not FieldNullable;
3937	+	RelationName := aRelationName;
3938		InternalCalcField := False;
3939		CharacterSetSize := CharSetSize;
3940		CharacterSetName := CharSetName;
3941	+	CodePage := FieldCodePage;
3942	+	ArrayDimensions := aArrayDimensions;
3943	+	ArrayBounds := aArrayBounds;
3944		if (FieldName <> '') and (RelationName <> '') then
3945		begin
3946		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3594 | Line 3968 | begin
3968		FreeNodes;
3969		Database.InternalTransaction.Commit;
3970		FieldDefs.EndUpdate;
3971	+	FieldDefs.Updated := true;
3972		end;
3973		end;
3974
#	Line 3611 | Line 3986 | begin
3986		else begin
3987		Buffer := AllocRecordBuffer;
3988		try
3989	<	while FQSelect.Next <> nil do
3989	>	while FQSelect.Next do
3990		begin
3991		FetchCurrentRecordToBuffer(FQSelect, FRecordCount, Buffer);
3992		Inc(FRecordCount);
#	Line 3626 | Line 4001 | end;
4001		procedure TIBCustomDataSet.InternalSetParamsFromCursor;
4002		var
4003		i: Integer;
4004	<	cur_param: TIBXSQLVAR;
4004	>	cur_param: ISQLParam;
4005		cur_field: TField;
4006		s: TStream;
4007		begin
#	Line 3634 | Line 4009 | begin
4009		IBError(ibxeEmptyQuery, [nil]);
4010		if not FInternalPrepared then
4011		InternalPrepare;
4012	<	if (SQLParams.Count > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4012	>	if (SQLParams.GetCount > 0) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
4013		begin
4014	<	for i := 0 to SQLParams.Count - 1 do
4014	>	for i := 0 to SQLParams.GetCount - 1 do
4015		begin
4016		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4017		cur_param := SQLParams[i];
#	Line 3670 | Line 4045 | begin
4045		try
4046		s := DataSource.DataSet.
4047		CreateBlobStream(cur_field, bmRead);
4048	<	cur_param.LoadFromStream(s);
4048	>	cur_param.AsBlob := TIBDSBlobStream(s).FBlobStream.Blob;
4049		finally
4050		s.free;
4051		end;
4052		end;
4053	+	ftArray:
4054	+	cur_param.AsArray := TIBArrayField(cur_field).ArrayIntf;
4055		else
4056		IBError(ibxeNotSupported, [nil]);
4057		end;
#	Line 3707 | Line 4084 | procedure TIBCustomDataSet.InternalOpen;
4084		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
4085		end;
4086
3710	–	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3711	–	var i: integer;
3712	–	begin
3713	–	Result := nil;
3714	–	for i := 0 to FieldDefs.Count - 1 do
3715	–	if FieldDefs[i].FieldNo = aFieldNo then
3716	–	begin
3717	–	Result := TIBFieldDef(FieldDefs[i]);
3718	–	break;
3719	–	end;
3720	–	end;
3721	–
3722	–	procedure SetExtendedProperties;
3723	–	var i: integer;
3724	–	IBFieldDef: TIBFieldDef;
3725	–	begin
3726	–	for i := 0 to Fields.Count - 1 do
3727	–	if Fields[i].FieldNo > 0 then
3728	–	begin
3729	–	if(Fields[i] is TIBStringField) then
3730	–	with TIBStringField(Fields[i]) do
3731	–	begin
3732	–	IBFieldDef := GetFieldDef(FieldNo);
3733	–	if IBFieldDef <> nil then
3734	–	begin
3735	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3736	–	CharacterSetName := IBFieldDef.CharacterSetName;
3737	–	end;
3738	–	end
3739	–	else
3740	–	if(Fields[i] is TIBWideStringField) then
3741	–	with TIBWideStringField(Fields[i]) do
3742	–	begin
3743	–	IBFieldDef := GetFieldDef(FieldNo);
3744	–	if IBFieldDef <> nil then
3745	–	begin
3746	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3747	–	CharacterSetName := IBFieldDef.CharacterSetName;
3748	–	end;
3749	–	end
3750	–	else
3751	–	if(Fields[i] is TIBMemoField) then
3752	–	with TIBMemoField(Fields[i]) do
3753	–	begin
3754	–	IBFieldDef := GetFieldDef(FieldNo);
3755	–	if IBFieldDef <> nil then
3756	–	begin
3757	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3758	–	CharacterSetName := IBFieldDef.CharacterSetName;
3759	–	end;
3760	–	end
3761	–	else
3762	–	if(Fields[i] is TIBWideMemoField) then
3763	–	with TIBWideMemoField(Fields[i]) do
3764	–	begin
3765	–	IBFieldDef := GetFieldDef(FieldNo);
3766	–	if IBFieldDef <> nil then
3767	–	begin
3768	–	CharacterSetSize := IBFieldDef.CharacterSetSize;
3769	–	CharacterSetName := IBFieldDef.CharacterSetName;
3770	–	end;
3771	–	end
3772	–	end
3773	–	end;
3774	–
4087		begin
4088		FBase.SetCursor;
4089		try
#	Line 3781 | Line 4093 | begin
4093		IBError(ibxeEmptyQuery, [nil]);
4094		if not FInternalPrepared then
4095		InternalPrepare;
4096	<	if FQSelect.SQLType = SQLSelect then
4096	>	if FQSelect.SQLStatementType = SQLSelect then
4097		begin
4098		if DefaultFields then
4099		CreateFields;
4100	+	FArrayFieldCount := 0;
4101		BindFields(True);
3789	–	SetExtendedProperties;
4102		FCurrentRecord := -1;
4103		FQSelect.ExecQuery;
4104		FOpen := FQSelect.Open;
#	Line 3797 | Line 4109 | begin
4109		3. After the dummy fetch, FRecordSize will be appropriately
4110		adjusted to reflect the additional "weight" of the field
4111		data.
4112	<	4. Set up the FCalcFieldsOffset, FBlobCacheOffset and FRecordBufferSize.
4112	>	4. Set up the FCalcFieldsOffset, FBlobCacheOffset, FArrayCacheOffset and FRecordBufferSize.
4113		5. Now, with the BufferSize available, allocate memory for chunks of records
4114		6. Re-allocate the model buffer, accounting for the new
4115		FRecordBufferSize.
4116		7. Finally, calls to AllocRecordBuffer will work!.
4117		}
4118		{Step 1}
4119	<	FRecordSize := RecordDataLength(FQSelect.Current.Count);
4119	>	FRecordSize := RecordDataLength(FQSelect.FieldCount);
4120		{Step 2, 3}
4121	+	GetMem(FFieldColumns,sizeof(TFieldColumns) * (FQSelect.FieldCount));
4122		IBAlloc(FModelBuffer, 0, FRecordSize);
4123	<	FetchCurrentRecordToBuffer(FQSelect, -1, FModelBuffer);
4123	>	InitModelBuffer(FQSelect, FModelBuffer);
4124		{Step 4}
4125		FCalcFieldsOffset := FRecordSize;
4126		FBlobCacheOffset := FCalcFieldsOffset + CalcFieldsSize;
4127	<	FRecordBufferSize := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4127	>	FArrayCacheOffset := (FBlobCacheOffset + (BlobFieldCount * SizeOf(TIBBlobStream)));
4128	>	FRecordBufferSize := FArrayCacheOffset + (ArrayFieldCount * sizeof(IArray));
4129		{Step 5}
4130		if UniDirectional then
4131		FBufferChunkSize := FRecordBufferSize * UniCache
#	Line 3827 | Line 4141 | begin
4141		FCacheSize := FBufferChunkSize;
4142		FOldCacheSize := FBufferChunkSize;
4143		{Step 6}
4144	<	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.Current.Count),
4144	>	IBAlloc(FModelBuffer, RecordDataLength(FQSelect.FieldCount),
4145		FRecordBufferSize);
4146		{Step 7}
4147		FOldBuffer := AllocRecordBuffer;
#	Line 3925 | Line 4239 | end;
4239		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4240		Options: TLocateOptions): Boolean;
4241		var
3928	–	{$IF FPC_FULLVERSION >= 20700 }
4242		CurBookmark: TBookmark;
3930	–	{$ELSE}
3931	–	CurBookmark: string;
3932	–	{$ENDIF}
4243		begin
4244		DisableControls;
4245		try
#	Line 3947 | Line 4257 | function TIBCustomDataSet.Lookup(const K
4257		const ResultFields: string): Variant;
4258		var
4259		fl: TList;
3950	–	{$IF FPC_FULLVERSION >= 20700 }
4260		CurBookmark: TBookmark;
3952	–	{$ELSE}
3953	–	CurBookmark: string;
3954	–	{$ENDIF}
4261		begin
4262		DisableControls;
4263		fl := TList.Create;
#	Line 4024 | Line 4330 | begin
4330		MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
4331		if (MappedFieldPos > 0) and
4332		(MappedFieldPos <= rdFieldCount) then
4333	+	with rdFields[MappedFieldPos], FFieldColumns^[MappedFieldPos] do
4334		begin
4335		Field.Validate(Buffer);
4336		if (Buffer = nil) or
4337		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
4338	<	rdFields[MappedFieldPos].fdIsNull := True
4339	<	else begin
4340	<	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
4341	<	rdFields[MappedFieldPos].fdDataSize);
4342	<	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
4343	<	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
4344	<	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
4038	<	rdFields[MappedFieldPos].fdIsNull := False;
4338	>	fdIsNull := True
4339	>	else
4340	>	begin
4341	>	Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4342	>	if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4343	>	fdDataLength := StrLen(PChar(Buffer));
4344	>	fdIsNull := False;
4345		if rdUpdateStatus = usUnmodified then
4346		begin
4347		if CachedUpdates then
#	Line 4136 | Line 4442 | begin
4442		if FInternalPrepared then
4443		begin
4444		CheckDatasetClosed;
4445	+	if FDidActivate then
4446	+	DeactivateTransaction;
4447		FieldDefs.Clear;
4448		FieldDefs.Updated := false;
4449		FInternalPrepared := False;
#	Line 4156 | Line 4464 | begin
4464		IBError(ibxeEmptyQuery, [nil]);
4465		if not FInternalPrepared then
4466		InternalPrepare;
4467	<	if FQSelect.SQLType = SQLSelect then
4467	>	if FQSelect.SQLStatementType = SQLSelect then
4468		begin
4469		IBError(ibxeIsASelectStatement, [nil]);
4470		end
#	Line 4169 | Line 4477 | begin
4477		end;
4478		end;
4479
4480	<	function TIBCustomDataSet.GetSelectStmtHandle: TISC_STMT_HANDLE;
4480	>	function TIBCustomDataSet.GetSelectStmtIntf: IStatement;
4481		begin
4482	<	Result := FQSelect.Handle;
4482	>	Result := FQSelect.Statement;
4483		end;
4484
4485		function TIBCustomDataSet.GetParser: TSelectSQLParser;
#	Line 4226 | Line 4534 | end;
4534
4535		{ TIBDataSet IProviderSupport }
4536
4537	<	(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4537	>	procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
4538		begin
4539		if Commit then
4540		Transaction.Commit else
#	Line 4389 | Line 4697 | begin
4697		if not FQSelect.Prepared then
4698		FQSelect.Prepare;
4699		Result := FQSelect.UniqueRelationName;
4700	<	end;*)
4700	>	end;
4701
4702		procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
4703		begin
#	Line 4531 | Line 4839 | begin
4839		DataSet.SetInternalSQLParams(Query, buff);
4840		end;
4841
4842	+	function TIBDSBlobStream.GetSize: Int64;
4843	+	begin
4844	+	Result := FBlobStream.BlobSize;
4845	+	end;
4846	+
4847		{ TIBDSBlobStream }
4848		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
4849		Mode: TBlobStreamMode);
#	Line 4539 | Line 4852 | begin
4852		FBlobStream := ABlobStream;
4853		FBlobStream.Seek(0, soFromBeginning);
4854		if (Mode = bmWrite) then
4855	+	begin
4856		FBlobStream.Truncate;
4857	+	TIBCustomDataSet(FField.DataSet).RecordModified(True);
4858	+	TBlobField(FField).Modified := true;
4859	+	FHasWritten := true;
4860	+	end;
4861		end;
4862
4863		destructor TIBDSBlobStream.Destroy;

Diff Legend

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