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 23 by tony, Fri Mar 13 10:26:52 2015 UTC vs.
Revision 31 by tony, Tue Jul 14 15:31:25 2015 UTC

#	Line 49 | Line 49 | uses
49		{$ELSE}
50		unix,
51		{$ENDIF}
52	<	SysUtils, Classes, Forms, Controls, IBDatabase,
53	<	IBExternals, IB, IBHeader,  IBSQL, Db,
52	>	SysUtils, Classes, IBDatabase, IBExternals, IB, IBHeader,  IBSQL, Db,
53		IBUtils, IBBlob, IBSQLParser;
54
55		const
#	Line 120 | Line 119 | type
119		{ TIBStringField allows us to have strings longer than 8196 }
120
121		TIBStringField = class(TStringField)
122	+	private
123	+	FInitialised: boolean;
124	+	protected
125	+	procedure SetSize(AValue: Integer); override;
126		public
127		constructor create(AOwner: TComponent); override;
128		class procedure CheckTypeSize(Value: Integer); override;
#	Line 187 | Line 190 | type
190		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
191		end;
192
193	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
194	+
195	+	TIBControlLink = class
196	+	private
197	+	FTIBDataSet: TIBCustomDataSet;
198	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
199	+	protected
200	+	procedure UpdateSQL(Sender: TObject); virtual;
201	+	procedure UpdateParams(Sender: TObject); virtual;
202	+	public
203	+	destructor Destroy; override;
204	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
205	+	end;
206	+
207		TIBAutoCommit = (acDisabled, acCommitRetaining);
208
209		{ TIBCustomDataSet }
210		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
211
212		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
213	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
213	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
214		of object;
215		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
216		var UpdateAction: TIBUpdateAction) of object;
217
218		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
219
220	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
221	+
222	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
223	+
224		TIBCustomDataSet = class(TDataset)
225		private
226		FAutoCommit: TIBAutoCommit;
#	Line 229 | Line 250 | type
250		FDeletedRecords: Long;
251		FModelBuffer,
252		FOldBuffer: PChar;
253	+	FOnValidatePost: TOnValidatePost;
254		FOpen: Boolean;
255		FInternalPrepared: Boolean;
256		FQDelete,
#	Line 239 | Line 261 | type
261		FRecordBufferSize: Integer;
262		FRecordCount: Integer;
263		FRecordSize: Integer;
264	+	FDataSetCloseAction: TDataSetCloseAction;
265		FUniDirectional: Boolean;
266		FUpdateMode: TUpdateMode;
267		FUpdateObject: TIBDataSetUpdateObject;
#	Line 260 | Line 283 | type
283		FAliasNameList: array of string;
284		FBaseSQLSelect: TStrings;
285		FParser: TSelectSQLParser;
286	+	FCloseAction: TTransactionAction;
287	+	FInTransactionEnd: boolean;
288	+	FIBLinks: TList;
289		function GetSelectStmtHandle: TISC_STMT_HANDLE;
290		procedure SetUpdateMode(const Value: TUpdateMode);
291		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 272 | Line 298 | type
298		function CanRefresh: Boolean;
299		procedure CheckEditState;
300		procedure ClearBlobCache;
301	+	procedure ClearIBLinks;
302		procedure CopyRecordBuffer(Source, Dest: Pointer);
303		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
304		procedure DoAfterDatabaseDisconnect(Sender: TObject);
305		procedure DoDatabaseFree(Sender: TObject);
306	<	procedure DoBeforeTransactionEnd(Sender: TObject);
306	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
307		procedure DoAfterTransactionEnd(Sender: TObject);
308		procedure DoTransactionFree(Sender: TObject);
309		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
#	Line 299 | Line 326 | type
326		procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
327		procedure InternalRevertRecord(RecordNumber: Integer); virtual;
328		function IsVisible(Buffer: PChar): Boolean;
329	+	procedure RegisterIBLink(Sender: TIBControlLink);
330	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
331		procedure SaveOldBuffer(Buffer: PChar);
332		procedure SetBufferChunks(Value: Integer);
333		procedure SetDatabase(Value: TIBDatabase);
#	Line 367 | Line 396 | type
396		procedure DoBeforeDelete; override;
397		procedure DoAfterDelete; override;
398		procedure DoBeforeEdit; override;
399	+	procedure DoAfterEdit; override;
400		procedure DoBeforeInsert; override;
401		procedure DoAfterInsert; override;
402	+	procedure DoBeforeClose; override;
403		procedure DoBeforeOpen; override;
404		procedure DoBeforePost; override;
405		procedure DoAfterPost; override;
#	Line 456 | Line 487 | type
487		write FAfterTransactionEnd;
488		property TransactionFree: TNotifyEvent read FTransactionFree
489		write FTransactionFree;
490	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
491
492		public
493		constructor Create(AOwner: TComponent); override;
#	Line 489 | Line 521 | type
521		const ResultFields: string): Variant; override;
522		function UpdateStatus: TUpdateStatus; override;
523		function IsSequenced: Boolean; override;
524	+	procedure Post; override;
525		function ParamByName(ParamName: String): TIBXSQLVAR;
526		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
527		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
#	Line 496 | Line 529 | type
529		property UpdatesPending: Boolean read FUpdatesPending;
530		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
531		write SetUpdateRecordTypes;
532	+	property DataSetCloseAction: TDataSetCloseAction
533	+	read FDataSetCloseAction write FDataSetCloseAction;
534
535		published
536		property Database: TIBDatabase read GetDatabase write SetDatabase;
#	Line 581 | Line 616 | type
616		property ParamCheck;
617		property UniDirectional;
618		property Filtered;
619	+	property DataSetCloseAction;
620
621		property BeforeDatabaseDisconnect;
622		property AfterDatabaseDisconnect;
#	Line 616 | Line 652 | type
652		property OnFilterRecord;
653		property OnNewRecord;
654		property OnPostError;
655	+	property OnValidatePost;
656		end;
657
658		{ TIBDSBlobStream }
659		TIBDSBlobStream = class(TStream)
660	+	private
661	+	FHasWritten: boolean;
662		protected
663		FField: TField;
664		FBlobStream: TIBBlobStream;
665		public
666		constructor Create(AField: TField; ABlobStream: TIBBlobStream;
667		Mode: TBlobStreamMode);
668	+	destructor Destroy; override;
669		function Read(var Buffer; Count: Longint): Longint; override;
670		function Seek(Offset: Longint; Origin: Word): Longint; override;
671		procedure SetSize(NewSize: Longint); override;
#	Line 713 | Line 753 | type
753		NextRelation : TRelationNode;
754		end;
755
756	+	{ TIBControlLink }
757	+
758	+	destructor TIBControlLink.Destroy;
759	+	begin
760	+	IBDataSet := nil;
761	+	inherited Destroy;
762	+	end;
763	+
764	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
765	+	begin
766	+
767	+	end;
768	+
769	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
770	+	begin
771	+
772	+	end;
773	+
774	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
775	+	begin
776	+	if FTIBDataSet = AValue then Exit;
777	+	if IBDataSet <> nil then
778	+	IBDataSet.UnRegisterIBLink(self);
779	+	FTIBDataSet := AValue;
780	+	if IBDataSet <> nil then
781	+	IBDataSet.RegisterIBLink(self);
782	+	end;
783	+
784
785		{ TIBStringField}
786
787	<	constructor TIBStringField.Create(AOwner: TComponent);
787	>	constructor TIBStringField.create(AOwner: TComponent);
788		begin
789		inherited Create(AOwner);
790		end;
#	Line 773 | Line 841 | begin
841		end;
842		end;
843
844	+	procedure TIBStringField.SetSize(AValue: Integer);
845	+	var FieldSize: integer;
846	+	begin
847	+	if csLoading in ComponentState then
848	+	FInitialised := true;
849	+	if FInitialised then
850	+	inherited SetSize(AValue)
851	+	else
852	+	begin
853	+	{IBCustomDataSet encodes the CharWidth size in the size}
854	+	FieldSize := AValue div 4;
855	+	inherited SetSize(FieldSize);
856	+	DisplayWidth := FieldSize div ((AValue mod 4) + 1);
857	+	FInitialised := true;
858	+	end;
859	+	end;
860	+
861		{ TIBBCDField }
862
863		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 870 | Line 955 | begin
955		CheckIBLoaded;
956		FIBLoaded := True;
957		FBase := TIBBase.Create(Self);
958	+	FIBLinks := TList.Create;
959		FCurrentRecord := -1;
960		FDeletedRecords := 0;
961		FUniDirectional := False;
#	Line 897 | Line 983 | begin
983		FGenerateParamNames := False;
984		FForcedRefresh := False;
985		FAutoCommit:= acDisabled;
986	+	FDataSetCloseAction := dcDiscardChanges;
987		{Bookmark Size is Integer for IBX}
988		BookmarkSize := SizeOf(Integer);
989		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 922 | Line 1009 | begin
1009		FDataLink.Free;
1010		FBase.Free;
1011		ClearBlobCache;
1012	+	ClearIBLinks;
1013	+	FIBLinks.Free;
1014		FBlobStreamList.Free;
1015		FreeMem(FBufferCache);
1016		FBufferCache := nil;
#	Line 1366 | Line 1455 | begin
1455		FDatabaseFree(Sender);
1456		end;
1457
1458	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1458	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1459	>	Action: TTransactionAction);
1460		begin
1461	<	if Active then
1462	<	Active := False;
1461	>	FCloseAction := Action;
1462	>	FInTransactionEnd := true;
1463	>	try
1464	>	if Active then
1465	>	Active := False;
1466	>	finally
1467	>	FInTransactionEnd := false;
1468	>	end;
1469		if FQSelect <> nil then
1470		FQSelect.FreeHandle;
1471		if FQDelete <> nil then
#	Line 1831 | Line 1927 | end;
1927		procedure TIBCustomDataSet.InternalRefreshRow;
1928		var
1929		Buff: PChar;
1834	–	SetCursor: Boolean;
1930		ofs: DWORD;
1931		Qry: TIBSQL;
1932		begin
1933	<	if Assigned(Database) and not Database.SQLHourGlass then
1839	<	SetCursor := False
1840	<	else
1841	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1842	<	if SetCursor then
1843	<	Screen.Cursor := crHourGlass;
1933	>	FBase.SetCursor;
1934		try
1935		Buff := GetActiveBuf;
1936		if CanRefresh then
#	Line 1884 | Line 1974 | begin
1974		else
1975		IBError(ibxeCannotRefresh, [nil]);
1976		finally
1977	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1888	<	Screen.Cursor := crDefault;
1977	>	FBase.RestoreCursor;
1978		end;
1979		end;
1980
#	Line 1956 | Line 2045 | end;
2045
2046		procedure TIBCustomDataSet.InternalPrepare;
2047		var
1959	–	SetCursor: Boolean;
2048		DidActivate: Boolean;
2049		begin
2050		if FInternalPrepared then
2051		Exit;
2052		DidActivate := False;
2053	<	if Assigned(Database) and not Database.SQLHourGlass then
1966	<	SetCursor := False
1967	<	else
1968	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1969	<	if SetCursor then
1970	<	Screen.Cursor := crHourGlass;
2053	>	FBase.SetCursor;
2054		try
2055		ActivateConnection;
2056		DidActivate := ActivateTransaction;
#	Line 2003 | Line 2086 | begin
2086		finally
2087		if DidActivate then
2088		DeactivateTransaction;
2089	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2007	<	Screen.Cursor := crDefault;
2089	>	FBase.RestoreCursor;
2090		end;
2091		end;
2092
#	Line 2283 | Line 2365 | begin
2365		end;
2366		end;
2367
2368	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2369	+	begin
2370	+	if FIBLinks.IndexOf(Sender) = -1 then
2371	+	FIBLinks.Add(Sender);
2372	+	end;
2373	+
2374
2375		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2376		begin
#	Line 2321 | Line 2409 | begin
2409		end;
2410		end;
2411
2412	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2413	+	begin
2414	+	FIBLinks.Remove(Sender);
2415	+	end;
2416	+
2417		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2418		begin
2419		if Active then
#	Line 2553 | Line 2646 | end;
2646		procedure TIBCustomDataSet.DoAfterDelete;
2647		begin
2648		inherited DoAfterDelete;
2649	+	FBase.DoAfterDelete(self);
2650		InternalAutoCommit;
2651		end;
2652
#	Line 2570 | Line 2664 | begin
2664		inherited DoBeforeEdit;
2665		end;
2666
2667	+	procedure TIBCustomDataSet.DoAfterEdit;
2668	+	begin
2669	+	inherited DoAfterEdit;
2670	+	FBase.DoAfterEdit(self);
2671	+	end;
2672	+
2673		procedure TIBCustomDataSet.DoBeforeInsert;
2674		begin
2675		if not CanInsert then
#	Line 2582 | Line 2682 | begin
2682		if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2683		GeneratorField.Apply;
2684		inherited DoAfterInsert;
2685	+	FBase.DoAfterInsert(self);
2686	+	end;
2687	+
2688	+	procedure TIBCustomDataSet.DoBeforeClose;
2689	+	begin
2690	+	inherited DoBeforeClose;
2691	+	if State in [dsInsert,dsEdit] then
2692	+	begin
2693	+	if FInTransactionEnd and (FCloseAction = TARollback) then
2694	+	Exit;
2695	+
2696	+	if DataSetCloseAction = dcSaveChanges then
2697	+	Post;
2698	+	{Note this can fail with an exception e.g. due to
2699	+	database validation error. In which case the dataset remains open }
2700	+	end;
2701		end;
2702
2703		procedure TIBCustomDataSet.DoBeforeOpen;
2704	+	var i: integer;
2705		begin
2706		if assigned(FParser) then
2707		FParser.Reset;
2708	<	DataEvent(deCheckBrowseMode,1); {Conventional use to report getting ready to prepare}
2708	>	for i := 0 to FIBLinks.Count - 1 do
2709	>	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2710		inherited DoBeforeOpen;
2711	<	DataEvent(deCheckBrowseMode,2); {Conventional use to report the right time to set parameters}
2711	>	for i := 0 to FIBLinks.Count - 1 do
2712	>	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2713		end;
2714
2715		procedure TIBCustomDataSet.DoBeforePost;
#	Line 2604 | Line 2723 | end;
2723		procedure TIBCustomDataSet.DoAfterPost;
2724		begin
2725		inherited DoAfterPost;
2726	+	FBase.DoAfterPost(self);
2727		InternalAutoCommit;
2728		end;
2729
2730		procedure TIBCustomDataSet.FetchAll;
2731		var
2612	–	SetCursor: Boolean;
2732		{$IF FPC_FULLVERSION >= 20700 }
2733		CurBookmark: TBookmark;
2734		{$ELSE}
2735		CurBookmark: string;
2736		{$ENDIF}
2737		begin
2738	<	if Assigned(Database) and not Database.SQLHourGlass then
2739	<	SetCursor := False
2621	<	else
2622	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2623	<	if SetCursor then
2624	<	Screen.Cursor := crHourGlass;
2625	<	try
2738	>	FBase.SetCursor;
2739	>	try
2740		if FQSelect.EOF or not FQSelect.Open then
2741		exit;
2742		DisableControls;
#	Line 2634 | Line 2748 | begin
2748		EnableControls;
2749		end;
2750		finally
2751	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2638	<	Screen.Cursor := crDefault;
2751	>	FBase.RestoreCursor;
2752		end;
2753		end;
2754
#	Line 2696 | Line 2809 | end;
2809		for i := 0 to Length(FAliasNameMap) - 1 do
2810		if FAliasNameMap[i] = aliasName then
2811		begin
2812	<	Result := FieldDefs[i+1];
2812	>	Result := FieldDefs[i];
2813		Exit
2814		end;
2815		end;
#	Line 2741 | Line 2854 | begin
2854		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
2855		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
2856		begin
2857	<	if fdDataLength <= Field.Size then
2857	>	if fdDataLength < Field.DataSize then
2858		begin
2859		Move(Data^, Buffer^, fdDataLength);
2860		PChar(Buffer)[fdDataLength] := #0;
#	Line 2790 | Line 2903 | begin
2903		if not Accept and (GetMode = gmCurrent) then
2904		GetMode := gmPrior;
2905		except
2906	<	//        Application.HandleException(Self);
2906	>	//        FBase.HandleException(Self);
2907		end;
2908		end;
2909		RestoreState(SaveState);
#	Line 2971 | Line 3084 | end;
3084		procedure TIBCustomDataSet.InternalDelete;
3085		var
3086		Buff: PChar;
2974	–	SetCursor: Boolean;
3087		begin
3088	<	if Assigned(Database) and not Database.SQLHourGlass then
2977	<	SetCursor := False
2978	<	else
2979	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2980	<	if SetCursor then
2981	<	Screen.Cursor := crHourGlass;
3088	>	FBase.SetCursor;
3089		try
3090		Buff := GetActiveBuf;
3091		if CanDelete then
#	Line 3003 | Line 3110 | begin
3110		end else
3111		IBError(ibxeCannotDelete, [nil]);
3112		finally
3113	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3007	<	Screen.Cursor := crDefault;
3113	>	FBase.RestoreCursor;
3114		end;
3115		end;
3116
#	Line 3020 | Line 3126 | end;
3126
3127		procedure TIBCustomDataSet.InternalHandleException;
3128		begin
3129	<	Application.HandleException(Self)
3129	>	FBase.HandleException(Self)
3130		end;
3131
3132		procedure TIBCustomDataSet.InternalInitFieldDefs;
#	Line 3045 | Line 3151 | const
3151		var
3152		FieldType: TFieldType;
3153		FieldSize: Word;
3154	+	CharSetSize: integer;
3155		FieldNullable : Boolean;
3156		i, FieldPosition, FieldPrecision: Integer;
3157		FieldAliasName, DBAliasName: string;
#	Line 3180 | Line 3287 | begin
3287		their values }
3288		SQL_VARYING, SQL_TEXT:
3289		begin
3290	<	FieldSize := sqllen;
3290	>	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3291	>	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3292	>	FieldSize := sqllen * 4 + (CharSetSize - 1);
3293		FieldType := ftString;
3294		end;
3295		{ All Doubles/Floats should be cast to doubles }
#	Line 3402 | Line 3511 | begin
3511		end;
3512
3513		procedure TIBCustomDataSet.InternalOpen;
3405	–	var
3406	–	SetCursor: Boolean;
3514
3515		function RecordDataLength(n: Integer): Long;
3516		begin
#	Line 3411 | Line 3518 | var
3518		end;
3519
3520		begin
3521	<	if Assigned(Database) and not Database.SQLHourGlass then
3415	<	SetCursor := False
3416	<	else
3417	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3418	<	if SetCursor then
3419	<	Screen.Cursor := crHourGlass;
3521	>	FBase.SetCursor;
3522		try
3523		ActivateConnection;
3524		ActivateTransaction;
#	Line 3477 | Line 3579 | begin
3579		else
3580		FQSelect.ExecQuery;
3581		finally
3582	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3481	<	Screen.Cursor := crDefault;
3582	>	FBase.RestoreCursor;
3583		end;
3584		end;
3585
#	Line 3486 | Line 3587 | procedure TIBCustomDataSet.InternalPost;
3587		var
3588		Qry: TIBSQL;
3589		Buff: PChar;
3489	–	SetCursor: Boolean;
3590		bInserting: Boolean;
3591		begin
3592	<	if Assigned(Database) and not Database.SQLHourGlass then
3493	<	SetCursor := False
3494	<	else
3495	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3496	<	if SetCursor then
3497	<	Screen.Cursor := crHourGlass;
3592	>	FBase.SetCursor;
3593		try
3594		Buff := GetActiveBuf;
3595		CheckEditState;
#	Line 3532 | Line 3627 | begin
3627		if bInserting then
3628		Inc(FRecordCount);
3629		finally
3630	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3536	<	Screen.Cursor := crDefault;
3630	>	FBase.RestoreCursor;
3631		end;
3632		end;
3633
#	Line 3560 | Line 3654 | begin
3654		inherited Loaded;
3655		end;
3656
3657	+	procedure TIBCustomDataSet.Post;
3658	+	var CancelPost: boolean;
3659	+	begin
3660	+	CancelPost := false;
3661	+	if assigned(FOnValidatePost) then
3662	+	OnValidatePost(self,CancelPost);
3663	+	if CancelPost then
3664	+	Cancel
3665	+	else
3666	+	inherited Post;
3667	+	end;
3668	+
3669		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3670		Options: TLocateOptions): Boolean;
3671		var
#	Line 3761 | Line 3867 | begin
3867		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
3868		end;
3869
3870	+	procedure TIBCustomDataSet.ClearIBLinks;
3871	+	var i: integer;
3872	+	begin
3873	+	for i := FIBLinks.Count - 1 downto 0 do
3874	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
3875	+	end;
3876	+
3877
3878		procedure TIBCustomDataSet.InternalUnPrepare;
3879		begin
#	Line 3777 | Line 3890 | end;
3890		procedure TIBCustomDataSet.InternalExecQuery;
3891		var
3892		DidActivate: Boolean;
3780	–	SetCursor: Boolean;
3893		begin
3894		DidActivate := False;
3895	<	if Assigned(Database) and not Database.SQLHourGlass then
3784	<	SetCursor := False
3785	<	else
3786	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3787	<	if SetCursor then
3788	<	Screen.Cursor := crHourGlass;
3895	>	FBase.SetCursor;
3896		try
3897		ActivateConnection;
3898		DidActivate := ActivateTransaction;
#	Line 3802 | Line 3909 | begin
3909		finally
3910		if DidActivate then
3911		DeactivateTransaction;
3912	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3806	<	Screen.Cursor := crDefault;
3912	>	FBase.RestoreCursor;
3913		end;
3914		end;
3915
#	Line 4175 | Line 4281 | begin
4281		FBlobStream.Truncate;
4282		end;
4283
4284	+	destructor TIBDSBlobStream.Destroy;
4285	+	begin
4286	+	if FHasWritten then
4287	+	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4288	+	inherited Destroy;
4289	+	end;
4290	+
4291		function TIBDSBlobStream.Read(var Buffer; Count: Longint): Longint;
4292		begin
4293		result := FBlobStream.Read(Buffer, Count);
#	Line 4197 | Line 4310 | begin
4310		TIBCustomDataSet(FField.DataSet).RecordModified(True);
4311		TBlobField(FField).Modified := true;
4312		result := FBlobStream.Write(Buffer, Count);
4313	<	TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4313	>	FHasWritten := true;
4314	>	{  TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, PtrInt(FField));
4315	>	Removed as this caused a seek to beginning of the blob stream thus corrupting
4316	>	the blob stream. Moved to the destructor i.e. called after blob written}
4317		end;
4318
4319		{ TIBGenerator }

Diff Legend

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