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 6 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 7 by tony, Sun Aug 5 18:28:19 2012 UTC

#	Line 24 | Line 24
24		{       Corporation. All Rights Reserved.                                }
25		{    Contributor(s): Jeff Overcash                                       }
26		{                                                                        }
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                                                 }
31	+	{                                                                        }
32		{************************************************************************}
33
34		unit IBCustomDataSet;
35
36		{$Mode Delphi}
37
38	+	{$IFDEF DELPHI}
39	+	{$DEFINE TDBDFIELD_IS_BCD}
40	+	{$ENDIF}
41	+
42		interface
43
44		uses
45	<	{$IFDEF LINUX }
37	<	unix,
38	<	{$ELSE}
45	>	{$IFDEF WINDOWS }
46		Windows,
47	+	{$ELSE}
48	+	unix,
49		{$ENDIF}
50		SysUtils, Classes, Forms, Controls, IBDatabase,
51		IBExternals, IB, IBHeader,  IBSQL, Db,
#	Line 50 | Line 59 | type
59		TIBCustomDataSet = class;
60		TIBDataSet = class;
61
62	+	{ TIBDataSetUpdateObject }
63	+
64		TIBDataSetUpdateObject = class(TComponent)
65		private
66		FRefreshSQL: TStrings;
#	Line 57 | Line 68 | type
68		protected
69		function GetDataSet: TIBCustomDataSet; virtual; abstract;
70		procedure SetDataSet(ADataSet: TIBCustomDataSet); virtual; abstract;
71	<	procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
71	>	procedure Apply(UpdateKind: TUpdateKind; buff: PChar); virtual; abstract;
72		function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
73	+	procedure InternalSetParams(Query: TIBSQL; buff: PChar);
74		property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
75		public
76		constructor Create(AOwner: TComponent); override;
#	Line 94 | Line 106 | type
106		TRecordData = record
107		rdBookmarkFlag: TBookmarkFlag;
108		rdFieldCount: Short;
109	<	rdRecordNumber: Long;
109	>	rdRecordNumber: Integer;
110		rdCachedUpdateStatus: TCachedUpdateStatus;
111		rdUpdateStatus: TUpdateStatus;
112		rdSavedOffset: DWORD;
#	Line 159 | Line 171 | type
171		FFieldName: string;
172		FGeneratorName: string;
173		FIncrement: integer;
162	–	function GetSelectSQL: string;
174		procedure SetIncrement(const AValue: integer);
175		protected
176		function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
#	Line 167 | Line 178 | type
178		constructor Create(Owner: TIBCustomDataSet);
179		procedure Apply;
180		property Owner: TIBCustomDataSet read FOwner;
170	–	property SelectSQL: string read GetSelectSQL;
181		published
182	<	property GeneratorName: string read FGeneratorName write FGeneratorName;
183	<	property FieldName: string read FFieldName write FFieldName;
182	>	property Generator: string read FGeneratorName write FGeneratorName;
183	>	property Field: string read FFieldName write FFieldName;
184		property Increment: integer read FIncrement write SetIncrement default 1;
185		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
186		end;
#	Line 188 | Line 198 | type
198
199		TIBCustomDataSet = class(TDataset)
200		private
201	<	FGenerator: TIBGenerator;
201	>	FGeneratorField: TIBGenerator;
202		FNeedsRefresh: Boolean;
203		FForcedRefresh: Boolean;
204		FDidActivate: Boolean;
#	Line 294 | Line 304 | type
304		procedure RefreshParams;
305		procedure SQLChanging(Sender: TObject); virtual;
306		function AdjustPosition(FCache: PChar; Offset: DWORD;
307	<	Origin: Integer): Integer;
307	>	Origin: Integer): DWORD;
308		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
309		Buffer: PChar);
310		procedure ReadRecordCache(RecordNumber: Integer; Buffer: PChar;
#	Line 402 | Line 412 | type
412		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
413		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
414		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
415	<	property Generator: TIBGenerator read FGenerator write FGenerator;
415	>	property GeneratorField: TIBGenerator read FGeneratorField write FGeneratorField;
416		property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
417		property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
418		property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
#	Line 452 | Line 462 | type
462		const ResultFields: string): Variant; override;
463		function UpdateStatus: TUpdateStatus; override;
464		function IsSequenced: Boolean; override;
465	<
465	>	function ParamByName(ParamName: String): TIBXSQLVAR;
466		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
467		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
468		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
#	Line 532 | Line 542 | type
542		property RefreshSQL;
543		property SelectSQL;
544		property ModifySQL;
545	<	property Generator;
545	>	property GeneratorField;
546		property ParamCheck;
547		property UniDirectional;
548		property Filtered;
#	Line 629 | Line 639 | DefaultFieldClasses: array[TFieldType] o
639		TIBBCDField,       {ftFMTBcd}
640		nil,  {ftFixedWideChar}
641		TWideMemoField);   {ftWideMemo}
642	<
643	<	(*    TADTField,          { ftADT }
642	>	(*
643	>	TADTField,          { ftADT }
644		TArrayField,        { ftArray }
645		TReferenceField,    { ftReference }
646		TDataSetField,     { ftDataSet }
#	Line 639 | Line 649 | DefaultFieldClasses: array[TFieldType] o
649		TVariantField,      { ftVariant }
650		TInterfaceField,    { ftInterface }
651		TIDispatchField,     { ftIDispatch }
652	<	TGuidField);        { ftGuid }*)
652	>	TGuidField);        { ftGuid } *)
653		(*var
654		CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
655
#	Line 770 | Line 780 | end;
780
781		function TIBBCDField.GetDataSize: Integer;
782		begin
783	+	{$IFDEF TBCDFIELD_IS_BCD}
784		Result := 8;
785	+	{$ELSE}
786	+	Result := inherited GetDataSize
787	+	{$ENDIF}
788		end;
789
790		{ TIBDataLink }
#	Line 826 | Line 840 | begin
840		FUniDirectional := False;
841		FBufferChunks := BufferCacheSize;
842		FBlobStreamList := TList.Create;
843	<	FGenerator := TIBGenerator.Create(self);
843	>	FGeneratorField := TIBGenerator.Create(self);
844		FDataLink := TIBDataLink.Create(Self);
845		FQDelete := TIBSQL.Create(Self);
846		FQDelete.OnSQLChanging := SQLChanging;
#	Line 863 | Line 877 | end;
877
878		destructor TIBCustomDataSet.Destroy;
879		begin
880	+	if Active then Active := false;
881		if FIBLoaded then
882		begin
883	<	if assigned(FGenerator) then FGenerator.Free;
883	>	if assigned(FGeneratorField) then FGeneratorField.Free;
884		FDataLink.Free;
885		FBase.Free;
886		ClearBlobCache;
#	Line 919 | Line 934 | end;
934
935		procedure TIBCustomDataSet.ApplyUpdates;
936		var
937	+	{$IF FPC_FULLVERSION > 20600 }
938	+	CurBookmark: TBookmark;
939	+	{$ELSE}
940		CurBookmark: string;
941	+	{$ENDIF}
942		Buffer: PRecordData;
943		CurUpdateTypes: TIBUpdateRecordTypes;
944		UpdateAction: TIBUpdateAction;
#	Line 979 | Line 998 | var
998		procedure UpdateUsingUpdateObject;
999		begin
1000		try
1001	<	FUpdateObject.Apply(UpdateKind);
1001	>	FUpdateObject.Apply(UpdateKind,PChar(Buffer));
1002		ResetBufferUpdateStatus;
1003		except
1004		on E: Exception do
#	Line 1589 | Line 1608 | end;
1608		procedure TIBCustomDataSet.InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
1609		begin
1610		if (Assigned(FUpdateObject) and (FUpdateObject.GetSQL(ukDelete).Text <> '')) then
1611	<	FUpdateObject.Apply(ukDelete)
1611	>	FUpdateObject.Apply(ukDelete,Buff)
1612		else
1613		begin
1614		SetInternalSQLParams(FQDelete, Buff);
#	Line 1606 | Line 1625 | end;
1625		function TIBCustomDataSet.InternalLocate(const KeyFields: string;
1626		const KeyValues: Variant; Options: TLocateOptions): Boolean;
1627		var
1628	<	fl: TList;
1628	>	keyFieldList: TList;
1629	>	{$IF FPC_FULLVERSION > 20600 }
1630	>	CurBookmark: TBookmark;
1631	>	{$ELSE}
1632		CurBookmark: string;
1633	<	fld, val: Variant;
1634	<	i, fld_cnt: Integer;
1633	>	{$ENDIF}
1634	>	fieldValue: Variant;
1635	>	lookupValues: array of variant;
1636	>	i, fieldCount: Integer;
1637	>	fieldValueAsString: string;
1638	>	lookupValueAsString: string;
1639		begin
1640	<	fl := TList.Create;
1640	>	keyFieldList := TList.Create;
1641		try
1642	<	GetFieldList(fl, KeyFields);
1643	<	fld_cnt := fl.Count;
1642	>	GetFieldList(keyFieldList, KeyFields);
1643	>	fieldCount := keyFieldList.Count;
1644		CurBookmark := Bookmark;
1645	<	result := False;
1646	<	while ((not result) and (not EOF)) do
1645	>	result := false;
1646	>	SetLength(lookupValues, fieldCount);
1647	>	if not EOF then
1648		begin
1649	<	i := 0;
1623	<	result := True;
1624	<	while (result and (i < fld_cnt)) do
1649	>	for i := 0 to fieldCount - 1 do  {expand key values into lookupValues array}
1650		begin
1651	<	if fld_cnt > 1 then
1652	<	val := KeyValues[i]
1651	>	if VarIsArray(KeyValues) then
1652	>	lookupValues[i] := KeyValues[i]
1653		else
1654	<	val := KeyValues;
1655	<	fld := TField(fl[i]).Value;
1656	<	result := not (VarIsNull(val) xor VarIsNull(fld));
1657	<	if result and not VarIsNull(val) then
1654	>	if i > 0 then
1655	>	lookupValues[i] := NULL
1656	>	else
1657	>	lookupValues[0] := KeyValues;
1658	>
1659	>	{convert to upper case is case insensitive search}
1660	>	if (TField(keyFieldList[i]).DataType = ftString) and
1661	>	not VarIsNull(lookupValues[i]) and (loCaseInsensitive in Options) then
1662	>	lookupValues[i] := UpperCase(lookupValues[i]);
1663	>	end;
1664	>	end;
1665	>	while not result and not EOF do   {search for a matching record}
1666	>	begin
1667	>	i := 0;
1668	>	result := true;
1669	>	while result and (i < fieldCount) do
1670	>	{see if all of the key fields matches}
1671	>	begin
1672	>	fieldValue := TField(keyFieldList[i]).Value;
1673	>	result := not (VarIsNull(fieldValue) xor VarIsNull(lookupValues[i]));
1674	>	if result and not VarIsNull(fieldValue) then
1675		begin
1676		try
1677	<	fld := VarAsType(fld, VarType(val));
1636	<	except
1637	<	on E: EVariantError do result := False;
1638	<	end;
1639	<	if Result then
1640	<	if TField(fl[i]).DataType = ftString then
1677	>	if TField(keyFieldList[i]).DataType = ftString then
1678		begin
1679	+	{strings need special handling because of the locate options that
1680	+	apply to them}
1681	+	fieldValueAsString := TField(keyFieldList[i]).AsString;
1682	+	lookupValueAsString := lookupValues[i];
1683		if (loCaseInsensitive in Options) then
1684	<	begin
1685	<	fld := AnsiUpperCase(fld);
1645	<	val := AnsiUpperCase(val);
1646	<	end;
1647	<	fld := TrimRight(fld);
1648	<	val := TrimRight(val);
1684	>	fieldValueAsString := UpperCase(fieldValueAsString);
1685	>
1686		if (loPartialKey in Options) then
1687	<	result := result and (AnsiPos(val, fld) = 1)
1687	>	result := result and (Pos(lookupValueAsString, fieldValueAsString) = 1)
1688		else
1689	<	result := result and (val = fld);
1690	<	end else
1691	<	result := result and (val = fld);
1689	>	result := result and (fieldValueAsString = lookupValueAsString);
1690	>	end
1691	>	else
1692	>	result := result and (lookupValues[i] =
1693	>	VarAsType(fieldValue, VarType(lookupValues[i])));
1694	>	except on EVariantError do
1695	>	result := False;
1696	>	end;
1697		end;
1698		Inc(i);
1699		end;
1700		if not result then
1701	<	Next;
1701	>	Next;
1702		end;
1703		if not result then
1704		Bookmark := CurBookmark
1705		else
1706		CursorPosChanged;
1707		finally
1708	<	fl.Free;
1708	>	keyFieldList.Free;
1709	>	SetLength(lookupValues,0)
1710		end;
1711		end;
1712
#	Line 1691 | Line 1734 | begin
1734		if Assigned(FUpdateObject) then
1735		begin
1736		if (Qry = FQDelete) then
1737	<	FUpdateObject.Apply(ukDelete)
1737	>	FUpdateObject.Apply(ukDelete,Buff)
1738		else if (Qry = FQInsert) then
1739	<	FUpdateObject.Apply(ukInsert)
1739	>	FUpdateObject.Apply(ukInsert,Buff)
1740		else
1741	<	FUpdateObject.Apply(ukModify);
1741	>	FUpdateObject.Apply(ukModify,Buff);
1742		end
1743		else begin
1744		SetInternalSQLParams(Qry, Buff);
#	Line 1855 | Line 1898 | begin
1898		FQSelect.ParamCheck := ParamCheck;
1899		FQSelect.Prepare;
1900		end;
1901	<	if (FQDelete.SQL.Text <> '') and (not FQDelete.Prepared) then
1901	>	if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
1902		FQDelete.Prepare;
1903	<	if (FQInsert.SQL.Text <> '') and (not FQInsert.Prepared) then
1903	>	if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
1904		FQInsert.Prepare;
1905	<	if (FQRefresh.SQL.Text <> '') and (not FQRefresh.Prepared) then
1905	>	if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
1906		FQRefresh.Prepare;
1907	<	if (FQModify.SQL.Text <> '') and (not FQModify.Prepared) then
1907	>	if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
1908		FQModify.Prepare;
1909		FInternalPrepared := True;
1910		InternalInitFieldDefs;
#	Line 2061 | Line 2104 | begin
2104		end;
2105		SQL_TIMESTAMP:
2106		Qry.Params[i].AsDateTime :=
2107	<	TimeStampToDateTime(
2065	<	MSecsToTimeStamp(PDouble(data)^));
2107	>	TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2108		end;
2109		end;
2110		end;
#	Line 2199 | Line 2241 | begin
2241		Result := Assigned( FQSelect ) and FQSelect.EOF;
2242		end;
2243
2244	+	function TIBCustomDataSet.ParamByName(ParamName: String): TIBXSQLVAR;
2245	+	begin
2246	+	ActivateConnection;
2247	+	ActivateTransaction;
2248	+	if not FInternalPrepared then
2249	+	InternalPrepare;
2250	+	Result := Params.ByName(ParamName);
2251	+	end;
2252	+
2253	+	{Beware: the parameter FCache is used as an identifier to determine which
2254	+	cache is being operated on and is not referenced in the computation.
2255	+	The result is an adjusted offset into the identified cache, either the
2256	+	Buffer Cache or the old Buffer Cache.}
2257	+
2258		function TIBCustomDataSet.AdjustPosition(FCache: PChar; Offset: DWORD;
2259	<	Origin: Integer): Integer;
2259	>	Origin: Integer): DWORD;
2260		var
2261		OldCacheSize: Integer;
2262		begin
#	Line 2237 | Line 2293 | procedure TIBCustomDataSet.ReadCache(FCa
2293		Buffer: PChar);
2294		var
2295		pCache: PChar;
2296	+	AdjustedOffset: DWORD;
2297		bOld: Boolean;
2298		begin
2299		bOld := (FCache = FOldBufferCache);
2300	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2300	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2301		if not bOld then
2302	<	pCache := FBufferCache + Integer(pCache)
2302	>	pCache := FBufferCache + AdjustedOffset
2303		else
2304	<	pCache := FOldBufferCache + Integer(pCache);
2304	>	pCache := FOldBufferCache + AdjustedOffset;
2305		Move(pCache^, Buffer^, DWORD(FRecordBufferSize));
2306		AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2307		end;
#	Line 2274 | Line 2331 | procedure TIBCustomDataSet.WriteCache(FC
2331		Buffer: PChar);
2332		var
2333		pCache: PChar;
2334	+	AdjustedOffset: DWORD;
2335		bOld: Boolean;
2336		dwEnd: DWORD;
2337		begin
2338		bOld := (FCache = FOldBufferCache);
2339	<	pCache := PChar(AdjustPosition(FCache, Offset, Origin));
2339	>	AdjustedOffset := AdjustPosition(FCache, Offset, Origin);
2340		if not bOld then
2341	<	pCache := FBufferCache + Integer(pCache)
2341	>	pCache := FBufferCache + AdjustedOffset
2342		else
2343	<	pCache := FOldBufferCache + Integer(pCache);
2343	>	pCache := FOldBufferCache + AdjustedOffset;
2344		Move(Buffer^, pCache^, FRecordBufferSize);
2345		dwEnd := AdjustPosition(FCache, FRecordBufferSize, FILE_CURRENT);
2346		if not bOld then
#	Line 2419 | Line 2477 | end;
2477
2478		procedure TIBCustomDataSet.DoAfterInsert;
2479		begin
2480	<	if Generator.ApplyOnEvent = gaeOnNewRecord then
2481	<	Generator.Apply;
2480	>	if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2481	>	GeneratorField.Apply;
2482		inherited DoAfterInsert;
2483		end;
2484
#	Line 2428 | Line 2486 | procedure TIBCustomDataSet.DoBeforePost;
2486		begin
2487		inherited DoBeforePost;
2488		if (State = dsInsert) and
2489	<	(Generator.ApplyOnEvent = gaeOnPostRecord) then
2490	<	Generator.Apply
2489	>	(GeneratorField.ApplyOnEvent = gaeOnPostRecord) then
2490	>	GeneratorField.Apply
2491		end;
2492
2493		procedure TIBCustomDataSet.FetchAll;
2494		var
2495		SetCursor: Boolean;
2496	+	{$IF FPC_FULLVERSION > 20600 }
2497	+	CurBookmark: TBookmark;
2498	+	{$ELSE}
2499		CurBookmark: string;
2500	+	{$ENDIF}
2501		begin
2502		SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2503		if SetCursor then
#	Line 2519 | Line 2581 | begin
2581		result := False;
2582		Buff := GetActiveBuf;
2583		if (Buff = nil) or
2584	<	(not IsVisible(Buff)) then
2584	>	(not IsVisible(Buff)) or not assigned(Field.DataSet) then
2585		exit;
2586		{ The intention here is to stuff the buffer with the data for the
2587		referenced field for the current record }
#	Line 2541 | Line 2603 | begin
2603		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
2604		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
2605		begin
2606	<	Move(Data^, Buffer^, fdDataLength);
2607	<	PChar(Buffer)[fdDataLength] := #0;
2606	>	if fdDataLength <= Field.Size then
2607	>	begin
2608	>	Move(Data^, Buffer^, fdDataLength);
2609	>	PChar(Buffer)[fdDataLength] := #0;
2610	>	end
2611	>	else
2612	>	IBError(ibxeFieldSizeError,[Field.FieldName])
2613		end
2614		else
2615		Move(Data^, Buffer^, Field.DataSize);
#	Line 2980 | Line 3047 | begin
3047		FieldSize := -sqlscale;
3048		end
3049		else
3050	<	FieldType := ftFloat;
3050	>	if Database.SQLDialect = 1 then
3051	>	FieldType := ftFloat
3052	>	else
3053	>	if (FieldCount > i) and (Fields[i] is TFloatField) then
3054	>	FieldType := ftFloat
3055	>	else
3056	>	begin
3057	>	FieldType := ftFMTBCD;
3058	>	FieldPrecision := 9;
3059	>	FieldSize := -sqlscale;
3060		end;
3061	+	end;
3062	+
3063		SQL_INT64:
3064		begin
3065		if (sqlscale = 0) then
#	Line 2993 | Line 3071 | begin
3071		FieldSize := -sqlscale;
3072		end
3073		else
3074	<	FieldType := ftFloat;
3075	<	end;
3074	>	FieldType := ftFloat
3075	>	end;
3076		SQL_TIMESTAMP: FieldType := ftDateTime;
3077		SQL_TYPE_TIME: FieldType := ftTime;
3078		SQL_TYPE_DATE: FieldType := ftDate;
#	Line 3021 | Line 3099 | begin
3099		Inc(FieldIndex);
3100		with FieldDefs.AddFieldDef do
3101		begin
3102	<	Name := string( FieldAliasName );
3102	>	Name := FieldAliasName;
3103		(*           FieldNo := FieldPosition;*)
3104		DataType := FieldType;
3105		Size := FieldSize;
#	Line 3308 | Line 3386 | end;
3386		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3387		Options: TLocateOptions): Boolean;
3388		var
3389	+	{$IF FPC_FULLVERSION > 20600 }
3390	+	CurBookmark: TBookmark;
3391	+	{$ELSE}
3392		CurBookmark: string;
3393	+	{$ENDIF}
3394		begin
3395		DisableControls;
3396		try
#	Line 3326 | Line 3408 | function TIBCustomDataSet.Lookup(const K
3408		const ResultFields: string): Variant;
3409		var
3410		fl: TList;
3411	+	{$IF FPC_FULLVERSION > 20600 }
3412	+	CurBookmark: TBookmark;
3413	+	{$ELSE}
3414		CurBookmark: string;
3415	+	{$ENDIF}
3416		begin
3417		DisableControls;
3418		fl := TList.Create;
#	Line 3432 | Line 3518 | begin
3518		end;
3519		end;
3520		if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
3521	<	DataEvent(deFieldChange, Longint(Field));
3521	>	DataEvent(deFieldChange, PtrInt(Field));
3522		end;
3523
3524		procedure TIBCustomDataSet.SetRecNo(Value: Integer);
#	Line 3788 | Line 3874 | end;
3874
3875		function TIBCustomDataSet.GetFieldData(Field: TField;
3876		Buffer: Pointer): Boolean;
3877	+	{$IFDEF TBCDFIELD_IS_BCD}
3878		var
3879		lTempCurr : System.Currency;
3880		begin
#	Line 3798 | Line 3885 | begin
3885		CurrToBCD(lTempCurr, TBCD(Buffer^), 32, Field.Size);
3886		end
3887		else
3888	+	{$ELSE}
3889	+	begin
3890	+	{$ENDIF}
3891		Result := InternalGetFieldData(Field, Buffer);
3892		end;
3893
#	Line 3811 | Line 3901 | begin
3901		end;
3902
3903		procedure TIBCustomDataSet.SetFieldData(Field: TField; Buffer: Pointer);
3904	+	{$IFDEF TDBDFIELD_IS_BCD}
3905		var
3906		lTempCurr : System.Currency;
3907		begin
#	Line 3820 | Line 3911 | begin
3911		InternalSetFieldData(Field, @lTempCurr);
3912		end
3913		else
3914	+	{$ELSE}
3915	+	begin
3916	+	{$ENDIF}
3917		InternalSetFieldData(Field, Buffer);
3918		end;
3919
#	Line 3851 | Line 3945 | begin
3945		FRefreshSQL.Assign(Value);
3946		end;
3947
3948	+	procedure TIBDataSetUpdateObject.InternalSetParams(Query: TIBSQL; buff: PChar);
3949	+	begin
3950	+	if not Assigned(DataSet) then Exit;
3951	+	DataSet.SetInternalSQLParams(Query, buff);
3952	+	end;
3953	+
3954		{ TIBDSBlobStream }
3955		constructor TIBDSBlobStream.Create(AField: TField; ABlobStream: TIBBlobStream;
3956		Mode: TBlobStreamMode);
#	Line 3884 | Line 3984 | begin
3984		TIBCustomDataSet(FField.DataSet).RecordModified(True);
3985		TBlobField(FField).Modified := true;
3986		result := FBlobStream.Write(Buffer, Count);
3987	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
3987	>	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
3988		end;
3989
3990		{ TIBGenerator }
#	Line 3896 | Line 3996 | begin
3996		FIncrement := AValue
3997		end;
3998
3899	–	function TIBGenerator.GetSelectSQL: string;
3900	–	begin
3901	–	Result := FOwner.SelectSQL.Text
3902	–	end;
3903	–
3999		function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
4000		ATransaction: TIBTransaction): integer;
4001		begin
#	Line 3914 | Line 4009 | begin
4009		IBError(ibxeCannotSetTransaction,[]);
4010		with Transaction do
4011		if not InTransaction then StartTransaction;
4012	<	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[GeneratorName,Increment]);
4012	>	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[FGeneratorName,Increment]);
4013		Prepare;
4014		ExecQuery;
4015		try
#	Line 3936 | Line 4031 | end;
4031
4032		procedure TIBGenerator.Apply;
4033		begin
4034	<	if (GeneratorName <> '') and (FieldName <> '')  then
4035	<	Owner.FieldByName(FieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4034	>	if (FGeneratorName <> '') and (FFieldName <> '')  then
4035	>	Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4036		end;
4037
4038		end.

Diff Legend

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