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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 107 by tony, Thu Jan 18 14:37:40 2018 UTC

#	Line 24 | Line 24
24		{       Corporation. All Rights Reserved.                                }
25		{    Contributor(s): Jeff Overcash                                       }
26		{                                                                        }
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                                                 }
31	+	{                                                                        }
32		{************************************************************************}
33
34		unit IBStoredProc;
35
36	<	interface
36	>	{$Mode Delphi}
37	>
38	>	{$codepage UTF8}
39
40	<	uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL, IB,
34	<	IBDatabase, IBCustomDataSet, IBHeader, IBSQL, IBUtils;
40	>	interface
41
42	+	uses SysUtils, Classes, DB, IB, IBDatabase, IBCustomDataSet,
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 55 | Line 68 | type
68		procedure FetchDataIntoOutputParams;
69		procedure ReadParamData(Reader: TReader);
70		procedure WriteParamData(Writer: TWriter);
71	<
71	>	procedure UpdateQuery;
72		protected
60	–	{ IProviderSupport }
61	–	procedure PSExecute; override;
62	–	function PSGetTableName: string; override;
63	–	function PSGetParams: TParams; override;
64	–	procedure PSSetCommandText(const CommandText: string); override;
65	–	procedure PSSetParams(AParams: TParams); override;
73
74		procedure DefineProperties(Filer: TFiler); override;
75		procedure SetFiltered(Value: Boolean); override;
76	+	procedure InitFieldDefs; override;
77		function GetParamsCount: Word;
78		procedure SetPrepared(Value: Boolean);
79		procedure SetPrepare(Value: Boolean);
#	Line 82 | 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 102 | Line 112 | type
112
113		implementation
114
115	<	uses
106	<	IBIntf;
115	>	uses  FBMessages;
116
117		{ TIBStoredProc }
118
119		constructor TIBStoredProc.Create(AOwner: TComponent);
120		begin
121		inherited Create(AOwner);
113	–	FIBLoaded := False;
114	–	CheckIBLoaded;
115	–	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;
127	<	FNameList.Destroy;
128	<	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 158 | 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
165	<	begin
166	<	FProcName := Value;
167	<	FreeStatement;
168	<	FParams.Clear;
169	<	if (Value <> '') and
170	<	(Database <> nil) then
171	<	GenerateSQL;
172	<	end;
173	<	end else begin
174	<	FProcName := Value;
175	<	if (Value <> '') and
176	<	(Database <> nil) then
177	<	GenerateSQL;
178	<	end;
166	>	if Value = FProcName then Exit;
167	>	CheckInactive;
168	>	FProcName := Value;
169	>	UpdateQuery;
170		end;
171
172		function TIBStoredProc.GetParamsCount: Word;
#	Line 198 | Line 189 | begin
189		inherited SetFiltered(value);
190		end;
191
192	+	procedure TIBStoredProc.InitFieldDefs;
193	+	begin
194	+	if (SelectSQL.Text = '') and (FProcName <> '') and (Database <> nil) then
195	+	GenerateSQL;
196	+	inherited InitFieldDefs;
197	+	end;
198	+
199		procedure TIBStoredProc.GenerateSQL;
200	+
201	+	var Params: TStringList;
202	+
203	+	function FormatParameter(Dialect: Integer; Value: String): String;
204	+	var j: integer;
205	+	begin
206	+	Value := Trim(Value);
207	+	if Dialect = 1 then
208	+	Result := AnsiUpperCase(Value)
209	+	else
210	+	begin
211	+	j := 1;
212	+	Value := Space2Underscore(AnsiUpperCase(Value));
213	+	Result := Value;
214	+	while Params.IndexOf(Result) <> -1 do
215	+	begin
216	+	Result := Value + IntToStr(j);
217	+	Inc(j)
218	+	end;
219	+	Params.Add(Result)
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;
236		begin
237	+	input := '';
238	+	if FProcName = '' then
239	+	IBError(ibxeNoStoredProcName,[nil]);
240		ActivateConnection;
241		Database.InternalTransaction.StartTransaction;
242	+	Params := TStringList.Create;
243		Query := TIBSQL.Create(self);
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	<	FormatIdentifier(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString) else {do not localize}
276	>	FormatParameter(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString) else {do not localize}
277		input := ':' +
278	<	FormatIdentifier(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString); {do not localize}
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	<	FormatIdentifier(Database.SQLDialect, FProcName) + ' ' + input;
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;
292		Database.InternalTransaction.Commit;
293		end;
294		end;
#	Line 240 | 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;
326		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: DataType := ftFloat;
327	+	SQL_BOOLEAN:
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;
363	+	SQL_BOOLEAN:
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 375 | 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;
483		Result := FParams.ParamByName(Value);
484		end;
485
#	Line 399 | 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 422 | Line 532 | begin
532		if (Params[j].ParamType <> ptInput) then
533		continue;
534		if not Params[j].Bound then
535	<	IBError(ibxeRequiredParamNotSet, [nil]);
535	>	IBError(ibxeRequiredParamNotSet, [Params[j].Name]);
536		if Params[j].IsNull then
537		SQLParams[i].IsNull := True
538		else begin
#	Line 430 | Line 540 | begin
540		case Params[j].DataType of
541		ftString:
542		SQLParams[i].AsString := Params[j].AsString;
543	<	ftBoolean, ftSmallint, ftWord:
543	>	ftSmallint, ftWord:
544		SQLParams[i].AsShort := Params[j].AsSmallInt;
545	+	ftBoolean:
546	+	SQLParams[i].AsBoolean := Params[j].AsBoolean;
547		ftInteger:
548		SQLParams[i].AsLong := Params[j].AsInteger;
549	<	{        ftLargeInt:
550	<	SQLParams[i].AsInt64 := Params[j].AsLargeInt; }
549	>	ftLargeInt:
550	>	SQLParams[i].AsInt64 := Params[j].AsLargeInt;
551		ftFloat, ftCurrency:
552		SQLParams[i].AsDouble := Params[j].AsFloat;
553		ftBCD:
#	Line 513 | Line 625 | begin
625		Writer.WriteCollection(Params);
626		end;
627
628	<	procedure TIBStoredProc.ReadParamData(Reader: TReader);
517	<	begin
518	<	Reader.ReadValue;
519	<	Reader.ReadCollection(Params);
520	<	end;
521	<
522	<	{ TIBStoredProc IProviderSupport }
523	<
524	<	function TIBStoredProc.PSGetParams: TParams;
525	<	begin
526	<	Result := Params;
527	<	end;
528	<
529	<	procedure TIBStoredProc.PSSetParams(AParams: TParams);
530	<	begin
531	<	if AParams.Count > 0 then
532	<	Params.Assign(AParams);
533	<	Close;
534	<	end;
535	<
536	<	function TIBStoredProc.PSGetTableName: string;
628	>	procedure TIBStoredProc.UpdateQuery;
629		begin
630	<	{ ! }
631	<	end;
632	<
633	<	procedure TIBStoredProc.PSExecute;
634	<	begin
635	<	ExecProc;
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.PSSetCommandText(const CommandText: string);
651	>	procedure TIBStoredProc.ReadParamData(Reader: TReader);
652		begin
653	<	if CommandText <> '' then
654	<	StoredProcName := CommandText;
653	>	Reader.ReadValue;
654	>	Reader.ReadCollection(Params);
655		end;
656
657		end.

Diff Legend

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