ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/nongui/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/nongui/IBCustomDataSet.pas (file contents):
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 308 by tony, Sat Jul 18 10:26:30 2020 UTC

#	Line 399 | Line 399 | type
399		FArrayFieldCount: integer;
400		FArrayCacheOffset: integer;
401		FAutoCommit: TIBAutoCommit;
402	+	FCaseSensitiveParameterNames: boolean;
403		FEnableStatistics: boolean;
404		FGenerateParamNames: Boolean;
405		FGeneratorField: TIBGenerator;
#	Line 440 | Line 441 | type
441		FRecordCount: Integer;
442		FRecordSize: Integer;
443		FDataSetCloseAction: TDataSetCloseAction;
444	+	FSQLFiltered: boolean;
445	+	FSQLFilterParams: TStrings;
446		FUniDirectional: Boolean;
447		FUpdateMode: TUpdateMode;
448		FUpdateObject: TIBDataSetUpdateObject;
#	Line 474 | Line 477 | type
477		FieldIndex: integer; Buffer: PChar);
478		procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
479		function GetSelectStmtIntf: IStatement;
480	+	procedure SetCaseSensitiveParameterNames(AValue: boolean);
481	+	procedure SetSQLFiltered(AValue: boolean);
482	+	procedure SetSQLFilterParams(AValue: TStrings);
483		procedure SetUpdateMode(const Value: TUpdateMode);
484		procedure SetUpdateObject(Value: TIBDataSetUpdateObject);
485
#	Line 507 | Line 513 | type
513		function GetModifySQL: TStrings;
514		function GetTransaction: TIBTransaction;
515		function GetParser: TSelectSQLParser;
516	+	procedure HandleSQLFilterParamsChanged(Sender: TObject);
517		procedure InternalDeleteRecord(Qry: TIBSQL; Buff: Pointer); virtual;
518		function InternalLocate(const KeyFields: string; const KeyValues: Variant;
519		Options: TLocateOptions): Boolean; virtual;
#	Line 591 | Line 598 | type
598		procedure DoBeforeInsert; override;
599		procedure DoAfterInsert; override;
600		procedure DoBeforeClose; override;
594	–	procedure DoBeforeOpen; override;
601		procedure DoBeforePost; override;
602		procedure DoAfterPost; override;
603		procedure FreeRecordBuffer(var Buffer: PChar); override;
#	Line 652 | Line 658 | type
658		property SelectStmtHandle: IStatement read GetSelectStmtIntf;
659
660		{Likely to be made published by descendant classes}
661	+	property CaseSensitiveParameterNames: boolean read FCaseSensitiveParameterNames
662	+	write SetCaseSensitiveParameterNames;
663		property BufferChunks: Integer read FBufferChunks write SetBufferChunks;
664		property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
665		property UniDirectional: Boolean read FUniDirectional write SetUniDirectional default False;
#	Line 665 | Line 673 | type
673		property ParamCheck: Boolean read FParamCheck write FParamCheck default True;
674		property Parser: TSelectSQLParser read GetParser;
675		property BaseSQLSelect: TStrings read FBaseSQLSelect;
676	+	property SQLFiltered: boolean read FSQLFiltered write SetSQLFiltered;
677	+	property SQLFilterParams: TStrings read FSQLFilterParams write SetSQLFilterParams;
678
679		property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
680		write FBeforeDatabaseDisconnect;
#	Line 716 | Line 726 | type
726		function IsSequenced: Boolean; override;
727		procedure Post; override;
728		function ParamByName(ParamName: String): ISQLParam;
729	+	function FindParam(ParamName: String): ISQLParam;
730		property ArrayFieldCount: integer read FArrayFieldCount;
731		property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
732		property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
#	Line 773 | Line 784 | type
784		write FOnDeleteReturning;
785		end;
786
787	+	{ TIBParserDataSet }
788	+
789		TIBParserDataSet = class(TIBCustomDataSet)
790	+	protected
791	+	procedure DoBeforeOpen; override;
792		public
793		property Parser;
794		end;
#	Line 810 | Line 825 | type
825		property AutoCommit;
826		property BufferChunks;
827		property CachedUpdates;
828	+	property CaseSensitiveParameterNames;
829		property EnableStatistics;
830		property DeleteSQL;
831		property InsertSQL;
#	Line 823 | Line 839 | type
839		property UniDirectional;
840		property Filtered;
841		property DataSetCloseAction;
842	+	property SQLFiltered;
843	+	property SQLFilterParams;
844
845		property BeforeDatabaseDisconnect;
846		property AfterDatabaseDisconnect;
#	Line 963 | Line 981 | const
981
982		implementation
983
984	<	uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery;
984	>	uses Variants, FmtBCD, LazUTF8, IBMessages, IBQuery;
985
986		type
987
#	Line 1025 | Line 1043 | type
1043		Result := str;
1044		end;
1045
1046	+	{ TIBParserDataSet }
1047	+
1048	+	procedure TIBParserDataSet.DoBeforeOpen;
1049	+	var i: integer;
1050	+	begin
1051	+	if assigned(FParser) then
1052	+	FParser.RestoreClauseValues;
1053	+	if SQLFiltered then
1054	+	for i := 0 to SQLFilterParams.Count - 1 do
1055	+	Parser.Add2WhereClause(SQLFilterParams[i]);
1056	+	for i := 0 to FIBLinks.Count - 1 do
1057	+	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
1058	+	inherited DoBeforeOpen;
1059	+	for i := 0 to FIBLinks.Count - 1 do
1060	+	TIBControlLink(FIBLinks[i]).UpdateParams(self);
1061	+	end;
1062	+
1063		{ TIBLargeIntField }
1064
1065		procedure TIBLargeIntField.Bind(Binding: Boolean);
#	Line 1331 | Line 1366 | begin
1366		SetCodePage(s,CodePage,false);
1367		if (CodePage <> CP_NONE) and (CodePage <> CP_UTF8) then
1368		SetCodePage(s,CP_UTF8,true);  {LCL only accepts UTF8}
1369	<	Value := s;
1369	>
1370	>	if (CodePage = CP_UTF8) and (UTF8Length(s) > Size) then
1371	>	{truncate to max. number of UTF8 characters - usually a problem with
1372	>	fixed width columns right padded with white space}
1373	>	Value := UTF8Copy(s,1,Size)
1374	>	else
1375	>	Value := s;
1376	>
1377		//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1378		if Transliterate and (Value <> '') then
1379		DataSet.Translate(PChar(Value), PChar(Value), False);
#	Line 1544 | Line 1586 | begin
1586		if AOwner is TIBTransaction then
1587		Transaction := TIBTransaction(AOwner);
1588		FBaseSQLSelect := TStringList.Create;
1589	+	FSQLFilterParams := TStringList.Create;
1590	+	TStringList(FSQLFilterParams).OnChange :=  HandleSQLFilterParamsChanged;
1591		end;
1592
1593		destructor TIBCustomDataSet.Destroy;
#	Line 1566 | Line 1610 | begin
1610		FMappedFieldPosition := nil;
1611		if assigned(FBaseSQLSelect) then FBaseSQLSelect.Free;
1612		if assigned(FParser) then FParser.Free;
1613	+	if assigned(FSQLFilterParams) then FSQLFilterParams.Free;
1614		inherited Destroy;
1615		end;
1616
#	Line 2988 | Line 3033 | procedure TIBCustomDataSet.SetUniDirecti
3033		begin
3034		CheckDatasetClosed;
3035		FUniDirectional := Value;
3036	+	inherited SetUniDirectional(Value);
3037		end;
3038
3039		procedure TIBCustomDataSet.SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
#	Line 3097 | Line 3143 | end;
3143
3144		function TIBCustomDataSet.ParamByName(ParamName: String): ISQLParam;
3145		begin
3146	+	Result := FindParam(ParamName);
3147	+	if Result = nil then
3148	+	IBError(ibxeParameterNameNotFound,[ParamName]);
3149	+	end;
3150	+
3151	+	function TIBCustomDataSet.FindParam(ParamName: String): ISQLParam;
3152	+	begin
3153		ActivateConnection;
3154		ActivateTransaction;
3155		if not FInternalPrepared then
#	Line 3450 | Line 3503 | begin
3503		ApplyUpdates;
3504		end;
3505
3453	–	procedure TIBCustomDataSet.DoBeforeOpen;
3454	–	var i: integer;
3455	–	begin
3456	–	if assigned(FParser) then
3457	–	FParser.RestoreClauseValues;
3458	–	for i := 0 to FIBLinks.Count - 1 do
3459	–	TIBControlLink(FIBLinks[i]).UpdateSQL(self);
3460	–	inherited DoBeforeOpen;
3461	–	for i := 0 to FIBLinks.Count - 1 do
3462	–	TIBControlLink(FIBLinks[i]).UpdateParams(self);
3463	–	end;
3464	–
3506		procedure TIBCustomDataSet.DoBeforePost;
3507		begin
3508		inherited DoBeforePost;
#	Line 4750 | Line 4791 | begin
4791		Result := FQSelect.Statement;
4792		end;
4793
4794	+	procedure TIBCustomDataSet.SetCaseSensitiveParameterNames(AValue: boolean);
4795	+	begin
4796	+	if FCaseSensitiveParameterNames = AValue then Exit;
4797	+	FCaseSensitiveParameterNames := AValue;
4798	+	if assigned(FQSelect) then
4799	+	FQSelect.CaseSensitiveParameterNames := AValue;
4800	+	end;
4801	+
4802	+	procedure TIBCustomDataSet.SetSQLFiltered(AValue: boolean);
4803	+	begin
4804	+	if FSQLFiltered = AValue then Exit;
4805	+	FSQLFiltered := AValue;
4806	+	if Active then
4807	+	begin
4808	+	Active := false;
4809	+	Active := true;
4810	+	end;
4811	+	end;
4812	+
4813	+	procedure TIBCustomDataSet.SetSQLFilterParams(AValue: TStrings);
4814	+	begin
4815	+	if FSQLFilterParams = AValue then Exit;
4816	+	FSQLFilterParams.Assign(AValue);
4817	+	end;
4818	+
4819		procedure TIBCustomDataSet.SetMasterDetailDelay(AValue: integer);
4820		begin
4821		FDataLink.DelayTimerValue := AValue;
#	Line 4762 | Line 4828 | begin
4828		Result := FParser
4829		end;
4830
4831	+	procedure TIBCustomDataSet.HandleSQLFilterParamsChanged(Sender: TObject);
4832	+	begin
4833	+	Active := false;
4834	+	end;
4835	+
4836		procedure TIBCustomDataSet.ResetParser;
4837		begin
4838		if assigned(FParser) then
#	Line 5216 | Line 5287 | end;
5287
5288		procedure TIBGenerator.SetQuerySQL;
5289		begin
5290	<	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',[FGeneratorName,Increment]);
5290	>	if Database <> nil then
5291	>	FQuery.SQL.Text := Format('Select Gen_ID(%s,%d) From RDB$Database',
5292	>	[QuoteIdentifierIfNeeded(Database.SQLDialect,FGeneratorName),Increment]);
5293		end;
5294
5295		function TIBGenerator.GetDatabase: TIBDatabase;
#	Line 5232 | Line 5305 | end;
5305		procedure TIBGenerator.SetDatabase(AValue: TIBDatabase);
5306		begin
5307		FQuery.Database := AValue;
5308	+	SetQuerySQL;
5309		end;
5310
5311		procedure TIBGenerator.SetGeneratorName(AValue: string);

Diff Legend

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