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 105 by tony, Thu Jan 18 14:37:32 2018 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 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 371 | 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 403 | Line 405 | type
405		FDeletedRecords: Long;
406		FModelBuffer,
407		FOldBuffer: PChar;
408	+	FOnDeleteReturning: TOnDeleteReturning;
409		FOnValidatePost: TOnValidatePost;
410		FOpen: Boolean;
411		FInternalPrepared: Boolean;
#	Line 441 | 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 465 | 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 685 | 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 729 | 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 815 | Line 823 | type
823		property OnNewRecord;
824		property OnPostError;
825		property OnValidatePost;
826	+	property OnDeleteReturning;
827		end;
828
829		{ TIBDSBlobStream }
#	Line 1964 | 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 2063 | 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 2074 | 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;
#	Line 2089 | Line 2108 | begin
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;
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;
2119		SQL_SHORT, SQL_LONG:
2120		begin
2121		if (fdDataScale = 0) then
#	Line 2322 | 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 2459 | 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 2471 | 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;
2475	–	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2476	–	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 2714 | 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 2754 | Line 2769 | var
2769		fn: string;
2770		st: RawByteString;
2771		OldBuffer: Pointer;
2757	–	ts: TTimeStamp;
2772		Param: ISQLParam;
2773		begin
2774		if (Buffer = nil) then
#	Line 2829 | Line 2843 | begin
2843		end;
2844		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2845		Param.AsQuad := PISC_QUAD(data)^;
2846	<	SQL_TYPE_DATE:
2847	<	begin
2834	<	ts.Date := PInt(data)^;
2835	<	ts.Time := 0;
2836	<	Param.AsDate := TimeStampToDateTime(ts);
2837	<	end;
2838	<	SQL_TYPE_TIME:
2839	<	begin
2840	<	ts.Date := 0;
2841	<	ts.Time := PInt(data)^;
2842	<	Param.AsTime := TimeStampToDateTime(ts);
2843	<	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 2935 | 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 3810 | Line 3821 | var
3821		FieldType: TFieldType;
3822		FieldSize: Word;
3823		FieldDataSize: integer;
3813	–	charSetID: short;
3824		CharSetSize: integer;
3825		CharSetName: RawByteString;
3826		FieldCodePage: TSystemCodePage;
#	Line 4170 | 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 4184 | 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 4938 | 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 4964 | 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 5001 | Line 5015 | begin
5015		InternalSetParams(Query.Params,buff);
5016		end;
5017
5018	<	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
5019	<	Buffer: PChar);
5018	>	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5019	>	QryResults: IResults; Buffer: PChar);
5020		begin
5021		if not Assigned(DataSet) then Exit;
5022	<	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
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;

Diff Legend

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