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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 105 by tony, Thu Jan 18 14:37:32 2018 UTC

#	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(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 358 | Line 411 | type
411		FQRefresh,
412		FQSelect,
413		FQModify: TIBSQL;
414	+	FDatabaseInfo: TIBDatabaseInfo;
415		FRecordBufferSize: Integer;
416		FRecordCount: Integer;
417		FRecordSize: Integer;
#	Line 387 | Line 441 | type
441		FInTransactionEnd: boolean;
442		FIBLinks: TList;
443		FFieldColumns: PFieldColumns;
444	+	procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
445	+	FieldIndex: integer; Buffer: PChar);
446		procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
447		function GetSelectStmtIntf: IStatement;
448		procedure SetUpdateMode(const Value: TUpdateMode);
#	Line 434 | Line 490 | type
490		procedure SetDatabase(Value: TIBDatabase);
491		procedure SetDeleteSQL(Value: TStrings);
492		procedure SetInsertSQL(Value: TStrings);
493	<	procedure SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
493	>	procedure SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
494		procedure SetRefreshSQL(Value: TStrings);
495		procedure SetSelectSQL(Value: TStrings);
496		procedure SetModifySQL(Value: TStrings);
497		procedure SetTransaction(Value: TIBTransaction);
498		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
499		procedure SetUniDirectional(Value: Boolean);
500	+	procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
501		procedure RefreshParams;
502		function AdjustPosition(FCache: PChar; Offset: DWORD;
503		Origin: Integer): DWORD;
#	Line 789 | Line 846 | type
846		FCharacterSetName: RawByteString;
847		FCharacterSetSize: integer;
848		FCodePage: TSystemCodePage;
849	+	FIdentityColumn: boolean;
850		FRelationName: string;
851	+	FDataSize: integer;
852		published
853		property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
854		property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
855		property CodePage: TSystemCodePage read FCodePage write FCodePage;
856	+	property DataSize: integer read FDataSize write FDataSize;
857		property RelationName: string read FRelationName write FRelationName;
858		property ArrayDimensions: integer read FArrayDimensions write FArrayDimensions;
859		property ArrayBounds: TArrayBounds read FArrayBounds write FArrayBounds;
860	+	property IdentityColumn: boolean read FIdentityColumn write FIdentityColumn default false;
861		end;
862
863		const
864		DefaultFieldClasses: array[TFieldType] of TFieldClass = (
865		nil,                { ftUnknown }
866		TIBStringField,     { ftString }
867	<	TSmallintField,     { ftSmallint }
868	<	TIntegerField,      { ftInteger }
867	>	TIBSmallintField,   { ftSmallint }
868	>	TIBIntegerField,      { ftInteger }
869		TWordField,         { ftWord }
870		TBooleanField,      { ftBoolean }
871		TFloatField,        { ftFloat }
#	Line 826 | Line 887 | DefaultFieldClasses: array[TFieldType] o
887		nil,                { ftCursor }
888		TStringField,       { ftFixedChar }
889		nil,    { ftWideString }
890	<	TLargeIntField,     { ftLargeInt }
890	>	TIBLargeIntField,     { ftLargeInt }
891		nil,          { ftADT }
892		TIBArrayField,        { ftArray }
893		nil,    { ftReference }
#	Line 870 | Line 931 | type
931		FieldName : String;
932		COMPUTED_BLR : Boolean;
933		DEFAULT_VALUE : boolean;
934	+	IDENTITY_COLUMN : boolean;
935		NextField : TFieldNode;
936		end;
937
#	Line 922 | Line 984 | type
984		Result := str;
985		end;
986
987	+	{ TIBLargeIntField }
988	+
989	+	procedure TIBLargeIntField.Bind(Binding: Boolean);
990	+	begin
991	+	inherited Bind(Binding);
992	+	if Binding and (FieldDef <> nil) then
993	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
994	+	end;
995	+
996	+	{ TIBIntegerField }
997	+
998	+	procedure TIBIntegerField.Bind(Binding: Boolean);
999	+	begin
1000	+	inherited Bind(Binding);
1001	+	if Binding and (FieldDef <> nil) then
1002	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1003	+	end;
1004	+
1005	+	{ TIBSmallintField }
1006	+
1007	+	procedure TIBSmallintField.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		{ TIBArray }
1015
1016		procedure TIBArray.EventHandler(Sender: IArray; Reason: TArrayEventReason);
#	Line 1031 | Line 1120 | begin
1120		{2: case 2 ignored. This should be handled by TIBWideMemo}
1121
1122		3, {Assume UNICODE_FSS is really UTF8}
1123	<	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
1123	>	4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1124		if DisplayWidth = 0 then
1125		Result := ValidUTF8String(TextToSingleLine(Result))
1126		else
#	Line 1089 | Line 1178 | procedure TIBMemoField.SetAsString(const
1178		var s: RawByteString;
1179		begin
1180		s := AValue;
1181	<	if StringCodePage(Value) <> CodePage then
1181	>	if StringCodePage(s) <> CodePage then
1182		SetCodePage(s,CodePage,CodePage<>CP_NONE);
1183		inherited SetAsString(s);
1184		end;
#	Line 1141 | Line 1230 | begin
1230		IBFieldDef := FieldDef as TIBFieldDef;
1231		CharacterSetSize := IBFieldDef.CharacterSetSize;
1232		CharacterSetName := IBFieldDef.CharacterSetName;
1233	+	FDataSize := IBFieldDef.DataSize + 1;
1234		if AutoFieldSize then
1235		Size := IBFieldDef.Size;
1236		CodePage := IBFieldDef.CodePage;
#	Line 1149 | Line 1239 | end;
1239
1240		function TIBStringField.GetDataSize: Integer;
1241		begin
1242	<	Result := Size * CharacterSetSize + 1;
1242	>	Result := FDataSize;
1243		end;
1244
1245		constructor TIBStringField.Create(aOwner: TComponent);
#	Line 1208 | Line 1298 | var
1298		s: RawByteString;
1299		begin
1300		Buffer := nil;
1301	<	IBAlloc(Buffer, 0, Size + 1);
1301	>	IBAlloc(Buffer, 0, DataSize);
1302		try
1303		s := Value;
1304		if StringCodePage(s) <> CodePage then
1305		SetCodePage(s,CodePage,CodePage<>CP_NONE);
1306	<	StrLCopy(Buffer, PChar(s), Size);
1306	>	StrLCopy(Buffer, PChar(s), DataSize-1);
1307		if Transliterate then
1308		DataSet.Translate(Buffer, Buffer, True);
1309		SetData(Buffer);
#	Line 1232 | Line 1322 | begin
1322		Size := 8;
1323		end;
1324
1325	+	procedure TIBBCDField.Bind(Binding: Boolean);
1326	+	begin
1327	+	inherited Bind(Binding);
1328	+	if Binding and (FieldDef <> nil) then
1329	+	FIdentityColumn := (FieldDef as TIBFieldDef).IdentityColumn;
1330	+	end;
1331	+
1332		class procedure TIBBCDField.CheckTypeSize(Value: Integer);
1333		begin
1334		{ No need to check as the base type is currency, not BCD }
#	Line 1317 | Line 1414 | constructor TIBCustomDataSet.Create(AOwn
1414		begin
1415		inherited Create(AOwner);
1416		FBase := TIBBase.Create(Self);
1417	+	FDatabaseInfo := TIBDatabaseInfo.Create(self);
1418		FIBLinks := TList.Create;
1419		FCurrentRecord := -1;
1420		FDeletedRecords := 0;
#	Line 1849 | Line 1947 | begin
1947		FQModify.FreeHandle;
1948		if FQRefresh <> nil then
1949		FQRefresh.FreeHandle;
1950	+	InternalUnPrepare;
1951		if Assigned(FBeforeTransactionEnd) then
1952		FBeforeTransactionEnd(Sender);
1953		end;
#	Line 1954 | Line 2053 | begin
2053		end;
2054		end;
2055
2056	+	{Update Buffer Fields from Query Results}
2057	+
2058	+	procedure TIBCustomDataSet.UpdateRecordFromQuery(QryResults: IResults;
2059	+	Buffer: PChar);
2060	+	var i, j: integer;
2061	+	begin
2062	+	for i := 0 to QryResults.Count - 1 do
2063	+	begin
2064	+	j := GetFieldPosition(QryResults[i].GetAliasName);
2065	+	if j > 0 then
2066	+	ColumnDataToBuffer(QryResults,i,j,Buffer);
2067	+	end;
2068	+	end;
2069	+
2070	+
2071	+	{Move column data returned from query to row buffer}
2072	+
2073	+	procedure TIBCustomDataSet.ColumnDataToBuffer(QryResults: IResults;
2074	+	ColumnIndex, FieldIndex: integer; Buffer: PChar);
2075	+	var
2076	+	LocalData: PByte;
2077	+	LocalDate, LocalDouble: Double;
2078	+	LocalInt: Integer;
2079	+	LocalBool: wordBool;
2080	+	LocalInt64: Int64;
2081	+	LocalCurrency: Currency;
2082	+	ColData: ISQLData;
2083	+	begin
2084	+	LocalData := nil;
2085	+	with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2086	+	begin
2087	+	QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2088	+	if not fdIsNull then
2089	+	begin
2090	+	ColData := QryResults[ColumnIndex];
2091	+	case fdDataType of  {Get Formatted data for column types that need formatting}
2092	+	SQL_TIMESTAMP:
2093	+	begin
2094	+	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(ColData.AsDateTime));
2095	+	LocalData := PByte(@LocalDate);
2096	+	end;
2097	+	SQL_TYPE_DATE:
2098	+	begin
2099	+	LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Date;
2100	+	LocalData := PByte(@LocalInt);
2101	+	end;
2102	+	SQL_TYPE_TIME:
2103	+	begin
2104	+	LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Time;
2105	+	LocalData := PByte(@LocalInt);
2106	+	end;
2107	+	SQL_SHORT, SQL_LONG:
2108	+	begin
2109	+	if (fdDataScale = 0) then
2110	+	begin
2111	+	LocalInt := ColData.AsLong;
2112	+	LocalData := PByte(@LocalInt);
2113	+	end
2114	+	else
2115	+	if (fdDataScale >= (-4)) then
2116	+	begin
2117	+	LocalCurrency := ColData.AsCurrency;
2118	+	LocalData := PByte(@LocalCurrency);
2119	+	end
2120	+	else
2121	+	begin
2122	+	LocalDouble := ColData.AsDouble;
2123	+	LocalData := PByte(@LocalDouble);
2124	+	end;
2125	+	end;
2126	+	SQL_INT64:
2127	+	begin
2128	+	if (fdDataScale = 0) then
2129	+	begin
2130	+	LocalInt64 := ColData.AsInt64;
2131	+	LocalData := PByte(@LocalInt64);
2132	+	end
2133	+	else
2134	+	if (fdDataScale >= (-4)) then
2135	+	begin
2136	+	LocalCurrency := ColData.AsCurrency;
2137	+	LocalData := PByte(@LocalCurrency);
2138	+	end
2139	+	else
2140	+	begin
2141	+	LocalDouble := ColData.AsDouble;
2142	+	LocalData := PByte(@LocalDouble);
2143	+	end
2144	+	end;
2145	+	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2146	+	begin
2147	+	LocalDouble := ColData.AsDouble;
2148	+	LocalData := PByte(@LocalDouble);
2149	+	end;
2150	+	SQL_BOOLEAN:
2151	+	begin
2152	+	LocalBool := ColData.AsBoolean;
2153	+	LocalData := PByte(@LocalBool);
2154	+	end;
2155	+	end;
2156	+
2157	+	if fdDataType = SQL_VARYING then
2158	+	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2159	+	else
2160	+	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2161	+	end
2162	+	else {Null column}
2163	+	if fdDataType = SQL_VARYING then
2164	+	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2165	+	else
2166	+	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2167	+	end;
2168	+	end;
2169	+
2170		{ Read the record from FQSelect.Current into the record buffer
2171		Then write the buffer to in memory cache }
2172		procedure TIBCustomDataSet.FetchCurrentRecordToBuffer(Qry: TIBSQL;
#	Line 1962 | Line 2175 | var
2175		pbd: PBlobDataArray;
2176		pda: PArrayDataArray;
2177		i, j: Integer;
1965	–	LocalData: PChar;
1966	–	LocalDate, LocalDouble: Double;
1967	–	LocalInt: Integer;
1968	–	LocalBool: wordBool;
1969	–	LocalInt64: Int64;
1970	–	LocalCurrency: Currency;
2178		FieldsLoaded: Integer;
2179		p: PRecordData;
2180		begin
#	Line 2018 | Line 2225 | begin
2225		continue;
2226		end;
2227		if j > 0 then
2228	<	begin
2022	<	LocalData := nil;
2023	<	with p^.rdFields[j], FFieldColumns^[j] do
2024	<	begin
2025	<	Qry.Current.GetData(i,fdIsNull,fdDataLength,LocalData);
2026	<	if not fdIsNull then
2027	<	begin
2028	<	case fdDataType of  {Get Formatted data for column types that need formatting}
2029	<	SQL_TIMESTAMP:
2030	<	begin
2031	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(Qry[i].AsDateTime));
2032	<	LocalData := PChar(@LocalDate);
2033	<	end;
2034	<	SQL_TYPE_DATE:
2035	<	begin
2036	<	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Date;
2037	<	LocalData := PChar(@LocalInt);
2038	<	end;
2039	<	SQL_TYPE_TIME:
2040	<	begin
2041	<	LocalInt := DateTimeToTimeStamp(Qry[i].AsDateTime).Time;
2042	<	LocalData := PChar(@LocalInt);
2043	<	end;
2044	<	SQL_SHORT, SQL_LONG:
2045	<	begin
2046	<	if (fdDataScale = 0) then
2047	<	begin
2048	<	LocalInt := Qry[i].AsLong;
2049	<	LocalData := PChar(@LocalInt);
2050	<	end
2051	<	else
2052	<	if (fdDataScale >= (-4)) then
2053	<	begin
2054	<	LocalCurrency := Qry[i].AsCurrency;
2055	<	LocalData := PChar(@LocalCurrency);
2056	<	end
2057	<	else
2058	<	begin
2059	<	LocalDouble := Qry[i].AsDouble;
2060	<	LocalData := PChar(@LocalDouble);
2061	<	end;
2062	<	end;
2063	<	SQL_INT64:
2064	<	begin
2065	<	if (fdDataScale = 0) then
2066	<	begin
2067	<	LocalInt64 := Qry[i].AsInt64;
2068	<	LocalData := PChar(@LocalInt64);
2069	<	end
2070	<	else
2071	<	if (fdDataScale >= (-4)) then
2072	<	begin
2073	<	LocalCurrency := Qry[i].AsCurrency;
2074	<	LocalData := PChar(@LocalCurrency);
2075	<	end
2076	<	else
2077	<	begin
2078	<	LocalDouble := Qry[i].AsDouble;
2079	<	LocalData := PChar(@LocalDouble);
2080	<	end
2081	<	end;
2082	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
2083	<	begin
2084	<	LocalDouble := Qry[i].AsDouble;
2085	<	LocalData := PChar(@LocalDouble);
2086	<	end;
2087	<	SQL_BOOLEAN:
2088	<	begin
2089	<	LocalBool := Qry[i].AsBoolean;
2090	<	LocalData := PChar(@LocalBool);
2091	<	end;
2092	<	end;
2093	<
2094	<	if fdDataType = SQL_VARYING then
2095	<	Move(LocalData^, Buffer[fdDataOfs], fdDataLength)
2096	<	else
2097	<	Move(LocalData^, Buffer[fdDataOfs], fdDataSize)
2098	<	end
2099	<	else {Null column}
2100	<	if fdDataType = SQL_VARYING then
2101	<	FillChar(Buffer[fdDataOfs],fdDataLength,0)
2102	<	else
2103	<	FillChar(Buffer[fdDataOfs],fdDataSize,0);
2104	<	end;
2105	<	end;
2228	>	ColumnDataToBuffer(Qry.Current,i,j,Buffer);
2229		end;
2230		WriteRecordCache(RecordNumber, Buffer);
2231		end;
#	Line 2197 | Line 2320 | begin
2320		FUpdateObject.Apply(ukDelete,Buff)
2321		else
2322		begin
2323	<	SetInternalSQLParams(FQDelete, Buff);
2323	>	SetInternalSQLParams(FQDelete.Params, Buff);
2324		FQDelete.ExecQuery;
2325		end;
2326		with PRecordData(Buff)^ do
#	Line 2346 | Line 2469 | begin
2469		FUpdateObject.Apply(ukModify,Buff);
2470		end
2471		else begin
2472	<	SetInternalSQLParams(Qry, Buff);
2472	>	SetInternalSQLParams(Qry.Params, Buff);
2473		Qry.ExecQuery;
2474		end;
2475	+	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2476	+	UpdateRecordFromQuery(Qry.Current,Buff);
2477		PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2478		PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2479		SetModified(False);
#	Line 2380 | Line 2505 | begin
2505		end
2506		else
2507		Qry := FQRefresh;
2508	<	SetInternalSQLParams(Qry, Buff);
2508	>	SetInternalSQLParams(Qry.Params, Buff);
2509		Qry.ExecQuery;
2510		try
2511		if (Qry.SQLStatementType = SQLExecProcedure) or Qry.Next then
#	Line 2592 | Line 2717 | begin
2717		if (FBase.Database <> Value) then
2718		begin
2719		CheckDatasetClosed;
2720	+	InternalUnPrepare;
2721		FBase.Database := Value;
2722		FQDelete.Database := Value;
2723		FQInsert.Database := Value;
2724		FQRefresh.Database := Value;
2725		FQSelect.Database := Value;
2726		FQModify.Database := Value;
2727	+	FDatabaseInfo.Database := Value;
2728	+	FGeneratorField.Database := Value;
2729		end;
2730		end;
2731
#	Line 2619 | Line 2747 | begin
2747		end;
2748		end;
2749
2750	<	procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
2750	>	procedure TIBCustomDataSet.SetInternalSQLParams(Params: ISQLParams; Buffer: Pointer);
2751		var
2752		i, j: Integer;
2753		cr, data: PChar;
#	Line 2635 | Line 2763 | begin
2763		InternalPrepare;
2764		OldBuffer := nil;
2765		try
2766	<	for i := 0 to Qry.Params.GetCount - 1 do
2766	>	for i := 0 to Params.GetCount - 1 do
2767		begin
2768	<	Param := Qry.Params[i];
2768	>	Param := Params[i];
2769		fn := Param.Name;
2770		if (Pos('OLD_', fn) = 1) then {mbcs ok}
2771		begin
#	Line 2766 | Line 2894 | begin
2894		FQRefresh.Transaction := Value;
2895		FQSelect.Transaction := Value;
2896		FQModify.Transaction := Value;
2897	+	FGeneratorField.Transaction := Value;
2898		end;
2899		end;
2900
#	Line 3667 | Line 3796 | const
3796		'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3797		'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3798		'     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3799	+
3800	+	DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3801	+	'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3802	+	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3803	+	'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3804	+	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
3805	+	'and ((not F.RDB$COMPUTED_BLR is NULL) or ' + {do not localize}
3806	+	'     (not F.RDB$DEFAULT_VALUE is NULL) or ' + {do not localize}
3807	+	'     ( not R.RDB$IDENTITY_TYPE is NULL))' ; {do not localize}
3808	+
3809		var
3810		FieldType: TFieldType;
3811		FieldSize: Word;
3812	+	FieldDataSize: integer;
3813		charSetID: short;
3814		CharSetSize: integer;
3815		CharSetName: RawByteString;
#	Line 3706 | Line 3846 | var
3846		FField.FieldName := Query.Fields[2].AsString;
3847		FField.DEFAULT_VALUE := not Query.Fields[1].IsNull;
3848		FField.COMPUTED_BLR := not Query.Fields[0].IsNull;
3849	+	FField.IDENTITY_COLUMN := (Query.FieldCount > 3) and not Query.Fields[3].IsNull;
3850		FField.NextField := Result.FieldNodes;
3851		Result.FieldNodes := FField;
3852		Query.Next;
#	Line 3759 | Line 3900 | var
3900		FField := Ffield.NextField;
3901		end;
3902
3903	+	function Is_IDENTITY_COLUMN(Relation, Field : String) : Boolean;
3904	+	var
3905	+	FRelation : TRelationNode;
3906	+	FField : TFieldNode;
3907	+	begin
3908	+	FRelation := FRelationNodes;
3909	+	while Assigned(FRelation) and
3910	+	(FRelation.RelationName <> Relation) do
3911	+	FRelation := FRelation.NextRelation;
3912	+	if not Assigned(FRelation) then
3913	+	FRelation := Add_Node(Relation, Field);
3914	+	Result := false;
3915	+	FField := FRelation.FieldNodes;
3916	+	while Assigned(FField) do
3917	+	if FField.FieldName = Field then
3918	+	begin
3919	+	Result := Ffield.IDENTITY_COLUMN;
3920	+	Exit;
3921	+	end
3922	+	else
3923	+	FField := Ffield.NextField;
3924	+	end;
3925	+
3926		Procedure FreeNodes;
3927		var
3928		FRelation : TRelationNode;
#	Line 3792 | Line 3956 | begin
3956		FieldIndex := 0;
3957		if (Length(FMappedFieldPosition) < SourceQuery.MetaData.Count) then
3958		SetLength(FMappedFieldPosition, SourceQuery.MetaData.Count);
3959	<	Query.SQL.Text := DefaultSQL;
3959	>	if FDatabaseInfo.ODSMajorVersion >= 12 then
3960	>	Query.SQL.Text := DefaultSQLODS12
3961	>	else
3962	>	Query.SQL.Text := DefaultSQL;
3963		Query.Prepare;
3964		SetLength(FAliasNameMap, SourceQuery.MetaData.Count);
3965		SetLength(FAliasNameList, SourceQuery.MetaData.Count);
#	Line 3806 | Line 3973 | begin
3973		FieldName := getSQLName;
3974		FAliasNameList[i] := DBAliasName;
3975		FieldSize := 0;
3976	+	FieldDataSize := GetSize;
3977		FieldPrecision := 0;
3978		FieldNullable := IsNullable;
3979		CharSetSize := 0;
#	Line 3818 | Line 3986 | begin
3986		their values }
3987		SQL_VARYING, SQL_TEXT:
3988		begin
3989	<	FirebirdAPI.CharSetWidth(getCharSetID,CharSetSize);
3990	<	CharSetName := FirebirdAPI.GetCharsetName(getCharSetID);
3991	<	FirebirdAPI.CharSetID2CodePage(getCharSetID,FieldCodePage);
3992	<	FieldSize := GetSize div CharSetSize;
3989	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
3990	>	CharSetSize := 1;
3991	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
3992	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
3993	>	FieldSize := FieldDataSize div CharSetSize;
3994		FieldType := ftString;
3995		end;
3996		{ All Doubles/Floats should be cast to doubles }
#	Line 3872 | Line 4041 | begin
4041		FieldSize := -getScale;
4042		end
4043		else
4044	<	FieldType := ftFloat
4044	>	FieldType := ftFloat;
4045		end;
4046		SQL_TIMESTAMP: FieldType := ftDateTime;
4047		SQL_TYPE_TIME: FieldType := ftTime;
#	Line 3882 | Line 4051 | begin
4051		FieldSize := sizeof (TISC_QUAD);
4052		if (getSubtype = 1) then
4053		begin
4054	<	FirebirdAPI.CharSetWidth(getCharSetID,CharSetSize);
4055	<	CharSetName := FirebirdAPI.GetCharsetName(getCharSetID);
4056	<	FirebirdAPI.CharSetID2CodePage(getCharSetID,FieldCodePage);
4054	>	if not Database.Attachment.CharSetWidth(getCharSetID,CharSetSize) then
4055	>	CharSetSize := 1;
4056	>	CharSetName := Database.Attachment.GetCharsetName(getCharSetID);
4057	>	Database.Attachment.CharSetID2CodePage(getCharSetID,FieldCodePage);
4058		FieldType := ftMemo;
4059		end
4060		else
#	Line 3916 | Line 4086 | begin
4086		Name := FieldAliasName;
4087		FAliasNameMap[FieldNo-1] := DBAliasName;
4088		Size := FieldSize;
4089	+	DataSize := FieldDataSize;
4090		Precision := FieldPrecision;
4091		Required := not FieldNullable;
4092		RelationName := aRelationName;
#	Line 3927 | Line 4098 | begin
4098		ArrayBounds := aArrayBounds;
4099		if (FieldName <> '') and (RelationName <> '') then
4100		begin
4101	+	IdentityColumn := Is_IDENTITY_COLUMN(RelationName, FieldName);
4102		if Has_COMPUTED_BLR(RelationName, FieldName) then
4103		begin
4104		Attributes := [faReadOnly];
#	Line 4671 | Line 4843 | begin
4843		Transaction.StartTransaction;
4844		end;
4845
4846	<	function TIBCustomDataSet.PSGetTableName: string;
4846	>	function TIBCustomDataSet.PsGetTableName: string;
4847		begin
4848		//  if not FInternalPrepared then
4849		//    InternalPrepare;
#	Line 4812 | Line 4984 | begin
4984		inherited Destroy;
4985		end;
4986
4987	<	procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
4987	>	procedure TIBDataSetUpdateObject.SetRefreshSQL(value: TStrings);
4988		begin
4989		FRefreshSQL.Assign(Value);
4990		end;
4991
4992	+	procedure TIBDataSetUpdateObject.InternalSetParams(Params: ISQLParams;
4993	+	buff: PChar);
4994	+	begin
4995	+	if not Assigned(DataSet) then Exit;
4996	+	DataSet.SetInternalSQLParams(Params, buff);
4997	+	end;
4998	+
4999		procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
5000		begin
5001	+	InternalSetParams(Query.Params,buff);
5002	+	end;
5003	+
5004	+	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
5005	+	Buffer: PChar);
5006	+	begin
5007		if not Assigned(DataSet) then Exit;
5008	<	DataSet.SetInternalSQLParams(Query, buff);
5008	>	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5009		end;
5010
5011		function TIBDSBlobStream.GetSize: Int64;
#	Line 4883 | Line 5068 | end;
5068
5069		procedure TIBGenerator.SetIncrement(const AValue: integer);
5070		begin
5071	+	if FIncrement = AValue then Exit;
5072		if AValue < 0 then
5073	<	raise Exception.Create('A Generator Increment cannot be negative');
5074	<	FIncrement := AValue
5073	>	IBError(ibxeNegativeGenerator,[]);
5074	>	FIncrement := AValue;
5075	>	SetQuerySQL;
5076		end;
5077
5078	<	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4892	<	ATransaction: TIBTransaction): integer;
5078	>	procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5079		begin
5080	<	with TIBSQL.Create(nil) do
5081	<	try
5082	<	Database := ADatabase;
5083	<	Transaction := ATransaction;
5084	<	if not assigned(Database) then
5085	<	IBError(ibxeCannotSetDatabase,[]);
5086	<	if not assigned(Transaction) then
5087	<	IBError(ibxeCannotSetTransaction,[]);
5088	<	with Transaction do
5089	<	if not InTransaction then StartTransaction;
5090	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
5091	<	Prepare;
5080	>	FQuery.Transaction := AValue;
5081	>	end;
5082	>
5083	>	procedure TIBGenerator.SetQuerySQL;
5084	>	begin
5085	>	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5086	>	end;
5087	>
5088	>	function TIBGenerator.GetDatabase: TIBDatabase;
5089	>	begin
5090	>	Result := FQuery.Database;
5091	>	end;
5092	>
5093	>	function TIBGenerator.GetTransaction: TIBTransaction;
5094	>	begin
5095	>	Result := FQuery.Transaction;
5096	>	end;
5097	>
5098	>	procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5099	>	begin
5100	>	FQuery.Database := AValue;
5101	>	end;
5102	>
5103	>	procedure TIBGenerator.SetGeneratorName(AValue: string);
5104	>	begin
5105	>	if FGeneratorName = AValue then Exit;
5106	>	FGeneratorName := AValue;
5107	>	SetQuerySQL;
5108	>	end;
5109	>
5110	>	function TIBGenerator.GetNextValue: integer;
5111	>	begin
5112	>	with FQuery do
5113	>	begin
5114	>	Transaction.Active := true;
5115		ExecQuery;
5116		try
5117	<	Result := FieldByName('ID').AsInteger
5117	>	Result := Fields[0].AsInteger
5118		finally
5119		Close
5120		end;
4912	–	finally
4913	–	Free
5121		end;
5122		end;
5123
#	Line 4918 | Line 5125 | constructor TIBGenerator.Create(Owner: T
5125		begin
5126		FOwner := Owner;
5127		FIncrement := 1;
5128	+	FQuery := TIBSQL.Create(nil);
5129	+	end;
5130	+
5131	+	destructor TIBGenerator.Destroy;
5132	+	begin
5133	+	if assigned(FQuery) then FQuery.Free;
5134	+	inherited Destroy;
5135		end;
5136
5137
5138		procedure TIBGenerator.Apply;
5139		begin
5140	<	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5141	<	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5140	>	if assigned(Database) and assigned(Transaction) and
5141	>	(FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5142	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5143		end;
5144
5145

Diff Legend

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