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 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 21 by tony, Thu Feb 26 10:33:34 2015 UTC

#	Line 33 | Line 33
33
34		unit IBCustomDataSet;
35
36	+	{$R-}
37	+
38		{$Mode Delphi}
39
40		{$IFDEF DELPHI}
#	Line 49 | Line 51 | uses
51		{$ENDIF}
52		SysUtils, Classes, Forms, Controls, IBDatabase,
53		IBExternals, IB, IBHeader,  IBSQL, Db,
54	<	IBUtils, IBBlob;
54	>	IBUtils, IBBlob, IBSQLParser;
55
56		const
57		BufferCacheSize    =  1000;  { Allocate cache in this many record chunks}
#	Line 198 | Line 200 | type
200
201		TIBCustomDataSet = class(TDataset)
202		private
203	+	FGenerateParamNames: Boolean;
204		FGeneratorField: TIBGenerator;
205		FNeedsRefresh: Boolean;
206		FForcedRefresh: Boolean;
#	Line 250 | Line 253 | type
253		FBeforeTransactionEnd,
254		FAfterTransactionEnd,
255		FTransactionFree: TNotifyEvent;
256	<
256	>	FAliasNameMap: array of string;
257	>	FAliasNameList: array of string;
258	>	FBaseSQLSelect: TStrings;
259	>	FParser: TSelectSQLParser;
260		function GetSelectStmtHandle: TISC_STMT_HANDLE;
261		procedure SetUpdateMode(const Value: TUpdateMode);
262		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
#	Line 283 | Line 289 | type
289		function GetModifySQL: TStrings;
290		function GetTransaction: TIBTransaction;
291		function GetTRHandle: PISC_TR_HANDLE;
292	+	function GetParser: TSelectSQLParser;
293		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
294		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
295		Options: TLocateOptions): Boolean; virtual;
#	Line 321 | Line 328 | type
328		procedure DeactivateTransaction;
329		procedure CheckDatasetClosed;
330		procedure CheckDatasetOpen;
331	+	function CreateParser: TSelectSQLParser; virtual;
332	+	procedure FieldDefsFromQuery(SourceQuery: TIBSQL);
333		function GetActiveBuf: PChar;
334		procedure InternalBatchInput(InputObject: TIBBatchInput); virtual;
335		procedure InternalBatchOutput(OutputObject: TIBBatchOutput); virtual;
#	Line 356 | Line 365 | type
365		procedure DoBeforeEdit; override;
366		procedure DoBeforeInsert; override;
367		procedure DoAfterInsert; override;
368	+	procedure DoBeforeOpen; override;
369		procedure DoBeforePost; override;
370		procedure FreeRecordBuffer(var Buffer: PChar); override;
371		procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
372		function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
373		function GetCanModify: Boolean; override;
374		function GetDataSource: TDataSource; override;
375	+	function GetDBAliasName(FieldNo: integer): string;
376	+	function GetFieldDefFromAlias(aliasName: string): TFieldDef;
377		function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
378		function GetRecNo: Integer; override;
379		function GetRecord(Buffer: PChar; GetMode: TGetMode;
#	Line 385 | Line 397 | type
397		procedure InternalSetFieldData(Field: TField; Buffer: Pointer); virtual;
398		procedure InternalSetToRecord(Buffer: PChar); override;
399		function IsCursorOpen: Boolean; override;
400	+	procedure Loaded; override;
401		procedure ReQuery;
402		procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
403		procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
404		procedure SetCachedUpdates(Value: Boolean);
405		procedure SetDataSource(Value: TDataSource);
406	+	procedure SetGenerateParamNames(AValue: Boolean); virtual;
407		procedure SetFieldData(Field : TField; Buffer : Pointer); override;
408		procedure SetFieldData(Field : TField; Buffer : Pointer;
409		NativeFormat : Boolean); overload; override;
#	Line 420 | Line 434 | type
434		property ModifySQL: TStrings read GetModifySQL write SetModifySQL;
435		property UpdateMode: TUpdateMode read FUpdateMode write SetUpdateMode default upWhereAll;
436		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
437	+	property Parser: TSelectSQLParser read GetParser;
438	+	property BaseSQLSelect: TStrings read FBaseSQLSelect;
439
440		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
441		write FBeforeDatabaseDisconnect;
#	Line 440 | Line 456 | type
456		procedure ApplyUpdates;
457		function CachedUpdateStatus: TCachedUpdateStatus;
458		procedure CancelUpdates;
459	+	function GetFieldPosition(AliasName: string): integer;
460		procedure FetchAll;
461		function LocateNext(const KeyFields: string; const KeyValues: Variant;
462		Options: TLocateOptions): Boolean;
463		procedure RecordModified(Value: Boolean);
464		procedure RevertRecord;
465		procedure Undelete;
466	+	procedure ResetParser;
467	+	function HasParser: boolean;
468
469		{ TDataSet support methods }
470		function BookmarkValid(Bookmark: TBookmark): Boolean; override;
#	Line 456 | Line 475 | type
475		function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; (*override;*)
476		function GetFieldData(Field : TField; Buffer : Pointer;
477		NativeFormat : Boolean) : Boolean; overload; override;
478	+	property GenerateParamNames: Boolean read FGenerateParamNames write SetGenerateParamNames;
479		function Locate(const KeyFields: string; const KeyValues: Variant;
480		Options: TLocateOptions): Boolean; override;
481		function Lookup(const KeyFields: string; const KeyValues: Variant;
#	Line 507 | Line 527 | type
527		write FOnUpdateRecord;
528		end;
529
530	<	TIBDataSet = class(TIBCustomDataSet)
530	>	TIBParserDataSet = class(TIBCustomDataSet)
531	>	public
532	>	property Parser;
533	>	end;
534	>
535	>	TIBDataSet = class(TIBParserDataSet)
536		private
537		function GetPrepared: Boolean;
538
#	Line 532 | Line 557 | type
557		property QModify;
558		property StatementType;
559		property SelectStmtHandle;
560	+	property BaseSQLSelect;
561
562		published
563		{ TIBCustomDataSet }
#	Line 543 | Line 569 | type
569		property SelectSQL;
570		property ModifySQL;
571		property GeneratorField;
572	+	property GenerateParamNames;
573		property ParamCheck;
574		property UniDirectional;
575		property Filtered;
#	Line 859 | Line 886 | begin
886		FQModify.GoToFirstRecordOnExecute := False;
887		FUpdateRecordTypes := [cusUnmodified, cusModified, cusInserted];
888		FParamCheck := True;
889	+	FGenerateParamNames := False;
890		FForcedRefresh := False;
891		{Bookmark Size is Integer for IBX}
892		BookmarkSize := SizeOf(Integer);
#	Line 873 | Line 901 | begin
901		else
902		if AOwner is TIBTransaction then
903		Transaction := TIBTransaction(AOwner);
904	+	FBaseSQLSelect := TStringList.Create;
905		end;
906
907		destructor TIBCustomDataSet.Destroy;
#	Line 893 | Line 922 | begin
922		FOldCacheSize := 0;
923		FMappedFieldPosition := nil;
924		end;
925	+	if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
926	+	if assigned(FParser) then FParser.Free;
927		inherited Destroy;
928		end;
929
#	Line 1136 | Line 1167 | begin
1167		end;
1168		end;
1169
1170	+	function TIBCustomDataSet.GetFieldPosition(AliasName: string): integer;
1171	+	var i: integer;
1172	+	Prepared: boolean;
1173	+	begin
1174	+	Result := 0;
1175	+	Prepared := FInternalPrepared;
1176	+	if not Prepared then
1177	+	InternalPrepare;
1178	+	try
1179	+	for i := 0 to Length(FAliasNameList) - 1 do
1180	+	if FAliasNameList[i] = AliasName then
1181	+	begin
1182	+	Result := i + 1;
1183	+	Exit
1184	+	end;
1185	+	finally
1186	+	if not Prepared then
1187	+	InternalUnPrepare;
1188	+	end;
1189	+	end;
1190	+
1191		procedure TIBCustomDataSet.ActivateConnection;
1192		begin
1193		if not Assigned(Database) then
#	Line 1196 | Line 1248 | begin
1248		IBError(ibxeDatasetClosed, [nil]);
1249		end;
1250
1251	+	function TIBCustomDataSet.CreateParser: TSelectSQLParser;
1252	+	begin
1253	+	Result := TSelectSQLParser.Create(self,FBaseSQLSelect);
1254	+	Result.OnSQLChanging := SQLChanging
1255	+	end;
1256	+
1257		procedure TIBCustomDataSet.CheckNotUniDirectional;
1258		begin
1259		if UniDirectional then
#	Line 1891 | Line 1949 | begin
1949		DidActivate := ActivateTransaction;
1950		FBase.CheckDatabase;
1951		FBase.CheckTransaction;
1952	+	if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
1953	+	FQSelect.SQL.Text := FParser.SQLText;
1954	+	//   writeln( FQSelect.SQL.Text);
1955		if FQSelect.SQL.Text <> '' then
1956		begin
1957		if not FQSelect.Prepared then
1958		begin
1959	+	FQSelect.GenerateParamNames := FGenerateParamNames;
1960		FQSelect.ParamCheck := ParamCheck;
1961		FQSelect.Prepare;
1962		end;
1963	+	FQDelete.GenerateParamNames := FGenerateParamNames;
1964		if (Trim(FQDelete.SQL.Text) <> '') and (not FQDelete.Prepared) then
1965		FQDelete.Prepare;
1966	+	FQInsert.GenerateParamNames := FGenerateParamNames;
1967		if (Trim(FQInsert.SQL.Text) <> '') and (not FQInsert.Prepared) then
1968		FQInsert.Prepare;
1969	+	FQRefresh.GenerateParamNames := FGenerateParamNames;
1970		if (Trim(FQRefresh.SQL.Text) <> '') and (not FQRefresh.Prepared) then
1971		FQRefresh.Prepare;
1972	+	FQModify.GenerateParamNames := FGenerateParamNames;
1973		if (Trim(FQModify.SQL.Text) <> '') and (not FQModify.Prepared) then
1974		FQModify.Prepare;
1975		FInternalPrepared := True;
#	Line 2130 | Line 2196 | begin
2196		begin
2197		Disconnect;
2198		FQSelect.SQL.Assign(Value);
2199	+	FBaseSQLSelect.assign(Value);
2200		end;
2201		end;
2202
#	Line 2193 | Line 2260 | end;
2260
2261		procedure TIBCustomDataSet.SQLChanging(Sender: TObject);
2262		begin
2263	<	if FOpen then
2264	<	InternalClose;
2263	>	Active := false;
2264	>	{  if FOpen then
2265	>	InternalClose;}
2266		if FInternalPrepared then
2267		InternalUnPrepare;
2268	+	FieldDefs.Clear;
2269	+	FieldDefs.Updated := false;
2270		end;
2271
2272		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2482 | Line 2552 | begin
2552		inherited DoAfterInsert;
2553		end;
2554
2555	+	procedure TIBCustomDataSet.DoBeforeOpen;
2556	+	begin
2557	+	if assigned(FParser) then
2558	+	FParser.Reset;
2559	+	DataEvent(deCheckBrowseMode,1); {Conventional use to report getting ready to prepare}
2560	+	inherited DoBeforeOpen;
2561	+	DataEvent(deCheckBrowseMode,2); {Conventional use to report the right time to set parameters}
2562	+	end;
2563	+
2564		procedure TIBCustomDataSet.DoBeforePost;
2565		begin
2566		inherited DoBeforePost;
#	Line 2563 | Line 2642 | begin
2642		result := FDataLink.DataSource;
2643		end;
2644
2645	+	function TIBCustomDataSet.GetDBAliasName(FieldNo: integer): string;
2646	+	begin
2647	+	Result := FAliasNameMap[FieldNo-1]
2648	+	end;
2649	+
2650	+	function TIBCustomDataSet.GetFieldDefFromAlias(aliasName: string): TFieldDef;
2651	+	var
2652	+	i: integer;
2653	+	begin
2654	+	Result := nil;
2655	+	for i := 0 to Length(FAliasNameMap) - 1 do
2656	+	if FAliasNameMap[i] = aliasName then
2657	+	begin
2658	+	Result := FieldDefs[i+1];
2659	+	Exit
2660	+	end;
2661	+	end;
2662	+
2663		function TIBCustomDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
2664		begin
2665		Result := DefaultFieldClasses[FieldType];
#	Line 2873 | Line 2970 | begin
2970		end;
2971
2972		procedure TIBCustomDataSet.InternalInitFieldDefs;
2973	+	begin
2974	+	if not InternalPrepared then
2975	+	begin
2976	+	InternalPrepare;
2977	+	exit;
2978	+	end;
2979	+	FieldDefsFromQuery(FQSelect);
2980	+	end;
2981	+
2982	+	procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
2983		const
2984		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
2985		'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
#	Line 2886 | Line 2993 | var
2993		FieldSize: Word;
2994		FieldNullable : Boolean;
2995		i, FieldPosition, FieldPrecision: Integer;
2996	<	FieldAliasName: string;
2996	>	FieldAliasName, DBAliasName: string;
2997		RelationName, FieldName: string;
2998		Query : TIBSQL;
2999		FieldIndex: Integer;
#	Line 2986 | Line 3093 | var
3093		end;
3094
3095		begin
2989	–	if not InternalPrepared then
2990	–	begin
2991	–	InternalPrepare;
2992	–	exit;
2993	–	end;
3096		FRelationNodes := TRelationNode.Create;
3097		FNeedsRefresh := False;
3098		Database.InternalTransaction.StartTransaction;
#	Line 3001 | Line 3103 | begin
3103		FieldDefs.BeginUpdate;
3104		FieldDefs.Clear;
3105		FieldIndex := 0;
3106	<	if (Length(FMappedFieldPosition) < FQSelect.Current.Count) then
3107	<	SetLength(FMappedFieldPosition, FQSelect.Current.Count);
3106	>	if (Length(FMappedFieldPosition) < SourceQuery.Current.Count) then
3107	>	SetLength(FMappedFieldPosition, SourceQuery.Current.Count);
3108		Query.SQL.Text := DefaultSQL;
3109		Query.Prepare;
3110	<	for i := 0 to FQSelect.Current.Count - 1 do
3111	<	with FQSelect.Current[i].Data^ do
3110	>	SetLength(FAliasNameMap, SourceQuery.Current.Count);
3111	>	SetLength(FAliasNameList, SourceQuery.Current.Count);
3112	>	for i := 0 to SourceQuery.Current.Count - 1 do
3113	>	with SourceQuery.Current[i].Data^ do
3114		begin
3115		{ Get the field name }
3116	<	SetString(FieldAliasName, aliasname, aliasname_length);
3116	>	FieldAliasName := SourceQuery.Current[i].Name;
3117	>	SetString(DBAliasName, aliasname, aliasname_length);
3118		SetString(RelationName, relname, relname_length);
3119		SetString(FieldName, sqlname, sqlname_length);
3120	+	FAliasNameList[i] := DBAliasName;
3121		FieldSize := 0;
3122		FieldPrecision := 0;
3123	<	FieldNullable := FQSelect.Current[i].IsNullable;
3123	>	FieldNullable := SourceQuery.Current[i].IsNullable;
3124		case sqltype and not 1 of
3125		{ All VARCHAR's must be converted to strings before recording
3126		their values }
#	Line 3100 | Line 3206 | begin
3206		with FieldDefs.AddFieldDef do
3207		begin
3208		Name := FieldAliasName;
3209	<	(*           FieldNo := FieldPosition;*)
3209	>	FAliasNameMap[FieldNo-1] := DBAliasName;
3210		DataType := FieldType;
3211		Size := FieldSize;
3212		Precision := FieldPrecision;
#	Line 3383 | Line 3489 | begin
3489		result := FOpen;
3490		end;
3491
3492	+	procedure TIBCustomDataSet.Loaded;
3493	+	begin
3494	+	if assigned(FQSelect) then
3495	+	FBaseSQLSelect.assign(FQSelect.SQL);
3496	+	inherited Loaded;
3497	+	end;
3498	+
3499		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
3500		Options: TLocateOptions): Boolean;
3501		var
#	Line 3465 | Line 3578 | end;
3578		procedure TIBCustomDataSet.InternalSetFieldData(Field: TField; Buffer: Pointer);
3579		var
3580		Buff, TmpBuff: PChar;
3581	+	MappedFieldPos: integer;
3582		begin
3583		Buff := GetActiveBuf;
3584		if Field.FieldNo < 0 then
#	Line 3481 | Line 3595 | begin
3595		begin
3596		{ If inserting, Adjust record position }
3597		AdjustRecordOnInsert(Buff);
3598	<	if (FMappedFieldPosition[Field.FieldNo - 1] > 0) and
3599	<	(FMappedFieldPosition[Field.FieldNo - 1] <= rdFieldCount) then
3598	>	MappedFieldPos := FMappedFieldPosition[Field.FieldNo - 1];
3599	>	if (MappedFieldPos > 0) and
3600	>	(MappedFieldPos <= rdFieldCount) then
3601		begin
3602		Field.Validate(Buffer);
3603		if (Buffer = nil) or
3604		(Field is TIBStringField) and (PChar(Buffer)[0] = #0) then
3605	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := True
3605	>	rdFields[MappedFieldPos].fdIsNull := True
3606		else begin
3607	<	Move(Buffer^, Buff[rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataOfs],
3608	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataSize);
3609	<	if (rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_TEXT) or
3610	<	(rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataType = SQL_VARYING) then
3611	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdDataLength := StrLen(PChar(Buffer));
3612	<	rdFields[FMappedFieldPosition[Field.FieldNo - 1]].fdIsNull := False;
3607	>	Move(Buffer^, Buff[rdFields[MappedFieldPos].fdDataOfs],
3608	>	rdFields[MappedFieldPos].fdDataSize);
3609	>	if (rdFields[MappedFieldPos].fdDataType = SQL_TEXT) or
3610	>	(rdFields[MappedFieldPos].fdDataType = SQL_VARYING) then
3611	>	rdFields[MappedFieldPos].fdDataLength := StrLen(PChar(Buffer));
3612	>	rdFields[MappedFieldPos].fdIsNull := False;
3613		if rdUpdateStatus = usUnmodified then
3614		begin
3615		if CachedUpdates then
#	Line 3589 | Line 3704 | begin
3704		begin
3705		CheckDatasetClosed;
3706		FieldDefs.Clear;
3707	+	FieldDefs.Updated := false;
3708		FInternalPrepared := False;
3709	+	Setlength(FAliasNameList,0);
3710		end;
3711		end;
3712
#	Line 3628 | Line 3745 | begin
3745		Result := FQSelect.Handle;
3746		end;
3747
3748	+	function TIBCustomDataSet.GetParser: TSelectSQLParser;
3749	+	begin
3750	+	if not assigned(FParser) then
3751	+	FParser := CreateParser;
3752	+	Result := FParser
3753	+	end;
3754	+
3755	+	procedure TIBCustomDataSet.ResetParser;
3756	+	begin
3757	+	if assigned(FParser) then
3758	+	begin
3759	+	FParser.Free;
3760	+	FParser := nil;
3761	+	SQLChanging(nil)
3762	+	end;
3763	+	end;
3764	+
3765	+	function TIBCustomDataSet.HasParser: boolean;
3766	+	begin
3767	+	Result := not (csDesigning in ComponentState) and (FParser <> nil)
3768	+	end;
3769	+
3770	+	procedure TIBCustomDataSet.SetGenerateParamNames(AValue: Boolean);
3771	+	begin
3772	+	if FGenerateParamNames = AValue then Exit;
3773	+	FGenerateParamNames := AValue;
3774	+	Disconnect
3775	+	end;
3776	+
3777		procedure TIBCustomDataSet.InitRecord(Buffer: PChar);
3778		begin
3779		inherited InitRecord(Buffer);
#	Line 4035 | Line 4181 | begin
4181		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4182		end;
4183
4184	<	end.
4184	>	end.

Diff Legend

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