ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBStoredProc.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBStoredProc.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 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   {$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;
44 <    FStmtHandle: TISC_STMT_HANDLE;
50 >    FStmtHandle: IStatement;
51      FProcName: string;
52      FParams: TParams;
53      FPrepared: Boolean;
# Line 62 | Line 68 | type
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 78 | 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 98 | Line 105 | type
105  
106   implementation
107  
108 < uses
102 <   IBIntf;
108 > uses  FBMessages;
109  
110   { TIBStoredProc }
111  
112   constructor TIBStoredProc.Create(AOwner: TComponent);
113   begin
114    inherited Create(AOwner);
109 –  FIBLoaded := False;
110 –  CheckIBLoaded;
111 –  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;
122 <    FParams.Free;
123 <    FNameList.Destroy;
124 <  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 194 | 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 213 | 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 236 | 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 373 | 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 398 | 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 418 | 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 426 | 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:

Diff Legend

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