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 104 by tony, Thu Jan 18 14:37:29 2018 UTC vs.
Revision 139 by tony, Wed Jan 24 16:16:29 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 1122 | Line 1131 | begin
1131		3, {Assume UNICODE_FSS is really UTF8}
1132		4: {Include GB18030 - assuming UTF8 routines work for this codeset}
1133		if DisplayWidth = 0 then
1134	<	Result := ValidUTF8String(TextToSingleLine(Result))
1134	>	Result := Utf8EscapeControlChars(TextToSingleLine(Result))
1135		else
1136		if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
1137	<	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1137	>	Result := Utf8EscapeControlChars(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
1138		end;
1139		end
1140		end;
#	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;
2100		LocalCurrency: Currency;
2082	–	p: PRecordData;
2101		ColData: ISQLData;
2102		begin
2085	–	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;
2099	–	SQL_TYPE_DATE:
2100	–	begin
2101	–	LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Date;
2102	–	LocalData := PByte(@LocalInt);
2103	–	end;
2104	–	SQL_TYPE_TIME:
2105	–	begin
2106	–	LocalInt := DateTimeToTimeStamp(ColData.AsDateTime).Time;
2107	–	LocalData := PByte(@LocalInt);
2108	–	end;
2119		SQL_SHORT, SQL_LONG:
2120		begin
2121		if (fdDataScale = 0) then
#	Line 2324 | 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 2461 | 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 2473 | 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;
2477	–	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2478	–	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 2716 | 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 2756 | Line 2769 | var
2769		fn: string;
2770		st: RawByteString;
2771		OldBuffer: Pointer;
2759	–	ts: TTimeStamp;
2772		Param: ISQLParam;
2773		begin
2774		if (Buffer = nil) then
#	Line 2831 | Line 2843 | begin
2843		end;
2844		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2845		Param.AsQuad := PISC_QUAD(data)^;
2846	<	SQL_TYPE_DATE:
2847	<	begin
2836	<	ts.Date := PInt(data)^;
2837	<	ts.Time := 0;
2838	<	Param.AsDate := TimeStampToDateTime(ts);
2839	<	end;
2840	<	SQL_TYPE_TIME:
2841	<	begin
2842	<	ts.Date := 0;
2843	<	ts.Time := PInt(data)^;
2844	<	Param.AsTime := TimeStampToDateTime(ts);
2845	<	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 3812 | Line 3814 | var
3814		FieldType: TFieldType;
3815		FieldSize: Word;
3816		FieldDataSize: integer;
3815	–	charSetID: short;
3817		CharSetSize: integer;
3818		CharSetName: RawByteString;
3819		FieldCodePage: TSystemCodePage;
#	Line 4172 | Line 4173 | begin
4173		for i := 0 to SQLParams.GetCount - 1 do
4174		begin
4175		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4176	<	cur_param := SQLParams[i];
4177	<	if (cur_field <> nil) then begin
4176	>	if (cur_field <> nil) then
4177	>	begin
4178	>	cur_param := SQLParams[i];
4179		if (cur_field.IsNull) then
4180		cur_param.IsNull := True
4181	<	else case cur_field.DataType of
4181	>	else
4182	>	case cur_field.DataType of
4183		ftString:
4184		cur_param.AsString := cur_field.AsString;
4185		ftBoolean:
#	Line 4186 | Line 4189 | begin
4189		ftInteger:
4190		cur_param.AsLong := cur_field.AsInteger;
4191		ftLargeInt:
4192	<	cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4192	>	cur_param.AsInt64 := cur_field.AsLargeInt;
4193		ftFloat, ftCurrency:
4194		cur_param.AsDouble := cur_field.AsFloat;
4195		ftBCD:
#	Line 4940 | Line 4943 | end;
4943		function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4944		NativeFormat: Boolean): Boolean;
4945		begin
4946	<	if (Field.DataType = ftBCD) and not NativeFormat then
4946	>	{These datatypes use IBX conventions and not TDataset conventions}
4947	>	if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4948		Result := InternalGetFieldData(Field, Buffer)
4949		else
4950		Result := inherited GetFieldData(Field, Buffer, NativeFormat);
#	Line 4966 | Line 4970 | end;
4970		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4971		NativeFormat: Boolean);
4972		begin
4973	<	if (not NativeFormat) and (Field.DataType = ftBCD) then
4973	>	{These datatypes use IBX conventions and not TDataset conventions}
4974	>	if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4975		InternalSetfieldData(Field, Buffer)
4976		else
4977		inherited SetFieldData(Field, buffer, NativeFormat);
#	Line 5003 | Line 5008 | begin
5008		InternalSetParams(Query.Params,buff);
5009		end;
5010
5011	<	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
5012	<	Buffer: PChar);
5011	>	procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5012	>	QryResults: IResults; Buffer: PChar);
5013		begin
5014		if not Assigned(DataSet) then Exit;
5015	<	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5015	>	case UpdateKind of
5016	>	ukModify, ukInsert:
5017	>	DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5018	>	ukDelete:
5019	>	DataSet.DoDeleteReturning(QryResults);
5020	>	end;
5021		end;
5022
5023		function TIBDSBlobStream.GetSize: Int64;

Diff Legend

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