ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBSQLData.pas
(Generate patch)

Comparing:
ibx/trunk/fbintf/client/FBSQLData.pas (file contents), Revision 308 by tony, Sat Jul 18 10:26:30 2020 UTC vs.
ibx/branches/journaling/fbintf/client/FBSQLData.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC

# Line 80 | Line 80 | unit FBSQLData;
80   interface
81  
82   uses
83 <  Classes, SysUtils, IBExternals, IBHeader, {$IFDEF WINDOWS} Windows, {$ENDIF} IB,  FBActivityMonitor, FBClientAPI;
83 >  Classes, SysUtils, IBExternals, {$IFDEF WINDOWS} Windows, {$ENDIF} IB,  FBActivityMonitor, FBClientAPI,
84 >  FmtBCD;
85  
86   type
87  
88 <  { TSQLDataItem }
88 >   {The IExTimeZoneServices is only available in FB4 and onwards}
89 >
90 >   IExTimeZoneServices = interface(ITimeZoneServices)
91 >   ['{789c2eeb-c4a7-4fed-837e-0cbdef775904}']
92 >   {encode/decode - used to encode/decode the wire protocol}
93 >   procedure EncodeTimestampTZ(timestamp: TDateTime; timezoneID: TFBTimeZoneID;
94 >     bufptr: PByte); overload;
95 >   procedure EncodeTimestampTZ(timestamp: TDateTime; timezone: AnsiString;
96 >       bufptr: PByte); overload;
97 >   procedure EncodeTimeTZ(time: TDateTime; timezoneID: TFBTimeZoneID; OnDate: TDateTime;
98 >     bufptr: PByte); overload;
99 >   procedure EncodeTimeTZ(time: TDateTime; timezone: AnsiString; OnDate: TDateTime;
100 >     bufptr: PByte); overload;
101 >   procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime;
102 >     var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
103 >   procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime;
104 >     var dstOffset: smallint; var timezone: AnsiString); overload;
105 >   procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime;
106 >     var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
107 >   procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime;
108 >     var dstOffset: smallint; var timezone: AnsiString); overload;
109 >   procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
110 >     var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
111 >   procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
112 >     var dstOffset: smallint; var timezone: AnsiString); overload;
113 >   procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
114 >     var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
115 >   procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
116 >     var dstOffset: smallint; var timezone: AnsiString); overload;
117 >   end;
118 >
119 >   { TSQLDataItem }
120  
121    TSQLDataItem = class(TFBInterfacedObject)
122    private
123       FFirebirdClientAPI: TFBClientAPI;
124 <     function AdjustScale(Value: Int64; aScale: Integer): Double;
93 <     function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
94 <     function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
95 <     function GetTimestampFormatStr: AnsiString;
124 >     FTimeZoneServices: IExTimeZoneServices;
125       function GetDateFormatStr(IncludeTime: boolean): AnsiString;
126       function GetTimeFormatStr: AnsiString;
127 +     function GetTimestampFormatStr: AnsiString;
128       procedure SetAsInteger(AValue: Integer);
129 +     procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
130 +       var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID);
131    protected
132 +     function AdjustScale(Value: Int64; aScale: Integer): Double;
133 +     function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
134 +     function AdjustScaleToStr(Value: Int64; aScale: Integer): AnsiString;
135 +     function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
136       function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
137       function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
138       procedure CheckActive; virtual;
139 +     procedure CheckTZSupport;
140 +     function GetAttachment: IAttachment; virtual; abstract;
141       function GetSQLDialect: integer; virtual; abstract;
142 +     function GetTimeZoneServices: IExTimeZoneServices; virtual;
143       procedure Changed; virtual;
144       procedure Changing; virtual;
145       procedure InternalSetAsString(Value: AnsiString); virtual;
# Line 113 | Line 152 | type
152       procedure SetDataLength(len: cardinal); virtual;
153       procedure SetSQLType(aValue: cardinal); virtual;
154       property DataLength: cardinal read GetDataLength write SetDataLength;
155 <
155 >     property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
156    public
157       constructor Create(api: TFBClientAPI);
158 <     function GetSQLType: cardinal; virtual; abstract;
158 >     function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
159       function GetSQLTypeName: AnsiString; overload;
160 <     class function GetSQLTypeName(SQLType: short): AnsiString; overload;
160 >     class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
161       function GetStrDataLength: short;
162       function GetName: AnsiString; virtual; abstract;
163 <     function GetScale: integer; virtual; abstract;
163 >     function GetScale: integer; virtual; abstract; {Current Field Data scale}
164       function GetAsBoolean: boolean;
165       function GetAsCurrency: Currency;
166       function GetAsInt64: Int64;
167 <     function GetAsDateTime: TDateTime;
167 >     function GetAsDateTime: TDateTime; overload;
168 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
169 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
170 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
171 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
172 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
173 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
174 >     function GetAsUTCDateTime: TDateTime;
175       function GetAsDouble: Double;
176       function GetAsFloat: Float;
177       function GetAsLong: Long;
# Line 138 | Line 184 | type
184       function GetAsVariant: Variant;
185       function GetModified: boolean; virtual;
186       function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
187 +     function GetAsBCD: tBCD;
188       function GetSize: cardinal; virtual; abstract;
189 +     function GetCharSetWidth: integer; virtual; abstract;
190       procedure SetAsBoolean(AValue: boolean); virtual;
191       procedure SetAsCurrency(Value: Currency); virtual;
192       procedure SetAsInt64(Value: Int64); virtual;
193       procedure SetAsDate(Value: TDateTime); virtual;
194       procedure SetAsLong(Value: Long); virtual;
195 <     procedure SetAsTime(Value: TDateTime); virtual;
196 <     procedure SetAsDateTime(Value: TDateTime);
195 >     procedure SetAsTime(Value: TDateTime); overload;
196 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime;aTimeZoneID: TFBTimeZoneID); overload;
197 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
198 >     procedure SetAsDateTime(Value: TDateTime); overload;
199 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
200 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
201 >     procedure SetAsUTCDateTime(aUTCTime: TDateTime);
202       procedure SetAsDouble(Value: Double); virtual;
203       procedure SetAsFloat(Value: Float); virtual;
204       procedure SetAsPointer(Value: Pointer);
# Line 153 | Line 206 | type
206       procedure SetAsShort(Value: short); virtual;
207       procedure SetAsString(Value: AnsiString); virtual;
208       procedure SetAsVariant(Value: Variant);
209 <     procedure SetAsNumeric(Value: Int64; aScale: integer);
209 >     procedure SetAsNumeric(Value: Int64; aScale: integer); virtual;
210 >     procedure SetAsBcd(aValue: tBCD); virtual;
211       procedure SetIsNull(Value: Boolean); virtual;
212       procedure SetIsNullable(Value: Boolean); virtual;
213       procedure SetName(aValue: AnsiString); virtual;
# Line 212 | Line 266 | type
266      function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
267      property CaseSensitiveParams: boolean read FCaseSensitiveParams
268                                              write FCaseSensitiveParams; {Only used when IsInputDataArea true}
269 +    function CanChangeMetaData: boolean; virtual; abstract;
270      property Count: integer read GetCount;
271      property Column[index: integer]: TSQLVarData read GetColumn;
272      property UniqueRelationName: AnsiString read FUniqueRelationName;
# Line 230 | Line 285 | type
285      FModified: boolean;
286      FUniqueName: boolean;
287      FVarString: RawByteString;
288 +    FColMetaData: IParamMetaData;
289      function GetStatement: IStatement;
290      procedure SetName(AValue: AnsiString);
291    protected
292 +    function GetAttachment: IAttachment; virtual; abstract;
293      function GetSQLType: cardinal; virtual; abstract;
294      function GetSubtype: integer; virtual; abstract;
295      function GetAliasName: AnsiString;  virtual; abstract;
# Line 241 | Line 298 | type
298      function GetRelationName: AnsiString;  virtual; abstract;
299      function GetScale: integer; virtual; abstract;
300      function GetCharSetID: cardinal; virtual; abstract;
301 +    function GetCharSetWidth: integer; virtual; abstract;
302      function GetCodePage: TSystemCodePage; virtual; abstract;
303      function GetIsNull: Boolean;   virtual; abstract;
304      function GetIsNullable: boolean; virtual; abstract;
305      function GetSQLData: PByte;  virtual; abstract;
306 <    function GetDataLength: cardinal; virtual; abstract;
306 >    function GetDataLength: cardinal; virtual; abstract; {current field length}
307 >    function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
308 >    function GetDefaultTextSQLType: cardinal; virtual; abstract;
309      procedure SetIsNull(Value: Boolean); virtual; abstract;
310      procedure SetIsNullable(Value: Boolean);  virtual; abstract;
311      procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
# Line 253 | Line 313 | type
313      procedure SetDataLength(len: cardinal); virtual; abstract;
314      procedure SetSQLType(aValue: cardinal); virtual; abstract;
315      procedure SetCharSetID(aValue: cardinal); virtual; abstract;
316 +    procedure SetMetaSize(aValue: cardinal); virtual;
317    public
318      constructor Create(aParent: TSQLDataArea; aIndex: integer);
319      procedure SetString(aValue: AnsiString);
# Line 263 | Line 324 | type
324      function CreateBlob: IBlob; virtual; abstract;
325      function GetArrayMetaData: IArrayMetaData; virtual; abstract;
326      function GetBlobMetaData: IBlobMetaData; virtual; abstract;
327 +    function getColMetadata: IParamMetaData;
328      procedure Initialize; virtual;
329 +    procedure SaveMetaData;
330  
331    public
332      property AliasName: AnsiString read GetAliasName;
# Line 297 | Line 360 | type
360      FChangeSeqNo: integer;
361    protected
362      procedure CheckActive; override;
363 +    function GetAttachment: IAttachment; override;
364      function SQLData: PByte; override;
365      function GetDataLength: cardinal; override;
366      function GetCodePage: TSystemCodePage; override;
# Line 320 | Line 384 | type
384      function getCharSetID: cardinal; override;
385      function GetIsNullable: boolean; override;
386      function GetSize: cardinal; override;
387 +    function GetCharSetWidth: integer; override;
388      function GetArrayMetaData: IArrayMetaData;
389      function GetBlobMetaData: IBlobMetaData;
390      function GetStatement: IStatement;
# Line 350 | Line 415 | type
415      property AsBlob: IBlob read GetAsBlob;
416   end;
417  
418 +  { TSQLParamMetaData }
419 +
420 +  TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
421 +  private
422 +    FSQLType: cardinal;
423 +    FSQLSubType: integer;
424 +    FScale: integer;
425 +    FCharSetID: cardinal;
426 +    FNullable: boolean;
427 +    FSize: cardinal;
428 +    FCodePage: TSystemCodePage;
429 +  public
430 +    constructor Create(src: TSQLVarData);
431 +    {IParamMetaData}
432 +    function GetSQLType: cardinal;
433 +    function GetSQLTypeName: AnsiString;
434 +    function getSubtype: integer;
435 +    function getScale: integer;
436 +    function getCharSetID: cardinal;
437 +    function getCodePage: TSystemCodePage;
438 +    function getIsNullable: boolean;
439 +    function GetSize: cardinal;
440 +    property SQLType: cardinal read GetSQLType;
441 +  end;
442 +
443    { TSQLParam }
444  
445 <  TSQLParam = class(TIBSQLData,ISQLParam)
445 >  TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
446    protected
447      procedure CheckActive; override;
448      procedure Changed; override;
# Line 362 | Line 452 | type
452      procedure SetSQLType(aValue: cardinal); override;
453    public
454      procedure Clear;
455 +    function getColMetadata: IParamMetaData;
456      function GetModified: boolean; override;
457      function GetAsPointer: Pointer;
458 +    function GetAsString: AnsiString; override;
459      procedure SetName(Value: AnsiString); override;
460      procedure SetIsNull(Value: Boolean);  override;
461      procedure SetIsNullable(Value: Boolean); override;
# Line 375 | Line 467 | type
467      procedure SetAsInt64(AValue: Int64);
468      procedure SetAsDate(AValue: TDateTime);
469      procedure SetAsLong(AValue: Long);
470 <    procedure SetAsTime(AValue: TDateTime);
471 <    procedure SetAsDateTime(AValue: TDateTime);
470 >    procedure SetAsTime(AValue: TDateTime); overload;
471 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
472 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
473 >    procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
474 >    procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
475 >    procedure SetAsDateTime(AValue: TDateTime); overload;
476 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
477 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
478      procedure SetAsDouble(AValue: Double);
479      procedure SetAsFloat(AValue: Float);
480      procedure SetAsPointer(AValue: Pointer);
# Line 386 | Line 484 | type
484      procedure SetAsBlob(aValue: IBlob);
485      procedure SetAsQuad(AValue: TISC_QUAD);
486      procedure SetCharSetID(aValue: cardinal);
487 +    procedure SetAsBcd(aValue: tBCD);
488  
489      property AsBlob: IBlob read GetAsBlob write SetAsBlob;
490      property IsNullable: Boolean read GetIsNullable write SetIsNullable;
# Line 459 | Line 558 | implementation
558  
559   uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
560  
561 + { TSQLParamMetaData }
562 +
563 + constructor TSQLParamMetaData.Create(src: TSQLVarData);
564 + begin
565 +  inherited Create;
566 +  FSQLType := src.GetSQLType;
567 +  FSQLSubType := src.getSubtype;
568 +  FScale := src.GetScale;
569 +  FCharSetID := src.getCharSetID;
570 +  FNullable := src.GetIsNullable;
571 +  FSize := src.GetSize;
572 +  FCodePage := src.GetCodePage;
573 + end;
574 +
575 + function TSQLParamMetaData.GetSQLType: cardinal;
576 + begin
577 +  Result := FSQLType;
578 + end;
579 +
580 + function TSQLParamMetaData.GetSQLTypeName: AnsiString;
581 + begin
582 +  Result := TSQLDataItem.GetSQLTypeName(FSQLType);
583 + end;
584 +
585 + function TSQLParamMetaData.getSubtype: integer;
586 + begin
587 +  Result := FSQLSubType;
588 + end;
589 +
590 + function TSQLParamMetaData.getScale: integer;
591 + begin
592 +  Result := FScale;
593 + end;
594 +
595 + function TSQLParamMetaData.getCharSetID: cardinal;
596 + begin
597 +  Result := FCharSetID;
598 + end;
599 +
600 + function TSQLParamMetaData.getCodePage: TSystemCodePage;
601 + begin
602 +  Result :=  FCodePage;
603 + end;
604 +
605 + function TSQLParamMetaData.getIsNullable: boolean;
606 + begin
607 +  Result :=  FNullable;
608 + end;
609 +
610 + function TSQLParamMetaData.GetSize: cardinal;
611 + begin
612 +  Result := FSize;
613 + end;
614 +
615   { TSQLDataArea }
616  
617   function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
# Line 605 | Line 758 | begin
758      FName := AValue;
759   end;
760  
761 + procedure TSQLVarData.SetMetaSize(aValue: cardinal);
762 + begin
763 +  //Ignore
764 + end;
765 +
766 + procedure TSQLVarData.SaveMetaData;
767 + begin
768 +  FColMetaData := TSQLParamMetaData.Create(self);
769 + end;
770 +
771   constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
772   begin
773    inherited Create;
# Line 621 | Line 784 | begin
784     a zero byte when the string is empty, neatly avoiding a nil pointer error.}
785  
786    FVarString := aValue;
787 <  SQLType := SQL_TEXT;
787 >  if SQLType = SQL_BLOB then
788 >    SetMetaSize(GetAttachment.GetInlineBlobLimit);
789 >  SQLType := GetDefaultTextSQLType;
790    Scale := 0;
791    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
792   end;
# Line 637 | Line 802 | begin
802    FVarString := '';
803   end;
804  
805 + function TSQLVarData.getColMetadata: IParamMetaData;
806 + begin
807 +  Result := FColMetaData;
808 + end;
809 +
810   procedure TSQLVarData.Initialize;
811  
812    function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
# Line 737 | Line 907 | begin
907      result := Val;
908   end;
909  
910 + function TSQLDataItem.AdjustScaleToStr(Value: Int64; aScale: Integer
911 +  ): AnsiString;
912 + var Scaling : AnsiString;
913 +    i: Integer;
914 + begin
915 +  Result := IntToStr(Value);
916 +  Scaling := '';
917 +  if aScale > 0 then
918 +  begin
919 +    for i := 1 to aScale do
920 +      Result := Result + '0';
921 +  end
922 +  else
923 +  if aScale < 0 then
924 +  {$IF declared(DefaultFormatSettings)}
925 +  with DefaultFormatSettings do
926 +  {$ELSE}
927 +  {$IF declared(FormatSettings)}
928 +  with FormatSettings do
929 +  {$IFEND}
930 +  {$IFEND}
931 +  begin
932 +    if Length(Result) > -aScale then
933 +      system.Insert(DecimalSeparator,Result,Length(Result) + aScale)
934 +    else
935 +    begin
936 +      Scaling := '0' + DecimalSeparator;
937 +      for i := -1 downto aScale + Length(Result) do
938 +        Scaling := Scaling + '0';
939 +      Result := Scaling + Result;
940 +    end;
941 +  end;
942 + end;
943 +
944   function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
945    ): Currency;
946   var
# Line 812 | Line 1016 | begin
1016    with FormatSettings do
1017    {$IFEND}
1018    {$IFEND}
1019 <    Result := LongTimeFormat;
1019 >    Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
1020   end;
1021  
1022   function TSQLDataItem.GetTimestampFormatStr: AnsiString;
# Line 824 | Line 1028 | begin
1028    with FormatSettings do
1029    {$IFEND}
1030    {$IFEND}
1031 <    Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
1031 >    Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
1032   end;
1033  
1034   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
# Line 832 | Line 1036 | begin
1036    SetAsLong(aValue);
1037   end;
1038  
1039 + procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
1040 +  var dstOffset: smallint; var aTimezone: AnsiString;
1041 +  var aTimeZoneID: TFBTimeZoneID);
1042 + begin
1043 +  CheckActive;
1044 +  aDateTime := 0;
1045 +  dstOffset := 0;
1046 +  aTimezone := '';
1047 +  aTimeZoneID := TimeZoneID_GMT;
1048 +  if not IsNull then
1049 +    with FFirebirdClientAPI do
1050 +    case SQLType of
1051 +      SQL_TEXT, SQL_VARYING:
1052 +        if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
1053 +          IBError(ibxeInvalidDataConversion, [nil]);
1054 +      SQL_TYPE_DATE:
1055 +        aDateTime := SQLDecodeDate(SQLData);
1056 +      SQL_TYPE_TIME:
1057 +        aDateTime := SQLDecodeTime(SQLData);
1058 +      SQL_TIMESTAMP:
1059 +        aDateTime := SQLDecodeDateTime(SQLData);
1060 +      SQL_TIMESTAMP_TZ:
1061 +        begin
1062 +          GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
1063 +          aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
1064 +        end;
1065 +      SQL_TIMESTAMP_TZ_EX:
1066 +      begin
1067 +        GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
1068 +        aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
1069 +      end;
1070 +      SQL_TIME_TZ:
1071 +        with GetTimeZoneServices do
1072 +        begin
1073 +          DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1074 +          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1075 +        end;
1076 +      SQL_TIME_TZ_EX:
1077 +        with GetTimeZoneServices do
1078 +        begin
1079 +          DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1080 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1081 +        end;
1082 +      else
1083 +        IBError(ibxeInvalidDataConversion, [nil]);
1084 +    end;
1085 + end;
1086 +
1087   function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1088    ): Int64;
1089   var
# Line 880 | Line 1132 | begin
1132    end
1133    else
1134      result := trunc(Value);
1135 + //  writeln('Adjusted ',Value,' to ',Result);
1136   end;
1137  
1138   procedure TSQLDataItem.CheckActive;
# Line 887 | Line 1140 | begin
1140    //Do nothing by default
1141   end;
1142  
1143 + procedure TSQLDataItem.CheckTZSupport;
1144 + begin
1145 +  if not FFirebirdClientAPI.HasTimeZoneSupport then
1146 +    IBError(ibxeNoTimezoneSupport,[]);
1147 + end;
1148 +
1149 + function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1150 + begin
1151 +  if FTimeZoneServices = nil then
1152 +  begin
1153 +    if not GetAttachment.HasTimeZoneSupport then
1154 +      IBError(ibxeNoTimezoneSupport,[]);
1155 +    GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1156 +  end;
1157 +  Result := FTimeZoneServices;
1158 + end;
1159 +
1160   procedure TSQLDataItem.Changed;
1161   begin
1162    //Do nothing by default
# Line 936 | Line 1206 | begin
1206    Result := GetSQLTypeName(GetSQLType);
1207   end;
1208  
1209 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1209 > class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1210   begin
1211    Result := 'Unknown';
1212    case SQLType of
# Line 947 | Line 1217 | begin
1217    SQL_LONG:             Result := 'SQL_LONG';
1218    SQL_SHORT:            Result := 'SQL_SHORT';
1219    SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1220 +  SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1221 +  SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1222    SQL_BLOB:             Result := 'SQL_BLOB';
1223    SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1224    SQL_ARRAY:            Result := 'SQL_ARRAY';
# Line 954 | Line 1226 | begin
1226    SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1227    SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1228    SQL_INT64:            Result := 'SQL_INT64';
1229 +  SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1230 +  SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1231 +  SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1232 +  SQL_DEC16:            Result := 'SQL_DEC16';
1233 +  SQL_DEC34:            Result := 'SQL_DEC34';
1234 +  SQL_INT128:           Result := 'SQL_INT128';
1235 +  SQL_NULL:             Result := 'SQL_NULL';
1236 +  SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1237    end;
1238   end;
1239  
# Line 1005 | Line 1285 | begin
1285            result := AdjustScaleToCurrency(PInt64(SQLData)^,
1286                                        Scale);
1287          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1288 <          result := Trunc(AsDouble);
1288 >          result := Round(AsDouble);
1289 >
1290 >        SQL_DEC_FIXED,
1291 >        SQL_DEC16,
1292 >        SQL_DEC34,
1293 >        SQL_INT128:
1294 >          if not BCDToCurr(GetAsBCD,Result) then
1295 >            IBError(ibxeInvalidDataConversion, [nil]);
1296 >
1297          else
1298            IBError(ibxeInvalidDataConversion, [nil]);
1299        end;
# Line 1035 | Line 1323 | begin
1323          result := AdjustScaleToInt64(PInt64(SQLData)^,
1324                                      Scale);
1325        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1326 <        result := Trunc(AsDouble);
1326 >        result := Round(AsDouble);
1327        else
1328          IBError(ibxeInvalidDataConversion, [nil]);
1329      end;
1330   end;
1331  
1332   function TSQLDataItem.GetAsDateTime: TDateTime;
1333 + var aTimezone: AnsiString;
1334 +    aTimeZoneID: TFBTimeZoneID;
1335 +    dstOffset: smallint;
1336 + begin
1337 +  InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1338 + end;
1339 +
1340 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1341 +  var dstOffset: smallint; var aTimezone: AnsiString);
1342 + var aTimeZoneID: TFBTimeZoneID;
1343 + begin
1344 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1345 + end;
1346 +
1347 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1348 +  var aTimezoneID: TFBTimeZoneID);
1349 + var aTimezone: AnsiString;
1350 + begin
1351 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1352 + end;
1353 +
1354 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1355 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1356 + var aTimeZone: AnsiString;
1357   begin
1358    CheckActive;
1359 <  result := 0;
1359 >  aTime := 0;
1360 >  dstOffset := 0;
1361    if not IsNull then
1362      with FFirebirdClientAPI do
1363      case SQLType of
1364 <      SQL_TEXT, SQL_VARYING: begin
1365 <        try
1366 <          result := StrToDate(AsString);
1367 <        except
1368 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1364 >      SQL_TIME_TZ:
1365 >        begin
1366 >          GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1367 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1368 >        end;
1369 >      SQL_TIME_TZ_EX:
1370 >        begin
1371 >          GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1372 >          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1373          end;
1374 +    else
1375 +      IBError(ibxeInvalidDataConversion, [nil]);
1376 +    end;
1377 + end;
1378 +
1379 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1380 +  var aTimezone: AnsiString; OnDate: TDateTime);
1381 + begin
1382 +  CheckActive;
1383 +  aTime := 0;
1384 +  dstOffset := 0;
1385 +  if not IsNull then
1386 +    with FFirebirdClientAPI do
1387 +    case SQLType of
1388 +      SQL_TIME_TZ:
1389 +        GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1390 +      SQL_TIME_TZ_EX:
1391 +        GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1392 +    else
1393 +      IBError(ibxeInvalidDataConversion, [nil]);
1394 +    end;
1395 + end;
1396 +
1397 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1398 +  var aTimezoneID: TFBTimeZoneID);
1399 + begin
1400 +  GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1401 + end;
1402 +
1403 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1404 +  var aTimezone: AnsiString);
1405 + begin
1406 +  GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1407 + end;
1408 +
1409 + function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1410 + var aTimezone: AnsiString;
1411 + begin
1412 +  CheckActive;
1413 +  result := 0;
1414 +  aTimezone := '';
1415 +  if not IsNull then
1416 +    with FFirebirdClientAPI do
1417 +    case SQLType of
1418 +      SQL_TEXT, SQL_VARYING:
1419 +      begin
1420 +        if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1421 +          IBError(ibxeInvalidDataConversion, [nil]);
1422 +        Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1423        end;
1424        SQL_TYPE_DATE:
1425          result := SQLDecodeDate(SQLData);
1426 <      SQL_TYPE_TIME:
1426 >      SQL_TYPE_TIME,
1427 >      SQL_TIME_TZ,
1428 >      SQL_TIME_TZ_EX:
1429          result := SQLDecodeTime(SQLData);
1430 <      SQL_TIMESTAMP:
1430 >      SQL_TIMESTAMP,
1431 >      SQL_TIMESTAMP_TZ,
1432 >      SQL_TIMESTAMP_TZ_EX:
1433          result := SQLDecodeDateTime(SQLData);
1434        else
1435          IBError(ibxeInvalidDataConversion, [nil]);
1436 <    end;
1436 >      end;
1437   end;
1438  
1439   function TSQLDataItem.GetAsDouble: Double;
# Line 1091 | Line 1461 | begin
1461          result := PFloat(SQLData)^;
1462        SQL_DOUBLE, SQL_D_FLOAT:
1463          result := PDouble(SQLData)^;
1464 +      SQL_DEC_FIXED,
1465 +      SQL_DEC16,
1466 +      SQL_DEC34,
1467 +      SQL_INT128:
1468 +        Result := BCDToDouble(GetAsBCD);
1469        else
1470          IBError(ibxeInvalidDataConversion, [nil]);
1471      end;
# Line 1127 | Line 1502 | begin
1502          end;
1503        end;
1504        SQL_SHORT:
1505 <        result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1505 >        result := Round(AdjustScale(Int64(PShort(SQLData)^),
1506                                      Scale));
1507        SQL_LONG:
1508 <        result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1508 >        result := Round(AdjustScale(Int64(PLong(SQLData)^),
1509                                      Scale));
1510        SQL_INT64:
1511 <        result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1511 >        result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1512        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1513 <        result := Trunc(AsDouble);
1513 >        result := Round(AsDouble);
1514 >      SQL_DEC_FIXED,
1515 >      SQL_DEC16,
1516 >      SQL_DEC34,
1517 >      SQL_INT128:
1518 >        Result := BCDToInteger(GetAsBCD);
1519        else
1520 <        IBError(ibxeInvalidDataConversion, [nil]);
1520 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1521      end;
1522   end;
1523  
# Line 1178 | Line 1558 | end;
1558   {Copied from LazUTF8}
1559  
1560   function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1561 < const TopBitSetMask   = $8000; {%10000000}
1562 <      Top2BitsSetMask = $C000; {%11000000}
1563 <      Top3BitsSetMask = $E000; {%11100000}
1564 <      Top4BitsSetMask = $F000; {%11110000}
1565 <      Top5BitsSetMask = $F800; {%11111000}
1561 > const TopBitSetMask   = $80; {%10000000}
1562 >      Top2BitsSetMask = $C0; {%11000000}
1563 >      Top3BitsSetMask = $E0; {%11100000}
1564 >      Top4BitsSetMask = $F0; {%11110000}
1565 >      Top5BitsSetMask = $F8; {%11111000}
1566   begin
1567    case p^ of
1568    #0..#191: // %11000000
# Line 1222 | Line 1602 | end;
1602  
1603   {Returns the byte length of a UTF8 string with a fixed charwidth}
1604  
1605 < function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer;
1605 > function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1606   var i: integer;
1607      cplen: integer;
1608 +    s: AnsiString;
1609   begin
1610    Result := 0;
1611 <  for i := 1 to CharWidth do
1611 >  s := strpas(p);
1612 >  for i := 1 to FieldWidth do
1613    begin
1614      cplen := UTF8CodepointSizeFull(p);
1615      Inc(p,cplen);
# Line 1245 | Line 1627 | var
1627    sz: PByte;
1628    str_len: Integer;
1629    rs: RawByteString;
1630 +  aTimeZone: AnsiString;
1631 +  aDateTime: TDateTime;
1632 +  dstOffset: smallint;
1633   begin
1634    CheckActive;
1635    result := '';
# Line 1264 | Line 1649 | begin
1649          if (SQLType = SQL_TEXT) then
1650          begin
1651            if GetCodePage = cp_utf8 then
1652 <            str_len := GetStrLen(PAnsiChar(sz),GetSize,DataLength)
1652 >            str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1653            else
1654              str_len := DataLength
1655          end
# Line 1276 | Line 1661 | begin
1661          SetCodePage(rs,GetCodePage,false);
1662          Result := rs;
1663        end;
1664 +
1665        SQL_TYPE_DATE:
1666 <        result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1281 <      SQL_TYPE_TIME :
1282 <        result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1666 >        Result := DateToStr(GetAsDateTime);
1667        SQL_TIMESTAMP:
1668 <        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1668 >        Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1669 >      SQL_TYPE_TIME:
1670 >        Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1671 >      SQL_TIMESTAMP_TZ,
1672 >      SQL_TIMESTAMP_TZ_EX:
1673 >        with GetAttachment.GetTimeZoneServices do
1674 >        begin
1675 >          if GetTZTextOption = tzGMT then
1676 >            Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1677 >          else
1678 >          begin
1679 >            GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1680 >            if GetTZTextOption = tzOffset then
1681 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1682 >            else
1683 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1684 >          end;
1685 >        end;
1686 >      SQL_TIME_TZ,
1687 >      SQL_TIME_TZ_EX:
1688 >        with GetAttachment.GetTimeZoneServices do
1689 >        begin
1690 >          if GetTZTextOption = tzGMT then
1691 >             Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1692 >          else
1693 >          begin
1694 >            GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1695 >            if GetTZTextOption = tzOffset then
1696 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1697 >            else
1698 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1699 >          end;
1700 >        end;
1701 >
1702        SQL_SHORT, SQL_LONG:
1703          if Scale = 0 then
1704            result := IntToStr(AsLong)
# Line 1298 | Line 1715 | begin
1715            result := FloatToStr(AsDouble);
1716        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1717          result := FloatToStr(AsDouble);
1718 +
1719 +      SQL_DEC16,
1720 +      SQL_DEC34:
1721 +        result := BCDToStr(GetAsBCD);
1722 +
1723 +      SQL_DEC_FIXED,
1724 +      SQL_INT128:
1725 +        result := Int128ToStr(SQLData,scale);
1726 +
1727        else
1728          IBError(ibxeInvalidDataConversion, [nil]);
1729      end;
# Line 1316 | Line 1742 | begin
1742   end;
1743  
1744   function TSQLDataItem.GetAsVariant: Variant;
1745 + var ts: TDateTime;
1746 +  dstOffset: smallint;
1747 +    timezone: AnsiString;
1748   begin
1749    CheckActive;
1750    if IsNull then
# Line 1329 | Line 1758 | begin
1758          result := AsString;
1759        SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1760          result := AsDateTime;
1761 +      SQL_TIMESTAMP_TZ,
1762 +      SQL_TIME_TZ,
1763 +      SQL_TIMESTAMP_TZ_EX,
1764 +      SQL_TIME_TZ_EX:
1765 +        begin
1766 +          GetAsDateTime(ts,dstOffset,timezone);
1767 +          result := VarArrayOf([ts,dstOffset,timezone]);
1768 +        end;
1769        SQL_SHORT, SQL_LONG:
1770          if Scale = 0 then
1771            result := AsLong
# Line 1347 | Line 1784 | begin
1784          result := AsDouble;
1785        SQL_BOOLEAN:
1786          result := AsBoolean;
1787 +      SQL_DEC_FIXED,
1788 +      SQL_DEC16,
1789 +      SQL_DEC34,
1790 +      SQL_INT128:
1791 +        result := VarFmtBCDCreate(GetAsBcd);
1792        else
1793          IBError(ibxeInvalidDataConversion, [nil]);
1794      end;
# Line 1367 | Line 1809 | begin
1809      Result := Length(GetDateFormatStr(true));
1810    dfTime:
1811      Result := Length(GetTimeFormatStr);
1812 +  dfTimestampTZ:
1813 +    Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1814 +  dfTimeTZ:
1815 +    Result := Length(GetTimeFormatStr)+ 6;
1816    else
1817      Result := 0;
1818 +  end;end;
1819 +
1820 + function TSQLDataItem.GetAsBCD: tBCD;
1821 +
1822 + begin
1823 +  CheckActive;
1824 +  if IsNull then
1825 +   with Result do
1826 +   begin
1827 +     FillChar(Result,sizeof(Result),0);
1828 +     Precision := 1;
1829 +     exit;
1830 +   end;
1831 +
1832 +  case SQLType of
1833 +  SQL_DEC16,
1834 +  SQL_DEC34:
1835 +    with FFirebirdClientAPI do
1836 +      Result := SQLDecFloatDecode(SQLType,  SQLData);
1837 +
1838 +  SQL_DEC_FIXED,
1839 +  SQL_INT128:
1840 +    with FFirebirdClientAPI do
1841 +      Result := StrToBCD(Int128ToStr(SQLData,scale));
1842 +  else
1843 +    if not CurrToBCD(GetAsCurrency,Result) then
1844 +      IBError(ibxeBadBCDConversion,[]);
1845    end;
1846   end;
1847  
# Line 1460 | Line 1933 | begin
1933    Changed;
1934   end;
1935  
1936 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1937 + begin
1938 +  CheckActive;
1939 +  CheckTZSupport;
1940 +  if GetSQLDialect < 3 then
1941 +  begin
1942 +    AsDateTime := aValue;
1943 +    exit;
1944 +  end;
1945 +
1946 +  Changing;
1947 +  if IsNullable then
1948 +    IsNull := False;
1949 +
1950 +  SQLType := SQL_TIME_TZ;
1951 +  DataLength := SizeOf(ISC_TIME_TZ);
1952 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1953 +  Changed;
1954 + end;
1955 +
1956 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1957 + begin
1958 +  CheckActive;
1959 +  CheckTZSupport;
1960 +  if GetSQLDialect < 3 then
1961 +  begin
1962 +    AsDateTime := aValue;
1963 +    exit;
1964 +  end;
1965 +
1966 +  Changing;
1967 +  if IsNullable then
1968 +    IsNull := False;
1969 +
1970 +  SQLType := SQL_TIME_TZ;
1971 +  DataLength := SizeOf(ISC_TIME_TZ);
1972 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1973 +  Changed;
1974 + end;
1975 +
1976   procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1977   begin
1978    CheckActive;
# Line 1474 | Line 1987 | begin
1987    Changed;
1988   end;
1989  
1990 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1991 +  aTimeZoneID: TFBTimeZoneID);
1992 + begin
1993 +  CheckActive;
1994 +  CheckTZSupport;
1995 +  if IsNullable then
1996 +    IsNull := False;
1997 +
1998 +  Changing;
1999 +  SQLType := SQL_TIMESTAMP_TZ;
2000 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
2001 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
2002 +  Changed;
2003 + end;
2004 +
2005 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
2006 +  );
2007 + begin
2008 +  CheckActive;
2009 +  CheckTZSupport;
2010 +  if IsNullable then
2011 +    IsNull := False;
2012 +
2013 +  Changing;
2014 +  SQLType := SQL_TIMESTAMP_TZ;
2015 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
2016 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
2017 +  Changed;
2018 + end;
2019 +
2020 + procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
2021 + begin
2022 +  SetAsDateTime(aUTCTime,TimeZoneID_GMT);
2023 + end;
2024 +
2025   procedure TSQLDataItem.SetAsDouble(Value: Double);
2026   begin
2027    CheckActive;
# Line 1569 | Line 2117 | begin
2117    CheckActive;
2118    if VarIsNull(Value) then
2119      IsNull := True
2120 +  else
2121 +  if VarIsArray(Value) then {must be datetime plus timezone}
2122 +    SetAsDateTime(Value[0],AnsiString(Value[1]))
2123    else case VarType(Value) of
2124      varEmpty, varNull:
2125        IsNull := True;
# Line 1591 | Line 2142 | begin
2142        IBError(ibxeNotSupported, [nil]);
2143      varByRef, varDispatch, varError, varUnknown, varVariant:
2144        IBError(ibxeNotPermitted, [nil]);
2145 +    else
2146 +      if VarIsFmtBCD(Value) then
2147 +        SetAsBCD(VarToBCD(Value))
2148 +      else
2149 +        IBError(ibxeNotSupported, [nil]);
2150    end;
2151   end;
2152  
# Line 1608 | Line 2164 | begin
2164    Changed;
2165   end;
2166  
2167 + procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2168 + var C: Currency;
2169 + begin
2170 +  CheckActive;
2171 +  Changing;
2172 +  if IsNullable then
2173 +    IsNull := False;
2174 +
2175 +
2176 +  with FFirebirdClientAPI do
2177 +  if aValue.Precision <= 16 then
2178 +  begin
2179 +    if not HasDecFloatSupport then
2180 +      IBError(ibxeDecFloatNotSupported,[]);
2181 +
2182 +    SQLType := SQL_DEC16;
2183 +    DataLength := 8;
2184 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2185 +  end
2186 +  else
2187 +  if aValue.Precision <= 34 then
2188 +  begin
2189 +    if not HasDecFloatSupport then
2190 +      IBError(ibxeDecFloatNotSupported,[]);
2191 +
2192 +    SQLType := SQL_DEC34;
2193 +    DataLength := 16;
2194 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2195 +  end
2196 +  else
2197 +  if aValue.Precision <= 38 then
2198 +  begin
2199 +    if not HasInt128Support then
2200 +      IBError(ibxeInt128NotSupported,[]);
2201 +
2202 +    SQLType := SQL_INT128;
2203 +    DataLength := 16;
2204 +    StrToInt128(scale,BcdToStr(aValue),SQLData);
2205 +  end
2206 +  else
2207 +    IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2208 +
2209 +  Changed;
2210 + end;
2211 +
2212   procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
2213   begin
2214    CheckActive;
# Line 1638 | Line 2239 | begin
2239      IBError(ibxeStatementNotPrepared, [nil]);
2240   end;
2241  
2242 + function TColumnMetaData.GetAttachment: IAttachment;
2243 + begin
2244 +  Result := GetStatement.GetAttachment;
2245 + end;
2246 +
2247   function TColumnMetaData.SQLData: PByte;
2248   begin
2249    Result := FIBXSQLVAR.SQLData;
# Line 1742 | Line 2348 | end;
2348   function TColumnMetaData.GetSize: cardinal;
2349   begin
2350    CheckActive;
2351 <  result := FIBXSQLVAR.DataLength;
2351 >  result := FIBXSQLVAR.GetSize;
2352 > end;
2353 >
2354 > function TColumnMetaData.GetCharSetWidth: integer;
2355 > begin
2356 >  CheckActive;
2357 >  result := FIBXSQLVAR.GetCharSetWidth;
2358   end;
2359  
2360   function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
# Line 1847 | Line 2459 | end;
2459  
2460   var b: IBlob;
2461      dt: TDateTime;
2462 <    CurrValue: Currency;
2463 <    FloatValue: single;
2462 >    timezone: AnsiString;
2463 >    Int64Value: Int64;
2464 >    BCDValue: TBCD;
2465 >    aScale: integer;
2466   begin
2467    CheckActive;
2468    if IsNullable then
2469      IsNull := False;
2470 <  case SQLTYPE of
2470 >  with FFirebirdClientAPI do
2471 >  case getColMetaData.SQLTYPE of
2472    SQL_BOOLEAN:
2473      if AnsiCompareText(Value,STrue) = 0 then
2474        AsBoolean := true
# Line 1864 | Line 2479 | begin
2479        IBError(ibxeInvalidDataConversion,[nil]);
2480  
2481    SQL_BLOB:
2482 +    if Length(Value) < GetAttachment.GetInlineBlobLimit then
2483 +      DoSetString
2484 +    else
2485      begin
2486        Changing;
2487        b := FIBXSQLVAR.CreateBlob;
# Line 1876 | Line 2494 | begin
2494    SQL_TEXT:
2495      DoSetString;
2496  
2497 <    SQL_SHORT,
2498 <    SQL_LONG,
2499 <    SQL_INT64:
2500 <      if TryStrToCurr(Value,CurrValue) then
2501 <        SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2502 <      else
2503 <        DoSetString;
2497 >  SQL_SHORT,
2498 >  SQL_LONG,
2499 >  SQL_INT64:
2500 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2501 >      SetAsNumeric(Int64Value,aScale)
2502 >    else
2503 >      DoSetString;
2504  
2505 <    SQL_D_FLOAT,
2506 <    SQL_DOUBLE,
2507 <    SQL_FLOAT:
2508 <      if TryStrToFloat(Value,FloatValue) then
2509 <        SetAsDouble(FloatValue)
2510 <      else
2511 <        DoSetString;
2505 >  SQL_DEC_FIXED,
2506 >  SQL_DEC16,
2507 >  SQL_DEC34,
2508 >  SQL_INT128:
2509 >    if TryStrToBCD(Value,BCDValue) then
2510 >      SetAsBCD(BCDValue)
2511 >    else
2512 >      DoSetString;
2513  
2514 <    SQL_TIMESTAMP:
2514 >  SQL_D_FLOAT,
2515 >  SQL_DOUBLE,
2516 >  SQL_FLOAT:
2517 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2518 >      SetAsDouble(NumericToDouble(Int64Value,aScale))
2519 >    else
2520 >      DoSetString;
2521 >
2522 >  SQL_TIMESTAMP:
2523        if TryStrToDateTime(Value,dt) then
2524          SetAsDateTime(dt)
2525        else
2526          DoSetString;
2527  
2528 <    SQL_TYPE_DATE:
2528 >  SQL_TYPE_DATE:
2529        if TryStrToDateTime(Value,dt) then
2530          SetAsDate(dt)
2531        else
2532          DoSetString;
2533  
2534 <    SQL_TYPE_TIME:
2534 >  SQL_TYPE_TIME:
2535        if TryStrToDateTime(Value,dt) then
2536          SetAsTime(dt)
2537        else
2538          DoSetString;
2539  
2540 <    else
2541 <      IBError(ibxeInvalidDataConversion,[nil]);
2540 >  SQL_TIMESTAMP_TZ,
2541 >  SQL_TIMESTAMP_TZ_EX:
2542 >      if ParseDateTimeTZString(value,dt,timezone) then
2543 >        SetAsDateTime(dt,timezone)
2544 >      else
2545 >        DoSetString;
2546 >
2547 >  SQL_TIME_TZ,
2548 >  SQL_TIME_TZ_EX:
2549 >      if ParseDateTimeTZString(value,dt,timezone,true) then
2550 >        SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2551 >      else
2552 >        DoSetString;
2553 >
2554 >  else
2555 >    IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2556    end;
2557   end;
2558  
# Line 1949 | Line 2590 | begin
2590    IsNull := true;
2591   end;
2592  
2593 + function TSQLParam.getColMetadata: IParamMetaData;
2594 + begin
2595 +  Result := FIBXSQLVAR.getColMetadata;
2596 + end;
2597 +
2598   function TSQLParam.GetModified: boolean;
2599   begin
2600    CheckActive;
# Line 1962 | Line 2608 | begin
2608    Result := inherited GetAsPointer;
2609   end;
2610  
2611 + function TSQLParam.GetAsString: AnsiString;
2612 + var rs: RawByteString;
2613 + begin
2614 +  Result := '';
2615 +  if (SQLType = SQL_VARYING) and not IsNull then
2616 +  {SQLData points to start of string - default is to length word}
2617 +  begin
2618 +    CheckActive;
2619 +    SetString(rs,PAnsiChar(SQLData),DataLength);
2620 +    SetCodePage(rs,GetCodePage,false);
2621 +    Result := rs;
2622 +  end
2623 +  else
2624 +    Result := inherited GetAsString;
2625 + end;
2626 +
2627   procedure TSQLParam.SetName(Value: AnsiString);
2628   begin
2629    CheckActive;
# Line 2153 | Line 2815 | begin
2815    end;
2816   end;
2817  
2818 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2819 + var i: integer;
2820 +    OldSQLVar: TSQLVarData;
2821 + begin
2822 +  if FIBXSQLVAR.UniqueName then
2823 +    inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2824 +  else
2825 +  with FIBXSQLVAR.Parent do
2826 +  begin
2827 +    for i := 0 to Count - 1 do
2828 +      if Column[i].Name = Name then
2829 +      begin
2830 +        OldSQLVar := FIBXSQLVAR;
2831 +        FIBXSQLVAR := Column[i];
2832 +        try
2833 +          inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2834 +        finally
2835 +          FIBXSQLVAR := OldSQLVar;
2836 +        end;
2837 +      end;
2838 +  end;
2839 + end;
2840 +
2841 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2842 + var i: integer;
2843 +    OldSQLVar: TSQLVarData;
2844 + begin
2845 +  if FIBXSQLVAR.UniqueName then
2846 +    inherited SetAsTime(AValue,OnDate,aTimeZone)
2847 +  else
2848 +  with FIBXSQLVAR.Parent do
2849 +  begin
2850 +    for i := 0 to Count - 1 do
2851 +      if Column[i].Name = Name then
2852 +      begin
2853 +        OldSQLVar := FIBXSQLVAR;
2854 +        FIBXSQLVAR := Column[i];
2855 +        try
2856 +          inherited SetAsTime(AValue,OnDate,aTimeZone);
2857 +        finally
2858 +          FIBXSQLVAR := OldSQLVar;
2859 +        end;
2860 +      end;
2861 +  end;
2862 + end;
2863 +
2864 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2865 + begin
2866 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2867 + end;
2868 +
2869 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2870 + begin
2871 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2872 + end;
2873 +
2874   procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2875   var i: integer;
2876      OldSQLVar: TSQLVarData;
# Line 2176 | Line 2894 | begin
2894    end;
2895   end;
2896  
2897 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2898 +  );
2899 + var i: integer;
2900 +    OldSQLVar: TSQLVarData;
2901 + begin
2902 +  if FIBXSQLVAR.UniqueName then
2903 +    inherited SetAsDateTime(AValue,aTimeZoneID)
2904 +  else
2905 +  with FIBXSQLVAR.Parent do
2906 +  begin
2907 +    for i := 0 to Count - 1 do
2908 +      if Column[i].Name = Name then
2909 +      begin
2910 +        OldSQLVar := FIBXSQLVAR;
2911 +        FIBXSQLVAR := Column[i];
2912 +        try
2913 +          inherited SetAsDateTime(AValue,aTimeZoneID);
2914 +        finally
2915 +          FIBXSQLVAR := OldSQLVar;
2916 +        end;
2917 +      end;
2918 +  end;
2919 + end;
2920 +
2921 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2922 + var i: integer;
2923 +    OldSQLVar: TSQLVarData;
2924 + begin
2925 +  if FIBXSQLVAR.UniqueName then
2926 +    inherited SetAsDateTime(AValue,aTimeZone)
2927 +  else
2928 +  with FIBXSQLVAR.Parent do
2929 +  begin
2930 +    for i := 0 to Count - 1 do
2931 +      if Column[i].Name = Name then
2932 +      begin
2933 +        OldSQLVar := FIBXSQLVAR;
2934 +        FIBXSQLVAR := Column[i];
2935 +        try
2936 +          inherited SetAsDateTime(AValue,aTimeZone);
2937 +        finally
2938 +          FIBXSQLVAR := OldSQLVar;
2939 +        end;
2940 +      end;
2941 +  end;
2942 + end;
2943 +
2944   procedure TSQLParam.SetAsDouble(AValue: Double);
2945   var i: integer;
2946      OldSQLVar: TSQLVarData;
# Line 2356 | Line 3121 | begin
3121    FIBXSQLVAR.SetCharSetID(aValue);
3122   end;
3123  
3124 + procedure TSQLParam.SetAsBcd(aValue: tBCD);
3125 + var i: integer;
3126 +    OldSQLVar: TSQLVarData;
3127 + begin
3128 +  if FIBXSQLVAR.UniqueName then
3129 +    inherited SetAsBcd(AValue)
3130 +  else
3131 +  with FIBXSQLVAR.Parent do
3132 +  begin
3133 +    for i := 0 to Count - 1 do
3134 +      if Column[i].Name = Name then
3135 +      begin
3136 +        OldSQLVar := FIBXSQLVAR;
3137 +        FIBXSQLVAR := Column[i];
3138 +        try
3139 +          inherited SetAsBcd(AValue);
3140 +        finally
3141 +          FIBXSQLVAR := OldSQLVar;
3142 +        end;
3143 +      end;
3144 +  end;
3145 + end;
3146 +
3147   { TMetaData }
3148  
3149   procedure TMetaData.CheckActive;
# Line 2511 | Line 3299 | begin
3299    if not FResults.CheckStatementStatus(ssPrepared)  then
3300      IBError(ibxeStatementNotPrepared, [nil]);
3301  
3302 <  with GetTransaction as TFBTransaction do
3302 >  with GetTransaction do
3303    if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3304      IBError(ibxeInterfaceOutofDate,[nil]);
3305   end;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines