ViewVC Help

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

root/public/ibx/trunk/runtime/IBQuery.pas

Comparing ibx/trunk/runtime/IBQuery.pas (file contents):
Revision 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 27 | Line 27
27		{    IBX For Lazarus (Firebird Express)                                  }
28		{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29		{    Portions created by MWA Software are copyright McCallum Whyman      }
30	<	{    Associates Ltd 2011                                                 }
30	>	{    Associates Ltd 2011 - 2018                                               }
31		{                                                                        }
32		{************************************************************************}
33
#	Line 43 | Line 43 | uses
43		{$ELSE}
44		unix,
45		{$ENDIF}
46	<	SysUtils, Graphics, Classes, Controls, Db,
47	<	IBHeader, IB, IBCustomDataSet, IBSQL;
46	>	SysUtils, Classes,  Db, IB, IBCustomDataSet, IBSQL;
47
48		type
49
50		{ TIBQuery }
51
52	<	TIBQuery = class(TIBCustomDataSet)
52	>	TIBQuery = class(TIBParserDataSet)
53		private
54		FSQL: TStrings;
55		FPrepared: Boolean;
56		FParams: TParams;
57		FText: string;
58	<	FRowsAffected: Integer;
59	<	FCheckRowsAffected: Boolean;
61	<	FGenerateParamNames: Boolean;
58	>	FSQLUpdating: boolean;
59	>	FInQueryChanged: boolean;
60		function GetRowsAffected: Integer;
61	<	procedure PrepareSQL(Value: PChar);
61	>	procedure PrepareSQL;
62		procedure QueryChanged(Sender: TObject);
63		procedure ReadParamData(Reader: TReader);
64		procedure SetQuery(Value: TStrings);
#	Line 70 | Line 68 | type
68		procedure SetPrepared(Value: Boolean);
69		procedure SetPrepare(Value: Boolean);
70		procedure WriteParamData(Writer: TWriter);
71	<	function GetStmtHandle: TISC_STMT_HANDLE;
71	>	function GetStmtHandle: IStatement;
72	>	procedure UpdateSQL;
73
74		protected
75		{ IProviderSupport }
#	Line 87 | Line 86 | type
86		function GetParamsCount: Word;
87		function GenerateQueryForLiveUpdate : Boolean;
88		procedure SetFiltered(Value: Boolean); override;
89	+	procedure SQLChanged(Sender: TObject); override;
90	+	procedure SQLChanging(Sender: TObject); override;
91
92		public
93		constructor Create(AOwner: TComponent); override;
#	Line 98 | Line 99 | type
99		function ParamByName(const Value: string): TParam;
100		procedure Prepare;
101		procedure UnPrepare;
102	+	procedure ResetParser; override;
103		property Prepared: Boolean read FPrepared write SetPrepare;
104		property ParamCount: Word read GetParamsCount;
105	<	property StmtHandle: TISC_STMT_HANDLE read GetStmtHandle;
105	>	property StmtHandle: IStatement read GetStmtHandle;
106		property StatementType;
107		property Text: string read FText;
108		property RowsAffected: Integer read GetRowsAffected;
107	–	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
109		//   property Params: TParams read FParams write SetParamsList;
110	+	property BaseSQLSelect;
111
112		published
113		property Active;
114	+	property AutoCommit;
115		property BufferChunks;
116		property CachedUpdates;
117		property DataSource read GetDataSource write SetDataSource;
118	+	property GenerateParamNames;
119		//   property Constraints stored ConstraintsStored;
120		property GeneratorField;
121		property ParamCheck;
122		property SQL: TStrings read FSQL write SetQuery;
123	<	property Params: TParams read FParams write SetParamsList;
123	>	property Params: TParams read FParams write SetParamsList;
124		property UniDirectional default False;
125		property UpdateObject;
126		property Filtered;
127	+	property DataSetCloseAction;
128
129		property BeforeDatabaseDisconnect;
130		property AfterDatabaseDisconnect;
#	Line 128 | Line 133 | type
133		property AfterTransactionEnd;
134		property TransactionFree;
135		property OnFilterRecord;
136	+	property OnValidatePost;
137	+	property OnDeleteReturning;
138		end;
139
140		implementation
141
142	+	uses FBMessages;
143	+
144		{ TIBQuery }
145
146		constructor TIBQuery.Create(AOwner: TComponent);
#	Line 141 | Line 150 | begin
150		TStringList(SQL).OnChange := QueryChanged;
151		FParams := TParams.Create(Self);
152		ParamCheck := True;
144	–	FGenerateParamNames := False;
145	–	FRowsAffected := -1;
153		end;
154
155		destructor TIBQuery.Destroy;
#	Line 163 | Line 170 | procedure TIBQuery.InternalOpen;
170		begin
171		ActivateConnection();
172		ActivateTransaction;
173	<	QSelect.GenerateParamNames := FGenerateParamNames;
173	>	QSelect.GenerateParamNames := GenerateParamNames;
174		SetPrepared(True);
175		if DataSource <> nil then
176		SetParamsFromCursor;
#	Line 195 | Line 202 | begin
202		SetPrepared(False);
203		end;
204
205	+	procedure TIBQuery.ResetParser;
206	+	begin
207	+	inherited ResetParser;
208	+	UpdateSQL;
209	+	end;
210	+
211		procedure TIBQuery.SetQuery(Value: TStrings);
212		begin
213		if SQL.Text <> Value.Text then
#	Line 210 | Line 223 | begin
223		end;
224
225		procedure TIBQuery.QueryChanged(Sender: TObject);
213	–	var
214	–	List: TParams;
226		begin
227	<	if not (csReading in ComponentState) then
228	<	begin
229	<	Disconnect;
230	<	if ParamCheck or (csDesigning in ComponentState) then
227	>	if FInQueryChanged then Exit;
228	>	FInQueryChanged := true;
229	>	try
230	>	if not (csReading in ComponentState) then
231		begin
232	<	List := TParams.Create(Self);
233	<	try
234	<	FText := List.ParseSQL(SQL.Text, True);
235	<	List.AssignValues(FParams);
236	<	FParams.Clear;
237	<	FParams.Assign(List);
227	<	finally
228	<	List.Free;
229	<	end;
232	>	Disconnect;
233	>	if csDesigning in ComponentState then
234	>	FText := FParams.ParseSQL(SQL.Text, true)
235	>	else
236	>	FText := SQL.Text;
237	>	DataEvent(dePropertyChange, 0);
238		end else
239	<	FText := SQL.Text;
240	<	DataEvent(dePropertyChange, 0);
241	<	end else
242	<	FText := FParams.ParseSQL(SQL.Text, true);
243	<	SelectSQL.Assign(SQL);
239	>	FText := FParams.ParseSQL(SQL.Text, true);
240	>
241	>	if not FSQLUpdating then
242	>	begin
243	>	Prepared := false;
244	>	SelectSQL.Assign(SQL);
245	>	end;
246	>	finally
247	>	FInQueryChanged := false;
248	>	end;
249		end;
250
251		procedure TIBQuery.SetParamsList(Value: TParams);
#	Line 261 | Line 274 | begin
274		Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData); {do not localize}
275		end;
276
277	+
278		procedure TIBQuery.ReadParamData(Reader: TReader);
279		begin
280		FParams.Clear;
#	Line 280 | Line 294 | begin
294		begin
295		if Value then
296		begin
297	<	FRowsAffected := -1;
284	<	FCheckRowsAffected := True;
285	<	if Length(Text) > 1 then PrepareSQL(PChar(Text))
297	>	if Length(Text) > 1 then PrepareSQL
298		else IBError(ibxeEmptySQLStatement, [nil]);
299		end
300		else
301		begin
290	–	if FCheckRowsAffected then
291	–	FRowsAffected := RowsAffected;
302		InternalUnPrepare;
303	+	FParams.Clear;
304		end;
305		FPrepared := Value;
306		end;
#	Line 308 | Line 319 | var
319		for I := 0 to FParams.Count - 1 do
320		with FParams[I] do
321		if not Bound then
322	<	IBError(ibxeRequiredParamNotSet, [nil]);
322	>	IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
323		end;
324
325		begin
#	Line 339 | Line 350 | end;
350
351		function TIBQuery.ParamByName(const Value: string): TParam;
352		begin
353	+	if not Prepared then
354	+	Prepare;
355		Result := FParams.ParamByName(Value);
356		end;
357
#	Line 358 | Line 371 | var
371		begin
372		CheckInActive;
373		if SQL.Count <= 0 then
361	–	begin
362	–	FCheckRowsAffected := False;
374		IBError(ibxeEmptySQLStatement, [nil]);
375	<	end;
375	>
376		ActivateConnection();
377		DidActivate := ActivateTransaction;
378		try
#	Line 372 | Line 383 | begin
383		finally
384		if DidActivate then
385		DeactivateTransaction;
375	–	FCheckRowsAffected := True;
386		end;
387		end;
388
#	Line 381 | Line 391 | procedure TIBQuery.SetParams;
391		var
392		i : integer;
393		Buffer: Pointer;
394	+	SQLParam: ISQLParam;
395
396		begin
397		for I := 0 to FParams.Count - 1 do
398		begin
399	+	SQLParam :=  SQLParams.ByName(Params[i].Name);
400		if Params[i].IsNull then
401	<	SQLParams[i].IsNull := True
401	>	SQLParam.IsNull := True
402		else begin
403	<	SQLParams[i].IsNull := False;
403	>	SQLParam.IsNull := False;
404		case Params[i].DataType of
405		ftBytes:
406		begin
407		GetMem(Buffer,Params[i].GetDataSize);
408		try
409		Params[i].GetData(Buffer);
410	<	SQLParams[i].AsPointer := Buffer;
410	>	SQLParam.AsPointer := Buffer;
411		finally
412		FreeMem(Buffer);
413		end;
414		end;
415		ftString:
416	<	SQLParams[i].AsString := Params[i].AsString;
417	<	ftBoolean, ftSmallint, ftWord:
418	<	SQLParams[i].AsShort := Params[i].AsSmallInt;
416	>	SQLParam.AsString := Params[i].AsString;
417	>	ftBoolean:
418	>	SQLParam.AsBoolean := Params[i].AsBoolean;
419	>	ftSmallint, ftWord:
420	>	SQLParam.AsShort := Params[i].AsSmallInt;
421		ftInteger:
422	<	SQLParams[i].AsLong := Params[i].AsInteger;
423	<	{        ftLargeInt:
424	<	SQLParams[i].AsInt64 := Params[i].AsLargeInt;  }
422	>	SQLParam.AsLong := Params[i].AsInteger;
423	>	ftLargeInt:
424	>	SQLParam.AsInt64 := Params[i].AsLargeInt;
425		ftFloat:
426	<	SQLParams[i].AsDouble := Params[i].AsFloat;
426	>	SQLParam.AsDouble := Params[i].AsFloat;
427		ftBCD, ftCurrency:
428	<	SQLParams[i].AsCurrency := Params[i].AsCurrency;
428	>	SQLParam.AsCurrency := Params[i].AsCurrency;
429		ftDate:
430	<	SQLParams[i].AsDate := Params[i].AsDateTime;
430	>	SQLParam.AsDate := Params[i].AsDateTime;
431		ftTime:
432	<	SQLParams[i].AsTime := Params[i].AsDateTime;
432	>	SQLParam.AsTime := Params[i].AsDateTime;
433		ftDateTime:
434	<	SQLParams[i].AsDateTime := Params[i].AsDateTime;
434	>	SQLParam.AsDateTime := Params[i].AsDateTime;
435		ftBlob, ftMemo:
436	<	SQLParams[i].AsString := Params[i].AsString;
436	>	SQLParam.AsString := Params[i].AsString;
437		else
438		IBError(ibxeNotSupported, [nil]);
439		end;
#	Line 427 | Line 441 | begin
441		end;
442		end;
443
444	<	procedure TIBQuery.PrepareSQL(Value: PChar);
444	>	procedure TIBQuery.PrepareSQL;
445	>	var List: TParams;
446		begin
447	<	QSelect.GenerateParamNames := FGenerateParamNames;
447	>	QSelect.GenerateParamNames := GenerateParamNames;
448		InternalPrepare;
449	+	UpdateSQL;
450	+	if ParamCheck  then
451	+	begin
452	+	List := TParams.Create(Self);
453	+	try
454	+	FText := List.ParseSQL(SQL.Text, True);
455	+	List.AssignValues(FParams);
456	+	FParams.Clear;
457	+	FParams.Assign(List);
458	+	finally
459	+	List.Free;
460	+	end;
461	+	end;
462		end;
463
464
#	Line 466 | Line 494 | begin
494		AddFieldToList(Params[i].Name, Self, DetailFields);
495		end;
496
497	<	function TIBQuery.GetStmtHandle: TISC_STMT_HANDLE;
497	>	function TIBQuery.GetStmtHandle: IStatement;
498		begin
499		Result := SelectStmtHandle;
500		end;
501
502	+	procedure TIBQuery.UpdateSQL;
503	+	begin
504	+	if not FSQLUpdating and not FInQueryChanged and (SQL.Text <> SelectSQL.Text) then
505	+	begin
506	+	FSQLUpdating := true;
507	+	try
508	+	SQL.Text := SelectSQL.Text;
509	+	finally
510	+	FSQLUpdating := false
511	+	end;
512	+	end;
513	+	end;
514	+
515		function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
516		begin
517		Result := False;
#	Line 491 | Line 532 | begin
532		inherited SetFiltered(value);
533		end;
534
535	+	procedure TIBQuery.SQLChanged(Sender: TObject);
536	+	begin
537	+	inherited SQLChanged(Sender);
538	+	UpdateSQL;
539	+	end;
540	+
541	+	procedure TIBQuery.SQLChanging(Sender: TObject);
542	+	begin
543	+	inherited SQLChanging(Sender);
544	+	Prepared := false;
545	+	end;
546	+
547		{ TIBQuery IProviderSupport }
548		(*
549		function TIBQuery.PSGetParams: TParams;

Diff Legend

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