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 107 by tony, Thu Jan 18 14:37:40 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 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 431 | Line 441 | type
441		FInTransactionEnd: boolean;
442		FIBLinks: TList;
443		FFieldColumns: PFieldColumns;
444	+	FBufferUpdatedOnQryReturn: boolean;
445		procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
446		FieldIndex: integer; Buffer: PChar);
447		procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
#	Line 675 | Line 686 | type
686		procedure Post; override;
687		function ParamByName(ParamName: String): ISQLParam;
688		property ArrayFieldCount: integer read FArrayFieldCount;
689	+	property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
690		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
691		property UpdatesPending: Boolean read FUpdatesPending;
692		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
#	Line 2053 | Line 2065 | begin
2065		begin
2066		j := GetFieldPosition(QryResults[i].GetAliasName);
2067		if j > 0 then
2068	+	begin
2069		ColumnDataToBuffer(QryResults,i,j,Buffer);
2070	+	FBufferUpdatedOnQryReturn := true;
2071	+	end;
2072		end;
2073		end;
2074
#	Line 2064 | Line 2079 | procedure TIBCustomDataSet.ColumnDataToB
2079		ColumnIndex, FieldIndex: integer; Buffer: PChar);
2080		var
2081		LocalData: PByte;
2082	<	LocalDate, LocalDouble: Double;
2082	>	LocalDate: TDateTime;
2083	>	LocalDouble: Double;
2084		LocalInt: Integer;
2085		LocalBool: wordBool;
2086		LocalInt64: Int64;
2087		LocalCurrency: Currency;
2072	–	p: PRecordData;
2088		ColData: ISQLData;
2089		begin
2075	–	p := PRecordData(Buffer);
2090		LocalData := nil;
2091	<	with p^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2091	>	with PRecordData(Buffer)^.rdFields[FieldIndex], FFieldColumns^[FieldIndex] do
2092		begin
2093		QryResults.GetData(ColumnIndex,fdIsNull,fdDataLength,LocalData);
2094		if not fdIsNull then
2095		begin
2096		ColData := QryResults[ColumnIndex];
2097		case fdDataType of  {Get Formatted data for column types that need formatting}
2098	+	SQL_TYPE_DATE,
2099	+	SQL_TYPE_TIME,
2100		SQL_TIMESTAMP:
2101		begin
2102	<	LocalDate := TimeStampToMSecs(DateTimeToTimeStamp(ColData.AsDateTime));
2102	>	{This is an IBX native format and not the TDataset approach. See also GetFieldData}
2103	>	LocalDate := ColData.AsDateTime;
2104		LocalData := PByte(@LocalDate);
2105		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;
2106		SQL_SHORT, SQL_LONG:
2107		begin
2108		if (fdDataScale = 0) then
#	Line 2451 | Line 2458 | begin
2458		end;
2459		Inc(arr);
2460		end;
2461	+	FBufferUpdatedOnQryReturn := false;
2462		if Assigned(FUpdateObject) then
2463		begin
2464		if (Qry = FQDelete) then
#	Line 2463 | Line 2471 | begin
2471		else begin
2472		SetInternalSQLParams(Qry.Params, Buff);
2473		Qry.ExecQuery;
2474	+	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2475	+	UpdateRecordFromQuery(Qry.Current,Buff);
2476		end;
2467	–	if Qry.FieldCount > 0 then {Has RETURNING Clause}
2468	–	UpdateRecordFromQuery(Qry.Current,Buff);
2477		PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2478		PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2479		SetModified(False);
2480		WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2481	<	if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
2481	>	if (FForcedRefresh or (FNeedsRefresh and not FBufferUpdatedOnQryReturn)) and CanRefresh then
2482		InternalRefreshRow;
2483		end;
2484
#	Line 2717 | Line 2725 | begin
2725		FQSelect.Database := Value;
2726		FQModify.Database := Value;
2727		FDatabaseInfo.Database := Value;
2728	+	FGeneratorField.Database := Value;
2729		end;
2730		end;
2731
#	Line 2820 | Line 2829 | begin
2829		end;
2830		SQL_BLOB, SQL_ARRAY, SQL_QUAD:
2831		Param.AsQuad := PISC_QUAD(data)^;
2832	<	SQL_TYPE_DATE:
2833	<	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;
2832	>	SQL_TYPE_DATE,
2833	>	SQL_TYPE_TIME,
2834		SQL_TIMESTAMP:
2835	<	Param.AsDateTime :=
2836	<	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2835	>	{This is an IBX native format and not the TDataset approach. See also SetFieldData}
2836	>	Param.AsDateTime := PDateTime(data)^;
2837		SQL_BOOLEAN:
2838		Param.AsBoolean := PWordBool(data)^;
2839		end;
#	Line 2885 | Line 2884 | begin
2884		FQRefresh.Transaction := Value;
2885		FQSelect.Transaction := Value;
2886		FQModify.Transaction := Value;
2887	+	FGeneratorField.Transaction := Value;
2888		end;
2889		end;
2890
#	Line 4160 | Line 4160 | begin
4160		for i := 0 to SQLParams.GetCount - 1 do
4161		begin
4162		cur_field := DataSource.DataSet.FindField(SQLParams[i].Name);
4163	<	cur_param := SQLParams[i];
4164	<	if (cur_field <> nil) then begin
4163	>	if (cur_field <> nil) then
4164	>	begin
4165	>	cur_param := SQLParams[i];
4166		if (cur_field.IsNull) then
4167		cur_param.IsNull := True
4168	<	else case cur_field.DataType of
4168	>	else
4169	>	case cur_field.DataType of
4170		ftString:
4171		cur_param.AsString := cur_field.AsString;
4172		ftBoolean:
#	Line 4174 | Line 4176 | begin
4176		ftInteger:
4177		cur_param.AsLong := cur_field.AsInteger;
4178		ftLargeInt:
4179	<	cur_param.AsInt64 := TLargeIntField(cur_field).AsLargeInt;
4179	>	cur_param.AsInt64 := cur_field.AsLargeInt;
4180		ftFloat, ftCurrency:
4181		cur_param.AsDouble := cur_field.AsFloat;
4182		ftBCD:
#	Line 4928 | Line 4930 | end;
4930		function TIBCustomDataSet.GetFieldData(Field: TField; Buffer: Pointer;
4931		NativeFormat: Boolean): Boolean;
4932		begin
4933	<	if (Field.DataType = ftBCD) and not NativeFormat then
4933	>	{These datatypes use IBX conventions and not TDataset conventions}
4934	>	if (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) and not NativeFormat then
4935		Result := InternalGetFieldData(Field, Buffer)
4936		else
4937		Result := inherited GetFieldData(Field, Buffer, NativeFormat);
#	Line 4954 | Line 4957 | end;
4957		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer;
4958		NativeFormat: Boolean);
4959		begin
4960	<	if (not NativeFormat) and (Field.DataType = ftBCD) then
4960	>	{These datatypes use IBX conventions and not TDataset conventions}
4961	>	if (not NativeFormat) and (Field.DataType in [ftBCD,ftDateTime,ftDate,ftTime]) then
4962		InternalSetfieldData(Field, Buffer)
4963		else
4964		inherited SetFieldData(Field, buffer, NativeFormat);
#	Line 5058 | Line 5062 | end;
5062
5063		procedure TIBGenerator.SetIncrement(const AValue: integer);
5064		begin
5065	+	if FIncrement = AValue then Exit;
5066		if AValue < 0 then
5067	<	raise Exception.Create('A Generator Increment cannot be negative');
5068	<	FIncrement := AValue
5067	>	IBError(ibxeNegativeGenerator,[]);
5068	>	FIncrement := AValue;
5069	>	SetQuerySQL;
5070		end;
5071
5072	<	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
5067	<	ATransaction: TIBTransaction): integer;
5072	>	procedure TIBGenerator.SetTransaction(AValue: TIBTransaction);
5073		begin
5074	<	with TIBSQL.Create(nil) do
5075	<	try
5076	<	Database := ADatabase;
5077	<	Transaction := ATransaction;
5078	<	if not assigned(Database) then
5079	<	IBError(ibxeCannotSetDatabase,[]);
5080	<	if not assigned(Transaction) then
5081	<	IBError(ibxeCannotSetTransaction,[]);
5082	<	with Transaction do
5083	<	if not InTransaction then StartTransaction;
5084	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
5085	<	Prepare;
5074	>	FQuery.Transaction := AValue;
5075	>	end;
5076	>
5077	>	procedure TIBGenerator.SetQuerySQL;
5078	>	begin
5079	>	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5080	>	end;
5081	>
5082	>	function TIBGenerator.GetDatabase: TIBDatabase;
5083	>	begin
5084	>	Result := FQuery.Database;
5085	>	end;
5086	>
5087	>	function TIBGenerator.GetTransaction: TIBTransaction;
5088	>	begin
5089	>	Result := FQuery.Transaction;
5090	>	end;
5091	>
5092	>	procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5093	>	begin
5094	>	FQuery.Database := AValue;
5095	>	end;
5096	>
5097	>	procedure TIBGenerator.SetGeneratorName(AValue: string);
5098	>	begin
5099	>	if FGeneratorName = AValue then Exit;
5100	>	FGeneratorName := AValue;
5101	>	SetQuerySQL;
5102	>	end;
5103	>
5104	>	function TIBGenerator.GetNextValue: integer;
5105	>	begin
5106	>	with FQuery do
5107	>	begin
5108	>	Transaction.Active := true;
5109		ExecQuery;
5110		try
5111	<	Result := FieldByName('ID').AsInteger
5111	>	Result := Fields[0].AsInteger
5112		finally
5113		Close
5114		end;
5087	–	finally
5088	–	Free
5115		end;
5116		end;
5117
#	Line 5093 | Line 5119 | constructor TIBGenerator.Create(Owner: T
5119		begin
5120		FOwner := Owner;
5121		FIncrement := 1;
5122	+	FQuery := TIBSQL.Create(nil);
5123	+	end;
5124	+
5125	+	destructor TIBGenerator.Destroy;
5126	+	begin
5127	+	if assigned(FQuery) then FQuery.Free;
5128	+	inherited Destroy;
5129		end;
5130
5131
5132		procedure TIBGenerator.Apply;
5133		begin
5134	<	if (FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5135	<	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
5134	>	if assigned(Database) and assigned(Transaction) and
5135	>	(FGeneratorName <> '') and (FFieldName <> '') and Owner.FieldByName(FFieldName).IsNull then
5136	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue;
5137		end;
5138
5139

Diff Legend

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