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 27 by tony, Tue Apr 14 13:10:23 2015 UTC

#	Line 120 | Line 120 | type
120		{ TIBStringField allows us to have strings longer than 8196 }
121
122		TIBStringField = class(TStringField)
123	+	private
124	+	FInitialised: boolean;
125	+	protected
126	+	procedure SetSize(AValue: Integer); override;
127		public
128		constructor create(AOwner: TComponent); override;
129		class procedure CheckTypeSize(Value: Integer); override;
#	Line 187 | Line 191 | type
191		property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
192		end;
193
194	+	{TIBControlLink - Allows IB Aware controls to react to dataset state changes}
195	+
196	+	TIBControlLink = class
197	+	private
198	+	FTIBDataSet: TIBCustomDataSet;
199	+	procedure SetIBDataSet(AValue: TIBCustomDataSet);
200	+	protected
201	+	procedure UpdateSQL(Sender: TObject); virtual;
202	+	procedure UpdateParams(Sender: TObject); virtual;
203	+	public
204	+	destructor Destroy; override;
205	+	property IBDataSet: TIBCustomDataSet read FTIBDataSet write SetIBDataSet;
206	+	end;
207	+
208		TIBAutoCommit = (acDisabled, acCommitRetaining);
209
210		{ TIBCustomDataSet }
211		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
212
213		TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
214	<	UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction)
214	>	UpdateKind: TUpdateKind; var TheUpdateAction: TIBUpdateAction)
215		of object;
216		TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
217		var UpdateAction: TIBUpdateAction) of object;
218
219		TIBUpdateRecordTypes = set of TCachedUpdateStatus;
220
221	+	TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges);
222	+
223	+	TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
224	+
225		TIBCustomDataSet = class(TDataset)
226		private
227		FAutoCommit: TIBAutoCommit;
#	Line 229 | Line 251 | type
251		FDeletedRecords: Long;
252		FModelBuffer,
253		FOldBuffer: PChar;
254	+	FOnValidatePost: TOnValidatePost;
255		FOpen: Boolean;
256		FInternalPrepared: Boolean;
257		FQDelete,
#	Line 239 | Line 262 | type
262		FRecordBufferSize: Integer;
263		FRecordCount: Integer;
264		FRecordSize: Integer;
265	+	FDataSetCloseAction: TDataSetCloseAction;
266		FUniDirectional: Boolean;
267		FUpdateMode: TUpdateMode;
268		FUpdateObject: TIBDataSetUpdateObject;
#	Line 260 | Line 284 | type
284		FAliasNameList: array of string;
285		FBaseSQLSelect: TStrings;
286		FParser: TSelectSQLParser;
287	+	FCloseAction: TTransactionAction;
288	+	FInTransactionEnd: boolean;
289	+	FIBLinks: TList;
290		function GetSelectStmtHandle: TISC_STMT_HANDLE;
291		procedure SetUpdateMode(const Value: TUpdateMode);
292		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 272 | Line 299 | type
299		function CanRefresh: Boolean;
300		procedure CheckEditState;
301		procedure ClearBlobCache;
302	+	procedure ClearIBLinks;
303		procedure CopyRecordBuffer(Source, Dest: Pointer);
304		procedure DoBeforeDatabaseDisconnect(Sender: TObject);
305		procedure DoAfterDatabaseDisconnect(Sender: TObject);
306		procedure DoDatabaseFree(Sender: TObject);
307	<	procedure DoBeforeTransactionEnd(Sender: TObject);
307	>	procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
308		procedure DoAfterTransactionEnd(Sender: TObject);
309		procedure DoTransactionFree(Sender: TObject);
310		procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
#	Line 299 | Line 327 | type
327		procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
328		procedure InternalRevertRecord(RecordNumber: Integer); virtual;
329		function IsVisible(Buffer: PChar): Boolean;
330	+	procedure RegisterIBLink(Sender: TIBControlLink);
331	+	procedure UnRegisterIBLink(Sender: TIBControlLink);
332		procedure SaveOldBuffer(Buffer: PChar);
333		procedure SetBufferChunks(Value: Integer);
334		procedure SetDatabase(Value: TIBDatabase);
#	Line 367 | Line 397 | type
397		procedure DoBeforeDelete; override;
398		procedure DoAfterDelete; override;
399		procedure DoBeforeEdit; override;
400	+	procedure DoAfterEdit; override;
401		procedure DoBeforeInsert; override;
402		procedure DoAfterInsert; override;
403	+	procedure DoBeforeClose; override;
404		procedure DoBeforeOpen; override;
405		procedure DoBeforePost; override;
406		procedure DoAfterPost; override;
#	Line 456 | Line 488 | type
488		write FAfterTransactionEnd;
489		property TransactionFree: TNotifyEvent read FTransactionFree
490		write FTransactionFree;
491	+	property OnValidatePost: TOnValidatePost read FOnValidatePost write FOnValidatePost;
492
493		public
494		constructor Create(AOwner: TComponent); override;
#	Line 489 | Line 522 | type
522		const ResultFields: string): Variant; override;
523		function UpdateStatus: TUpdateStatus; override;
524		function IsSequenced: Boolean; override;
525	+	procedure Post; override;
526		function ParamByName(ParamName: String): TIBXSQLVAR;
527		property DBHandle: PISC_DB_HANDLE read GetDBHandle;
528		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
#	Line 496 | Line 530 | type
530		property UpdatesPending: Boolean read FUpdatesPending;
531		property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
532		write SetUpdateRecordTypes;
533	+	property DataSetCloseAction: TDataSetCloseAction
534	+	read FDataSetCloseAction write FDataSetCloseAction;
535
536		published
537		property Database: TIBDatabase read GetDatabase write SetDatabase;
#	Line 581 | Line 617 | type
617		property ParamCheck;
618		property UniDirectional;
619		property Filtered;
620	+	property DataSetCloseAction;
621
622		property BeforeDatabaseDisconnect;
623		property AfterDatabaseDisconnect;
#	Line 616 | Line 653 | type
653		property OnFilterRecord;
654		property OnNewRecord;
655		property OnPostError;
656	+	property OnValidatePost;
657		end;
658
659		{ TIBDSBlobStream }
#	Line 713 | Line 751 | type
751		NextRelation : TRelationNode;
752		end;
753
754	+	{ TIBControlLink }
755	+
756	+	destructor TIBControlLink.Destroy;
757	+	begin
758	+	IBDataSet := nil;
759	+	inherited Destroy;
760	+	end;
761	+
762	+	procedure TIBControlLink.UpdateParams(Sender: TObject);
763	+	begin
764	+
765	+	end;
766	+
767	+	procedure TIBControlLink.UpdateSQL(Sender: TObject);
768	+	begin
769	+
770	+	end;
771	+
772	+	procedure TIBControlLink.SetIBDataSet(AValue: TIBCustomDataSet);
773	+	begin
774	+	if FTIBDataSet = AValue then Exit;
775	+	if IBDataSet <> nil then
776	+	IBDataSet.UnRegisterIBLink(self);
777	+	FTIBDataSet := AValue;
778	+	if IBDataSet <> nil then
779	+	IBDataSet.RegisterIBLink(self);
780	+	end;
781	+
782
783		{ TIBStringField}
784
785	<	constructor TIBStringField.Create(AOwner: TComponent);
785	>	constructor TIBStringField.create(AOwner: TComponent);
786		begin
787		inherited Create(AOwner);
788		end;
#	Line 773 | Line 839 | begin
839		end;
840		end;
841
842	+	procedure TIBStringField.SetSize(AValue: Integer);
843	+	var FieldSize: integer;
844	+	begin
845	+	if csLoading in ComponentState then
846	+	FInitialised := true;
847	+	if FInitialised then
848	+	inherited SetSize(AValue)
849	+	else
850	+	begin
851	+	{IBCustomDataSet encodes the CharWidth size in the size}
852	+	FieldSize := AValue div 4;
853	+	inherited SetSize(FieldSize);
854	+	DisplayWidth := FieldSize div ((AValue mod 4) + 1);
855	+	FInitialised := true;
856	+	end;
857	+	end;
858	+
859		{ TIBBCDField }
860
861		constructor TIBBCDField.Create(AOwner: TComponent);
#	Line 870 | Line 953 | begin
953		CheckIBLoaded;
954		FIBLoaded := True;
955		FBase := TIBBase.Create(Self);
956	+	FIBLinks := TList.Create;
957		FCurrentRecord := -1;
958		FDeletedRecords := 0;
959		FUniDirectional := False;
#	Line 897 | Line 981 | begin
981		FGenerateParamNames := False;
982		FForcedRefresh := False;
983		FAutoCommit:= acDisabled;
984	+	FDataSetCloseAction := dcDiscardChanges;
985		{Bookmark Size is Integer for IBX}
986		BookmarkSize := SizeOf(Integer);
987		FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
#	Line 922 | Line 1007 | begin
1007		FDataLink.Free;
1008		FBase.Free;
1009		ClearBlobCache;
1010	+	ClearIBLinks;
1011	+	FIBLinks.Free;
1012		FBlobStreamList.Free;
1013		FreeMem(FBufferCache);
1014		FBufferCache := nil;
#	Line 1366 | Line 1453 | begin
1453		FDatabaseFree(Sender);
1454		end;
1455
1456	<	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject);
1456	>	procedure TIBCustomDataSet.DoBeforeTransactionEnd(Sender: TObject;
1457	>	Action: TTransactionAction);
1458		begin
1459	<	if Active then
1460	<	Active := False;
1459	>	FCloseAction := Action;
1460	>	FInTransactionEnd := true;
1461	>	try
1462	>	if Active then
1463	>	Active := False;
1464	>	finally
1465	>	FInTransactionEnd := false;
1466	>	end;
1467		if FQSelect <> nil then
1468		FQSelect.FreeHandle;
1469		if FQDelete <> nil then
#	Line 2283 | Line 2377 | begin
2377		end;
2378		end;
2379
2380	+	procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2381	+	begin
2382	+	if FIBLinks.IndexOf(Sender) = -1 then
2383	+	FIBLinks.Add(Sender);
2384	+	end;
2385	+
2386
2387		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2388		begin
#	Line 2321 | Line 2421 | begin
2421		end;
2422		end;
2423
2424	+	procedure TIBCustomDataSet.UnRegisterIBLink(Sender: TIBControlLink);
2425	+	begin
2426	+	FIBLinks.Remove(Sender);
2427	+	end;
2428	+
2429		function TIBCustomDataSet.UpdateStatus: TUpdateStatus;
2430		begin
2431		if Active then
#	Line 2553 | Line 2658 | end;
2658		procedure TIBCustomDataSet.DoAfterDelete;
2659		begin
2660		inherited DoAfterDelete;
2661	+	FBase.DoAfterDelete(self);
2662		InternalAutoCommit;
2663		end;
2664
#	Line 2570 | Line 2676 | begin
2676		inherited DoBeforeEdit;
2677		end;
2678
2679	+	procedure TIBCustomDataSet.DoAfterEdit;
2680	+	begin
2681	+	inherited DoAfterEdit;
2682	+	FBase.DoAfterEdit(self);
2683	+	end;
2684	+
2685		procedure TIBCustomDataSet.DoBeforeInsert;
2686		begin
2687		if not CanInsert then
#	Line 2582 | Line 2694 | begin
2694		if GeneratorField.ApplyOnEvent = gaeOnNewRecord then
2695		GeneratorField.Apply;
2696		inherited DoAfterInsert;
2697	+	FBase.DoAfterInsert(self);
2698	+	end;
2699	+
2700	+	procedure TIBCustomDataSet.DoBeforeClose;
2701	+	begin
2702	+	inherited DoBeforeClose;
2703	+	if State in [dsInsert,dsEdit] then
2704	+	begin
2705	+	if FInTransactionEnd and (FCloseAction = TARollback) then
2706	+	Exit;
2707	+
2708	+	if DataSetCloseAction = dcSaveChanges then
2709	+	Post;
2710	+	{Note this can fail with an exception e.g. due to
2711	+	database validation error. In which case the dataset remains open }
2712	+	end;
2713		end;
2714
2715		procedure TIBCustomDataSet.DoBeforeOpen;
2716	+	var i: integer;
2717		begin
2718		if assigned(FParser) then
2719		FParser.Reset;
2720	<	DataEvent(deCheckBrowseMode,1); {Conventional use to report getting ready to prepare}
2720	>	for i := 0 to FIBLinks.Count - 1 do
2721	>	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
2722		inherited DoBeforeOpen;
2723	<	DataEvent(deCheckBrowseMode,2); {Conventional use to report the right time to set parameters}
2723	>	for i := 0 to FIBLinks.Count - 1 do
2724	>	TIBControlLink(FIBLinks[i]).UpdateParams(self);
2725		end;
2726
2727		procedure TIBCustomDataSet.DoBeforePost;
#	Line 2604 | Line 2735 | end;
2735		procedure TIBCustomDataSet.DoAfterPost;
2736		begin
2737		inherited DoAfterPost;
2738	+	FBase.DoAfterPost(self);
2739		InternalAutoCommit;
2740		end;
2741
#	Line 2741 | Line 2873 | begin
2873		Data := Buff + CurrentRecord^.rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs;
2874		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
2875		begin
2876	<	if fdDataLength <= Field.Size then
2876	>	if fdDataLength < Field.DataSize then
2877		begin
2878		Move(Data^, Buffer^, fdDataLength);
2879		PChar(Buffer)[fdDataLength] := #0;
#	Line 3045 | Line 3177 | const
3177		var
3178		FieldType: TFieldType;
3179		FieldSize: Word;
3180	+	CharSetSize: integer;
3181		FieldNullable : Boolean;
3182		i, FieldPosition, FieldPrecision: Integer;
3183		FieldAliasName, DBAliasName: string;
#	Line 3180 | Line 3313 | begin
3313		their values }
3314		SQL_VARYING, SQL_TEXT:
3315		begin
3316	<	FieldSize := sqllen;
3316	>	CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3317	>	{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3318	>	FieldSize := sqllen * 4 + (CharSetSize - 1);
3319		FieldType := ftString;
3320		end;
3321		{ All Doubles/Floats should be cast to doubles }
#	Line 3560 | Line 3695 | begin
3695		inherited Loaded;
3696		end;
3697
3698	+	procedure TIBCustomDataSet.Post;
3699	+	var CancelPost: boolean;
3700	+	begin
3701	+	CancelPost := false;
3702	+	if assigned(FOnValidatePost) then
3703	+	OnValidatePost(self,CancelPost);
3704	+	if CancelPost then
3705	+	Cancel
3706	+	else
3707	+	inherited Post;
3708	+	end;
3709	+
3710		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3711		Options: TLocateOptions): Boolean;
3712		var
#	Line 3761 | Line 3908 | begin
3908		FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
3909		end;
3910
3911	+	procedure TIBCustomDataSet.ClearIBLinks;
3912	+	var i: integer;
3913	+	begin
3914	+	for i := FIBLinks.Count - 1 downto 0 do
3915	+	TIBControlLink(FIBLinks[i]).IBDataSet := nil;
3916	+	end;
3917	+
3918
3919		procedure TIBCustomDataSet.InternalUnPrepare;
3920		begin

Diff Legend

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