ViewVC Help

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

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

Comparing ibx/trunk/runtime/IBStoredProc.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 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 47 | Line 47 | type
47
48		TIBStoredProc = class(TIBCustomDataSet)
49		private
50	+	FPackageName: string;
51		FStmtHandle: IStatement;
52		FProcName: string;
53		FParams: TParams;
54		FPrepared: Boolean;
55		FNameList: TStrings;
56	+	FPackageNameList: TStrings;
57	+	function GetPackageNames: TStrings;
58	+	procedure GetPackageNamesFromServer;
59	+	procedure SetPackageName(AValue: string);
60		procedure SetParamsList(Value: TParams);
61		procedure FreeStatement;
62		function GetStoredProcedureNames: TStrings;
#	Line 63 | Line 68 | type
68		procedure FetchDataIntoOutputParams;
69		procedure ReadParamData(Reader: TReader);
70		procedure WriteParamData(Writer: TWriter);
71	<
71	>	procedure UpdateQuery;
72		protected
73
74		procedure DefineProperties(Filer: TFiler); override;
#	Line 88 | Line 93 | type
93		property StmtHandle: IStatement read FStmtHandle;
94		property Prepared: Boolean read FPrepared write SetPrepare;
95		property StoredProcedureNames: TStrings read GetStoredProcedureNames;
96	+	property PackageNames: TStrings read GetPackageNames;
97
98		published
99	+	property PackageName: string read FPackageName write SetPackageName;
100		property StoredProcName: string read FProcName write SetProcName;
101		property Params: TParams read FParams write SetParamsList;
102		property Filtered;
#	Line 114 | Line 121 | begin
121		inherited Create(AOwner);
122		FParams := TParams.Create (self);
123		FNameList := TStringList.Create;
124	+	FPackageNameList := TStringList.Create;
125		end;
126
127		destructor TIBStoredProc.Destroy;
#	Line 121 | Line 129 | begin
129		Destroying;
130		Disconnect;
131		if assigned (FParams) then FParams.Free;
132	<	if assigned(FNameList) then FNameList.Destroy;
132	>	if assigned(FNameList) then FNameList.Free;
133	>	if assigned(FPackageNameList) then FPackageNameList.Free;
134		inherited Destroy;
135		end;
136
#	Line 154 | Line 163 | end;
163
164		procedure TIBStoredProc.SetProcName(Value: string);
165		begin
166	<	if not (csReading in ComponentState) then
167	<	begin
168	<	CheckInactive;
169	<	if Value <> FProcName then
161	<	begin
162	<	FProcName := Value;
163	<	FreeStatement;
164	<	FParams.Clear;
165	<	if (Value <> '') and
166	<	(Database <> nil) then
167	<	GenerateSQL;
168	<	end;
169	<	end else begin
170	<	FProcName := Value;
171	<	if (Value <> '') and
172	<	(Database <> nil) then
173	<	GenerateSQL;
174	<	end;
166	>	if Value = FProcName then Exit;
167	>	CheckInactive;
168	>	FProcName := Value;
169	>	UpdateQuery;
170		end;
171
172		function TIBStoredProc.GetParamsCount: Word;
#	Line 196 | Line 191 | end;
191
192		procedure TIBStoredProc.InitFieldDefs;
193		begin
194	<	if SelectSQL.Text = '' then
194	>	if (SelectSQL.Text = '') and (FProcName <> '') and (Database <> nil) then
195		GenerateSQL;
196		inherited InitFieldDefs;
197		end;
#	Line 225 | Line 220 | var Params: TStringList;
220		end;
221		end;
222
223	+	{Trim and make uppercase unless not an SQL Identifier when leave as it is}
224	+	function FormatProcName(Dialect: Integer; Value: String): String;
225	+	begin
226	+	Value := Trim(Value);
227	+	if (Dialect = 1) or IsSQLIdentifier(Value) then
228	+	Result := AnsiUpperCase(Value)
229	+	else
230	+	Result := SQLSafeString(Value);
231	+	end;
232	+
233		var
234		Query : TIBSQL;
235		input : string;
#	Line 239 | Line 244 | begin
244		try
245		Query.Database := DataBase;
246		Query.Transaction := Database.InternalTransaction;
247	<	Query.SQL.Text := 'SELECT RDB$PARAMETER_NAME,  RDB$PARAMETER_TYPE ' + {do not localize}
248	<	'FROM RDB$PROCEDURE_PARAMETERS ' + {do not localize}
249	<	'WHERE RDB$PROCEDURE_NAME = ' + {do not localize}
250	<	'''' + FormatIdentifierValue(Database.SQLDialect, FProcName) + '''' +
251	<	' ORDER BY RDB$PARAMETER_NUMBER'; {do not localize}
247	>	if DatabaseInfo.ODSMajorVersion < 12 then
248	>	Query.SQL.Text := 'SELECT RDB$PARAMETER_NAME,  RDB$PARAMETER_TYPE ' + {do not localize}
249	>	'FROM RDB$PROCEDURE_PARAMETERS ' + {do not localize}
250	>	'WHERE RDB$PROCEDURE_NAME = ' + {do not localize}
251	>	'''' + FormatProcName(Database.SQLDialect, FProcName) + '''' +
252	>	' ORDER BY RDB$PARAMETER_NUMBER' {do not localize}
253	>	else
254	>	if FPackageName = '' then
255	>	Query.SQL.Text := 'SELECT RDB$PARAMETER_NAME,  RDB$PARAMETER_TYPE ' + {do not localize}
256	>	'FROM RDB$PROCEDURE_PARAMETERS ' + {do not localize}
257	>	'WHERE RDB$PROCEDURE_NAME = ' + {do not localize}
258	>	'''' + FormatProcName(Database.SQLDialect, FProcName) + '''' +
259	>	'AND RDB$PACKAGE_NAME IS NULL' + {do not localize}
260	>	' ORDER BY RDB$PARAMETER_NUMBER' {do not localize}
261	>	else
262	>	Query.SQL.Text := 'SELECT RDB$PARAMETER_NAME,  RDB$PARAMETER_TYPE ' + {do not localize}
263	>	'FROM RDB$PROCEDURE_PARAMETERS ' + {do not localize}
264	>	'WHERE RDB$PROCEDURE_NAME = ' + {do not localize}
265	>	'''' + FormatProcName(Database.SQLDialect, FProcName) + '''' +
266	>	'AND RDB$PACKAGE_NAME = ' + {do not localize}
267	>	'''' + FormatProcName(Database.SQLDialect, FPackageName) + '''' +
268	>	' ORDER BY RDB$PARAMETER_NUMBER'; {do not localize}
269		Query.Prepare;
270		Query.GoToFirstRecordOnExecute := False;
271		Query.ExecQuery;
#	Line 256 | Line 278 | begin
278		FormatParameter(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString); {do not localize}
279		end
280		end;
281	<	SelectSQL.Text := 'Execute Procedure ' + {do not localize}
282	<	FormatParameter(Database.SQLDialect, FProcName) + ' ' + input;
283	<	{   writeln(SelectSQL.Text);}
281	>	if FPackageName = '' then
282	>	SelectSQL.Text := 'Execute Procedure ' + {do not localize}
283	>	QuoteIdentifierIfNeeded(Database.SQLDialect, FProcName) + ' ' + input
284	>	else
285	>	SelectSQL.Text := 'Execute Procedure ' + {do not localize}
286	>	QuoteIdentifierIfNeeded(Database.SQLDialect,FPackageName) + '.' +
287	>	QuoteIdentifierIfNeeded(Database.SQLDialect, FProcName) + ' ' + input;
288	>	//    writeln(SelectSQL.Text);
289		finally
290		Query.Free;
291		Params.Free;
#	Line 411 | Line 438 | begin
438		FParams.Assign(Value);
439		end;
440
441	+	procedure TIBStoredProc.SetPackageName(AValue: string);
442	+	begin
443	+	if FPackageName = AValue then Exit;
444	+	CheckInactive;
445	+	FPackageName := AValue;
446	+	FProcName := '';
447	+	UpdateQuery;
448	+	end;
449	+
450	+	procedure TIBStoredProc.GetPackageNamesFromServer;
451	+	var
452	+	Query : TIBSQL;
453	+	begin
454	+	ActivateConnection;
455	+	if (csReading in ComponentState) or (DatabaseInfo.ODSMajorVersion < 12) then Exit;
456	+	Database.InternalTransaction.StartTransaction;
457	+	Query := TIBSQL.Create(self);
458	+	try
459	+	Query.GoToFirstRecordOnExecute := False;
460	+	Query.Database := DataBase;
461	+	Query.Transaction := Database.InternalTransaction;
462	+	Query.SQL.Text := 'Select distinct RDB$PACKAGE_NAME from RDB$PROCEDURES Where RDB$PACKAGE_NAME is not null'; {do not localize}
463	+	Query.Prepare;
464	+	Query.ExecQuery;
465	+	while (not Query.EOF) and Query.Next do
466	+	FPackageNameList.Add(TrimRight(Query.Current.ByName('RDB$PACKAGE_NAME').AsString)); {do not localize}
467	+	finally
468	+	Query.Free;
469	+	Database.InternalTransaction.Commit;
470	+	end;
471	+	end;
472	+
473	+	function TIBStoredProc.GetPackageNames: TStrings;
474	+	begin
475	+	FPackageNameList.Clear;
476	+	GetPackageNamesFromServer;
477	+	Result := FPackageNameList;
478	+	end;
479	+
480		function TIBStoredProc.ParamByName(const Value: string): TParam;
481		begin
482		Prepare;
#	Line 436 | Line 502 | begin
502		Query.GoToFirstRecordOnExecute := False;
503		Query.Database := DataBase;
504		Query.Transaction := Database.InternalTransaction;
505	<	Query.SQL.Text := 'Select RDB$PROCEDURE_NAME from RDB$PROCEDURES'; {do not localize}
505	>	if DatabaseInfo.ODSMajorVersion < 12 then
506	>	Query.SQL.Text := 'Select RDB$PROCEDURE_NAME from RDB$PROCEDURES' {do not localize}
507	>	else
508	>	if FPackageName = '' then
509	>	Query.SQL.Text := 'Select RDB$PROCEDURE_NAME from RDB$PROCEDURES Where RDB$PACKAGE_NAME is NULL' {do not localize}
510	>	else
511	>	Query.SQL.Text := 'Select RDB$PROCEDURE_NAME from RDB$PROCEDURES Where RDB$PACKAGE_NAME = ''' + {do not localize}
512	>	SQLSafeString(FPackageName) + '''';
513		Query.Prepare;
514		Query.ExecQuery;
515		while (not Query.EOF) and Query.Next do
#	Line 552 | Line 625 | begin
625		Writer.WriteCollection(Params);
626		end;
627
628	+	procedure TIBStoredProc.UpdateQuery;
629	+	begin
630	+	if not (csReading in ComponentState) then
631	+	begin
632	+	FreeStatement;
633	+	FParams.Clear;
634	+	if (FProcName <> '') and (Database <> nil) then
635	+	begin
636	+	GenerateSQL;
637	+	if csDesigning in ComponentState then
638	+	begin
639	+	Prepare;  {Fills the Params collection}
640	+	UnPrepare;
641	+	end;
642	+	end;
643	+	end
644	+	else
645	+	begin
646	+	if (FProcName <> '') and (Database <> nil) then
647	+	GenerateSQL;
648	+	end;
649	+	end;
650	+
651		procedure TIBStoredProc.ReadParamData(Reader: TReader);
652		begin
653		Reader.ReadValue;

Diff Legend

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