--- ibx/trunk/fbintf/client/FBSQLData.pas 2020/07/21 08:00:42 309 +++ ibx/trunk/fbintf/client/FBSQLData.pas 2021/02/25 11:56:36 315 @@ -80,27 +80,65 @@ unit FBSQLData; interface uses - Classes, SysUtils, IBExternals, IBHeader, {$IFDEF WINDOWS} Windows, {$ENDIF} IB, FBActivityMonitor, FBClientAPI; + Classes, SysUtils, IBExternals, {$IFDEF WINDOWS} Windows, {$ENDIF} IB, FBActivityMonitor, FBClientAPI, + FmtBCD; type - { TSQLDataItem } + {The IExTimeZoneServices is only available in FB4 and onwards} + + IExTimeZoneServices = interface(ITimeZoneServices) + ['{789c2eeb-c4a7-4fed-837e-0cbdef775904}'] + {encode/decode - used to encode/decode the wire protocol} + procedure EncodeTimestampTZ(timestamp: TDateTime; timezoneID: TFBTimeZoneID; + bufptr: PByte); overload; + procedure EncodeTimestampTZ(timestamp: TDateTime; timezone: AnsiString; + bufptr: PByte); overload; + procedure EncodeTimeTZ(time: TDateTime; timezoneID: TFBTimeZoneID; OnDate: TDateTime; + bufptr: PByte); overload; + procedure EncodeTimeTZ(time: TDateTime; timezone: AnsiString; OnDate: TDateTime; + bufptr: PByte); overload; + procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime; + var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload; + procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime; + var dstOffset: smallint; var timezone: AnsiString); overload; + procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime; + var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload; + procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime; + var dstOffset: smallint; var timezone: AnsiString); overload; + procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime; + var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload; + procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime; + var dstOffset: smallint; var timezone: AnsiString); overload; + procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime; + var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload; + procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime; + var dstOffset: smallint; var timezone: AnsiString); overload; + end; + + { TSQLDataItem } TSQLDataItem = class(TFBInterfacedObject) private FFirebirdClientAPI: TFBClientAPI; + FTimeZoneServices: IExTimeZoneServices; function AdjustScale(Value: Int64; aScale: Integer): Double; function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64; function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency; - function GetTimestampFormatStr: AnsiString; function GetDateFormatStr(IncludeTime: boolean): AnsiString; function GetTimeFormatStr: AnsiString; + function GetTimestampFormatStr: AnsiString; procedure SetAsInteger(AValue: Integer); + procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; + var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID); protected function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64; function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64; procedure CheckActive; virtual; + procedure CheckTZSupport; + function GetAttachment: IAttachment; virtual; abstract; function GetSQLDialect: integer; virtual; abstract; + function GetTimeZoneServices: IExTimeZoneServices; virtual; procedure Changed; virtual; procedure Changing; virtual; procedure InternalSetAsString(Value: AnsiString); virtual; @@ -113,7 +151,7 @@ type procedure SetDataLength(len: cardinal); virtual; procedure SetSQLType(aValue: cardinal); virtual; property DataLength: cardinal read GetDataLength write SetDataLength; - + property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI; public constructor Create(api: TFBClientAPI); function GetSQLType: cardinal; virtual; abstract; @@ -125,7 +163,14 @@ type function GetAsBoolean: boolean; function GetAsCurrency: Currency; function GetAsInt64: Int64; - function GetAsDateTime: TDateTime; + function GetAsDateTime: TDateTime; overload; + procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload; + procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload; + procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload; + procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload; + procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload; + procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload; + function GetAsUTCDateTime: TDateTime; function GetAsDouble: Double; function GetAsFloat: Float; function GetAsLong: Long; @@ -138,6 +183,7 @@ type function GetAsVariant: Variant; function GetModified: boolean; virtual; function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer; + function GetAsBCD: tBCD; function GetSize: cardinal; virtual; abstract; function GetCharSetWidth: integer; virtual; abstract; procedure SetAsBoolean(AValue: boolean); virtual; @@ -145,8 +191,13 @@ type procedure SetAsInt64(Value: Int64); virtual; procedure SetAsDate(Value: TDateTime); virtual; procedure SetAsLong(Value: Long); virtual; - procedure SetAsTime(Value: TDateTime); virtual; - procedure SetAsDateTime(Value: TDateTime); + procedure SetAsTime(Value: TDateTime); overload; + procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime;aTimeZoneID: TFBTimeZoneID); overload; + procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload; + procedure SetAsDateTime(Value: TDateTime); overload; + procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload; + procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload; + procedure SetAsUTCDateTime(aUTCTime: TDateTime); procedure SetAsDouble(Value: Double); virtual; procedure SetAsFloat(Value: Float); virtual; procedure SetAsPointer(Value: Pointer); @@ -155,6 +206,7 @@ type procedure SetAsString(Value: AnsiString); virtual; procedure SetAsVariant(Value: Variant); procedure SetAsNumeric(Value: Int64; aScale: integer); + procedure SetAsBcd(aValue: tBCD); virtual; procedure SetIsNull(Value: Boolean); virtual; procedure SetIsNullable(Value: Boolean); virtual; procedure SetName(aValue: AnsiString); virtual; @@ -247,7 +299,8 @@ type function GetIsNull: Boolean; virtual; abstract; function GetIsNullable: boolean; virtual; abstract; function GetSQLData: PByte; virtual; abstract; - function GetDataLength: cardinal; virtual; abstract; + function GetDataLength: cardinal; virtual; abstract; {current field length} + function GetSize: cardinal; virtual; abstract; {field length as given by metadata} procedure SetIsNull(Value: Boolean); virtual; abstract; procedure SetIsNullable(Value: Boolean); virtual; abstract; procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract; @@ -299,6 +352,7 @@ type FChangeSeqNo: integer; protected procedure CheckActive; override; + function GetAttachment: IAttachment; override; function SQLData: PByte; override; function GetDataLength: cardinal; override; function GetCodePage: TSystemCodePage; override; @@ -355,7 +409,7 @@ type { TSQLParam } - TSQLParam = class(TIBSQLData,ISQLParam) + TSQLParam = class(TIBSQLData,ISQLParam,ISQLData) protected procedure CheckActive; override; procedure Changed; override; @@ -378,8 +432,14 @@ type procedure SetAsInt64(AValue: Int64); procedure SetAsDate(AValue: TDateTime); procedure SetAsLong(AValue: Long); - procedure SetAsTime(AValue: TDateTime); - procedure SetAsDateTime(AValue: TDateTime); + procedure SetAsTime(AValue: TDateTime); overload; + procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload; + procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload; + procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload; + procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload; + procedure SetAsDateTime(AValue: TDateTime); overload; + procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload; + procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload; procedure SetAsDouble(AValue: Double); procedure SetAsFloat(AValue: Float); procedure SetAsPointer(AValue: Pointer); @@ -389,6 +449,7 @@ type procedure SetAsBlob(aValue: IBlob); procedure SetAsQuad(AValue: TISC_QUAD); procedure SetCharSetID(aValue: cardinal); + procedure SetAsBcd(aValue: tBCD); property AsBlob: IBlob read GetAsBlob write SetAsBlob; property IsNullable: Boolean read GetIsNullable write SetIsNullable; @@ -815,7 +876,7 @@ begin with FormatSettings do {$IFEND} {$IFEND} - Result := LongTimeFormat; + Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';; end; function TSQLDataItem.GetTimestampFormatStr: AnsiString; @@ -827,7 +888,7 @@ begin with FormatSettings do {$IFEND} {$IFEND} - Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzz'; + Result := ShortDateFormat + ' ' + 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz'; end; procedure TSQLDataItem.SetAsInteger(AValue: Integer); @@ -835,6 +896,54 @@ begin SetAsLong(aValue); end; +procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime; + var dstOffset: smallint; var aTimezone: AnsiString; + var aTimeZoneID: TFBTimeZoneID); +begin + CheckActive; + aDateTime := 0; + dstOffset := 0; + aTimezone := ''; + aTimeZoneID := TimeZoneID_GMT; + if not IsNull then + with FFirebirdClientAPI do + case SQLType of + SQL_TEXT, SQL_VARYING: + if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then + IBError(ibxeInvalidDataConversion, [nil]); + SQL_TYPE_DATE: + aDateTime := SQLDecodeDate(SQLData); + SQL_TYPE_TIME: + aDateTime := SQLDecodeTime(SQLData); + SQL_TIMESTAMP: + aDateTime := SQLDecodeDateTime(SQLData); + SQL_TIMESTAMP_TZ: + begin + GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone); + aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone; + end; + SQL_TIMESTAMP_TZ_EX: + begin + GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone); + aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone; + end; + SQL_TIME_TZ: + with GetTimeZoneServices do + begin + DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone); + aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone; + end; + SQL_TIME_TZ_EX: + with GetTimeZoneServices do + begin + DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone); + aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone; + end; + else + IBError(ibxeInvalidDataConversion, [nil]); + end; +end; + function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer ): Int64; var @@ -890,6 +999,23 @@ begin //Do nothing by default end; +procedure TSQLDataItem.CheckTZSupport; +begin + if not FFirebirdClientAPI.HasTimeZoneSupport then + IBError(ibxeNoTimezoneSupport,[]); +end; + +function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices; +begin + if FTimeZoneServices = nil then + begin + if not GetAttachment.HasTimeZoneSupport then + IBError(ibxeNoTimezoneSupport,[]); + GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices); + end; + Result := FTimeZoneServices; +end; + procedure TSQLDataItem.Changed; begin //Do nothing by default @@ -950,6 +1076,8 @@ begin SQL_LONG: Result := 'SQL_LONG'; SQL_SHORT: Result := 'SQL_SHORT'; SQL_TIMESTAMP: Result := 'SQL_TIMESTAMP'; + SQL_TIMESTAMP_TZ: Result := 'SQL_TIMESTAMP_TZ'; + SQL_TIMESTAMP_TZ_EX: Result := 'SQL_TIMESTAMP_TZ_EX'; SQL_BLOB: Result := 'SQL_BLOB'; SQL_D_FLOAT: Result := 'SQL_D_FLOAT'; SQL_ARRAY: Result := 'SQL_ARRAY'; @@ -957,6 +1085,14 @@ begin SQL_TYPE_TIME: Result := 'SQL_TYPE_TIME'; SQL_TYPE_DATE: Result := 'SQL_TYPE_DATE'; SQL_INT64: Result := 'SQL_INT64'; + SQL_TIME_TZ: Result := 'SQL_TIME_TZ'; + SQL_TIME_TZ_EX: Result := 'SQL_TIME_TZ_EX'; + SQL_DEC_FIXED: Result := 'SQL_DEC_FIXED'; + SQL_DEC16: Result := 'SQL_DEC16'; + SQL_DEC34: Result := 'SQL_DEC34'; + SQL_INT128: Result := 'SQL_INT128'; + SQL_NULL: Result := 'SQL_NULL'; + SQL_BOOLEAN: Result := 'SQL_BOOLEAN'; end; end; @@ -1009,6 +1145,14 @@ begin Scale); SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: result := Trunc(AsDouble); + + SQL_DEC_FIXED, + SQL_DEC16, + SQL_DEC34, + SQL_INT128: + if not BCDToCurr(GetAsBCD,Result) then + IBError(ibxeInvalidDataConversion, [nil]); + else IBError(ibxeInvalidDataConversion, [nil]); end; @@ -1045,28 +1189,110 @@ begin end; function TSQLDataItem.GetAsDateTime: TDateTime; +var aTimezone: AnsiString; + aTimeZoneID: TFBTimeZoneID; + dstOffset: smallint; +begin + InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID); +end; + +procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; + var dstOffset: smallint; var aTimezone: AnsiString); +var aTimeZoneID: TFBTimeZoneID; +begin + InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID); +end; + +procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; + var aTimezoneID: TFBTimeZoneID); +var aTimezone: AnsiString; +begin + InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID); +end; + +procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint; + var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); +var aTimeZone: AnsiString; begin CheckActive; - result := 0; + aTime := 0; + dstOffset := 0; if not IsNull then with FFirebirdClientAPI do case SQLType of - SQL_TEXT, SQL_VARYING: begin - try - result := StrToDate(AsString); - except - on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]); + SQL_TIME_TZ: + begin + GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone); + aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone; + end; + SQL_TIME_TZ_EX: + begin + GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone); + aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone; end; + else + IBError(ibxeInvalidDataConversion, [nil]); + end; +end; + +procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint; + var aTimezone: AnsiString; OnDate: TDateTime); +begin + CheckActive; + aTime := 0; + dstOffset := 0; + if not IsNull then + with FFirebirdClientAPI do + case SQLType of + SQL_TIME_TZ: + GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone); + SQL_TIME_TZ_EX: + GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone); + else + IBError(ibxeInvalidDataConversion, [nil]); + end; +end; + +procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint; + var aTimezoneID: TFBTimeZoneID); +begin + GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate); +end; + +procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint; + var aTimezone: AnsiString); +begin + GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate); +end; + +function TSQLDataItem.GetAsUTCDateTime: TDateTime; +var aTimezone: AnsiString; +begin + CheckActive; + result := 0; + aTimezone := ''; + if not IsNull then + with FFirebirdClientAPI do + case SQLType of + SQL_TEXT, SQL_VARYING: + begin + if not ParseDateTimeTZString(AsString,Result,aTimeZone) then + IBError(ibxeInvalidDataConversion, [nil]); + Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone); end; SQL_TYPE_DATE: result := SQLDecodeDate(SQLData); - SQL_TYPE_TIME: + SQL_TYPE_TIME, + SQL_TIME_TZ, + SQL_TIME_TZ_EX: result := SQLDecodeTime(SQLData); - SQL_TIMESTAMP: + SQL_TIMESTAMP, + SQL_TIMESTAMP_TZ, + SQL_TIMESTAMP_TZ_EX: result := SQLDecodeDateTime(SQLData); else IBError(ibxeInvalidDataConversion, [nil]); - end; + end; end; function TSQLDataItem.GetAsDouble: Double; @@ -1094,6 +1320,11 @@ begin result := PFloat(SQLData)^; SQL_DOUBLE, SQL_D_FLOAT: result := PDouble(SQLData)^; + SQL_DEC_FIXED, + SQL_DEC16, + SQL_DEC34, + SQL_INT128: + Result := BCDToDouble(GetAsBCD); else IBError(ibxeInvalidDataConversion, [nil]); end; @@ -1139,8 +1370,13 @@ begin result := Trunc(AdjustScale(PInt64(SQLData)^, Scale)); SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: result := Trunc(AsDouble); + SQL_DEC_FIXED, + SQL_DEC16, + SQL_DEC34, + SQL_INT128: + Result := BCDToInteger(GetAsBCD); else - IBError(ibxeInvalidDataConversion, [nil]); + IBError(ibxeInvalidDataConversion, [GetSQLTypeName]); end; end; @@ -1225,14 +1461,14 @@ end; {Returns the byte length of a UTF8 string with a fixed charwidth} -function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer; +function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer; var i: integer; cplen: integer; s: AnsiString; begin Result := 0; s := strpas(p); - for i := 1 to CharWidth do + for i := 1 to FieldWidth do begin cplen := UTF8CodepointSizeFull(p); Inc(p,cplen); @@ -1250,6 +1486,9 @@ var sz: PByte; str_len: Integer; rs: RawByteString; + aTimeZone: AnsiString; + aDateTime: TDateTime; + dstOffset: smallint; begin CheckActive; result := ''; @@ -1281,12 +1520,44 @@ begin SetCodePage(rs,GetCodePage,false); Result := rs; end; + SQL_TYPE_DATE: - result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime); - SQL_TYPE_TIME : - result := FormatDateTime(GetTimeFormatStr,AsDateTime); + Result := DateToStr(GetAsDateTime); SQL_TIMESTAMP: - result := FormatDateTime(GetTimestampFormatStr,AsDateTime); + Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime); + SQL_TYPE_TIME: + Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime); + SQL_TIMESTAMP_TZ, + SQL_TIMESTAMP_TZ_EX: + with GetAttachment.GetTimeZoneServices do + begin + if GetTZTextOption = tzGMT then + Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime) + else + begin + GetAsDateTime(aDateTime,dstOffset,aTimeZone); + if GetTZTextOption = tzOffset then + Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset) + else + Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone; + end; + end; + SQL_TIME_TZ, + SQL_TIME_TZ_EX: + with GetAttachment.GetTimeZoneServices do + begin + if GetTZTextOption = tzGMT then + Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime) + else + begin + GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate); + if GetTZTextOption = tzOffset then + Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset) + else + Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone; + end; + end; + SQL_SHORT, SQL_LONG: if Scale = 0 then result := IntToStr(AsLong) @@ -1303,6 +1574,15 @@ begin result := FloatToStr(AsDouble); SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: result := FloatToStr(AsDouble); + + SQL_DEC16, + SQL_DEC34: + result := BCDToStr(GetAsBCD); + + SQL_DEC_FIXED, + SQL_INT128: + result := Int128ToStr(SQLData,scale); + else IBError(ibxeInvalidDataConversion, [nil]); end; @@ -1321,6 +1601,9 @@ begin end; function TSQLDataItem.GetAsVariant: Variant; +var ts: TDateTime; + dstOffset: smallint; + timezone: AnsiString; begin CheckActive; if IsNull then @@ -1334,6 +1617,14 @@ begin result := AsString; SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME: result := AsDateTime; + SQL_TIMESTAMP_TZ, + SQL_TIME_TZ, + SQL_TIMESTAMP_TZ_EX, + SQL_TIME_TZ_EX: + begin + GetAsDateTime(ts,dstOffset,timezone); + result := VarArrayOf([ts,dstOffset,timezone]); + end; SQL_SHORT, SQL_LONG: if Scale = 0 then result := AsLong @@ -1352,6 +1643,11 @@ begin result := AsDouble; SQL_BOOLEAN: result := AsBoolean; + SQL_DEC_FIXED, + SQL_DEC16, + SQL_DEC34, + SQL_INT128: + result := VarFmtBCDCreate(GetAsBcd); else IBError(ibxeInvalidDataConversion, [nil]); end; @@ -1372,8 +1668,39 @@ begin Result := Length(GetDateFormatStr(true)); dfTime: Result := Length(GetTimeFormatStr); + dfTimestampTZ: + Result := Length(GetTimestampFormatStr) + 6; {assume time offset format} + dfTimeTZ: + Result := Length(GetTimeFormatStr)+ 6; else Result := 0; + end;end; + +function TSQLDataItem.GetAsBCD: tBCD; + +begin + CheckActive; + if IsNull then + with Result do + begin + FillChar(Result,sizeof(Result),0); + Precision := 1; + exit; + end; + + case SQLType of + SQL_DEC16, + SQL_DEC34: + with FFirebirdClientAPI do + Result := SQLDecFloatDecode(SQLType, SQLData); + + SQL_DEC_FIXED, + SQL_INT128: + with FFirebirdClientAPI do + Result := StrToBCD(Int128ToStr(SQLData,scale)); + else + if not CurrToBCD(GetAsCurrency,Result) then + IBError(ibxeBadBCDConversion,[]); end; end; @@ -1465,6 +1792,46 @@ begin Changed; end; +procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); +begin + CheckActive; + CheckTZSupport; + if GetSQLDialect < 3 then + begin + AsDateTime := aValue; + exit; + end; + + Changing; + if IsNullable then + IsNull := False; + + SQLType := SQL_TIME_TZ; + DataLength := SizeOf(ISC_TIME_TZ); + GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData); + Changed; +end; + +procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); +begin + CheckActive; + CheckTZSupport; + if GetSQLDialect < 3 then + begin + AsDateTime := aValue; + exit; + end; + + Changing; + if IsNullable then + IsNull := False; + + SQLType := SQL_TIME_TZ; + DataLength := SizeOf(ISC_TIME_TZ); + GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData); + Changed; +end; + procedure TSQLDataItem.SetAsDateTime(Value: TDateTime); begin CheckActive; @@ -1479,6 +1846,41 @@ begin Changed; end; +procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; + aTimeZoneID: TFBTimeZoneID); +begin + CheckActive; + CheckTZSupport; + if IsNullable then + IsNull := False; + + Changing; + SQLType := SQL_TIMESTAMP_TZ; + DataLength := SizeOf(ISC_TIMESTAMP_TZ); + GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData); + Changed; +end; + +procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString + ); +begin + CheckActive; + CheckTZSupport; + if IsNullable then + IsNull := False; + + Changing; + SQLType := SQL_TIMESTAMP_TZ; + DataLength := SizeOf(ISC_TIMESTAMP_TZ); + GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData); + Changed; +end; + +procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime); +begin + SetAsDateTime(aUTCTime,TimeZoneID_GMT); +end; + procedure TSQLDataItem.SetAsDouble(Value: Double); begin CheckActive; @@ -1574,6 +1976,9 @@ begin CheckActive; if VarIsNull(Value) then IsNull := True + else + if VarIsArray(Value) then {must be datetime plus timezone} + SetAsDateTime(Value[0],AnsiString(Value[1])) else case VarType(Value) of varEmpty, varNull: IsNull := True; @@ -1596,6 +2001,11 @@ begin IBError(ibxeNotSupported, [nil]); varByRef, varDispatch, varError, varUnknown, varVariant: IBError(ibxeNotPermitted, [nil]); + else + if VarIsFmtBCD(Value) then + SetAsBCD(VarToBCD(Value)) + else + IBError(ibxeNotSupported, [nil]); end; end; @@ -1613,6 +2023,51 @@ begin Changed; end; +procedure TSQLDataItem.SetAsBcd(aValue: tBCD); +var C: Currency; +begin + CheckActive; + Changing; + if IsNullable then + IsNull := False; + + + with FFirebirdClientAPI do + if aValue.Precision <= 16 then + begin + if not HasDecFloatSupport then + IBError(ibxeDecFloatNotSupported,[]); + + SQLType := SQL_DEC16; + DataLength := 8; + SQLDecFloatEncode(aValue,SQLType,SQLData); + end + else + if aValue.Precision <= 34 then + begin + if not HasDecFloatSupport then + IBError(ibxeDecFloatNotSupported,[]); + + SQLType := SQL_DEC34; + DataLength := 16; + SQLDecFloatEncode(aValue,SQLType,SQLData); + end + else + if aValue.Precision <= 38 then + begin + if not HasInt128Support then + IBError(ibxeInt128NotSupported,[]); + + SQLType := SQL_INT128; + DataLength := 16; + StrToInt128(scale,BcdToStr(aValue),SQLData); + end + else + IBError(ibxeBCDOverflow,[BCDToStr(aValue)]); + + Changed; +end; + procedure TSQLDataItem.SetAsBoolean(AValue: boolean); begin CheckActive; @@ -1643,6 +2098,11 @@ begin IBError(ibxeStatementNotPrepared, [nil]); end; +function TColumnMetaData.GetAttachment: IAttachment; +begin + Result := GetStatement.GetAttachment; +end; + function TColumnMetaData.SQLData: PByte; begin Result := FIBXSQLVAR.SQLData; @@ -1747,7 +2207,7 @@ end; function TColumnMetaData.GetSize: cardinal; begin CheckActive; - result := FIBXSQLVAR.DataLength; + result := FIBXSQLVAR.GetSize; end; function TColumnMetaData.GetCharSetWidth: integer; @@ -1860,10 +2320,12 @@ var b: IBlob; dt: TDateTime; CurrValue: Currency; FloatValue: single; + timezone: AnsiString; begin CheckActive; if IsNullable then IsNull := False; + with FFirebirdClientAPI do case SQLTYPE of SQL_BOOLEAN: if AnsiCompareText(Value,STrue) = 0 then @@ -1921,6 +2383,24 @@ begin else DoSetString; + SQL_TIMESTAMP_TZ: + if ParseDateTimeTZString(value,dt,timezone) then + SetAsDateTime(dt,timezone) + else + DoSetString; + + SQL_TIME_TZ: + if ParseDateTimeTZString(value,dt,timezone,true) then + SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone) + else + DoSetString; + + SQL_DEC_FIXED, + SQL_DEC16, + SQL_DEC34, + SQL_INT128: + SetAsBCD(StrToBCD(Value)); + else IBError(ibxeInvalidDataConversion,[nil]); end; @@ -2164,6 +2644,62 @@ begin end; end; +procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); +var i: integer; + OldSQLVar: TSQLVarData; +begin + if FIBXSQLVAR.UniqueName then + inherited SetAsTime(AValue,OnDate, aTimeZoneID) + else + with FIBXSQLVAR.Parent do + begin + for i := 0 to Count - 1 do + if Column[i].Name = Name then + begin + OldSQLVar := FIBXSQLVAR; + FIBXSQLVAR := Column[i]; + try + inherited SetAsTime(AValue,OnDate, aTimeZoneID); + finally + FIBXSQLVAR := OldSQLVar; + end; + end; + end; +end; + +procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); +var i: integer; + OldSQLVar: TSQLVarData; +begin + if FIBXSQLVAR.UniqueName then + inherited SetAsTime(AValue,OnDate,aTimeZone) + else + with FIBXSQLVAR.Parent do + begin + for i := 0 to Count - 1 do + if Column[i].Name = Name then + begin + OldSQLVar := FIBXSQLVAR; + FIBXSQLVAR := Column[i]; + try + inherited SetAsTime(AValue,OnDate,aTimeZone); + finally + FIBXSQLVAR := OldSQLVar; + end; + end; + end; +end; + +procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); +begin + SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID); +end; + +procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); +begin + SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone); +end; + procedure TSQLParam.SetAsDateTime(AValue: TDateTime); var i: integer; OldSQLVar: TSQLVarData; @@ -2187,6 +2723,53 @@ begin end; end; +procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID + ); +var i: integer; + OldSQLVar: TSQLVarData; +begin + if FIBXSQLVAR.UniqueName then + inherited SetAsDateTime(AValue,aTimeZoneID) + else + with FIBXSQLVAR.Parent do + begin + for i := 0 to Count - 1 do + if Column[i].Name = Name then + begin + OldSQLVar := FIBXSQLVAR; + FIBXSQLVAR := Column[i]; + try + inherited SetAsDateTime(AValue,aTimeZoneID); + finally + FIBXSQLVAR := OldSQLVar; + end; + end; + end; +end; + +procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); +var i: integer; + OldSQLVar: TSQLVarData; +begin + if FIBXSQLVAR.UniqueName then + inherited SetAsDateTime(AValue,aTimeZone) + else + with FIBXSQLVAR.Parent do + begin + for i := 0 to Count - 1 do + if Column[i].Name = Name then + begin + OldSQLVar := FIBXSQLVAR; + FIBXSQLVAR := Column[i]; + try + inherited SetAsDateTime(AValue,aTimeZone); + finally + FIBXSQLVAR := OldSQLVar; + end; + end; + end; +end; + procedure TSQLParam.SetAsDouble(AValue: Double); var i: integer; OldSQLVar: TSQLVarData; @@ -2367,6 +2950,29 @@ begin FIBXSQLVAR.SetCharSetID(aValue); end; +procedure TSQLParam.SetAsBcd(aValue: tBCD); +var i: integer; + OldSQLVar: TSQLVarData; +begin + if FIBXSQLVAR.UniqueName then + inherited SetAsBcd(AValue) + else + with FIBXSQLVAR.Parent do + begin + for i := 0 to Count - 1 do + if Column[i].Name = Name then + begin + OldSQLVar := FIBXSQLVAR; + FIBXSQLVAR := Column[i]; + try + inherited SetAsBcd(AValue); + finally + FIBXSQLVAR := OldSQLVar; + end; + end; + end; +end; + { TMetaData } procedure TMetaData.CheckActive; @@ -2522,7 +3128,7 @@ begin if not FResults.CheckStatementStatus(ssPrepared) then IBError(ibxeStatementNotPrepared, [nil]); - with GetTransaction as TFBTransaction do + with GetTransaction do if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then IBError(ibxeInterfaceOutofDate,[nil]); end;