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 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 27 | Line 27
27		{    IBX For Lazarus (Firebird Express)                                  }
28		{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29		{    Portions created by MWA Software are copyright McCallum Whyman      }
30	<	{    Associates Ltd 2011 - 2015                                                }
30	>	{    Associates Ltd 2011 - 2015                                          }
31		{                                                                        }
32		{************************************************************************}
33
#	Line 53 | Line 53 | uses
53		unix,
54		{$ENDIF}
55		SysUtils, Classes, IBDatabase, IBExternals, IB,  IBSQL, Db,
56	<	IBUtils, IBBlob, IBSQLParser;
56	>	IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo;
57
58		const
59		BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
#	Line 74 | Line 74 | type
74		procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
75		procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
76		function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77	<	procedure InternalSetParams(Query: TIBSQL; buff: PChar);
77	>	procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78	>	procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79	>	procedure UpdateRecordFromQuery(UpdateKind: TUpdateKind; QryResults: IResults; Buffer: PChar);
80		property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
81		public
82		constructor Create(AOwner: TComponent); override;
#	Line 181 | Line 183 | type
183		FCharacterSetSize: integer;
184		FAutoFieldSize: boolean;
185		FCodePage: TSystemCodePage;
186	+	FDataSize: integer;
187		protected
188		procedure Bind(Binding: Boolean); override;
189		function GetDataSize: Integer; override;
#	Line 206 | 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 214 | 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 272 | Line 315 | type
315		FFieldName: string;
316		FGeneratorName: string;
317		FIncrement: integer;
318	+	FQuery: TIBSQL;
319	+	function GetDatabase: TIBDatabase;
320	+	function GetTransaction: TIBTransaction;
321	+	procedure SetDatabase(AValue: TIBDatabase);
322	+	procedure SetGeneratorName(AValue: string);
323		procedure SetIncrement(const AValue: integer);
324	+	procedure SetTransaction(AValue: TIBTransaction);
325	+	procedure SetQuerySQL;
326		protected
327	<	function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
327	>	function GetNextValue: integer;
328		public
329		constructor Create(Owner: TIBCustomDataSet);
330	+	destructor Destroy; override;
331		procedure Apply;
332		property Owner: TIBCustomDataSet read FOwner;
333	+	property Database: TIBDatabase read GetDatabase write SetDatabase;
334	+	property Transaction: TIBTransaction read GetTransaction write SetTransaction;
335		published
336	<	property Generator: string read FGeneratorName write FGeneratorName;
336	>	property Generator: string read FGeneratorName write SetGeneratorName;
337		property Field: string read FFieldName write FFieldName;
338		property Increment: integer read FIncrement write SetIncrement default 1;
339		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
#	Line 318 | Line 371 | type
371
372		TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
373
374	+	TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object;
375	+
376		TIBCustomDataSet = class(TDataset)
377		private
378		FAllowAutoActivateTransaction: Boolean;
#	Line 350 | Line 405 | type
405		FDeletedRecords: Long;
406		FModelBuffer,
407		FOldBuffer: PChar;
408	+	FOnDeleteReturning: TOnDeleteReturning;
409		FOnValidatePost: TOnValidatePost;
410		FOpen: Boolean;
411		FInternalPrepared: Boolean;
#	Line 358 | Line 414 | type
414		FQRefresh,
415		FQSelect,
416		FQModify: TIBSQL;
417	+	FDatabaseInfo: TIBDatabaseInfo;
418		FRecordBufferSize: Integer;
419		FRecordCount: Integer;
420		FRecordSize: Integer;
#	Line 387 | Line 444 | type
444		FInTransactionEnd: boolean;
445		FIBLinks: TList;
446		FFieldColumns: PFieldColumns;
447	+	FBufferUpdatedOnQryReturn: boolean;
448	+	procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
449	+	FieldIndex: integer; Buffer: PChar);
450		procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
451		function GetSelectStmtIntf: IStatement;
452		procedure SetUpdateMode(const Value: TUpdateMode);
#	Line 409 | Line 469 | type
469		procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
470		procedure DoAfterTransactionEnd(Sender: TObject);
471		procedure DoTransactionFree(Sender: TObject);
472	+	procedure DoDeleteReturning(QryResults: IResults);
473		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
474		Buffer: PChar);
475		function GetDatabase: TIBDatabase;
#	Line 434 | Line 495 | type
495		procedure SetDatabase(Value: TIBDatabase);
496		procedure SetDeleteSQL(Value: TStrings);
497		procedure SetInsertSQL(Value: TStrings);
498	<	procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
498	>	procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
499		procedure SetRefreshSQL(Value: TStrings);
500		procedure SetSelectSQL(Value: TStrings);
501		procedure SetModifySQL(Value: TStrings);
502		procedure SetTransaction(Value: TIBTransaction);
503		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
504		procedure SetUniDirectional(Value: Boolean);
505	+	procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
506		procedure RefreshParams;
507		function AdjustPosition(FCache: PChar; Offset: DWORD;
508		Origin: Integer): DWORD;
#	Line 628 | Line 690 | type
690		procedure Post; override;
691		function ParamByName(ParamName: String): ISQLParam;
692		property ArrayFieldCount: integer read FArrayFieldCount;
693	+	property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
694		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
695		property UpdatesPending: Boolean read FUpdatesPending;
696		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
#	Line 672 | Line 735 | type
735		write FOnUpdateError;
736		property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
737		write FOnUpdateRecord;
738	+	property OnDeleteReturning: TOnDeleteReturning read FOnDeleteReturning
739	+	write FOnDeleteReturning;
740		end;
741
742		TIBParserDataSet = class(TIBCustomDataSet)
#	Line 758 | Line 823 | type
823		property OnNewRecord;
824		property OnPostError;
825		property OnValidatePost;
826	+	property OnDeleteReturning;
827		end;
828
829		{ TIBDSBlobStream }
#	Line 789 | Line 855 | type
855		FCharacterSetName: RawByteString;
856		FCharacterSetSize: integer;
857		FCodePage: TSystemCodePage;
858	+	FIdentityColumn: boolean;
859		FRelationName: string;
860	+	FDataSize: integer;
861		published
862		property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
863		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
864		property CodePage: TSystemCodePage read FCodePage write FCodePage;
865	+	property DataSize: integer read FDataSize write FDataSize;
866		property RelationName: string read FRelationName write FRelationName;
867		property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
868		property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
869	+	property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
870		end;
871
872		const
873		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
874		nil,                { ftUnknown }
875		TIBStringField,     { ftString }
876	<	TSmallintField,     { ftSmallint }
877	<	TIntegerField,      { ftInteger }
876	>	TIBSmallintField,   { ftSmallint }
877	>	TIBIntegerField,      { ftInteger }
878		TWordField,         { ftWord }
879		TBooleanField,      { ftBoolean }
880		TFloatField,        { ftFloat }
#	Line 826 | Line 896 | DefaultFieldClasses: array[TFieldType] o
896		nil,                { ftCursor }
897		TStringField,       { ftFixedChar }
898		nil,    { ftWideString }
899	<	TLargeIntField,     { ftLargeInt }
899	>	TIBLargeIntField,     { ftLargeInt }
900		nil,          { ftADT }
901		TIBArrayField,        { ftArray }
902		nil,    { ftReference }
#	Line 870 | Line 940 | type
940		FieldName : String;
941		COMPUTED_BLR : Boolean;
942		DEFAULT_VALUE : boolean;
943	+	IDENTITY_COLUMN : boolean;
944		NextField : TFieldNode;
945		end;
946
#	Line 922 | Line 993 | type
993		Result := str;
994		end;
995
996	+	{ TIBLargeIntField }
997	+
998	+	procedure TIBLargeIntField.Bind(Binding: Boolean);
999	+	begin
1000	+	inherited Bind(Binding);
1001	+	if Binding and (FieldDef <> nil) then
1002	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1003	+	end;
1004	+
1005	+	{ TIBIntegerField }
1006	+
1007	+	procedure TIBIntegerField.Bind(Binding: Boolean);
1008	+	begin
1009	+	inherited Bind(Binding);
1010	+	if Binding and (FieldDef <> nil) then
1011	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1012	+	end;
1013	+
1014	+	{ TIBSmallintField }
1015	+
1016	+	procedure TIBSmallintField.Bind(Binding: Boolean);
1017	+	begin
1018	+	inherited Bind(Binding);
1019	+	if Binding and (FieldDef <> nil) then
1020	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1021	+	end;
1022	+
1023		{ TIBArray }
1024
1025		procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
#	Line 1031 | Line 1129 | begin
1129		{2: case 2 ignored. This should be handled by TIBWideMemo}
1130
1131		3, {Assume UNICODE_FSS is really UTF8}
1132	<	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1132	>	4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1133		if DisplayWidth = 0 then
1134		Result := ValidUTF8String(TextToSingleLine(Result))
1135		else
#	Line 1089 | Line 1187 | procedure TIBMemoField.SetAsString(const
1187		var s: RawByteString;
1188		begin
1189		s := AValue;
1190	<	if StringCodePage(Value) <> CodePage then
1190	>	if StringCodePage(s) <> CodePage then
1191		SetCodePage(s,CodePage,CodePage<>CP_NONE);
1192		inherited SetAsString(s);
1193		end;
#	Line 1141 | Line 1239 | begin
1239		IBFieldDef := FieldDef as TIBFieldDef;
1240		CharacterSetSize := IBFieldDef.CharacterSetSize;
1241		CharacterSetName := IBFieldDef.CharacterSetName;
1242	+	FDataSize := IBFieldDef.DataSize + 1;
1243		if AutoFieldSize then
1244		Size := IBFieldDef.Size;
1245		CodePage := IBFieldDef.CodePage;
#	Line 1149 | Line 1248 | end;
1248
1249		function TIBStringField.GetDataSize: Integer;
1250		begin
1251	<	Result := Size * CharacterSetSize + 1;
1251	>	Result := FDataSize;
1252		end;
1253
1254		constructor TIBStringField.Create(aOwner: TComponent);
#	Line 1208 | Line 1307 | var
1307		s: RawByteString;
1308		begin
1309		Buffer := nil;
1310	<	IBAlloc(Buffer, 0, Size + 1);
1310	>	IBAlloc(Buffer, 0, DataSize);
1311		try
1312		s := Value;
1313		if StringCodePage(s) <> CodePage then
1314		SetCodePage(s,CodePage,CodePage<>CP_NONE);
1315	<	StrLCopy(Buffer, PChar(s), Size);
1315	>	StrLCopy(Buffer, PChar(s), DataSize-1);
1316		if Transliterate then
1317		DataSet.Translate(Buffer, Buffer, True);
1318		SetData(Buffer);
#	Line 1232 | Line 1331 | begin
1331		Size := 8;
1332		end;
1333
1334	+	procedure TIBBCDField.Bind(Binding: Boolean);
1335	+	begin
1336	+	inherited Bind(Binding);
1337	+	if Binding and (FieldDef <> nil) then
1338	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1339	+	end;
1340	+
1341		class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1342		begin
1343		{ No need to check as the base type is currency, not BCD }
#	Line 1317 | Line 1423 | constructor TIBCustomDataSet.Create(AOwn
1423		begin
1424		inherited Create(AOwner);
1425		FBase := TIBBase.Create(Self);
1426	+	FDatabaseInfo := TIBDatabaseInfo.Create(self);
1427		FIBLinks := TList.Create;
1428		FCurrentRecord := -1;
1429		FDeletedRecords := 0;
#	Line 1866 | Line 1973 | begin
1973		FTransactionFree(Sender);
1974		end;
1975
1976	+	procedure TIBCustomDataSet.DoDeleteReturning(QryResults: IResults);
1977	+	begin
1978	+	if assigned(FOnDeleteReturning) then
1979	+	OnDeleteReturning(self,QryResults);
1980	+	end;
1981	+
1982		procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1983		var i, j: Integer;
1984		FieldsLoaded: integer;
#	Line 1955 | Line 2068 | begin
2068		end;
2069		end;
2070
2071	+	{Update Buffer Fields from Query Results}
2072	+
2073	+	procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2074	+	Buffer: PChar);
2075	+	var i, j: integer;
2076	+	begin
2077	+	for i := 0 to QryResults.Count - 1 do
2078	+	begin
2079	+	j := GetFieldPosition(QryResults[i].GetAliasName);
2080	+	if j > 0 then
2081	+	begin
2082	+	ColumnDataToBuffer(QryResults,i,j,Buffer);
2083	+	FBufferUpdatedOnQryReturn := true;
2084	+	end;
2085	+	end;
2086	+	end;
2087	+
2088	+
2089	+	{Move column data returned from query to row buffer}
2090	+
2091	+	procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2092	+	ColumnIndex, FieldIndex: integer; Buffer: PChar);
2093	+	var
2094	+	LocalData: PByte;
2095	+	LocalDate: TDateTime;
2096	+	LocalDouble: Double;
2097	+	LocalInt: Integer;
2098	+	LocalBool: wordBool;
2099	+	LocalInt64: Int64;
2100	+	LocalCurrency: Currency;
2101	+	ColData: ISQLData;
2102	+	begin
2103	+	LocalData := nil;
2104	+	with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2105	+	begin
2106	+	QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2107	+	if not fdIsNull then
2108	+	begin
2109	+	ColData := QryResults[ColumnIndex];
2110	+	case fdDataType of  {Get Formatted data for column types that need formatting}
2111	+	SQL_TYPE_DATE,
2112	+	SQL_TYPE_TIME,
2113	+	SQL_TIMESTAMP:
2114	+	begin
2115	+	{This is an IBX native format and not the TDataset approach. See also GetFieldData}
2116	+	LocalDate := ColData.AsDateTime;
2117	+	LocalData := PByte(@LocalDate);
2118	+	end;
2119	+	SQL_SHORT, SQL_LONG:
2120	+	begin
2121	+	if (fdDataScale = 0) then
2122	+	begin
2123	+	LocalInt := ColData.AsLong;
2124	+	LocalData := PByte(@LocalInt);
2125	+	end
2126	+	else
2127	+	if (fdDataScale >= (-4)) then
2128	+	begin
2129	+	LocalCurrency := ColData.AsCurrency;
2130	+	LocalData := PByte(@LocalCurrency);
2131	+	end
2132	+	else
2133	+	begin
2134	+	LocalDouble := ColData.AsDouble;
2135	+	LocalData := PByte(@LocalDouble);
2136	+	end;
2137	+	end;
2138	+	SQL_INT64:
2139	+	begin
2140	+	if (fdDataScale = 0) then
2141	+	begin
2142	+	LocalInt64 := ColData.AsInt64;
2143	+	LocalData := PByte(@LocalInt64);
2144	+	end
2145	+	else
2146	+	if (fdDataScale >= (-4)) then
2147	+	begin
2148	+	LocalCurrency := ColData.AsCurrency;
2149	+	LocalData := PByte(@LocalCurrency);
2150	+	end
2151	+	else
2152	+	begin
2153	+	LocalDouble := ColData.AsDouble;
2154	+	LocalData := PByte(@LocalDouble);
2155	+	end
2156	+	end;
2157	+	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2158	+	begin
2159	+	LocalDouble := ColData.AsDouble;
2160	+	LocalData := PByte(@LocalDouble);
2161	+	end;
2162	+	SQL_BOOLEAN:
2163	+	begin
2164	+	LocalBool := ColData.AsBoolean;
2165	+	LocalData := PByte(@LocalBool);
2166	+	end;
2167	+	end;
2168	+
2169	+	if fdDataType = SQL_VARYING then
2170	+	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2171	+	else
2172	+	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2173	+	end
2174	+	else {Null column}
2175	+	if fdDataType = SQL_VARYING then
2176	+	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2177	+	else
2178	+	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2179	+	end;
2180	+	end;
2181	+
2182		{ Read the record from FQSelect.Current into the record buffer
2183		Then write the buffer to in memory cache }
2184		procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
#	Line 1963 | Line 2187 | var
2187		pbd: PBlobDataArray;
2188		pda: PArrayDataArray;
2189		i, j: Integer;
1966	–	LocalData: PByte;
1967	–	LocalDate, LocalDouble: Double;
1968	–	LocalInt: Integer;
1969	–	LocalBool: wordBool;
1970	–	LocalInt64: Int64;
1971	–	LocalCurrency: Currency;
2190		FieldsLoaded: Integer;
2191		p: PRecordData;
2192		begin
#	Line 2019 | Line 2237 | begin
2237		continue;
2238		end;
2239		if j > 0 then
2240	<	begin
2023	<	LocalData := nil;
2024	<	with p^.rdFields[j], FFieldColumns^[j] do
2025	<	begin
2026	<	Qry.Current.GetData(i,fdIsNull,fdDataLength,LocalData);
2027	<	if not fdIsNull then
2028	<	begin
2029	<	case fdDataType of  {Get Formatted data for column types that need formatting}
2030	<	SQL_TIMESTAMP:
2031	<	begin
2032	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry[i].AsDateTime));
2033	<	LocalData := PByte(@LocalDate);
2034	<	end;
2035	<	SQL_TYPE_DATE:
2036	<	begin
2037	<	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Date;
2038	<	LocalData := PByte(@LocalInt);
2039	<	end;
2040	<	SQL_TYPE_TIME:
2041	<	begin
2042	<	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Time;
2043	<	LocalData := PByte(@LocalInt);
2044	<	end;
2045	<	SQL_SHORT, SQL_LONG:
2046	<	begin
2047	<	if (fdDataScale = 0) then
2048	<	begin
2049	<	LocalInt := Qry[i].AsLong;
2050	<	LocalData := PByte(@LocalInt);
2051	<	end
2052	<	else
2053	<	if (fdDataScale >= (-4)) then
2054	<	begin
2055	<	LocalCurrency := Qry[i].AsCurrency;
2056	<	LocalData := PByte(@LocalCurrency);
2057	<	end
2058	<	else
2059	<	begin
2060	<	LocalDouble := Qry[i].AsDouble;
2061	<	LocalData := PByte(@LocalDouble);
2062	<	end;
2063	<	end;
2064	<	SQL_INT64:
2065	<	begin
2066	<	if (fdDataScale = 0) then
2067	<	begin
2068	<	LocalInt64 := Qry[i].AsInt64;
2069	<	LocalData := PByte(@LocalInt64);
2070	<	end
2071	<	else
2072	<	if (fdDataScale >= (-4)) then
2073	<	begin
2074	<	LocalCurrency := Qry[i].AsCurrency;
2075	<	LocalData := PByte(@LocalCurrency);
2076	<	end
2077	<	else
2078	<	begin
2079	<	LocalDouble := Qry[i].AsDouble;
2080	<	LocalData := PByte(@LocalDouble);
2081	<	end
2082	<	end;
2083	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2084	<	begin
2085	<	LocalDouble := Qry[i].AsDouble;
2086	<	LocalData := PByte(@LocalDouble);
2087	<	end;
2088	<	SQL_BOOLEAN:
2089	<	begin
2090	<	LocalBool := Qry[i].AsBoolean;
2091	<	LocalData := PByte(@LocalBool);
2092	<	end;
2093	<	end;
2094	<
2095	<	if fdDataType = SQL_VARYING then
2096	<	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2097	<	else
2098	<	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2099	<	end
2100	<	else {Null column}
2101	<	if fdDataType = SQL_VARYING then
2102	<	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2103	<	else
2104	<	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2105	<	end;
2106	<	end;
2240	>	ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2241		end;
2242		WriteRecordCache(RecordNumber, Buffer);
2243		end;
#	Line 2198 | Line 2332 | begin
2332		FUpdateObject.Apply(ukDelete,Buff)
2333		else
2334		begin
2335	<	SetInternalSQLParams(FQDelete, Buff);
2335	>	SetInternalSQLParams(FQDelete.Params, Buff);
2336		FQDelete.ExecQuery;
2337	+	if (FQDelete.FieldCount > 0)  then
2338	+	DoDeleteReturning(FQDelete.Current);
2339		end;
2340		with PRecordData(Buff)^ do
2341		begin
#	Line 2337 | Line 2473 | begin
2473		end;
2474		Inc(arr);
2475		end;
2476	+	FBufferUpdatedOnQryReturn := false;
2477		if Assigned(FUpdateObject) then
2478		begin
2479		if (Qry = FQDelete) then
#	Line 2347 | Line 2484 | begin
2484		FUpdateObject.Apply(ukModify,Buff);
2485		end
2486		else begin
2487	<	SetInternalSQLParams(Qry, Buff);
2487	>	SetInternalSQLParams(Qry.Params, Buff);
2488		Qry.ExecQuery;
2489	+	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2490	+	UpdateRecordFromQuery(Qry.Current,Buff);
2491		end;
2492		PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2493		PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2494		SetModified(False);
2495		WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2496	<	if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
2496	>	if (FForcedRefresh or (FNeedsRefresh and not FBufferUpdatedOnQryReturn)) and CanRefresh then
2497		InternalRefreshRow;
2498		end;
2499
#	Line 2381 | Line 2520 | begin
2520		end
2521		else
2522		Qry := FQRefresh;
2523	<	SetInternalSQLParams(Qry, Buff);
2523	>	SetInternalSQLParams(Qry.Params, Buff);
2524		Qry.ExecQuery;
2525		try
2526		if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
#	Line 2590 | Line 2729 | end;
2729
2730		procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
2731		begin
2732	<	if (FBase.Database <> Value) then
2732	>	if (csLoading in ComponentState) or (FBase.Database <> Value) then
2733		begin
2734		CheckDatasetClosed;
2735	+	InternalUnPrepare;
2736		FBase.Database := Value;
2737		FQDelete.Database := Value;
2738		FQInsert.Database := Value;
2739		FQRefresh.Database := Value;
2740		FQSelect.Database := Value;
2741		FQModify.Database := Value;
2742	+	FDatabaseInfo.Database := Value;
2743	+	FGeneratorField.Database := Value;
2744		end;
2745		end;
2746
#	Line 2620 | Line 2762 | begin
2762		end;
2763		end;
2764
2765	<	procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2765	>	procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2766		var
2767		i, j: Integer;
2768		cr, data: PChar;
2769		fn: string;
2770		st: RawByteString;
2771		OldBuffer: Pointer;
2630	–	ts: TTimeStamp;
2772		Param: ISQLParam;
2773		begin
2774		if (Buffer = nil) then
#	Line 2636 | Line 2777 | begin
2777		InternalPrepare;
2778		OldBuffer := nil;
2779		try
2780	<	for i := 0 to Qry.Params.GetCount - 1 do
2780	>	for i := 0 to Params.GetCount - 1 do
2781		begin
2782	<	Param := Qry.Params[i];
2782	>	Param := Params[i];
2783		fn := Param.Name;
2784		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2785		begin
#	Line 2702 | Line 2843 | begin
2843		end;
2844		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2845		Param.AsQuad := PISC_QUAD(data)^;
2846	<	SQL_TYPE_DATE:
2847	<	begin
2707	<	ts.Date := PInt(data)^;
2708	<	ts.Time := 0;
2709	<	Param.AsDate := TimeStampToDateTime(ts);
2710	<	end;
2711	<	SQL_TYPE_TIME:
2712	<	begin
2713	<	ts.Date := 0;
2714	<	ts.Time := PInt(data)^;
2715	<	Param.AsTime := TimeStampToDateTime(ts);
2716	<	end;
2846	>	SQL_TYPE_DATE,
2847	>	SQL_TYPE_TIME,
2848		SQL_TIMESTAMP:
2849	<	Param.AsDateTime :=
2850	<	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2849	>	{This is an IBX native format and not the TDataset approach. See also SetFieldData}
2850	>	Param.AsDateTime := PDateTime(data)^;
2851		SQL_BOOLEAN:
2852		Param.AsBoolean := PWordBool(data)^;
2853		end;
#	Line 2767 | Line 2898 | begin
2898		FQRefresh.Transaction := Value;
2899		FQSelect.Transaction := Value;
2900		FQModify.Transaction := Value;
2901	+	FGeneratorField.Transaction := Value;
2902		end;
2903		end;
2904
#	Line 2807 | Line 2939 | end;
2939		procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2940		begin
2941		if FIBLinks.IndexOf(Sender) = -1 then
2942	+	begin
2943		FIBLinks.Add(Sender);
2944	+	if Active then
2945	+	begin
2946	+	Active := false;
2947	+	Active := true;
2948	+	end;
2949	+	end;
2950		end;
2951
2952
#	Line 3668 | Line 3807 | const
3807		'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3808		'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3809		'     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3810	+
3811	+	DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3812	+	'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3813	+	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3814	+	'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3815	+	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3816	+	'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3817	+	'     (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3818	+	'     ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3819	+
3820		var
3821		FieldType: TFieldType;
3822		FieldSize: Word;
3823	<	charSetID: short;
3823	>	FieldDataSize: integer;
3824		CharSetSize: integer;
3825		CharSetName: RawByteString;
3826		FieldCodePage: TSystemCodePage;
#	Line 3707 | Line 3856 | var
3856		FField.FieldName := Query.Fields[2].AsString;
3857		FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3858		FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3859	+	FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3860		FField.NextField := Result.FieldNodes;
3861		Result.FieldNodes := FField;
3862		Query.Next;
#	Line 3760 | Line 3910 | var
3910		FField := Ffield.NextField;
3911		end;
3912
3913	+	function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3914	+	var
3915	+	FRelation : TRelationNode;
3916	+	FField : TFieldNode;
3917	+	begin
3918	+	FRelation := FRelationNodes;
3919	+	while Assigned(FRelation) and
3920	+	(FRelation.RelationName <> Relation) do
3921	+	FRelation := FRelation.NextRelation;
3922	+	if not Assigned(FRelation) then
3923	+	FRelation := Add_Node(Relation, Field);
3924	+	Result := false;
3925	+	FField := FRelation.FieldNodes;
3926	+	while Assigned(FField) do
3927	+	if FField.FieldName = Field then
3928	+	begin
3929	+	Result := Ffield.IDENTITY_COLUMN;
3930	+	Exit;
3931	+	end
3932	+	else
3933	+	FField := Ffield.NextField;
3934	+	end;
3935	+
3936		Procedure FreeNodes;
3937		var
3938		FRelation : TRelationNode;
#	Line 3793 | Line 3966 | begin
3966		FieldIndex := 0;
3967		if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3968		SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3969	<	Query.SQL.Text := DefaultSQL;
3969	>	if FDatabaseInfo.ODSMajorVersion >= 12 then
3970	>	Query.SQL.Text := DefaultSQLODS12
3971	>	else
3972	>	Query.SQL.Text := DefaultSQL;
3973		Query.Prepare;
3974		SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3975		SetLength(FAliasNameList, SourceQuery.MetaData.Count);
#	Line 3807 | Line 3983 | begin
3983		FieldName := getSQLName;
3984		FAliasNameList[i] := DBAliasName;
3985		FieldSize := 0;
3986	+	FieldDataSize := GetSize;
3987		FieldPrecision := 0;
3988		FieldNullable := IsNullable;
3989		CharSetSize := 0;
#	Line 3819 | Line 3996 | begin
3996		their values }
3997		SQL_VARYING, SQL_TEXT:
3998		begin
3999	<	FirebirdAPI.CharSetWidth(getCharSetID,CharSetSize);
4000	<	CharSetName := FirebirdAPI.GetCharsetName(getCharSetID);
4001	<	FirebirdAPI.CharSetID2CodePage(getCharSetID,FieldCodePage);
4002	<	FieldSize := GetSize div CharSetSize;
3999	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4000	>	CharSetSize := 1;
4001	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4002	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4003	>	FieldSize := FieldDataSize div CharSetSize;
4004		FieldType := ftString;
4005		end;
4006		{ All Doubles/Floats should be cast to doubles }
#	Line 3873 | Line 4051 | begin
4051		FieldSize := -getScale;
4052		end
4053		else
4054	<	FieldType := ftFloat
4054	>	FieldType := ftFloat;
4055		end;
4056		SQL_TIMESTAMP: FieldType := ftDateTime;
4057		SQL_TYPE_TIME: FieldType := ftTime;
#	Line 3883 | Line 4061 | begin
4061		FieldSize := sizeof (TISC_QUAD);
4062		if (getSubtype = 1) then
4063		begin
4064	<	FirebirdAPI.CharSetWidth(getCharSetID,CharSetSize);
4065	<	CharSetName := FirebirdAPI.GetCharsetName(getCharSetID);
4066	<	FirebirdAPI.CharSetID2CodePage(getCharSetID,FieldCodePage);
4064	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4065	>	CharSetSize := 1;
4066	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4067	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4068		FieldType := ftMemo;
4069		end
4070		else
#	Line 3917 | Line 4096 | begin
4096		Name := FieldAliasName;
4097		FAliasNameMap[FieldNo-1] := DBAliasName;
4098		Size := FieldSize;
4099	+	DataSize := FieldDataSize;
4100		Precision := FieldPrecision;
4101		Required := not FieldNullable;
4102		RelationName := aRelationName;
#	Line 3928 | Line 4108 | begin
4108		ArrayBounds := aArrayBounds;
4109		if (FieldName <> '') and (RelationName <> '') then
4110		begin
4111	+	IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4112		if Has_COMPUTED_BLR(RelationName, FieldName) then
4113		begin
4114		Attributes := [faReadOnly];
#	Line 3999 | Line 4180 | begin
4180		for i := 0 to SQLParams.GetCount - 1 do
4181		begin
4182		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4183	<	cur_param := SQLParams[i];
4184	<	if (cur_field <> nil) then begin
4183	>	if (cur_field <> nil) then
4184	>	begin
4185	>	cur_param := SQLParams[i];
4186		if (cur_field.IsNull) then
4187		cur_param.IsNull := True
4188	<	else case cur_field.DataType of
4188	>	else
4189	>	case cur_field.DataType of
4190		ftString:
4191		cur_param.AsString := cur_field.AsString;
4192		ftBoolean:
#	Line 4013 | Line 4196 | begin
4196		ftInteger:
4197		cur_param.AsLong := cur_field.AsInteger;
4198		ftLargeInt:
4199	<	cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4199	>	cur_param.AsInt64 := cur_field.AsLargeInt;
4200		ftFloat, ftCurrency:
4201		cur_param.AsDouble := cur_field.AsFloat;
4202		ftBCD:
#	Line 4672 | Line 4855 | begin
4855		Transaction.StartTransaction;
4856		end;
4857
4858	<	function TIBCustomDataSet.PSGetTableName: string;
4858	>	function TIBCustomDataSet.PsGetTableName: string;
4859		begin
4860		//  if not FInternalPrepared then
4861		//    InternalPrepare;
#	Line 4767 | Line 4950 | end;
4950		function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4951		NativeFormat: Boolean): Boolean;
4952		begin
4953	<	if (Field.DataType = ftBCD) and not NativeFormat then
4953	>	{These datatypes use IBX conventions and not TDataset conventions}
4954	>	if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4955		Result := InternalGetFieldData(Field, Buffer)
4956		else
4957		Result := inherited GetFieldData(Field, Buffer, NativeFormat);
#	Line 4793 | Line 4977 | end;
4977		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4978		NativeFormat: Boolean);
4979		begin
4980	<	if (not NativeFormat) and (Field.DataType = ftBCD) then
4980	>	{These datatypes use IBX conventions and not TDataset conventions}
4981	>	if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4982		InternalSetfieldData(Field, Buffer)
4983		else
4984		inherited SetFieldData(Field, buffer, NativeFormat);
#	Line 4813 | Line 4998 | begin
4998		inherited Destroy;
4999		end;
5000
5001	<	procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
5001	>	procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
5002		begin
5003		FRefreshSQL.Assign(Value);
5004		end;
5005
5006	+	procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
5007	+	buff: PChar);
5008	+	begin
5009	+	if not Assigned(DataSet) then Exit;
5010	+	DataSet.SetInternalSQLParams(Params, buff);
5011	+	end;
5012	+
5013		procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
5014		begin
5015	+	InternalSetParams(Query.Params,buff);
5016	+	end;
5017	+
5018	+	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5019	+	QryResults: IResults; Buffer: PChar);
5020	+	begin
5021		if not Assigned(DataSet) then Exit;
5022	<	DataSet.SetInternalSQLParams(Query, buff);
5022	>	case UpdateKind of
5023	>	ukModify, ukInsert:
5024	>	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5025	>	ukDelete:
5026	>	DataSet.DoDeleteReturning(QryResults);
5027	>	end;
5028		end;
5029
5030		function TIBDSBlobStream.GetSize: Int64;
#	Line 4884 | Line 5087 | end;
5087
5088		procedure TIBGenerator.SetIncrement(const AValue: integer);
5089		begin
5090	+	if FIncrement = AValue then Exit;
5091		if AValue < 0 then
5092	<	raise Exception.Create('A Generator Increment cannot be negative');
5093	<	FIncrement := AValue
5092	>	IBError(ibxeNegativeGenerator,[]);
5093	>	FIncrement := AValue;
5094	>	SetQuerySQL;
5095		end;
5096
5097	<	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4893	<	ATransaction: TIBTransaction): integer;
5097	>	procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5098		begin
5099	<	with TIBSQL.Create(nil) do
5100	<	try
5101	<	Database := ADatabase;
5102	<	Transaction := ATransaction;
5103	<	if not assigned(Database) then
5104	<	IBError(ibxeCannotSetDatabase,[]);
5105	<	if not assigned(Transaction) then
5106	<	IBError(ibxeCannotSetTransaction,[]);
5107	<	with Transaction do
5108	<	if not InTransaction then StartTransaction;
5109	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
5110	<	Prepare;
5099	>	FQuery.Transaction := AValue;
5100	>	end;
5101	>
5102	>	procedure TIBGenerator.SetQuerySQL;
5103	>	begin
5104	>	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5105	>	end;
5106	>
5107	>	function TIBGenerator.GetDatabase: TIBDatabase;
5108	>	begin
5109	>	Result := FQuery.Database;
5110	>	end;
5111	>
5112	>	function TIBGenerator.GetTransaction: TIBTransaction;
5113	>	begin
5114	>	Result := FQuery.Transaction;
5115	>	end;
5116	>
5117	>	procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5118	>	begin
5119	>	FQuery.Database := AValue;
5120	>	end;
5121	>
5122	>	procedure TIBGenerator.SetGeneratorName(AValue: string);
5123	>	begin
5124	>	if FGeneratorName = AValue then Exit;
5125	>	FGeneratorName := AValue;
5126	>	SetQuerySQL;
5127	>	end;
5128	>
5129	>	function TIBGenerator.GetNextValue: integer;
5130	>	begin
5131	>	with FQuery do
5132	>	begin
5133	>	Transaction.Active := true;
5134		ExecQuery;
5135		try
5136	<	Result := FieldByName('ID').AsInteger
5136	>	Result := Fields[0].AsInteger
5137		finally
5138		Close
5139		end;
4913	–	finally
4914	–	Free
5140		end;
5141		end;
5142
#	Line 4919 | Line 5144 | constructor TIBGenerator.Create(Owner: T
5144		begin
5145		FOwner := Owner;
5146		FIncrement := 1;
5147	+	FQuery := TIBSQL.Create(nil);
5148	+	end;
5149	+
5150	+	destructor TIBGenerator.Destroy;
5151	+	begin
5152	+	if assigned(FQuery) then FQuery.Free;
5153	+	inherited Destroy;
5154		end;
5155
5156
5157		procedure TIBGenerator.Apply;
5158		begin
5159	<	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5160	<	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5159	>	if assigned(Database) and assigned(Transaction) and
5160	>	(FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5161	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5162		end;
5163
5164

Diff Legend

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