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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC

#	Line 28 | Line 28
28
29		unit IBCustomDataSet;
30
31	+	{$Mode Delphi}
32	+
33		interface
34
35		uses
36	<	Windows, SysUtils, Classes, Forms, Controls, StdVCL,
37	<	IBExternals, IB, IBHeader, IBDatabase, IBSQL, Db,
36	>	{$IFDEF LINUX }
37	>	unix,
38	>	{$ELSE}
39	>	Windows,
40	>	{$ENDIF}
41	>	SysUtils, Classes, Forms, Controls, IBDatabase,
42	>	IBExternals, IB, IBHeader,  IBSQL, Db,
43		IBUtils, IBBlob;
44
45		const
#	Line 60 | Line 67 | type
67		property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL;
68		end;
69
63	–	PDateTime = ^TDateTime;
70		TBlobDataArray = array[0..0] of TIBBlobStream;
71		PBlobDataArray = ^TBlobDataArray;
72
#	Line 142 | Line 148 | type
148		destructor Destroy; override;
149		end;
150
151	+	TIBGeneratorApplyOnEvent = (gaeOnNewRecord,gaeOnPostRecord);
152	+
153	+	{ TIBGenerator }
154	+
155	+	TIBGenerator = class(TPersistent)
156	+	private
157	+	FOwner: TIBCustomDataSet;
158	+	FApplyOnEvent: TIBGeneratorApplyOnEvent;
159	+	FFieldName: string;
160	+	FGeneratorName: string;
161	+	FIncrement: integer;
162	+	function GetSelectSQL: string;
163	+	procedure SetIncrement(const AValue: integer);
164	+	protected
165	+	function GetNextValue(ADatabase: TIBDatabase; ATransaction: TIBTransaction): integer;
166	+	public
167	+	constructor Create(Owner: TIBCustomDataSet);
168	+	procedure Apply;
169	+	property Owner: TIBCustomDataSet read FOwner;
170	+	property SelectSQL: string read GetSelectSQL;
171	+	published
172	+	property GeneratorName: string read FGeneratorName write FGeneratorName;
173	+	property FieldName: string read FFieldName write FFieldName;
174	+	property Increment: integer read FIncrement write SetIncrement default 1;
175	+	property ApplyOnEvent: TIBGeneratorApplyOnEvent read FApplyOnEvent write FApplyOnEvent;
176	+	end;
177	+
178		{ TIBCustomDataSet }
179		TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied);
180
#	Line 155 | Line 188 | type
188
189		TIBCustomDataSet = class(TDataset)
190		private
191	+	FGenerator: TIBGenerator;
192		FNeedsRefresh: Boolean;
193		FForcedRefresh: Boolean;
194		FDidActivate: Boolean;
#	Line 239 | Line 273 | type
273		function GetModifySQL: TStrings;
274		function GetTransaction: TIBTransaction;
275		function GetTRHandle: PISC_TR_HANDLE;
276	<	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer);
276	>	procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
277		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
278		Options: TLocateOptions): Boolean; virtual;
279	<	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer);
280	<	procedure InternalRevertRecord(RecordNumber: Integer);
279	>	procedure InternalPostRecord(Qry: TIBSQL; Buff: Pointer); virtual;
280	>	procedure InternalRevertRecord(RecordNumber: Integer); virtual;
281		function IsVisible(Buffer: PChar): Boolean;
282		procedure SaveOldBuffer(Buffer: PChar);
283		procedure SetBufferChunks(Value: Integer);
#	Line 269 | Line 303 | type
303		Buffer: PChar);
304		procedure WriteRecordCache(RecordNumber: Integer; Buffer: PChar);
305		function InternalGetRecord(Buffer: PChar; GetMode: TGetMode;
306	<	DoCheck: Boolean): TGetResult;
306	>	DoCheck: Boolean): TGetResult; virtual;
307
308		protected
309		procedure ActivateConnection;
#	Line 278 | Line 312 | type
312		procedure CheckDatasetClosed;
313		procedure CheckDatasetOpen;
314		function GetActiveBuf: PChar;
315	<	procedure InternalBatchInput(InputObject: TIBBatchInput);
316	<	procedure InternalBatchOutput(OutputObject: TIBBatchOutput);
315	>	procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
316	>	procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
317		procedure InternalPrepare; virtual;
318		procedure InternalUnPrepare; virtual;
319		procedure InternalExecQuery; virtual;
320		procedure InternalRefreshRow; virtual;
321	<	procedure InternalSetParamsFromCursor;
321	>	procedure InternalSetParamsFromCursor; virtual;
322		procedure CheckNotUniDirectional;
323
324	<	{ IProviderSupport }
324	>	(*    { IProviderSupport }
325		procedure PSEndTransaction(Commit: Boolean); override;
326		function PSExecuteStatement(const ASQL: string; AParams: TParams;
327		ResultSet: Pointer = nil): Integer; override;
#	Line 300 | Line 334 | type
334		procedure PSStartTransaction; override;
335		procedure PSReset; override;
336		function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
337	<
337	>	*)
338		{ TDataSet support }
339		procedure InternalInsert; override;
340		procedure InitRecord(Buffer: PChar); override;
#	Line 311 | Line 345 | type
345		procedure DoBeforeDelete; override;
346		procedure DoBeforeEdit; override;
347		procedure DoBeforeInsert; override;
348	+	procedure DoAfterInsert; override;
349	+	procedure DoBeforePost; override;
350		procedure FreeRecordBuffer(var Buffer: PChar); override;
351		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
352		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
#	Line 327 | Line 363 | type
363		procedure InternalClose; override;
364		procedure InternalDelete; override;
365		procedure InternalFirst; override;
366	<	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean;
366	>	function InternalGetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual;
367		procedure InternalGotoBookmark(Bookmark: Pointer); override;
368		procedure InternalHandleException; override;
369		procedure InternalInitFieldDefs; override;
#	Line 336 | Line 372 | type
372		procedure InternalOpen; override;
373		procedure InternalPost; override;
374		procedure InternalRefresh; override;
375	<	procedure InternalSetFieldData(Field: TField; Buffer: Pointer);
375	>	procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
376		procedure InternalSetToRecord(Buffer: PChar); override;
377		function IsCursorOpen: Boolean; override;
378		procedure ReQuery;
#	Line 366 | Line 402 | type
402		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
403		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
404		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
405	+	property Generator: TIBGenerator read FGenerator write FGenerator;
406		property DeleteSQL: TStrings read GetDeleteSQL write SetDeleteSQL;
407		property InsertSQL: TStrings read GetInsertSQL write SetInsertSQL;
408		property RefreshSQL: TStrings read GetRefreshSQL write SetRefreshSQL;
#	Line 406 | Line 443 | type
443		function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
444		function GetCurrentRecord(Buffer: PChar): Boolean; override;
445		function GetFieldData(Field : TField; Buffer : Pointer) : Boolean; overload; override;
446	<	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
446	>	function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
447		function GetFieldData(Field : TField; Buffer : Pointer;
448		NativeFormat : Boolean) : Boolean; overload; override;
449		function Locate(const KeyFields: string; const KeyValues: Variant;
#	Line 430 | Line 467 | type
467		property ForcedRefresh: Boolean read FForcedRefresh
468		write FForcedRefresh default False;
469		property AutoCalcFields;
433	–	property ObjectView default False;
470
471		property AfterCancel;
472		property AfterClose;
#	Line 496 | Line 532 | type
532		property RefreshSQL;
533		property SelectSQL;
534		property ModifySQL;
535	+	property Generator;
536		property ParamCheck;
537		property UniDirectional;
538		property Filtered;
#	Line 576 | Line 613 | DefaultFieldClasses: array[TFieldType] o
613		TBlobField,         { ftTypedBinary }
614		nil,                { ftCursor }
615		TStringField,       { ftFixedChar }
616	<	nil, {TWideStringField } { ftWideString }
616	>	TWideStringField,    { ftWideString }
617		TLargeIntField,     { ftLargeInt }
618	<	TADTField,          { ftADT }
618	>	nil,          { ftADT }
619	>	nil,        { ftArray }
620	>	nil,    { ftReference }
621	>	nil,     { ftDataSet }
622	>	TBlobField,         { ftOraBlob }
623	>	TMemoField,         { ftOraClob }
624	>	TVariantField,      { ftVariant }
625	>	nil,    { ftInterface }
626	>	nil,     { ftIDispatch }
627	>	TGuidField,        { ftGuid }
628	>	TDateTimeField,    {ftTimestamp}
629	>	TIBBCDField,       {ftFMTBcd}
630	>	nil,  {ftFixedWideChar}
631	>	TWideMemoField);   {ftWideMemo}
632	>
633	>	(*    TADTField,          { ftADT }
634		TArrayField,        { ftArray }
635		TReferenceField,    { ftReference }
636		TDataSetField,     { ftDataSet }
#	Line 587 | Line 639 | DefaultFieldClasses: array[TFieldType] o
639		TVariantField,      { ftVariant }
640		TInterfaceField,    { ftInterface }
641		TIDispatchField,     { ftIDispatch }
642	<	TGuidField);        { ftGuid }
643	<	var
644	<	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;
642	>	TGuidField);        { ftGuid }*)
643	>	(*var
644	>	CreateProviderProc: function(DataSet: TIBCustomDataSet): IProvider = nil;*)
645
646		implementation
647
648	<	uses IBIntf, IBQuery;
648	>	uses IBIntf, Variants, FmtBCD;
649	>
650	>	const FILE_BEGIN = 0;
651	>	FILE_CURRENT = 1;
652	>	FILE_END = 2;
653
654		type
655
#	Line 617 | Line 673 | type
673
674		constructor TIBStringField.Create(AOwner: TComponent);
675		begin
676	<	inherited;
676	>	inherited Create(AOwner);
677		end;
678
679		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 728 | Line 784 | end;
784		destructor TIBDataLink.Destroy;
785		begin
786		FDataSet.FDataLink := nil;
787	<	inherited;
787	>	inherited Destroy;
788		end;
789
790
#	Line 760 | Line 816 | end;
816
817		constructor TIBCustomDataSet.Create(AOwner: TComponent);
818		begin
819	<	inherited;
819	>	inherited Create(AOwner);
820		FIBLoaded := False;
821		CheckIBLoaded;
822		FIBLoaded := True;
#	Line 770 | Line 826 | begin
826		FUniDirectional := False;
827		FBufferChunks := BufferCacheSize;
828		FBlobStreamList := TList.Create;
829	+	FGenerator := TIBGenerator.Create(self);
830		FDataLink := TIBDataLink.Create(Self);
831		FQDelete := TIBSQL.Create(Self);
832		FQDelete.OnSQLChanging := SQLChanging;
#	Line 806 | Line 863 | end;
863
864		destructor TIBCustomDataSet.Destroy;
865		begin
809	–	inherited;
866		if FIBLoaded then
867		begin
868	+	if assigned(FGenerator) then FGenerator.Free;
869		FDataLink.Free;
870		FBase.Free;
871		ClearBlobCache;
#	Line 821 | Line 878 | begin
878		FOldCacheSize := 0;
879		FMappedFieldPosition := nil;
880		end;
881	+	inherited Destroy;
882		end;
883
884		function TIBCustomDataSet.AdjustCurrentRecord(Buffer: Pointer; GetMode: TGetMode):
#	Line 1266 | Line 1324 | var
1324		LocalInt64: Int64;
1325		LocalCurrency: Currency;
1326		FieldsLoaded: Integer;
1327	+	temp: TIBXSQLVAR;
1328		begin
1329		p := PRecordData(Buffer);
1330		{ Make sure blob cache is empty }
#	Line 1399 | Line 1458 | begin
1458		if (rdFields[j].fdDataLength = 0) then
1459		LocalData := nil
1460		else
1461	<	LocalData := @Qry.Current[i].Data^.sqldata[2];
1461	>	begin
1462	>	temp :=  Qry.Current[i];
1463	>	LocalData := @temp.Data^.sqldata[2];
1464	>	(*              LocalData := @Qry.Current[i].Data^.sqldata[2];*)
1465	>	end;
1466		end;
1467		end;
1468		else { SQL_TEXT, SQL_BLOB, SQL_ARRAY, SQL_QUAD }
#	Line 2330 | Line 2393 | begin
2393		if FCachedUpdates and
2394		(Buff^.rdCachedUpdateStatus in [cusUnmodified]) then
2395		SaveOldBuffer(PChar(Buff));
2396	<	inherited;
2396	>	inherited DoBeforeDelete;
2397		end;
2398
2399		procedure TIBCustomDataSet.DoBeforeEdit;
#	Line 2344 | Line 2407 | begin
2407		if FCachedUpdates and (Buff^.rdCachedUpdateStatus in [cusUnmodified, cusInserted]) then
2408		SaveOldBuffer(PChar(Buff));
2409		CopyRecordBuffer(GetActiveBuf, FOldBuffer);
2410	<	inherited;
2410	>	inherited DoBeforeEdit;
2411		end;
2412
2413		procedure TIBCustomDataSet.DoBeforeInsert;
2414		begin
2415		if not CanInsert then
2416		IBError(ibxeCannotInsert, [nil]);
2417	<	inherited;
2417	>	inherited DoBeforeInsert;
2418	>	end;
2419	>
2420	>	procedure TIBCustomDataSet.DoAfterInsert;
2421	>	begin
2422	>	if Generator.ApplyOnEvent = gaeOnNewRecord then
2423	>	Generator.Apply;
2424	>	inherited DoAfterInsert;
2425	>	end;
2426	>
2427	>	procedure TIBCustomDataSet.DoBeforePost;
2428	>	begin
2429	>	inherited DoBeforePost;
2430	>	if (State = dsInsert) and
2431	>	(Generator.ApplyOnEvent = gaeOnPostRecord) then
2432	>	Generator.Apply
2433		end;
2434
2435		procedure TIBCustomDataSet.FetchAll;
#	Line 2629 | Line 2707 | var
2707		Buff: PChar;
2708		CurRec: Integer;
2709		begin
2710	<	inherited;
2710	>	inherited InternalCancel;
2711		Buff := GetActiveBuf;
2712		if Buff <> nil then begin
2713		CurRec := FCurrentRecord;
#	Line 2944 | Line 3022 | begin
3022		with FieldDefs.AddFieldDef do
3023		begin
3024		Name := string( FieldAliasName );
3025	<	FieldNo := FieldPosition;
3025	>	(*           FieldNo := FieldPosition;*)
3026		DataType := FieldType;
3027		Size := FieldSize;
3028		Precision := FieldPrecision;
3029	<	Required := False;
3029	>	Required := not FieldNullable;
3030		InternalCalcField := False;
3031		if (FieldName <> '') and (RelationName <> '') then
3032		begin
#	Line 3213 | Line 3291 | end;
3291
3292		procedure TIBCustomDataSet.InternalRefresh;
3293		begin
3294	<	inherited;
3294	>	inherited InternalRefresh;
3295		InternalRefreshRow;
3296		end;
3297
#	Line 3482 | Line 3560 | end;
3560
3561		{ TIBDataSet IProviderSupport }
3562
3563	<	procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
3563	>	(*procedure TIBCustomDataSet.PSEndTransaction(Commit: Boolean);
3564		begin
3565		if Commit then
3566		Transaction.Commit else
#	Line 3645 | Line 3723 | begin
3723		if not FQSelect.Prepared then
3724		FQSelect.Prepare;
3725		Result := FQSelect.UniqueRelationName;
3726	<	end;
3726	>	end;*)
3727
3728		procedure TIBDataSet.BatchInput(InputObject: TIBBatchInput);
3729		begin
#	Line 3682 | Line 3760 | begin
3760		ActivateConnection;
3761		ActivateTransaction;
3762		InternalSetParamsFromCursor;
3763	<	Inherited;
3763	>	Inherited InternalOpen;
3764		end;
3765
3766		procedure TIBDataSet.SetFiltered(Value: Boolean);
#	Line 3736 | Line 3814 | procedure TIBCustomDataSet.SetFieldData(
3814		var
3815		lTempCurr : System.Currency;
3816		begin
3817	<	if Field.DataType = ftBCD then
3817	>	if (Field.DataType = ftBCD) and (Buffer <> nil) then
3818		begin
3819		BCDToCurr(TBCD(Buffer^), lTempCurr);
3820		InternalSetFieldData(Field, @lTempCurr);
#	Line 3765 | Line 3843 | end;
3843		destructor TIBDataSetUpdateObject.Destroy;
3844		begin
3845		FRefreshSQL.Free;
3846	<	inherited destroy;
3846	>	inherited Destroy;
3847		end;
3848
3849		procedure TIBDataSetUpdateObject.SetRefreshSQL(Value: TStrings);
#	Line 3804 | Line 3882 | begin
3882		if not (FField.DataSet.State in [dsEdit, dsInsert]) then
3883		IBError(ibxeNotEditing, [nil]);
3884		TIBCustomDataSet(FField.DataSet).RecordModified(True);
3885	+	TBlobField(FField).Modified := true;
3886		result := FBlobStream.Write(Buffer, Count);
3887		TIBCustomDataSet(FField.DataSet).DataEvent(deFieldChange, Longint(FField));
3888		end;
3889
3890	+	{ TIBGenerator }
3891	+
3892	+	procedure TIBGenerator.SetIncrement(const AValue: integer);
3893	+	begin
3894	+	if AValue < 0 then
3895	+	raise Exception.Create('A Generator Increment cannot be negative');
3896	+	FIncrement := AValue
3897	+	end;
3898	+
3899	+	function TIBGenerator.GetSelectSQL: string;
3900	+	begin
3901	+	Result := FOwner.SelectSQL.Text
3902	+	end;
3903	+
3904	+	function TIBGenerator.GetNextValue(ADatabase: TIBDatabase;
3905	+	ATransaction: TIBTransaction): integer;
3906	+	begin
3907	+	with TIBSQL.Create(nil) do
3908	+	try
3909	+	Database := ADatabase;
3910	+	Transaction := ATransaction;
3911	+	if not assigned(Database) then
3912	+	IBError(ibxeCannotSetDatabase,[]);
3913	+	if not assigned(Transaction) then
3914	+	IBError(ibxeCannotSetTransaction,[]);
3915	+	with Transaction do
3916	+	if not InTransaction then StartTransaction;
3917	+	SQL.Text := Format('Select Gen_ID(%s,%d) as ID From RDB$Database',[GeneratorName,Increment]);
3918	+	Prepare;
3919	+	ExecQuery;
3920	+	try
3921	+	Result := FieldByName('ID').AsInteger
3922	+	finally
3923	+	Close
3924	+	end;
3925	+	finally
3926	+	Free
3927	+	end;
3928	+	end;
3929	+
3930	+	constructor TIBGenerator.Create(Owner: TIBCustomDataSet);
3931	+	begin
3932	+	FOwner := Owner;
3933	+	FIncrement := 1;
3934	+	end;
3935	+
3936	+
3937	+	procedure TIBGenerator.Apply;
3938	+	begin
3939	+	if (GeneratorName <> '') and (FieldName <> '')  then
3940	+	Owner.FieldByName(FieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
3941	+	end;
3942	+
3943		end.

Diff Legend

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