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 21 by tony, Thu Feb 26 10:33:34 2015 UTC vs.
Revision 31 by tony, Tue Jul 14 15:31:25 2015 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                                                 }
30	>	{    Associates Ltd 2011 - 2015                                                }
31		{                                                                        }
32		{************************************************************************}
33
#	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;
227		FGenerateParamNames: Boolean;
228		FGeneratorField: TIBGenerator;
229		FNeedsRefresh: Boolean;
#	Line 226 | Line 250 | type
250		FDeletedRecords: Long;
251		FModelBuffer,
252		FOldBuffer: PChar;
253	+	FOnValidatePost: TOnValidatePost;
254		FOpen: Boolean;
255		FInternalPrepared: Boolean;
256		FQDelete,
#	Line 236 | 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 257 | 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 269 | 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 296 | 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 362 | Line 394 | type
394		procedure ClearCalcFields(Buffer: PChar); override;
395		function AllocRecordBuffer: PChar; override;
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;
406		procedure FreeRecordBuffer(var Buffer: PChar); override;
407		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
408		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
#	Line 380 | Line 416 | type
416		DoCheck: Boolean): TGetResult; override;
417		function GetRecordCount: Integer; override;
418		function GetRecordSize: Word; override;
419	+	procedure InternalAutoCommit;
420		procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
421		procedure InternalCancel; override;
422		procedure InternalClose; override;
#	Line 411 | Line 448 | type
448
449		protected
450		{Likely to be made public by descendant classes}
451	+	property AutoCommit: TIBAutoCommit read FAutoCommit write FAutoCommit default acDisabled;
452		property SQLParams: TIBXSQLDA read GetSQLParams;
453		property Params: TIBXSQLDA read GetSQLParams;
454		property InternalPrepared: Boolean read FInternalPrepared;
#	Line 449 | 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 482 | 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 489 | 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 561 | Line 603 | type
603
604		published
605		{ TIBCustomDataSet }
606	+	property AutoCommit;
607		property BufferChunks;
608		property CachedUpdates;
609		property DeleteSQL;
#	Line 573 | Line 616 | type
616		property ParamCheck;
617		property UniDirectional;
618		property Filtered;
619	+	property DataSetCloseAction;
620
621		property BeforeDatabaseDisconnect;
622		property AfterDatabaseDisconnect;
#	Line 608 | 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 705 | 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 765 | 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 862 | 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 888 | Line 982 | begin
982		FParamCheck := True;
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 913 | 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 1357 | 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 1398 | Line 1503 | var
1503		LocalData: Pointer;
1504		LocalDate, LocalDouble: Double;
1505		LocalInt: Integer;
1506	+	LocalBool: wordBool;
1507		LocalInt64: Int64;
1508		LocalCurrency: Currency;
1509		FieldsLoaded: Integer;
#	Line 1542 | Line 1648 | begin
1648		end;
1649		end;
1650		end;
1651	+	SQL_BOOLEAN:
1652	+	begin
1653	+	LocalBool:= false;
1654	+	rdFields[j].fdDataSize := SizeOf(wordBool);
1655	+	if RecordNumber >= 0 then
1656	+	LocalBool := Qry.Current[i].AsBoolean;
1657	+	LocalData := PChar(@LocalBool);
1658	+	end;
1659		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
1660		begin
1661		rdFields[j].fdDataSize := Qry.Current[i].Data^.sqllen;
#	Line 1813 | Line 1927 | end;
1927		procedure TIBCustomDataSet.InternalRefreshRow;
1928		var
1929		Buff: PChar;
1816	–	SetCursor: Boolean;
1930		ofs: DWORD;
1931		Qry: TIBSQL;
1932		begin
1933	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1821	<	if SetCursor then
1822	<	Screen.Cursor := crHourGlass;
1933	>	FBase.SetCursor;
1934		try
1935		Buff := GetActiveBuf;
1936		if CanRefresh then
#	Line 1863 | Line 1974 | begin
1974		else
1975		IBError(ibxeCannotRefresh, [nil]);
1976		finally
1977	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1867	<	Screen.Cursor := crDefault;
1977	>	FBase.RestoreCursor;
1978		end;
1979		end;
1980
#	Line 1935 | Line 2045 | end;
2045
2046		procedure TIBCustomDataSet.InternalPrepare;
2047		var
1938	–	SetCursor: Boolean;
2048		DidActivate: Boolean;
2049		begin
2050		if FInternalPrepared then
2051		Exit;
2052		DidActivate := False;
2053	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
1945	<	if SetCursor then
1946	<	Screen.Cursor := crHourGlass;
2053	>	FBase.SetCursor;
2054		try
2055		ActivateConnection;
2056		DidActivate := ActivateTransaction;
#	Line 1979 | Line 2086 | begin
2086		finally
2087		if DidActivate then
2088		DeactivateTransaction;
2089	<	if SetCursor and (Screen.Cursor = crHourGlass) then
1983	<	Screen.Cursor := crDefault;
2089	>	FBase.RestoreCursor;
2090		end;
2091		end;
2092
#	Line 2171 | Line 2277 | begin
2277		SQL_TIMESTAMP:
2278		Qry.Params[i].AsDateTime :=
2279		TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(data)^)));
2280	+	SQL_BOOLEAN:
2281	+	Qry.Params[i].AsBoolean := PWordBool(data)^;
2282		end;
2283		end;
2284		end;
#	Line 2257 | 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 2295 | 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 2524 | Line 2643 | begin
2643		inherited DoBeforeDelete;
2644		end;
2645
2646	+	procedure TIBCustomDataSet.DoAfterDelete;
2647	+	begin
2648	+	inherited DoAfterDelete;
2649	+	FBase.DoAfterDelete(self);
2650	+	InternalAutoCommit;
2651	+	end;
2652	+
2653		procedure TIBCustomDataSet.DoBeforeEdit;
2654		var
2655		Buff: PRecordData;
#	Line 2538 | 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 2550 | 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 2569 | Line 2720 | begin
2720		GeneratorField.Apply
2721		end;
2722
2723	+	procedure TIBCustomDataSet.DoAfterPost;
2724	+	begin
2725	+	inherited DoAfterPost;
2726	+	FBase.DoAfterPost(self);
2727	+	InternalAutoCommit;
2728	+	end;
2729	+
2730		procedure TIBCustomDataSet.FetchAll;
2731		var
2574	–	SetCursor: Boolean;
2732		{$IF FPC_FULLVERSION >= 20700 }
2733		CurBookmark: TBookmark;
2734		{$ELSE}
2735		CurBookmark: string;
2736		{$ENDIF}
2737		begin
2738	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2739	<	if SetCursor then
2583	<	Screen.Cursor := crHourGlass;
2584	<	try
2738	>	FBase.SetCursor;
2739	>	try
2740		if FQSelect.EOF or not FQSelect.Open then
2741		exit;
2742		DisableControls;
#	Line 2593 | Line 2748 | begin
2748		EnableControls;
2749		end;
2750		finally
2751	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2597	<	Screen.Cursor := crDefault;
2751	>	FBase.RestoreCursor;
2752		end;
2753		end;
2754
#	Line 2655 | 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 2700 | 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 2749 | 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 2843 | Line 2997 | begin
2997		result := FRecordBufferSize;
2998		end;
2999
3000	+	procedure TIBCustomDataSet.InternalAutoCommit;
3001	+	begin
3002	+	with Transaction do
3003	+	if InTransaction and (FAutoCommit = acCommitRetaining) then
3004	+	begin
3005	+	if CachedUpdates then ApplyUpdates;
3006	+	CommitRetaining;
3007	+	end;
3008	+	end;
3009	+
3010		procedure TIBCustomDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
3011		begin
3012		CheckEditState;
#	Line 2920 | Line 3084 | end;
3084		procedure TIBCustomDataSet.InternalDelete;
3085		var
3086		Buff: PChar;
2923	–	SetCursor: Boolean;
3087		begin
3088	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
2926	<	if SetCursor then
2927	<	Screen.Cursor := crHourGlass;
3088	>	FBase.SetCursor;
3089		try
3090		Buff := GetActiveBuf;
3091		if CanDelete then
#	Line 2949 | Line 3110 | begin
3110		end else
3111		IBError(ibxeCannotDelete, [nil]);
3112		finally
3113	<	if SetCursor and (Screen.Cursor = crHourGlass) then
2953	<	Screen.Cursor := crDefault;
3113	>	FBase.RestoreCursor;
3114		end;
3115		end;
3116
#	Line 2966 | 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 2991 | 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 3126 | 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 3195 | Line 3358 | begin
3358		FieldSize := sizeof (TISC_QUAD);
3359		FieldType := ftUnknown;
3360		end;
3361	+	SQL_BOOLEAN:
3362	+	FieldType:= ftBoolean;
3363		else
3364		FieldType := ftUnknown;
3365		end;
#	Line 3291 | Line 3456 | begin
3456		else case cur_field.DataType of
3457		ftString:
3458		cur_param.AsString := cur_field.AsString;
3459	<	ftBoolean, ftSmallint, ftWord:
3459	>	ftBoolean:
3460	>	cur_param.AsBoolean := cur_field.AsBoolean;
3461	>	ftSmallint, ftWord:
3462		cur_param.AsShort := cur_field.AsInteger;
3463		ftInteger:
3464		cur_param.AsLong := cur_field.AsInteger;
#	Line 3344 | Line 3511 | begin
3511		end;
3512
3513		procedure TIBCustomDataSet.InternalOpen;
3347	–	var
3348	–	SetCursor: Boolean;
3514
3515		function RecordDataLength(n: Integer): Long;
3516		begin
#	Line 3353 | Line 3518 | var
3518		end;
3519
3520		begin
3521	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3357	<	if SetCursor then
3358	<	Screen.Cursor := crHourGlass;
3521	>	FBase.SetCursor;
3522		try
3523		ActivateConnection;
3524		ActivateTransaction;
#	Line 3416 | Line 3579 | begin
3579		else
3580		FQSelect.ExecQuery;
3581		finally
3582	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3420	<	Screen.Cursor := crDefault;
3582	>	FBase.RestoreCursor;
3583		end;
3584		end;
3585
#	Line 3425 | Line 3587 | procedure TIBCustomDataSet.InternalPost;
3587		var
3588		Qry: TIBSQL;
3589		Buff: PChar;
3428	–	SetCursor: Boolean;
3590		bInserting: Boolean;
3591		begin
3592	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3432	<	if SetCursor then
3433	<	Screen.Cursor := crHourGlass;
3592	>	FBase.SetCursor;
3593		try
3594		Buff := GetActiveBuf;
3595		CheckEditState;
#	Line 3468 | Line 3627 | begin
3627		if bInserting then
3628		Inc(FRecordCount);
3629		finally
3630	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3472	<	Screen.Cursor := crDefault;
3630	>	FBase.RestoreCursor;
3631		end;
3632		end;
3633
#	Line 3496 | 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 3697 | 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 3713 | Line 3890 | end;
3890		procedure TIBCustomDataSet.InternalExecQuery;
3891		var
3892		DidActivate: Boolean;
3716	–	SetCursor: Boolean;
3893		begin
3894		DidActivate := False;
3895	<	SetCursor := (GetCurrentThreadID = MainThreadID) and (Screen.Cursor = crDefault);
3720	<	if SetCursor then
3721	<	Screen.Cursor := crHourGlass;
3895	>	FBase.SetCursor;
3896		try
3897		ActivateConnection;
3898		DidActivate := ActivateTransaction;
#	Line 3735 | Line 3909 | begin
3909		finally
3910		if DidActivate then
3911		DeactivateTransaction;
3912	<	if SetCursor and (Screen.Cursor = crHourGlass) then
3739	<	Screen.Cursor := crDefault;
3912	>	FBase.RestoreCursor;
3913		end;
3914		end;
3915
#	Line 4108 | 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 4130 | 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 }
#	Line 4181 | Line 4364 | begin
4364		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4365		end;
4366
4367	<	end.
4367	>	end.

Diff Legend

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