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 20 by tony, Mon Jul 7 13:00:15 2014 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 252 | Line 254 | type
254		FAfterTransactionEnd,
255		FTransactionFree: TNotifyEvent;
256		FAliasNameMap: array of string;
257	<
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 285 | 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 323 | 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;
#	Line 359 | 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;
#	Line 390 | 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;
#	Line 426 | 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 446 | 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 514 | 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 539 | Line 557 | type
557		property QModify;
558		property StatementType;
559		property SelectStmtHandle;
560	+	property BaseSQLSelect;
561
562		published
563		{ TIBCustomDataSet }
#	Line 882 | 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 902 | 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 1145 | 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 1205 | 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 1900 | 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
#	Line 2144 | Line 2196 | begin
2196		begin
2197		Disconnect;
2198		FQSelect.SQL.Assign(Value);
2199	+	FBaseSQLSelect.assign(Value);
2200		end;
2201		end;
2202
#	Line 2207 | 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
2269	>	FieldDefs.Updated := false;
2270		end;
2271
2272		{ I can "undelete" uninserted records (make them "inserted" again).
#	Line 2498 | 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 3045 | Line 3108 | begin
3108		Query.SQL.Text := DefaultSQL;
3109		Query.Prepare;
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
#	Line 3053 | Line 3117 | begin
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 := SourceQuery.Current[i].IsNullable;
#	Line 3424 | 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 3506 | 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 3522 | 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 3632 | Line 3706 | begin
3706		FieldDefs.Clear;
3707		FieldDefs.Updated := false;
3708		FInternalPrepared := False;
3709	+	Setlength(FAliasNameList,0);
3710		end;
3711		end;
3712
#	Line 3670 | 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;

Diff Legend

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