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 39 by tony, Tue May 17 08:14:52 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 35 | Line 35 | unit IBStoredProc;
35
36		{$Mode Delphi}
37
38	–	{$IF FPC_FULLVERSION >= 20700 }
38		{$codepage UTF8}
40	–	{$ENDIF}
39
40		interface
41
42		uses SysUtils, Classes, DB, IB, IBDatabase, IBCustomDataSet,
43	<	IBHeader, IBSQL, IBUtils;
43	>	IBSQL, IBUtils;
44
45		{ TIBStoredProc }
46		type
47
48		TIBStoredProc = class(TIBCustomDataSet)
49		private
50	<	FIBLoaded: Boolean;
51	<	FStmtHandle: TISC_STMT_HANDLE;
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 66 | 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 90 | type
90		procedure Prepare;
91		procedure UnPrepare;
92		property ParamCount: Word read GetParamsCount;
93	<	property StmtHandle: TISC_STMT_HANDLE read FStmtHandle;
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 108 | Line 112 | type
112
113		implementation
114
115	<	uses
112	<	IBIntf;
115	>	uses  FBMessages;
116
117		{ TIBStoredProc }
118
119		constructor TIBStoredProc.Create(AOwner: TComponent);
120		begin
121		inherited Create(AOwner);
119	–	FIBLoaded := False;
120	–	CheckIBLoaded;
121	–	FIBLoaded := True;
122		FParams := TParams.Create (self);
123		FNameList := TStringList.Create;
124	+	FPackageNameList := TStringList.Create;
125		end;
126
127		destructor TIBStoredProc.Destroy;
128		begin
129	<	if FIBLoaded then
130	<	begin
131	<	Destroying;
132	<	Disconnect;
133	<	FParams.Free;
133	<	FNameList.Destroy;
134	<	end;
129	>	Destroying;
130	>	Disconnect;
131	>	if assigned (FParams) then FParams.Free;
132	>	if assigned(FNameList) then FNameList.Free;
133	>	if assigned(FPackageNameList) then FPackageNameList.Free;
134		inherited Destroy;
135		end;
136
#	Line 164 | 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
171	<	begin
172	<	FProcName := Value;
173	<	FreeStatement;
174	<	FParams.Clear;
175	<	if (Value <> '') and
176	<	(Database <> nil) then
177	<	GenerateSQL;
178	<	end;
179	<	end else begin
180	<	FProcName := Value;
181	<	if (Value <> '') and
182	<	(Database <> nil) then
183	<	GenerateSQL;
184	<	end;
166	>	if Value = FProcName then Exit;
167	>	CheckInactive;
168	>	FProcName := Value;
169	>	UpdateQuery;
170		end;
171
172		function TIBStoredProc.GetParamsCount: Word;
#	Line 206 | 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 235 | 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 249 | 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;
272	<	while (not Query.EOF) and (Query.Next <> nil) do begin
273	<	if (Query.Current.ByName('RDB$PARAMETER_TYPE').AsInteger = 0) then begin {do not localize}
272	>	while (not Query.EOF) and Query.Next do begin
273	>	if (Query.FieldByName('RDB$PARAMETER_TYPE').AsInteger = 0) then begin {do not localize}
274		if (input <> '') then
275		input := input + ', :' +
276		FormatParameter(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString) else {do not localize}
#	Line 266 | 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 282 | Line 299 | var
299		DataType : TFieldType;
300		begin
301		DataType := ftUnknown;
302	<	for i := 0 to QSelect.Current.Count - 1 do begin
303	<	case QSelect.Fields[i].SQLtype of
302	>	for i := 0 to QSelect.MetaData.Count - 1 do begin
303	>	case QSelect.MetaData[i].SQLtype of
304		SQL_TYPE_DATE: DataType := ftDate;
305		SQL_TYPE_TIME: DataType := ftTime;
306		SQL_TIMESTAMP: DataType := ftDateTime;
307		SQL_SHORT:
308	<	if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale = 0) then
308	>	if QSelect.MetaData[i].getScale = 0 then
309		DataType := ftSmallInt
310		else
311		DataType := ftBCD;
312		SQL_LONG:
313	<	if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale = 0) then
313	>	if QSelect.MetaData[i].getScale = 0 then
314		DataType := ftInteger
315	<	else if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale >= (-4)) then
315	>	else if QSelect.MetaData[i].getScale >= -4 then
316		DataType := ftBCD
317		else
318		DataType := ftFloat;
319		SQL_INT64:
320	<	if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale = 0) then
320	>	if QSelect.MetaData[i].getScale = 0 then
321		DataType := ftLargeInt
322	<	else if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale >= (-4)) then
322	>	else if QSelect.MetaData[i].getScale >= -4 then
323		DataType := ftBCD
324		else
325		DataType := ftFloat;
#	Line 311 | Line 328 | begin
328		DataType := ftBoolean;
329		SQL_TEXT: DataType := ftString;
330		SQL_VARYING:
331	<	if ((QSelect.Fields[i].AsXSQLVar)^.sqllen < 1024) then
331	>	if QSelect.MetaData[i].GetSize < 1024 then
332		DataType := ftString
333		else DataType := ftBlob;
334		SQL_BLOB, SQL_ARRAY, SQL_QUAD: DataType := ftBlob;
335		end;
336	<	FParams.CreateParam(DataType, Trim(QSelect.Fields[i].Name), ptOutput);
336	>	FParams.CreateParam(DataType, Trim(QSelect.MetaData[i].Name), ptOutput);
337		end;
338
339		DataType := ftUnknown;
340		for i := 0 to QSelect.Params.Count - 1 do begin
341	<	case QSelect.Params[i].SQLtype of
341	>	case QSelect.Params[i].GetSQLtype of
342		SQL_TYPE_DATE: DataType := ftDate;
343		SQL_TYPE_TIME: DataType := ftTime;
344		SQL_TIMESTAMP: DataType := ftDateTime;
345		SQL_SHORT:
346	<	if ((QSelect.Params[i].AsXSQLVar)^.sqlscale = 0) then
346	>	if QSelect.Params[i].getScale = 0 then
347		DataType := ftSmallInt
348		else
349		DataType := ftBCD;
350		SQL_LONG:
351	<	if ((QSelect.Params[i].AsXSQLVar)^.sqlscale = 0) then
351	>	if QSelect.Params[i].getScale = 0 then
352		DataType := ftInteger
353	<	else if ((QSelect.Params[i].AsXSQLVar)^.sqlscale >= (-4)) then
353	>	else if QSelect.Params[i].getScale >= -4 then
354		DataType := ftBCD
355		else DataType := ftFloat;
356		SQL_INT64:
357	<	if ((QSelect.Params[i].AsXSQLVar)^.sqlscale = 0) then
357	>	if QSelect.Params[i].getScale = 0 then
358		DataType := ftLargeInt
359	<	else if ((QSelect.Params[i].AsXSQLVar)^.sqlscale >= (-4)) then
359	>	else if QSelect.Params[i].getScale >= -4 then
360		DataType := ftBCD
361		else DataType := ftFloat;
362		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: DataType := ftFloat;
#	Line 347 | Line 364 | begin
364		DataType := ftBoolean;
365		SQL_TEXT: DataType := ftString;
366		SQL_VARYING:
367	<	if ((QSelect.Params[i].AsXSQLVar)^.sqllen < 1024) then
367	>	if QSelect.Params[i].GetSize < 1024 then
368		DataType := ftString
369		else DataType := ftBlob;
370		SQL_BLOB, SQL_ARRAY, SQL_QUAD: DataType := ftBlob;
#	Line 421 | 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 446 | 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 <> nil) do
515	>	while (not Query.EOF) and Query.Next do
516		FNameList.Add(TrimRight(Query.Current.ByName('RDB$PROCEDURE_NAME').AsString)); {do not localize}
517		finally
518		Query.Free;
#	Line 562 | 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