--- ibx/trunk/fbintf/client/FBArray.pas 2021/02/25 11:27:14 314 +++ ibx/trunk/fbintf/client/FBArray.pas 2021/02/25 11:56:36 315 @@ -38,8 +38,8 @@ unit FBArray; interface uses - Classes, SysUtils, IB, IBHeader, FBTransaction, - FBSQLData, FBClientAPI, IBExternals, FBActivityMonitor; + Classes, SysUtils, IBHeader, IB, FBTransaction, + FBSQLData, FBClientAPI, IBExternals, FBActivityMonitor, FmtBCD; (* @@ -75,6 +75,7 @@ type FBufPtr: PByte; FArray: TFBArray; protected + function GetAttachment: IAttachment; override; function GetSQLDialect: integer; override; procedure Changing; override; procedure Changed; override; @@ -99,6 +100,7 @@ type procedure SetAsDouble(Value: Double); override; procedure SetAsFloat(Value: Float); override; procedure SetAsCurrency(Value: Currency); override; + procedure SetAsBcd(aValue: tBCD); override; end; { TFBArrayMetaData } @@ -138,7 +140,7 @@ type { TFBArray } - TFBArray = class(TActivityReporter,IArray) + TFBArray = class(TActivityReporter,IArray,ITransactionUser) private FFirebirdClientAPI: TFBClientAPI; FMetaData: IArrayMetaData; @@ -175,6 +177,9 @@ type aField: IArrayMetaData; ArrayID: TISC_QUAD); overload; destructor Destroy; override; function GetSQLDialect: integer; + + public + {ITransactionUser} procedure TransactionEnding(aTransaction: ITransaction; Force: boolean); public @@ -200,26 +205,38 @@ type function GetAsBoolean(index: array of integer): boolean; function GetAsCurrency(index: array of integer): Currency; function GetAsInt64(index: array of integer): Int64; - function GetAsDateTime(index: array of integer): TDateTime; + function GetAsDateTime(index: array of integer): TDateTime; overload; + procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload; + procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload; + procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload; + procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload; + function GetAsUTCDateTime(index: array of integer): TDateTime; function GetAsDouble(index: array of integer): Double; function GetAsFloat(index: array of integer): Float; function GetAsLong(index: array of integer): Long; function GetAsShort(index: array of integer): Short; function GetAsString(index: array of integer): AnsiString; function GetAsVariant(index: array of integer): Variant; + function GetAsBCD(index: array of integer): tBCD; procedure SetAsInteger(index: array of integer; AValue: integer); procedure SetAsBoolean(index: array of integer; AValue: boolean); procedure SetAsCurrency(index: array of integer; Value: Currency); procedure SetAsInt64(index: array of integer; Value: Int64); procedure SetAsDate(index: array of integer; Value: TDateTime); procedure SetAsLong(index: array of integer; Value: Long); - procedure SetAsTime(index: array of integer; Value: TDateTime); - procedure SetAsDateTime(index: array of integer; Value: TDateTime); + procedure SetAsTime(index: array of integer; Value: TDateTime); overload; + procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload; + procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload; + procedure SetAsDateTime(index: array of integer; Value: TDateTime); overload; + procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload; + procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZone: AnsiString); overload; + procedure SetAsUTCDateTime(index: array of integer; aUTCTime: TDateTime); procedure SetAsDouble(index: array of integer; Value: Double); procedure SetAsFloat(index: array of integer; Value: Float); procedure SetAsShort(index: array of integer; Value: Short); procedure SetAsString(index: array of integer; Value: AnsiString); procedure SetAsVariant(index: array of integer; Value: Variant); + procedure SetAsBcd(index: array of integer; aValue: tBCD); procedure SetBounds(dim, UpperBound, LowerBound: integer); function GetAttachment: IAttachment; function GetTransaction: ITransaction; @@ -233,6 +250,11 @@ uses FBMessages; { TFBArrayElement } +function TFBArrayElement.GetAttachment: IAttachment; +begin + Result := FArray.GetAttachment; +end; + function TFBArrayElement.GetSQLDialect: integer; begin Result := FArray.GetSQLDialect; @@ -484,9 +506,32 @@ begin end end; +procedure TFBArrayElement.SetAsBcd(aValue: tBCD); +var C: Currency; +begin + CheckActive; + with FirebirdClientAPI do + case SQLType of + SQL_DEC_FIXED, + SQL_DEC16, + SQL_DEC34: + SQLDecFloatEncode(aValue,SQLType,SQLData); + + SQL_INT128: + StrToInt128(Scale,BcdToStr(aValue),SQLData); + + else + begin + BCDToCurr(aValue,C); + SetAsCurrency(C); + end; + end; + Changed; +end; + procedure TFBArrayElement.SetSQLType(aValue: cardinal); begin - if aValue = GetSQLType then + if aValue <> GetSQLType then IBError(ibxeInvalidDataConversion, [nil]); end; @@ -553,6 +598,20 @@ begin Result := SQL_TYPE_TIME; blr_int64: Result := SQL_INT64; + blr_sql_time_tz: + Result := SQL_TIME_TZ; + blr_timestamp_tz: + Result := SQL_TIMESTAMP_TZ; + blr_ex_time_tz: + Result := SQL_TIME_TZ_EX; + blr_ex_timestamp_tz: + Result := SQL_TIMESTAMP_TZ_EX; + blr_dec64: + Result := SQL_DEC16; + blr_dec128: + Result := SQL_DEC34; + blr_int128: + Result := SQL_INT128; end; end; @@ -563,7 +622,7 @@ end; function TFBArrayMetaData.GetScale: integer; begin - Result := byte(FArrayDesc.array_desc_scale); + Result := FArrayDesc.array_desc_scale; end; function TFBArrayMetaData.GetSize: cardinal; @@ -626,6 +685,20 @@ begin Result := blr_sql_time; SQL_INT64: Result := blr_int64; + SQL_TIME_TZ: + Result := blr_sql_time_tz; + SQL_TIMESTAMP_TZ: + Result := blr_timestamp_tz; + SQL_TIME_TZ_EX: + Result := blr_ex_time_tz; + SQL_TIMESTAMP_TZ_EX: + Result := blr_ex_timestamp_tz; + SQL_DEC16: + Result := blr_dec64; + SQL_DEC34: + Result := blr_dec128; + SQL_INT128: + Result := blr_int128; end; end; @@ -835,7 +908,7 @@ end; procedure TFBArray.TransactionEnding(aTransaction: ITransaction; Force: boolean ); begin - if (aTransaction = FTransactionIntf) and FModified and not FIsNew then + if ((aTransaction as TObject) = (FTransactionIntf as TObject)) and FModified and not FIsNew then PutArraySlice(Force); end; @@ -924,6 +997,46 @@ begin Result := FElement.GetAsDateTime; end; +procedure TFBArray.GetAsDateTime(index: array of integer; + var aDateTime: TDateTime; var dstOffset: smallint; + var aTimezoneID: TFBTimeZoneID); +begin + GetArraySlice; + FElement.FBufPtr := GetOffset(index); + FElement.GetAsDateTime(aDateTime,dstOffset,aTimezoneID); +end; + +procedure TFBArray.GetAsDateTime(index: array of integer; + var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); +begin + GetArraySlice; + FElement.FBufPtr := GetOffset(index); + FElement.GetAsDateTime(aDateTime,dstOffset,aTimezone); +end; + +procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime; + var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); +begin + GetArraySlice; + FElement.FBufPtr := GetOffset(index); + FElement.GetAsTime(aTime,dstOffset,aTimezoneID,OnDate); +end; + +procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime; + var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); +begin + GetArraySlice; + FElement.FBufPtr := GetOffset(index); + FElement.GetAsTime(aTime,dstOffset,aTimezone,OnDate); +end; + +function TFBArray.GetAsUTCDateTime(index: array of integer): TDateTime; +begin + GetArraySlice; + FElement.FBufPtr := GetOffset(index); + Result := FElement.GetAsUTCDateTime; +end; + function TFBArray.GetAsDouble(index: array of integer): Double; begin GetArraySlice; @@ -966,6 +1079,13 @@ begin Result := FElement.GetAsVariant; end; +function TFBArray.GetAsBCD(index: array of integer): tBCD; +begin + GetArraySlice; + FElement.FBufPtr := GetOffset(index); + Result := FElement.GetAsBCD; +end; + procedure TFBArray.SetAsInteger(index: array of integer; AValue: integer); begin FElement.FBufPtr := GetOffset(index); @@ -1008,12 +1128,47 @@ begin FElement.SetAsTime(Value); end; +procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; + aTimeZoneID: TFBTimeZoneID); +begin + FElement.FBufPtr := GetOffset(index); + FElement.SetAsTime(aValue,OnDate,aTimeZoneID); +end; + +procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; + aTimeZone: AnsiString); +begin + FElement.FBufPtr := GetOffset(index); + FElement.SetAsTime(aValue,OnDate, aTimeZone); +end; + procedure TFBArray.SetAsDateTime(index: array of integer; Value: TDateTime); begin FElement.FBufPtr := GetOffset(index); FElement.SetAsDateTime(Value); end; +procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime; + aTimeZoneID: TFBTimeZoneID); +begin + FElement.FBufPtr := GetOffset(index); + FElement.SetAsDateTime(aValue,aTimeZoneID); +end; + +procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime; + aTimeZone: AnsiString); +begin + FElement.FBufPtr := GetOffset(index); + FElement.SetAsDateTime(aValue,aTimeZone); +end; + +procedure TFBArray.SetAsUTCDateTime(index: array of integer; + aUTCTime: TDateTime); +begin + FElement.FBufPtr := GetOffset(index); + FElement.SetAsUTCDateTime(aUTCTime); +end; + procedure TFBArray.SetAsDouble(index: array of integer; Value: Double); begin FElement.FBufPtr := GetOffset(index); @@ -1044,6 +1199,12 @@ begin FElement.SetAsVariant(Value); end; +procedure TFBArray.SetAsBcd(index: array of integer; aValue: tBCD); +begin + FElement.FBufPtr := GetOffset(index); + FElement.SetAsBcd(aValue); +end; + procedure TFBArray.SetBounds(dim, UpperBound, LowerBound: integer); begin with (FMetaData as TFBArrayMetaData) do