| 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; |
| 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; |
| 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); |
| 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); |
| 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; |
| 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; |
| 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; |
| 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 |
| 1561 |
|
FParent[i].xSetIsNullable(Value); |
| 1562 |
|
end; |
| 1563 |
|
|
| 1564 |
+ |
procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean); |
| 1565 |
+ |
begin |
| 1566 |
+ |
if IsNullable then |
| 1567 |
+ |
IsNull := False; |
| 1568 |
+ |
|
| 1569 |
+ |
FXSQLVAR^.sqltype := SQL_BOOLEAN; |
| 1570 |
+ |
FXSQLVAR^.sqllen := 1; |
| 1571 |
+ |
FXSQLVAR^.sqlscale := 0; |
| 1572 |
+ |
IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen); |
| 1573 |
+ |
if AValue then |
| 1574 |
+ |
PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE |
| 1575 |
+ |
else |
| 1576 |
+ |
PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE; |
| 1577 |
+ |
FModified := True; |
| 1578 |
+ |
end; |
| 1579 |
+ |
|
| 1580 |
|
procedure TIBXSQLVAR.Clear; |
| 1581 |
|
begin |
| 1582 |
|
IsNull := true; |
| 1770 |
|
|
| 1771 |
|
case sqltype and (not 1) of |
| 1772 |
|
SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP, |
| 1773 |
< |
SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, |
| 1773 |
> |
SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN, |
| 1774 |
|
SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin |
| 1775 |
|
if (sqllen = 0) then |
| 1776 |
|
{ Make sure you get a valid pointer anyway |
| 2759 |
|
on E: Exception do begin |
| 2760 |
|
if (FHandle <> nil) then |
| 2761 |
|
FreeHandle; |
| 2762 |
< |
raise; |
| 2762 |
> |
if E is EIBInterBaseError then |
| 2763 |
> |
raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode, |
| 2764 |
> |
EIBInterBaseError(E).IBErrorCode, |
| 2765 |
> |
EIBInterBaseError(E).Message + |
| 2766 |
> |
sSQLErrorSeparator + FProcessedSQL.Text) |
| 2767 |
> |
else |
| 2768 |
> |
raise; |
| 2769 |
|
end; |
| 2770 |
|
end; |
| 2771 |
|
end; |
