| 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, |
| 39 |
< |
IBDatabase, IBCustomDataSet, IBHeader, IBSQL, IBUtils; |
| 38 |
> |
{$IF FPC_FULLVERSION >= 20700 } |
| 39 |
> |
{$codepage UTF8} |
| 40 |
> |
{$ENDIF} |
| 41 |
> |
|
| 42 |
> |
interface |
| 43 |
|
|
| 44 |
+ |
uses SysUtils, Classes, DB, IB, IBDatabase, IBCustomDataSet, |
| 45 |
+ |
IBHeader, IBSQL, IBUtils; |
| 46 |
+ |
|
| 47 |
|
{ TIBStoredProc } |
| 48 |
|
type |
| 49 |
|
|
| 68 |
|
procedure WriteParamData(Writer: TWriter); |
| 69 |
|
|
| 70 |
|
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; |
| 71 |
|
|
| 72 |
|
procedure DefineProperties(Filer: TFiler); override; |
| 73 |
|
procedure SetFiltered(Value: Boolean); override; |
| 74 |
+ |
procedure InitFieldDefs; override; |
| 75 |
|
function GetParamsCount: Word; |
| 76 |
|
procedure SetPrepared(Value: Boolean); |
| 77 |
|
procedure SetPrepare(Value: Boolean); |
| 204 |
|
inherited SetFiltered(value); |
| 205 |
|
end; |
| 206 |
|
|
| 207 |
+ |
procedure TIBStoredProc.InitFieldDefs; |
| 208 |
+ |
begin |
| 209 |
+ |
if SelectSQL.Text = '' then |
| 210 |
+ |
GenerateSQL; |
| 211 |
+ |
inherited InitFieldDefs; |
| 212 |
+ |
end; |
| 213 |
+ |
|
| 214 |
|
procedure TIBStoredProc.GenerateSQL; |
| 215 |
+ |
|
| 216 |
+ |
var Params: TStringList; |
| 217 |
+ |
|
| 218 |
+ |
function FormatParameter(Dialect: Integer; Value: String): String; |
| 219 |
+ |
var j: integer; |
| 220 |
+ |
begin |
| 221 |
+ |
Value := Trim(Value); |
| 222 |
+ |
if Dialect = 1 then |
| 223 |
+ |
Result := AnsiUpperCase(Value) |
| 224 |
+ |
else |
| 225 |
+ |
begin |
| 226 |
+ |
j := 1; |
| 227 |
+ |
Value := Space2Underscore(AnsiUpperCase(Value)); |
| 228 |
+ |
Result := Value; |
| 229 |
+ |
while Params.IndexOf(Result) <> -1 do |
| 230 |
+ |
begin |
| 231 |
+ |
Result := Value + IntToStr(j); |
| 232 |
+ |
Inc(j) |
| 233 |
+ |
end; |
| 234 |
+ |
Params.Add(Result) |
| 235 |
+ |
end; |
| 236 |
+ |
end; |
| 237 |
+ |
|
| 238 |
|
var |
| 239 |
|
Query : TIBSQL; |
| 240 |
|
input : string; |
| 241 |
|
begin |
| 242 |
+ |
input := ''; |
| 243 |
+ |
if FProcName = '' then |
| 244 |
+ |
IBError(ibxeNoStoredProcName,[nil]); |
| 245 |
|
ActivateConnection; |
| 246 |
|
Database.InternalTransaction.StartTransaction; |
| 247 |
+ |
Params := TStringList.Create; |
| 248 |
|
Query := TIBSQL.Create(self); |
| 249 |
|
try |
| 250 |
|
Query.Database := DataBase; |
| 261 |
|
if (Query.Current.ByName('RDB$PARAMETER_TYPE').AsInteger = 0) then begin {do not localize} |
| 262 |
|
if (input <> '') then |
| 263 |
|
input := input + ', :' + |
| 264 |
< |
FormatIdentifier(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString) else {do not localize} |
| 264 |
> |
FormatParameter(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString) else {do not localize} |
| 265 |
|
input := ':' + |
| 266 |
< |
FormatIdentifier(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString); {do not localize} |
| 266 |
> |
FormatParameter(Database.SQLDialect, Query.Current.ByName('RDB$PARAMETER_NAME').AsString); {do not localize} |
| 267 |
|
end |
| 268 |
|
end; |
| 269 |
|
SelectSQL.Text := 'Execute Procedure ' + {do not localize} |
| 270 |
< |
FormatIdentifier(Database.SQLDialect, FProcName) + ' ' + input; |
| 270 |
> |
FormatParameter(Database.SQLDialect, FProcName) + ' ' + input; |
| 271 |
> |
{ writeln(SelectSQL.Text);} |
| 272 |
|
finally |
| 273 |
|
Query.Free; |
| 274 |
+ |
Params.Free; |
| 275 |
|
Database.InternalTransaction.Commit; |
| 276 |
|
end; |
| 277 |
|
end; |
| 307 |
|
else |
| 308 |
|
DataType := ftFloat; |
| 309 |
|
SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: DataType := ftFloat; |
| 310 |
+ |
SQL_BOOLEAN: |
| 311 |
+ |
DataType := ftBoolean; |
| 312 |
|
SQL_TEXT: DataType := ftString; |
| 313 |
|
SQL_VARYING: |
| 314 |
|
if ((QSelect.Fields[i].AsXSQLVar)^.sqllen < 1024) then |
| 343 |
|
DataType := ftBCD |
| 344 |
|
else DataType := ftFloat; |
| 345 |
|
SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: DataType := ftFloat; |
| 346 |
+ |
SQL_BOOLEAN: |
| 347 |
+ |
DataType := ftBoolean; |
| 348 |
|
SQL_TEXT: DataType := ftString; |
| 349 |
|
SQL_VARYING: |
| 350 |
|
if ((QSelect.Params[i].AsXSQLVar)^.sqllen < 1024) then |
| 423 |
|
|
| 424 |
|
function TIBStoredProc.ParamByName(const Value: string): TParam; |
| 425 |
|
begin |
| 426 |
+ |
Prepare; |
| 427 |
|
Result := FParams.ParamByName(Value); |
| 428 |
|
end; |
| 429 |
|
|
| 469 |
|
if (Params[j].ParamType <> ptInput) then |
| 470 |
|
continue; |
| 471 |
|
if not Params[j].Bound then |
| 472 |
< |
IBError(ibxeRequiredParamNotSet, [nil]); |
| 472 |
> |
IBError(ibxeRequiredParamNotSet, [Params[j].Name]); |
| 473 |
|
if Params[j].IsNull then |
| 474 |
|
SQLParams[i].IsNull := True |
| 475 |
|
else begin |
| 477 |
|
case Params[j].DataType of |
| 478 |
|
ftString: |
| 479 |
|
SQLParams[i].AsString := Params[j].AsString; |
| 480 |
< |
ftBoolean, ftSmallint, ftWord: |
| 480 |
> |
ftSmallint, ftWord: |
| 481 |
|
SQLParams[i].AsShort := Params[j].AsSmallInt; |
| 482 |
+ |
ftBoolean: |
| 483 |
+ |
SQLParams[i].AsBoolean := Params[j].AsBoolean; |
| 484 |
|
ftInteger: |
| 485 |
|
SQLParams[i].AsLong := Params[j].AsInteger; |
| 486 |
< |
{ ftLargeInt: |
| 487 |
< |
SQLParams[i].AsInt64 := Params[j].AsLargeInt; } |
| 486 |
> |
ftLargeInt: |
| 487 |
> |
SQLParams[i].AsInt64 := Params[j].AsLargeInt; |
| 488 |
|
ftFloat, ftCurrency: |
| 489 |
|
SQLParams[i].AsDouble := Params[j].AsFloat; |
| 490 |
|
ftBCD: |
| 568 |
|
Reader.ReadCollection(Params); |
| 569 |
|
end; |
| 570 |
|
|
| 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 |
– |
|
| 571 |
|
end. |
