[ViewVC] Diff of: public/ibx/trunk/runtime/IBStoredProc.pas

Comparing ibx/trunk/runtime/IBStoredProc.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 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 - 2018 }
31	+	{ }
32		{************************************************************************}
33
34		unit IBStoredProc;
35
36		{$Mode Delphi}
37
38	+	{$codepage UTF8}
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 57 \| 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;
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 78 \| 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 98 \| Line 112 \| type
112
113		implementation
114
115	<	uses
102	<	IBIntf;
115	>	uses FBMessages;
116
117		{ TIBStoredProc }
118
119		constructor TIBStoredProc.Create(AOwner: TComponent);
120		begin
121		inherited Create(AOwner);
109	–	FIBLoaded := False;
110	–	CheckIBLoaded;
111	–	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;
123	<	FNameList.Destroy;
124	<	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 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 194 \| 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 236 \| 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 371 \| 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 395 \| 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 418 \| 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 426 \| 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 509 \| 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

Comparing ibx/trunk/runtime/IBStoredProc.pas (file contents): Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs. Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

Diff Legend

Comparing ibx/trunk/runtime/IBStoredProc.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC