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

Comparing ibx/trunk/runtime/IBSQL.pas (file contents):
Revision 19 by tony, Mon Jul 7 13:00:15 2014 UTC vs.
Revision 27 by tony, Tue Apr 14 13:10:23 2015 UTC

# Line 79 | Line 79 | uses
79    SysUtils, Classes, Forms, Controls, IBHeader,
80    IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
81  
82 + const
83 +   sSQLErrorSeparator = ' When Executing: ';
84 +
85   type
86    TIBSQL = class;
87    TIBXSQLDA = class;
# Line 97 | Line 100 | type
100      function AdjustScale(Value: Int64; Scale: Integer): Double;
101      function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
102      function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
103 +    function GetAsBoolean: boolean;
104      function GetAsCurrency: Currency;
105      function GetAsInt64: Int64;
106      function GetAsDateTime: TDateTime;
# Line 113 | Line 117 | type
117      function GetIsNullable: Boolean;
118      function GetSize: Integer;
119      function GetSQLType: Integer;
120 +    procedure SetAsBoolean(AValue: boolean);
121      procedure SetAsCurrency(Value: Currency);
122      procedure SetAsInt64(Value: Int64);
123      procedure SetAsDate(Value: TDateTime);
124 +    procedure SetAsLong(Value: Long);
125      procedure SetAsTime(Value: TDateTime);
126      procedure SetAsDateTime(Value: TDateTime);
127      procedure SetAsDouble(Value: Double);
128      procedure SetAsFloat(Value: Float);
123 –    procedure SetAsLong(Value: Long);
129      procedure SetAsPointer(Value: Pointer);
130      procedure SetAsQuad(Value: TISC_QUAD);
131      procedure SetAsShort(Value: Short);
# Line 129 | Line 134 | type
134      procedure SetAsXSQLVAR(Value: PXSQLVAR);
135      procedure SetIsNull(Value: Boolean);
136      procedure SetIsNullable(Value: Boolean);
137 +    procedure xSetAsBoolean(AValue: boolean);
138      procedure xSetAsCurrency(Value: Currency);
139      procedure xSetAsInt64(Value: Int64);
140      procedure xSetAsDate(Value: TDateTime);
# Line 154 | Line 160 | type
160      procedure SaveToFile(const FileName: String);
161      procedure SaveToStream(Stream: TStream);
162      property AsDate: TDateTime read GetAsDateTime write SetAsDate;
163 +    property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
164      property AsTime: TDateTime read GetAsDateTime write SetAsTime;
165      property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
166      property AsDouble: Double read GetAsDouble write SetAsDouble;
# Line 359 | Line 366 | type
366      procedure SetSQL(Value: TStrings);
367      procedure SetTransaction(Value: TIBTransaction);
368      procedure SQLChanging(Sender: TObject);
369 <    procedure BeforeTransactionEnd(Sender: TObject);
369 >    procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
370    public
371      constructor Create(AOwner: TComponent); override;
372      destructor Destroy; override;
# Line 585 | Line 592 | begin
592        result := Value;
593   end;
594  
595 + function TIBXSQLVAR.GetAsBoolean: boolean;
596 + begin
597 +  result := false;
598 +  if not IsNull then
599 +  begin
600 +    if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then
601 +      result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE
602 +    else
603 +      IBError(ibxeInvalidDataConversion, [nil]);
604 +  end
605 + end;
606 +
607   function TIBXSQLVAR.GetAsCurrency: Currency;
608   begin
609    result := 0;
# Line 896 | Line 915 | begin
915            result := AsDouble;
916        SQL_INT64:
917          if FXSQLVAR^.sqlscale = 0 then
918 <          IBError(ibxeInvalidDataConversion, [nil])
918 >          result := AsInt64
919          else if FXSQLVAR^.sqlscale >= (-4) then
920            result := AsCurrency
921          else
922            result := AsDouble;
923        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
924          result := AsDouble;
925 +      SQL_BOOLEAN:
926 +        result := AsBoolean;
927        else
928          IBError(ibxeInvalidDataConversion, [nil]);
929      end;
# Line 991 | Line 1012 | begin
1012    result := FXSQLVAR^.sqltype and (not 1);
1013   end;
1014  
1015 + procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean);
1016 + var
1017 +  i: Integer;
1018 + begin
1019 +  if FUniqueName then
1020 +     xSetAsBoolean(AValue)
1021 +  else
1022 +  for i := 0 to FParent.FCount - 1 do
1023 +    if FParent[i].FName = FName then
1024 +       FParent[i].xSetAsBoolean(AValue);
1025 + end;
1026 +
1027   procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
1028   begin
1029    if IsNullable then
# Line 1398 | Line 1431 | begin
1431      varCurrency:
1432        AsCurrency := Value;
1433      varBoolean:
1434 <      if Value then
1402 <        AsLong := ISC_TRUE
1403 <      else
1404 <        AsLong := ISC_FALSE;
1434 >      AsBoolean := Value;
1435      varDate:
1436        AsDateTime := Value;
1437      varOleStr, varString:
# Line 1528 | Line 1558 | begin
1558         FParent[i].xSetIsNullable(Value);
1559   end;
1560  
1561 + procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean);
1562 + begin
1563 +  if IsNullable then
1564 +    IsNull := False;
1565 +
1566 +  FXSQLVAR^.sqltype := SQL_BOOLEAN;
1567 +  FXSQLVAR^.sqllen := 1;
1568 +  FXSQLVAR^.sqlscale := 0;
1569 +  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1570 +  if AValue then
1571 +    PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE
1572 +  else
1573 +    PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE;
1574 +  FModified := True;
1575 + end;
1576 +
1577   procedure TIBXSQLVAR.Clear;
1578   begin
1579    IsNull := true;
# Line 1721 | Line 1767 | begin
1767  
1768          case sqltype and (not 1) of
1769            SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1770 <          SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1770 >          SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
1771            SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1772              if (sqllen = 0) then
1773                { Make sure you get a valid pointer anyway
# Line 2297 | Line 2343 | begin
2343                             TRHandle,
2344                             @FHandle,
2345                             Database.SQLDialect,
2346 <                           FSQLParams.AsXSQLDA), True)
2346 >                           FSQLParams.AsXSQLDA), True);
2347    end;
2348    if not (csDesigning in ComponentState) then
2349      MonitorHook.SQLExecute(Self);
2350 +  FBase.DoAfterExecQuery(self);
2351 + //  writeln('Rows Affected = ',RowsAffected);
2352   end;
2353  
2354   function TIBSQL.GetEOF: Boolean;
# Line 2412 | Line 2460 | begin
2460         SQLUpdate, SQLDelete])) then
2461      result := ''
2462    else begin
2463 <    info_request := Char(isc_info_sql_get_plan);
2463 >    info_request := isc_info_sql_get_plan;
2464      Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2465                             SizeOf(result_buffer), result_buffer), True);
2466 <    if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then
2466 >    if (result_buffer[0] <> isc_info_sql_get_plan) then
2467        IBError(ibxeUnknownError, [nil]);
2468      result_length := isc_vax_integer(@result_buffer[1], 2);
2469      SetString(result, nil, result_length);
# Line 2432 | Line 2480 | end;
2480  
2481   function TIBSQL.GetRowsAffected: Integer;
2482   var
2435 –  result_buffer: array[0..1048] of Char;
2483    info_request: Char;
2484 +  RB: TResultBuffer;
2485   begin
2486    if not Prepared then
2487      result := -1
2488    else begin
2489 <    info_request := Char(isc_info_sql_records);
2490 <    if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2491 <                         SizeOf(result_buffer), result_buffer) > 0 then
2492 <      IBDatabaseError;
2493 <    if (result_buffer[0] <> Char(isc_info_sql_records)) then
2494 <      result := -1
2495 <    else
2496 <    case SQLType of
2497 <    SQLUpdate:   Result := isc_vax_integer(@result_buffer[6], 4);
2498 <    SQLDelete:   Result := isc_vax_integer(@result_buffer[13], 4);
2499 <    SQLInsert:   Result := isc_vax_integer(@result_buffer[27], 4);
2500 <    else         Result := -1 ;
2501 <    end ;
2489 >    RB := TResultBuffer.Create;
2490 >    try
2491 >      info_request := isc_info_sql_records;
2492 >      if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2493 >                         RB.Size, RB.buffer) > 0 then
2494 >        IBDatabaseError;
2495 >      case SQLType of
2496 >      SQLInsert, SQLUpdate: {Covers Insert or Update as well as individual update}
2497 >        Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count)+
2498 >         RB.GetValue(isc_info_sql_records, isc_info_req_update_count);
2499 >      SQLDelete:
2500 >        Result := RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2501 >      SQLExecProcedure:
2502 >        Result :=  RB.GetValue(isc_info_sql_records, isc_info_req_insert_count) +
2503 >                   RB.GetValue(isc_info_sql_records, isc_info_req_update_count) +
2504 >                   RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2505 >      else
2506 >        Result := 0;
2507 >      end;
2508 >    finally
2509 >      RB.Free;
2510 >    end;
2511    end;
2512   end;
2513  
# Line 2502 | Line 2559 | const
2559    end;
2560  
2561   begin
2562 +  sParamName := '';
2563    slNames := TStringList.Create;
2564    try
2565      { Do some initializations of variables }
# Line 2662 | Line 2720 | begin
2720      { After preparing the statement, query the stmt type and possibly
2721        create a FSQLRecord "holder" }
2722      { Get the type of the statement }
2723 <    type_item := Char(isc_info_sql_stmt_type);
2723 >    type_item := isc_info_sql_stmt_type;
2724      Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2725                           SizeOf(res_buffer), res_buffer), True);
2726 <    if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then
2726 >    if (res_buffer[0] <> isc_info_sql_stmt_type) then
2727        IBError(ibxeUnknownError, [nil]);
2728      stmt_len := isc_vax_integer(@res_buffer[1], 2);
2729      FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
# Line 2710 | Line 2768 | begin
2768      on E: Exception do begin
2769        if (FHandle <> nil) then
2770          FreeHandle;
2771 <      raise;
2771 >      if E is EIBInterBaseError then
2772 >        raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2773 >                                       EIBInterBaseError(E).IBErrorCode,
2774 >                                       EIBInterBaseError(E).Message +
2775 >                                       sSQLErrorSeparator + FProcessedSQL.Text)
2776 >      else
2777 >        raise;
2778      end;
2779    end;
2780   end;
# Line 2748 | Line 2812 | begin
2812    if FHandle <> nil then FreeHandle;
2813   end;
2814  
2815 < procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
2815 > procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
2816 >  Action: TTransactionAction);
2817   begin
2818    if (FOpen) then
2819      Close;

Diff Legend

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