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 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 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 2745 | Line 2769 | var
2769		fn: string;
2770		st: RawByteString;
2771		OldBuffer: Pointer;
2748	–	ts: TTimeStamp;
2772		Param: ISQLParam;
2773		begin
2774		if (Buffer = nil) then
#	Line 2820 | Line 2843 | begin
2843		end;
2844		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2845		Param.AsQuad := PISC_QUAD(data)^;
2846	<	SQL_TYPE_DATE:
2847	<	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;
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 2885 | 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 2925 | 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 3800 | Line 3821 | var
3821		FieldType: TFieldType;
3822		FieldSize: Word;
3823		FieldDataSize: integer;
3803	–	charSetID: short;
3824		CharSetSize: integer;
3825		CharSetName: RawByteString;
3826		FieldCodePage: TSystemCodePage;
#	Line 4160 | 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 4174 | 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 4928 | 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 4954 | 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 4991 | 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;
#	Line 5058 | 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;
5067	<	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;
5087	–	finally
5088	–	Free
5140		end;
5141		end;
5142
#	Line 5093 | 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