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 101 by tony, Thu Jan 18 14:37:18 2018 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 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 76 | Line 76 | type
76		function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77		procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78		procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79	<	procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
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 315 | 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 361 | 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 393 | Line 405 | type
405		FDeletedRecords: Long;
406		FModelBuffer,
407		FOldBuffer: PChar;
408	+	FOnDeleteReturning: TOnDeleteReturning;
409		FOnValidatePost: TOnValidatePost;
410		FOpen: Boolean;
411		FInternalPrepared: Boolean;
#	Line 431 | 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);
#	Line 455 | 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 675 | 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 719 | 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 805 | Line 823 | type
823		property OnNewRecord;
824		property OnPostError;
825		property OnValidatePost;
826	+	property OnDeleteReturning;
827		end;
828
829		{ TIBDSBlobStream }
#	Line 1954 | 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 2053 | Line 2078 | begin
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
#	Line 2064 | Line 2092 | procedure TIBCustomDataSet.ColumnDataToB
2092		ColumnIndex, FieldIndex: integer; Buffer: PChar);
2093		var
2094		LocalData: PByte;
2095	<	LocalDate, LocalDouble: Double;
2095	>	LocalDate: TDateTime;
2096	>	LocalDouble: Double;
2097		LocalInt: Integer;
2098		LocalBool: wordBool;
2099		LocalInt64: Int64;
2100		LocalCurrency: Currency;
2072	–	p: PRecordData;
2101		ColData: ISQLData;
2102		begin
2075	–	p := PRecordData(Buffer);
2103		LocalData := nil;
2104	<	with p^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
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	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(ColData.AsDateTime));
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;
2089	–	SQL_TYPE_DATE:
2090	–	begin
2091	–	LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Date;
2092	–	LocalData := PByte(@LocalInt);
2093	–	end;
2094	–	SQL_TYPE_TIME:
2095	–	begin
2096	–	LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Time;
2097	–	LocalData := PByte(@LocalInt);
2098	–	end;
2119		SQL_SHORT, SQL_LONG:
2120		begin
2121		if (fdDataScale = 0) then
#	Line 2314 | Line 2334 | begin
2334		begin
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 2451 | 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 2463 | Line 2486 | begin
2486		else begin
2487		SetInternalSQLParams(Qry.Params, Buff);
2488		Qry.ExecQuery;
2489	+	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2490	+	UpdateRecordFromQuery(Qry.Current,Buff);
2491		end;
2467	–	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2468	–	UpdateRecordFromQuery(Qry.Current,Buff);
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 2706 | 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;
#	Line 2717 | Line 2740 | begin
2740		FQSelect.Database := Value;
2741		FQModify.Database := Value;
2742		FDatabaseInfo.Database := Value;
2743	+	FGeneratorField.Database := Value;
2744		end;
2745		end;
2746
#	Line 2820 | Line 2844 | begin
2844		end;
2845		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2846		Param.AsQuad := PISC_QUAD(data)^;
2847	<	SQL_TYPE_DATE:
2848	<	begin
2825	<	ts.Date := PInt(data)^;
2826	<	ts.Time := 0;
2827	<	Param.AsDate := TimeStampToDateTime(ts);
2828	<	end;
2829	<	SQL_TYPE_TIME:
2830	<	begin
2831	<	ts.Date := 0;
2832	<	ts.Time := PInt(data)^;
2833	<	Param.AsTime := TimeStampToDateTime(ts);
2834	<	end;
2847	>	SQL_TYPE_DATE,
2848	>	SQL_TYPE_TIME,
2849		SQL_TIMESTAMP:
2850	<	Param.AsDateTime :=
2851	<	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2850	>	{This is an IBX native format and not the TDataset approach. See also SetFieldData}
2851	>	Param.AsDateTime := PDateTime(data)^;
2852		SQL_BOOLEAN:
2853		Param.AsBoolean := PWordBool(data)^;
2854		end;
#	Line 2885 | Line 2899 | begin
2899		FQRefresh.Transaction := Value;
2900		FQSelect.Transaction := Value;
2901		FQModify.Transaction := Value;
2902	+	FGeneratorField.Transaction := Value;
2903		end;
2904		end;
2905
#	Line 4160 | Line 4175 | begin
4175		for i := 0 to SQLParams.GetCount - 1 do
4176		begin
4177		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4178	<	cur_param := SQLParams[i];
4179	<	if (cur_field <> nil) then begin
4178	>	if (cur_field <> nil) then
4179	>	begin
4180	>	cur_param := SQLParams[i];
4181		if (cur_field.IsNull) then
4182		cur_param.IsNull := True
4183	<	else case cur_field.DataType of
4183	>	else
4184	>	case cur_field.DataType of
4185		ftString:
4186		cur_param.AsString := cur_field.AsString;
4187		ftBoolean:
#	Line 4174 | Line 4191 | begin
4191		ftInteger:
4192		cur_param.AsLong := cur_field.AsInteger;
4193		ftLargeInt:
4194	<	cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4194	>	cur_param.AsInt64 := cur_field.AsLargeInt;
4195		ftFloat, ftCurrency:
4196		cur_param.AsDouble := cur_field.AsFloat;
4197		ftBCD:
#	Line 4928 | Line 4945 | end;
4945		function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4946		NativeFormat: Boolean): Boolean;
4947		begin
4948	<	if (Field.DataType = ftBCD) and not NativeFormat then
4948	>	{These datatypes use IBX conventions and not TDataset conventions}
4949	>	if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4950		Result := InternalGetFieldData(Field, Buffer)
4951		else
4952		Result := inherited GetFieldData(Field, Buffer, NativeFormat);
#	Line 4954 | Line 4972 | end;
4972		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4973		NativeFormat: Boolean);
4974		begin
4975	<	if (not NativeFormat) and (Field.DataType = ftBCD) then
4975	>	{These datatypes use IBX conventions and not TDataset conventions}
4976	>	if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4977		InternalSetfieldData(Field, Buffer)
4978		else
4979		inherited SetFieldData(Field, buffer, NativeFormat);
#	Line 4991 | Line 5010 | begin
5010		InternalSetParams(Query.Params,buff);
5011		end;
5012
5013	<	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
5014	<	Buffer: PChar);
5013	>	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5014	>	QryResults: IResults; Buffer: PChar);
5015		begin
5016		if not Assigned(DataSet) then Exit;
5017	<	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5017	>	case UpdateKind of
5018	>	ukModify, ukInsert:
5019	>	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5020	>	ukDelete:
5021	>	DataSet.DoDeleteReturning(QryResults);
5022	>	end;
5023		end;
5024
5025		function TIBDSBlobStream.GetSize: Int64;
#	Line 5058 | Line 5082 | end;
5082
5083		procedure TIBGenerator.SetIncrement(const AValue: integer);
5084		begin
5085	+	if FIncrement = AValue then Exit;
5086		if AValue < 0 then
5087	<	raise Exception.Create('A Generator Increment cannot be negative');
5088	<	FIncrement := AValue
5087	>	IBError(ibxeNegativeGenerator,[]);
5088	>	FIncrement := AValue;
5089	>	SetQuerySQL;
5090		end;
5091
5092	<	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
5067	<	ATransaction: TIBTransaction): integer;
5092	>	procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5093		begin
5094	<	with TIBSQL.Create(nil) do
5095	<	try
5096	<	Database := ADatabase;
5097	<	Transaction := ATransaction;
5098	<	if not assigned(Database) then
5099	<	IBError(ibxeCannotSetDatabase,[]);
5100	<	if not assigned(Transaction) then
5101	<	IBError(ibxeCannotSetTransaction,[]);
5102	<	with Transaction do
5103	<	if not InTransaction then StartTransaction;
5104	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
5105	<	Prepare;
5094	>	FQuery.Transaction := AValue;
5095	>	end;
5096	>
5097	>	procedure TIBGenerator.SetQuerySQL;
5098	>	begin
5099	>	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5100	>	end;
5101	>
5102	>	function TIBGenerator.GetDatabase: TIBDatabase;
5103	>	begin
5104	>	Result := FQuery.Database;
5105	>	end;
5106	>
5107	>	function TIBGenerator.GetTransaction: TIBTransaction;
5108	>	begin
5109	>	Result := FQuery.Transaction;
5110	>	end;
5111	>
5112	>	procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5113	>	begin
5114	>	FQuery.Database := AValue;
5115	>	end;
5116	>
5117	>	procedure TIBGenerator.SetGeneratorName(AValue: string);
5118	>	begin
5119	>	if FGeneratorName = AValue then Exit;
5120	>	FGeneratorName := AValue;
5121	>	SetQuerySQL;
5122	>	end;
5123	>
5124	>	function TIBGenerator.GetNextValue: integer;
5125	>	begin
5126	>	with FQuery do
5127	>	begin
5128	>	Transaction.Active := true;
5129		ExecQuery;
5130		try
5131	<	Result := FieldByName('ID').AsInteger
5131	>	Result := Fields[0].AsInteger
5132		finally
5133		Close
5134		end;
5087	–	finally
5088	–	Free
5135		end;
5136		end;
5137
#	Line 5093 | Line 5139 | constructor TIBGenerator.Create(Owner: T
5139		begin
5140		FOwner := Owner;
5141		FIncrement := 1;
5142	+	FQuery := TIBSQL.Create(nil);
5143	+	end;
5144	+
5145	+	destructor TIBGenerator.Destroy;
5146	+	begin
5147	+	if assigned(FQuery) then FQuery.Free;
5148	+	inherited Destroy;
5149		end;
5150
5151
5152		procedure TIBGenerator.Apply;
5153		begin
5154	<	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5155	<	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5154	>	if assigned(Database) and assigned(Transaction) and
5155	>	(FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5156	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5157		end;
5158
5159

Diff Legend

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