ViewVC Help

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

root/public/ibx/branches/journaling/runtime/nongui/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/nongui/IBCustomDataSet.pas (file contents):
Revision 287 by tony, Thu Apr 11 08:51:23 2019 UTC vs.
Revision 311 by tony, Mon Aug 24 09:32:58 2020 UTC

#	Line 441 | 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 476 | Line 478 | type
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 509 | 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 668 | 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 781 | Line 788 | type
788
789		TIBParserDataSet = class(TIBCustomDataSet)
790		protected
784	–	procedure SetFilterText(const Value: string); override;
791		procedure DoBeforeOpen; override;
792		public
793		property Parser;
#	Line 833 | 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 973 | 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 1037 | Line 1045 | type
1045
1046		{ TIBParserDataSet }
1047
1040	–	procedure TIBParserDataSet.SetFilterText(const Value: string);
1041	–	begin
1042	–	if Filter = Value then Exit;
1043	–	inherited SetFilterText(Value);
1044	–	if Active and Filtered then {reopen dataset}
1045	–	begin
1046	–	Active := false;
1047	–	Active := true;
1048	–	end;
1049	–	end;
1050	–
1048		procedure TIBParserDataSet.DoBeforeOpen;
1049		var i: integer;
1050		begin
1051		if assigned(FParser) then
1052		FParser.RestoreClauseValues;
1053	<	if Filtered and (Filter <> '') then
1054	<	Parser.Add2WhereClause(Filter);
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;
#	Line 1316 | Line 1314 | begin
1314		IBFieldDef := FieldDef as TIBFieldDef;
1315		CharacterSetSize := IBFieldDef.CharacterSetSize;
1316		CharacterSetName := IBFieldDef.CharacterSetName;
1317	<	FDataSize := IBFieldDef.DataSize + 1;
1317	>	FDataSize := IBFieldDef.DataSize;
1318		if AutoFieldSize then
1319		Size := IBFieldDef.Size;
1320		CodePage := IBFieldDef.CodePage;
#	Line 1359 | Line 1357 | var
1357		s: RawByteString;
1358		begin
1359		Buffer := nil;
1360	<	IBAlloc(Buffer, 0, DataSize);
1360	>	IBAlloc(Buffer, 0, DataSize + 1); {allow for trailing #0}
1361		try
1362		Result := GetData(Buffer);
1363		if Result then
#	Line 1368 | 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 1384 | Line 1389 | var
1389		s: RawByteString;
1390		begin
1391		Buffer := nil;
1392	<	IBAlloc(Buffer, 0, DataSize);
1392	>	IBAlloc(Buffer, 0, DataSize + 1); {allow for trailing #0}
1393		try
1394		s := Value;
1395		if StringCodePage(s) <> CodePage then
1396		SetCodePage(s,CodePage,CodePage<>CP_NONE);
1397	<	StrLCopy(Buffer, PChar(s), DataSize-1);
1397	>	StrLCopy(Buffer, PChar(s), DataSize);
1398		if Transliterate then
1399		DataSet.Translate(Buffer, Buffer, True);
1400		SetData(Buffer);
#	Line 1497 | Line 1502 | end;
1502
1503		procedure TIBDataLink.ActiveChanged;
1504		begin
1505	<	if FDataSet.Active then
1505	>	if DetailDataSet.Active and DataSet.Active then
1506		FDataSet.RefreshParams;
1507		end;
1508
#	Line 1581 | 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 1603 | 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 3025 | 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 3634 | Line 3643 | begin
3643		Data := Buff + fdDataOfs;
3644		if (fdDataType = SQL_VARYING) or (fdDataType = SQL_TEXT) then
3645		begin
3646	<	if fdDataLength < Field.DataSize then
3646	>	if fdDataLength <= Field.DataSize then
3647		begin
3648		Move(Data^, Buffer^, fdDataLength);
3649		PChar(Buffer)[fdDataLength] := #0;
#	Line 3643 | Line 3652 | begin
3652		IBError(ibxeFieldSizeError,[Field.FieldName])
3653		end
3654		else
3655	<	Move(Data^, Buffer^, Field.DataSize);
3655	>	if fdDataLength <= Field.DataSize then
3656	>	Move(Data^, Buffer^, Field.DataSize)
3657	>	else
3658	>	IBError(ibxeFieldSizeError,[Field.FieldName,Field.DataSize,fdDataLength])
3659		end;
3660		end;
3661		end;
#	Line 3814 | Line 3826 | var
3826		Buff: PChar;
3827		CurRec: Integer;
3828		pda: PArrayDataArray;
3829	+	pbd: PBlobDataArray;
3830		i: integer;
3831		begin
3832		inherited InternalCancel;
#	Line 3821 | Line 3834 | begin
3834		if Buff <> nil then
3835		begin
3836		pda := PArrayDataArray(Buff + FArrayCacheOffset);
3837	+	pbd := PBlobDataArray(Buff + FBlobCacheOffset);
3838		for i := 0 to ArrayFieldCount - 1 do
3839		pda^[i].ArrayIntf.CancelChanges;
3840		CurRec := FCurrentRecord;
3841		AdjustRecordOnInsert(Buff);
3842		if (State = dsEdit) then begin
3843		CopyRecordBuffer(FOldBuffer, Buff);
3844	+	for i := 0 to BlobFieldCount - 1 do
3845	+	pbd^[i] := nil;
3846		WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
3847		end else begin
3848		CopyRecordBuffer(FModelBuffer, Buff);
#	Line 3906 | Line 3922 | end;
3922		procedure TIBCustomDataSet.InternalFirst;
3923		begin
3924		FCurrentRecord := -1;
3925	+	if Unidirectional then GetNextRecord;
3926		end;
3927
3928		procedure TIBCustomDataSet.InternalGotoBookmark(Bookmark: Pointer);
#	Line 3931 | Line 3948 | begin
3948		procedure TIBCustomDataSet.FieldDefsFromQuery(SourceQuery: TIBSQL);
3949		const
3950		DefaultSQL = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3951	<	'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME ' + {do not localize}
3951	>	'F.RDB$DEFAULT_VALUE, Trim(R.RDB$FIELD_NAME) as RDB$FIELD_NAME ' + {do not localize}
3952		'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3953		'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3954		'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
#	Line 3939 | Line 3956 | const
3956		'     (not F.RDB$DEFAULT_VALUE is NULL)) '; {do not localize}
3957
3958		DefaultSQLODS12 = 'Select F.RDB$COMPUTED_BLR, ' + {do not localize}
3959	<	'F.RDB$DEFAULT_VALUE, R.RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3959	>	'F.RDB$DEFAULT_VALUE, Trim(R.RDB$FIELD_NAME) as RDB$FIELD_NAME, R.RDB$IDENTITY_TYPE ' + {do not localize}
3960		'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
3961		'where R.RDB$RELATION_NAME = :RELATION ' +  {do not localize}
3962		'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
#	Line 4638 | Line 4655 | begin
4655		fdIsNull := True
4656		else
4657		begin
4658	<	Move(Buffer^, Buff[fdDataOfs],fdDataSize);
4658	>	if fdDataSize >= Field.DataSize then
4659	>	Move(Buffer^, Buff[fdDataOfs],fdDataSize)
4660	>	else
4661	>	IBError(ibxeDBBufferTooSmall,[fdDataSize,Field.FieldName,Field.DataSize]);
4662	>
4663		if (fdDataType = SQL_TEXT) or (fdDataType = SQL_VARYING) then
4664		fdDataLength := StrLen(PChar(Buffer));
4665		fdIsNull := False;
#	Line 4790 | Line 4811 | begin
4811		FQSelect.CaseSensitiveParameterNames := AValue;
4812		end;
4813
4814	+	procedure TIBCustomDataSet.SetSQLFiltered(AValue: boolean);
4815	+	begin
4816	+	if FSQLFiltered = AValue then Exit;
4817	+	FSQLFiltered := AValue;
4818	+	if Active then
4819	+	begin
4820	+	Active := false;
4821	+	Active := true;
4822	+	end;
4823	+	end;
4824	+
4825	+	procedure TIBCustomDataSet.SetSQLFilterParams(AValue: TStrings);
4826	+	begin
4827	+	if FSQLFilterParams = AValue then Exit;
4828	+	FSQLFilterParams.Assign(AValue);
4829	+	end;
4830	+
4831		procedure TIBCustomDataSet.SetMasterDetailDelay(AValue: integer);
4832		begin
4833		FDataLink.DelayTimerValue := AValue;
#	Line 4802 | Line 4840 | begin
4840		Result := FParser
4841		end;
4842
4843	+	procedure TIBCustomDataSet.HandleSQLFilterParamsChanged(Sender: TObject);
4844	+	begin
4845	+	Active := false;
4846	+	end;
4847	+
4848		procedure TIBCustomDataSet.ResetParser;
4849		begin
4850		if assigned(FParser) then

Diff Legend

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