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 45 by tony, Tue Dec 6 10:33:46 2016 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	<	uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL, IB,
34	<	IBDatabase, IBCustomDataSet, IBHeader, IBSQL, IBUtils;
38	>	{$codepage UTF8}
39
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;
42	<	FStmtHandle: TISC_STMT_HANDLE;
50	>	FStmtHandle: IStatement;
51		FProcName: string;
52		FParams: TParams;
53		FPrepared: Boolean;
#	Line 57 | Line 65 | type
65		procedure WriteParamData(Writer: TWriter);
66
67		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;
68
69		procedure DefineProperties(Filer: TFiler); override;
70		procedure SetFiltered(Value: Boolean); override;
71	+	procedure InitFieldDefs; override;
72		function GetParamsCount: Word;
73		procedure SetPrepared(Value: Boolean);
74		procedure SetPrepare(Value: Boolean);
#	Line 82 | Line 85 | type
85		procedure Prepare;
86		procedure UnPrepare;
87		property ParamCount: Word read GetParamsCount;
88	<	property StmtHandle: TISC_STMT_HANDLE read FStmtHandle;
88	>	property StmtHandle: IStatement read FStmtHandle;
89		property Prepared: Boolean read FPrepared write SetPrepare;
90		property StoredProcedureNames: TStrings read GetStoredProcedureNames;
91
#	Line 102 | Line 105 | type
105
106		implementation
107
108	<	uses
106	<	IBIntf;
108	>	uses  FBMessages;
109
110		{ TIBStoredProc }
111
112		constructor TIBStoredProc.Create(AOwner: TComponent);
113		begin
114		inherited Create(AOwner);
113	–	FIBLoaded := False;
114	–	CheckIBLoaded;
115	–	FIBLoaded := True;
115		FParams := TParams.Create (self);
116		FNameList := TStringList.Create;
117		end;
118
119		destructor TIBStoredProc.Destroy;
120		begin
121	<	if FIBLoaded then
122	<	begin
123	<	Destroying;
124	<	Disconnect;
126	<	FParams.Free;
127	<	FNameList.Destroy;
128	<	end;
121	>	Destroying;
122	>	Disconnect;
123	>	if assigned (FParams) then FParams.Free;
124	>	if assigned(FNameList) then FNameList.Destroy;
125		inherited Destroy;
126		end;
127
#	Line 198 | Line 194 | begin
194		inherited SetFiltered(value);
195		end;
196
197	+	procedure TIBStoredProc.InitFieldDefs;
198	+	begin
199	+	if SelectSQL.Text = '' then
200	+	GenerateSQL;
201	+	inherited InitFieldDefs;
202	+	end;
203	+
204		procedure TIBStoredProc.GenerateSQL;
205	+
206	+	var Params: TStringList;
207	+
208	+	function FormatParameter(Dialect: Integer; Value: String): String;
209	+	var j: integer;
210	+	begin
211	+	Value := Trim(Value);
212	+	if Dialect = 1 then
213	+	Result := AnsiUpperCase(Value)
214	+	else
215	+	begin
216	+	j := 1;
217	+	Value := Space2Underscore(AnsiUpperCase(Value));
218	+	Result := Value;
219	+	while Params.IndexOf(Result) <> -1 do
220	+	begin
221	+	Result := Value + IntToStr(j);
222	+	Inc(j)
223	+	end;
224	+	Params.Add(Result)
225	+	end;
226	+	end;
227	+
228		var
229		Query : TIBSQL;
230		input : string;
231		begin
232	+	input := '';
233	+	if FProcName = '' then
234	+	IBError(ibxeNoStoredProcName,[nil]);
235		ActivateConnection;
236		Database.InternalTransaction.StartTransaction;
237	+	Params := TStringList.Create;
238		Query := TIBSQL.Create(self);
239		try
240		Query.Database := DataBase;
#	Line 217 | Line 247 | begin
247		Query.Prepare;
248		Query.GoToFirstRecordOnExecute := False;
249		Query.ExecQuery;
250	<	while (not Query.EOF) and (Query.Next <> nil) do begin
251	<	if (Query.Current.ByName('RDB$PARAMETER_TYPE').AsInteger = 0) then begin {do not localize}
250	>	while (not Query.EOF) and Query.Next do begin
251	>	if (Query.FieldByName('RDB$PARAMETER_TYPE').AsInteger = 0) then begin {do not localize}
252		if (input <> '') then
253		input := input + ', :' +
254	<	FormatIdentifier(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString) else {do not localize}
254	>	FormatParameter(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString) else {do not localize}
255		input := ':' +
256	<	FormatIdentifier(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString); {do not localize}
256	>	FormatParameter(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString); {do not localize}
257		end
258		end;
259		SelectSQL.Text := 'Execute Procedure ' + {do not localize}
260	<	FormatIdentifier(Database.SQLDialect, FProcName) + ' ' + input;
260	>	FormatParameter(Database.SQLDialect, FProcName) + ' ' + input;
261	>	{   writeln(SelectSQL.Text);}
262		finally
263		Query.Free;
264	+	Params.Free;
265		Database.InternalTransaction.Commit;
266		end;
267		end;
#	Line 240 | Line 272 | var
272		DataType : TFieldType;
273		begin
274		DataType := ftUnknown;
275	<	for i := 0 to QSelect.Current.Count - 1 do begin
276	<	case QSelect.Fields[i].SQLtype of
275	>	for i := 0 to QSelect.MetaData.Count - 1 do begin
276	>	case QSelect.MetaData[i].SQLtype of
277		SQL_TYPE_DATE: DataType := ftDate;
278		SQL_TYPE_TIME: DataType := ftTime;
279		SQL_TIMESTAMP: DataType := ftDateTime;
280		SQL_SHORT:
281	<	if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale = 0) then
281	>	if QSelect.MetaData[i].getScale = 0 then
282		DataType := ftSmallInt
283		else
284		DataType := ftBCD;
285		SQL_LONG:
286	<	if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale = 0) then
286	>	if QSelect.MetaData[i].getScale = 0 then
287		DataType := ftInteger
288	<	else if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale >= (-4)) then
288	>	else if QSelect.MetaData[i].getScale >= -4 then
289		DataType := ftBCD
290		else
291		DataType := ftFloat;
292		SQL_INT64:
293	<	if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale = 0) then
293	>	if QSelect.MetaData[i].getScale = 0 then
294		DataType := ftLargeInt
295	<	else if ((QSelect.Fields[i].AsXSQLVar)^.sqlscale >= (-4)) then
295	>	else if QSelect.MetaData[i].getScale >= -4 then
296		DataType := ftBCD
297		else
298		DataType := ftFloat;
299		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: DataType := ftFloat;
300	+	SQL_BOOLEAN:
301	+	DataType := ftBoolean;
302		SQL_TEXT: DataType := ftString;
303		SQL_VARYING:
304	<	if ((QSelect.Fields[i].AsXSQLVar)^.sqllen < 1024) then
304	>	if QSelect.MetaData[i].GetSize < 1024 then
305		DataType := ftString
306		else DataType := ftBlob;
307		SQL_BLOB, SQL_ARRAY, SQL_QUAD: DataType := ftBlob;
308		end;
309	<	FParams.CreateParam(DataType, Trim(QSelect.Fields[i].Name), ptOutput);
309	>	FParams.CreateParam(DataType, Trim(QSelect.MetaData[i].Name), ptOutput);
310		end;
311
312		DataType := ftUnknown;
313		for i := 0 to QSelect.Params.Count - 1 do begin
314	<	case QSelect.Params[i].SQLtype of
314	>	case QSelect.Params[i].GetSQLtype of
315		SQL_TYPE_DATE: DataType := ftDate;
316		SQL_TYPE_TIME: DataType := ftTime;
317		SQL_TIMESTAMP: DataType := ftDateTime;
318		SQL_SHORT:
319	<	if ((QSelect.Params[i].AsXSQLVar)^.sqlscale = 0) then
319	>	if QSelect.Params[i].getScale = 0 then
320		DataType := ftSmallInt
321		else
322		DataType := ftBCD;
323		SQL_LONG:
324	<	if ((QSelect.Params[i].AsXSQLVar)^.sqlscale = 0) then
324	>	if QSelect.Params[i].getScale = 0 then
325		DataType := ftInteger
326	<	else if ((QSelect.Params[i].AsXSQLVar)^.sqlscale >= (-4)) then
326	>	else if QSelect.Params[i].getScale >= -4 then
327		DataType := ftBCD
328		else DataType := ftFloat;
329		SQL_INT64:
330	<	if ((QSelect.Params[i].AsXSQLVar)^.sqlscale = 0) then
330	>	if QSelect.Params[i].getScale = 0 then
331		DataType := ftLargeInt
332	<	else if ((QSelect.Params[i].AsXSQLVar)^.sqlscale >= (-4)) then
332	>	else if QSelect.Params[i].getScale >= -4 then
333		DataType := ftBCD
334		else DataType := ftFloat;
335		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: DataType := ftFloat;
336	+	SQL_BOOLEAN:
337	+	DataType := ftBoolean;
338		SQL_TEXT: DataType := ftString;
339		SQL_VARYING:
340	<	if ((QSelect.Params[i].AsXSQLVar)^.sqllen < 1024) then
340	>	if QSelect.Params[i].GetSize < 1024 then
341		DataType := ftString
342		else DataType := ftBlob;
343		SQL_BLOB, SQL_ARRAY, SQL_QUAD: DataType := ftBlob;
#	Line 377 | Line 413 | end;
413
414		function TIBStoredProc.ParamByName(const Value: string): TParam;
415		begin
416	+	Prepare;
417		Result := FParams.ParamByName(Value);
418		end;
419
#	Line 402 | Line 439 | begin
439		Query.SQL.Text := 'Select RDB$PROCEDURE_NAME from RDB$PROCEDURES'; {do not localize}
440		Query.Prepare;
441		Query.ExecQuery;
442	<	while (not Query.EOF) and (Query.Next <> nil) do
442	>	while (not Query.EOF) and Query.Next do
443		FNameList.Add(TrimRight(Query.Current.ByName('RDB$PROCEDURE_NAME').AsString)); {do not localize}
444		finally
445		Query.Free;
#	Line 422 | Line 459 | begin
459		if (Params[j].ParamType <> ptInput) then
460		continue;
461		if not Params[j].Bound then
462	<	IBError(ibxeRequiredParamNotSet, [nil]);
462	>	IBError(ibxeRequiredParamNotSet, [Params[j].Name]);
463		if Params[j].IsNull then
464		SQLParams[i].IsNull := True
465		else begin
#	Line 430 | Line 467 | begin
467		case Params[j].DataType of
468		ftString:
469		SQLParams[i].AsString := Params[j].AsString;
470	<	ftBoolean, ftSmallint, ftWord:
470	>	ftSmallint, ftWord:
471		SQLParams[i].AsShort := Params[j].AsSmallInt;
472	+	ftBoolean:
473	+	SQLParams[i].AsBoolean := Params[j].AsBoolean;
474		ftInteger:
475		SQLParams[i].AsLong := Params[j].AsInteger;
476	<	{        ftLargeInt:
477	<	SQLParams[i].AsInt64 := Params[j].AsLargeInt; }
476	>	ftLargeInt:
477	>	SQLParams[i].AsInt64 := Params[j].AsLargeInt;
478		ftFloat, ftCurrency:
479		SQLParams[i].AsDouble := Params[j].AsFloat;
480		ftBCD:
#	Line 519 | Line 558 | begin
558		Reader.ReadCollection(Params);
559		end;
560
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;
537	–	begin
538	–	{ ! }
539	–	end;
540	–
541	–	procedure TIBStoredProc.PSExecute;
542	–	begin
543	–	ExecProc;
544	–	end;
545	–
546	–	procedure TIBStoredProc.PSSetCommandText(const CommandText: string);
547	–	begin
548	–	if CommandText <> '' then
549	–	StoredProcName := CommandText;
550	–	end;
551	–
561		end.

Diff Legend

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