ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/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.
Revision 349 by tony, Mon Oct 18 08:39:40 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 +     FTimeZoneServices: IExTimeZoneServices;
125       function AdjustScale(Value: Int64; aScale: Integer): Double;
126       function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
127       function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
95     function GetTimestampFormatStr: AnsiString;
128       function GetDateFormatStr(IncludeTime: boolean): AnsiString;
129       function GetTimeFormatStr: AnsiString;
130 +     function GetTimestampFormatStr: AnsiString;
131       procedure SetAsInteger(AValue: Integer);
132 +     procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
133 +       var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID);
134    protected
135       function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
136       function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
137       procedure CheckActive; virtual;
138 +     procedure CheckTZSupport;
139 +     function GetAttachment: IAttachment; virtual; abstract;
140       function GetSQLDialect: integer; virtual; abstract;
141 +     function GetTimeZoneServices: IExTimeZoneServices; virtual;
142       procedure Changed; virtual;
143       procedure Changing; virtual;
144       procedure InternalSetAsString(Value: AnsiString); virtual;
# Line 113 | Line 151 | type
151       procedure SetDataLength(len: cardinal); virtual;
152       procedure SetSQLType(aValue: cardinal); virtual;
153       property DataLength: cardinal read GetDataLength write SetDataLength;
154 <
154 >     property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
155    public
156       constructor Create(api: TFBClientAPI);
157 <     function GetSQLType: cardinal; virtual; abstract;
157 >     function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
158       function GetSQLTypeName: AnsiString; overload;
159 <     class function GetSQLTypeName(SQLType: short): AnsiString; overload;
159 >     class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
160       function GetStrDataLength: short;
161       function GetName: AnsiString; virtual; abstract;
162 <     function GetScale: integer; virtual; abstract;
162 >     function GetScale: integer; virtual; abstract; {Current Field Data scale}
163       function GetAsBoolean: boolean;
164       function GetAsCurrency: Currency;
165       function GetAsInt64: Int64;
166 <     function GetAsDateTime: TDateTime;
166 >     function GetAsDateTime: TDateTime; overload;
167 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
168 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
169 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
170 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
171 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
172 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
173 >     function GetAsUTCDateTime: TDateTime;
174       function GetAsDouble: Double;
175       function GetAsFloat: Float;
176       function GetAsLong: Long;
# Line 138 | Line 183 | type
183       function GetAsVariant: Variant;
184       function GetModified: boolean; virtual;
185       function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
186 +     function GetAsBCD: tBCD;
187       function GetSize: cardinal; virtual; abstract;
188 +     function GetCharSetWidth: integer; virtual; abstract;
189       procedure SetAsBoolean(AValue: boolean); virtual;
190       procedure SetAsCurrency(Value: Currency); virtual;
191       procedure SetAsInt64(Value: Int64); virtual;
192       procedure SetAsDate(Value: TDateTime); virtual;
193       procedure SetAsLong(Value: Long); virtual;
194 <     procedure SetAsTime(Value: TDateTime); virtual;
195 <     procedure SetAsDateTime(Value: TDateTime);
194 >     procedure SetAsTime(Value: TDateTime); overload;
195 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime;aTimeZoneID: TFBTimeZoneID); overload;
196 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
197 >     procedure SetAsDateTime(Value: TDateTime); overload;
198 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
199 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
200 >     procedure SetAsUTCDateTime(aUTCTime: TDateTime);
201       procedure SetAsDouble(Value: Double); virtual;
202       procedure SetAsFloat(Value: Float); virtual;
203       procedure SetAsPointer(Value: Pointer);
# Line 154 | Line 206 | type
206       procedure SetAsString(Value: AnsiString); virtual;
207       procedure SetAsVariant(Value: Variant);
208       procedure SetAsNumeric(Value: Int64; aScale: integer);
209 +     procedure SetAsBcd(aValue: tBCD); virtual;
210       procedure SetIsNull(Value: Boolean); virtual;
211       procedure SetIsNullable(Value: Boolean); virtual;
212       procedure SetName(aValue: AnsiString); virtual;
# Line 212 | Line 265 | type
265      function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
266      property CaseSensitiveParams: boolean read FCaseSensitiveParams
267                                              write FCaseSensitiveParams; {Only used when IsInputDataArea true}
268 +    function CanChangeMetaData: boolean; virtual; abstract;
269      property Count: integer read GetCount;
270      property Column[index: integer]: TSQLVarData read GetColumn;
271      property UniqueRelationName: AnsiString read FUniqueRelationName;
# Line 230 | Line 284 | type
284      FModified: boolean;
285      FUniqueName: boolean;
286      FVarString: RawByteString;
287 +    FColMetaData: IParamMetaData;
288      function GetStatement: IStatement;
289      procedure SetName(AValue: AnsiString);
290    protected
291 +    function GetAttachment: IAttachment; virtual; abstract;
292      function GetSQLType: cardinal; virtual; abstract;
293      function GetSubtype: integer; virtual; abstract;
294      function GetAliasName: AnsiString;  virtual; abstract;
# Line 241 | Line 297 | type
297      function GetRelationName: AnsiString;  virtual; abstract;
298      function GetScale: integer; virtual; abstract;
299      function GetCharSetID: cardinal; virtual; abstract;
300 +    function GetCharSetWidth: integer; virtual; abstract;
301      function GetCodePage: TSystemCodePage; virtual; abstract;
302      function GetIsNull: Boolean;   virtual; abstract;
303      function GetIsNullable: boolean; virtual; abstract;
304      function GetSQLData: PByte;  virtual; abstract;
305 <    function GetDataLength: cardinal; virtual; abstract;
305 >    function GetDataLength: cardinal; virtual; abstract; {current field length}
306 >    function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
307 >    function GetDefaultTextSQLType: cardinal; virtual; abstract;
308      procedure SetIsNull(Value: Boolean); virtual; abstract;
309      procedure SetIsNullable(Value: Boolean);  virtual; abstract;
310      procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
# Line 253 | Line 312 | type
312      procedure SetDataLength(len: cardinal); virtual; abstract;
313      procedure SetSQLType(aValue: cardinal); virtual; abstract;
314      procedure SetCharSetID(aValue: cardinal); virtual; abstract;
315 +    procedure SetMetaSize(aValue: cardinal); virtual;
316    public
317      constructor Create(aParent: TSQLDataArea; aIndex: integer);
318      procedure SetString(aValue: AnsiString);
# Line 263 | Line 323 | type
323      function CreateBlob: IBlob; virtual; abstract;
324      function GetArrayMetaData: IArrayMetaData; virtual; abstract;
325      function GetBlobMetaData: IBlobMetaData; virtual; abstract;
326 +    function getColMetadata: IParamMetaData;
327      procedure Initialize; virtual;
328 +    procedure SaveMetaData;
329  
330    public
331      property AliasName: AnsiString read GetAliasName;
# Line 297 | Line 359 | type
359      FChangeSeqNo: integer;
360    protected
361      procedure CheckActive; override;
362 +    function GetAttachment: IAttachment; override;
363      function SQLData: PByte; override;
364      function GetDataLength: cardinal; override;
365      function GetCodePage: TSystemCodePage; override;
# Line 320 | Line 383 | type
383      function getCharSetID: cardinal; override;
384      function GetIsNullable: boolean; override;
385      function GetSize: cardinal; override;
386 +    function GetCharSetWidth: integer; override;
387      function GetArrayMetaData: IArrayMetaData;
388      function GetBlobMetaData: IBlobMetaData;
389      function GetStatement: IStatement;
# Line 350 | Line 414 | type
414      property AsBlob: IBlob read GetAsBlob;
415   end;
416  
417 +  { TSQLParamMetaData }
418 +
419 +  TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
420 +  private
421 +    FSQLType: cardinal;
422 +    FSQLSubType: integer;
423 +    FScale: integer;
424 +    FCharSetID: cardinal;
425 +    FNullable: boolean;
426 +    FSize: cardinal;
427 +    FCodePage: TSystemCodePage;
428 +  public
429 +    constructor Create(src: TSQLVarData);
430 +    {IParamMetaData}
431 +    function GetSQLType: cardinal;
432 +    function GetSQLTypeName: AnsiString;
433 +    function getSubtype: integer;
434 +    function getScale: integer;
435 +    function getCharSetID: cardinal;
436 +    function getCodePage: TSystemCodePage;
437 +    function getIsNullable: boolean;
438 +    function GetSize: cardinal;
439 +    property SQLType: cardinal read GetSQLType;
440 +  end;
441 +
442    { TSQLParam }
443  
444 <  TSQLParam = class(TIBSQLData,ISQLParam)
444 >  TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
445    protected
446      procedure CheckActive; override;
447      procedure Changed; override;
# Line 362 | Line 451 | type
451      procedure SetSQLType(aValue: cardinal); override;
452    public
453      procedure Clear;
454 +    function getColMetadata: IParamMetaData;
455      function GetModified: boolean; override;
456      function GetAsPointer: Pointer;
457 +    function GetAsString: AnsiString; override;
458      procedure SetName(Value: AnsiString); override;
459      procedure SetIsNull(Value: Boolean);  override;
460      procedure SetIsNullable(Value: Boolean); override;
# Line 375 | Line 466 | type
466      procedure SetAsInt64(AValue: Int64);
467      procedure SetAsDate(AValue: TDateTime);
468      procedure SetAsLong(AValue: Long);
469 <    procedure SetAsTime(AValue: TDateTime);
470 <    procedure SetAsDateTime(AValue: TDateTime);
469 >    procedure SetAsTime(AValue: TDateTime); overload;
470 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
471 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
472 >    procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
473 >    procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
474 >    procedure SetAsDateTime(AValue: TDateTime); overload;
475 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
476 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
477      procedure SetAsDouble(AValue: Double);
478      procedure SetAsFloat(AValue: Float);
479      procedure SetAsPointer(AValue: Pointer);
# Line 386 | Line 483 | type
483      procedure SetAsBlob(aValue: IBlob);
484      procedure SetAsQuad(AValue: TISC_QUAD);
485      procedure SetCharSetID(aValue: cardinal);
486 +    procedure SetAsBcd(aValue: tBCD);
487  
488      property AsBlob: IBlob read GetAsBlob write SetAsBlob;
489      property IsNullable: Boolean read GetIsNullable write SetIsNullable;
# Line 459 | Line 557 | implementation
557  
558   uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
559  
560 + { TSQLParamMetaData }
561 +
562 + constructor TSQLParamMetaData.Create(src: TSQLVarData);
563 + begin
564 +  inherited Create;
565 +  FSQLType := src.GetSQLType;
566 +  FSQLSubType := src.getSubtype;
567 +  FScale := src.GetScale;
568 +  FCharSetID := src.getCharSetID;
569 +  FNullable := src.GetIsNullable;
570 +  FSize := src.GetSize;
571 +  FCodePage := src.GetCodePage;
572 + end;
573 +
574 + function TSQLParamMetaData.GetSQLType: cardinal;
575 + begin
576 +  Result := FSQLType;
577 + end;
578 +
579 + function TSQLParamMetaData.GetSQLTypeName: AnsiString;
580 + begin
581 +  Result := TSQLDataItem.GetSQLTypeName(FSQLType);
582 + end;
583 +
584 + function TSQLParamMetaData.getSubtype: integer;
585 + begin
586 +  Result := FSQLSubType;
587 + end;
588 +
589 + function TSQLParamMetaData.getScale: integer;
590 + begin
591 +  Result := FScale;
592 + end;
593 +
594 + function TSQLParamMetaData.getCharSetID: cardinal;
595 + begin
596 +  Result := FCharSetID;
597 + end;
598 +
599 + function TSQLParamMetaData.getCodePage: TSystemCodePage;
600 + begin
601 +  Result :=  FCodePage;
602 + end;
603 +
604 + function TSQLParamMetaData.getIsNullable: boolean;
605 + begin
606 +  Result :=  FNullable;
607 + end;
608 +
609 + function TSQLParamMetaData.GetSize: cardinal;
610 + begin
611 +  Result := FSize;
612 + end;
613 +
614   { TSQLDataArea }
615  
616   function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
# Line 605 | Line 757 | begin
757      FName := AValue;
758   end;
759  
760 + procedure TSQLVarData.SetMetaSize(aValue: cardinal);
761 + begin
762 +  //Ignore
763 + end;
764 +
765 + procedure TSQLVarData.SaveMetaData;
766 + begin
767 +  FColMetaData := TSQLParamMetaData.Create(self);
768 + end;
769 +
770   constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
771   begin
772    inherited Create;
# Line 621 | Line 783 | begin
783     a zero byte when the string is empty, neatly avoiding a nil pointer error.}
784  
785    FVarString := aValue;
786 <  SQLType := SQL_TEXT;
786 >  if SQLType = SQL_BLOB then
787 >    SetMetaSize(GetAttachment.GetInlineBlobLimit);
788 >  SQLType := GetDefaultTextSQLType;
789    Scale := 0;
790    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
791   end;
# Line 637 | Line 801 | begin
801    FVarString := '';
802   end;
803  
804 + function TSQLVarData.getColMetadata: IParamMetaData;
805 + begin
806 +  Result := FColMetaData;
807 + end;
808 +
809   procedure TSQLVarData.Initialize;
810  
811    function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
# Line 812 | Line 981 | begin
981    with FormatSettings do
982    {$IFEND}
983    {$IFEND}
984 <    Result := LongTimeFormat;
984 >    Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
985   end;
986  
987   function TSQLDataItem.GetTimestampFormatStr: AnsiString;
# Line 824 | Line 993 | begin
993    with FormatSettings do
994    {$IFEND}
995    {$IFEND}
996 <    Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
996 >    Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
997   end;
998  
999   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
# Line 832 | Line 1001 | begin
1001    SetAsLong(aValue);
1002   end;
1003  
1004 + procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
1005 +  var dstOffset: smallint; var aTimezone: AnsiString;
1006 +  var aTimeZoneID: TFBTimeZoneID);
1007 + begin
1008 +  CheckActive;
1009 +  aDateTime := 0;
1010 +  dstOffset := 0;
1011 +  aTimezone := '';
1012 +  aTimeZoneID := TimeZoneID_GMT;
1013 +  if not IsNull then
1014 +    with FFirebirdClientAPI do
1015 +    case SQLType of
1016 +      SQL_TEXT, SQL_VARYING:
1017 +        if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
1018 +          IBError(ibxeInvalidDataConversion, [nil]);
1019 +      SQL_TYPE_DATE:
1020 +        aDateTime := SQLDecodeDate(SQLData);
1021 +      SQL_TYPE_TIME:
1022 +        aDateTime := SQLDecodeTime(SQLData);
1023 +      SQL_TIMESTAMP:
1024 +        aDateTime := SQLDecodeDateTime(SQLData);
1025 +      SQL_TIMESTAMP_TZ:
1026 +        begin
1027 +          GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
1028 +          aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
1029 +        end;
1030 +      SQL_TIMESTAMP_TZ_EX:
1031 +      begin
1032 +        GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
1033 +        aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
1034 +      end;
1035 +      SQL_TIME_TZ:
1036 +        with GetTimeZoneServices do
1037 +        begin
1038 +          DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1039 +          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1040 +        end;
1041 +      SQL_TIME_TZ_EX:
1042 +        with GetTimeZoneServices do
1043 +        begin
1044 +          DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1045 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1046 +        end;
1047 +      else
1048 +        IBError(ibxeInvalidDataConversion, [nil]);
1049 +    end;
1050 + end;
1051 +
1052   function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1053    ): Int64;
1054   var
# Line 880 | Line 1097 | begin
1097    end
1098    else
1099      result := trunc(Value);
1100 + //  writeln('Adjusted ',Value,' to ',Result);
1101   end;
1102  
1103   procedure TSQLDataItem.CheckActive;
# Line 887 | Line 1105 | begin
1105    //Do nothing by default
1106   end;
1107  
1108 + procedure TSQLDataItem.CheckTZSupport;
1109 + begin
1110 +  if not FFirebirdClientAPI.HasTimeZoneSupport then
1111 +    IBError(ibxeNoTimezoneSupport,[]);
1112 + end;
1113 +
1114 + function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1115 + begin
1116 +  if FTimeZoneServices = nil then
1117 +  begin
1118 +    if not GetAttachment.HasTimeZoneSupport then
1119 +      IBError(ibxeNoTimezoneSupport,[]);
1120 +    GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1121 +  end;
1122 +  Result := FTimeZoneServices;
1123 + end;
1124 +
1125   procedure TSQLDataItem.Changed;
1126   begin
1127    //Do nothing by default
# Line 936 | Line 1171 | begin
1171    Result := GetSQLTypeName(GetSQLType);
1172   end;
1173  
1174 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1174 > class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1175   begin
1176    Result := 'Unknown';
1177    case SQLType of
# Line 947 | Line 1182 | begin
1182    SQL_LONG:             Result := 'SQL_LONG';
1183    SQL_SHORT:            Result := 'SQL_SHORT';
1184    SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1185 +  SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1186 +  SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1187    SQL_BLOB:             Result := 'SQL_BLOB';
1188    SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1189    SQL_ARRAY:            Result := 'SQL_ARRAY';
# Line 954 | Line 1191 | begin
1191    SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1192    SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1193    SQL_INT64:            Result := 'SQL_INT64';
1194 +  SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1195 +  SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1196 +  SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1197 +  SQL_DEC16:            Result := 'SQL_DEC16';
1198 +  SQL_DEC34:            Result := 'SQL_DEC34';
1199 +  SQL_INT128:           Result := 'SQL_INT128';
1200 +  SQL_NULL:             Result := 'SQL_NULL';
1201 +  SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1202    end;
1203   end;
1204  
# Line 1005 | Line 1250 | begin
1250            result := AdjustScaleToCurrency(PInt64(SQLData)^,
1251                                        Scale);
1252          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1253 <          result := Trunc(AsDouble);
1253 >          result := Round(AsDouble);
1254 >
1255 >        SQL_DEC_FIXED,
1256 >        SQL_DEC16,
1257 >        SQL_DEC34,
1258 >        SQL_INT128:
1259 >          if not BCDToCurr(GetAsBCD,Result) then
1260 >            IBError(ibxeInvalidDataConversion, [nil]);
1261 >
1262          else
1263            IBError(ibxeInvalidDataConversion, [nil]);
1264        end;
# Line 1035 | Line 1288 | begin
1288          result := AdjustScaleToInt64(PInt64(SQLData)^,
1289                                      Scale);
1290        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1291 <        result := Trunc(AsDouble);
1291 >        result := Round(AsDouble);
1292        else
1293          IBError(ibxeInvalidDataConversion, [nil]);
1294      end;
1295   end;
1296  
1297   function TSQLDataItem.GetAsDateTime: TDateTime;
1298 + var aTimezone: AnsiString;
1299 +    aTimeZoneID: TFBTimeZoneID;
1300 +    dstOffset: smallint;
1301 + begin
1302 +  InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1303 + end;
1304 +
1305 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1306 +  var dstOffset: smallint; var aTimezone: AnsiString);
1307 + var aTimeZoneID: TFBTimeZoneID;
1308 + begin
1309 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1310 + end;
1311 +
1312 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1313 +  var aTimezoneID: TFBTimeZoneID);
1314 + var aTimezone: AnsiString;
1315 + begin
1316 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1317 + end;
1318 +
1319 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1320 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1321 + var aTimeZone: AnsiString;
1322   begin
1323    CheckActive;
1324 <  result := 0;
1324 >  aTime := 0;
1325 >  dstOffset := 0;
1326    if not IsNull then
1327      with FFirebirdClientAPI do
1328      case SQLType of
1329 <      SQL_TEXT, SQL_VARYING: begin
1330 <        try
1331 <          result := StrToDate(AsString);
1332 <        except
1055 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1329 >      SQL_TIME_TZ:
1330 >        begin
1331 >          GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1332 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1333          end;
1334 +      SQL_TIME_TZ_EX:
1335 +        begin
1336 +          GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1337 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1338 +        end;
1339 +    else
1340 +      IBError(ibxeInvalidDataConversion, [nil]);
1341 +    end;
1342 + end;
1343 +
1344 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1345 +  var aTimezone: AnsiString; OnDate: TDateTime);
1346 + begin
1347 +  CheckActive;
1348 +  aTime := 0;
1349 +  dstOffset := 0;
1350 +  if not IsNull then
1351 +    with FFirebirdClientAPI do
1352 +    case SQLType of
1353 +      SQL_TIME_TZ:
1354 +        GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1355 +      SQL_TIME_TZ_EX:
1356 +        GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1357 +    else
1358 +      IBError(ibxeInvalidDataConversion, [nil]);
1359 +    end;
1360 + end;
1361 +
1362 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1363 +  var aTimezoneID: TFBTimeZoneID);
1364 + begin
1365 +  GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1366 + end;
1367 +
1368 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1369 +  var aTimezone: AnsiString);
1370 + begin
1371 +  GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1372 + end;
1373 +
1374 + function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1375 + var aTimezone: AnsiString;
1376 + begin
1377 +  CheckActive;
1378 +  result := 0;
1379 +  aTimezone := '';
1380 +  if not IsNull then
1381 +    with FFirebirdClientAPI do
1382 +    case SQLType of
1383 +      SQL_TEXT, SQL_VARYING:
1384 +      begin
1385 +        if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1386 +          IBError(ibxeInvalidDataConversion, [nil]);
1387 +        Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1388        end;
1389        SQL_TYPE_DATE:
1390          result := SQLDecodeDate(SQLData);
1391 <      SQL_TYPE_TIME:
1391 >      SQL_TYPE_TIME,
1392 >      SQL_TIME_TZ,
1393 >      SQL_TIME_TZ_EX:
1394          result := SQLDecodeTime(SQLData);
1395 <      SQL_TIMESTAMP:
1395 >      SQL_TIMESTAMP,
1396 >      SQL_TIMESTAMP_TZ,
1397 >      SQL_TIMESTAMP_TZ_EX:
1398          result := SQLDecodeDateTime(SQLData);
1399        else
1400          IBError(ibxeInvalidDataConversion, [nil]);
1401 <    end;
1401 >      end;
1402   end;
1403  
1404   function TSQLDataItem.GetAsDouble: Double;
# Line 1091 | Line 1426 | begin
1426          result := PFloat(SQLData)^;
1427        SQL_DOUBLE, SQL_D_FLOAT:
1428          result := PDouble(SQLData)^;
1429 +      SQL_DEC_FIXED,
1430 +      SQL_DEC16,
1431 +      SQL_DEC34,
1432 +      SQL_INT128:
1433 +        Result := BCDToDouble(GetAsBCD);
1434        else
1435          IBError(ibxeInvalidDataConversion, [nil]);
1436      end;
# Line 1127 | Line 1467 | begin
1467          end;
1468        end;
1469        SQL_SHORT:
1470 <        result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1470 >        result := Round(AdjustScale(Int64(PShort(SQLData)^),
1471                                      Scale));
1472        SQL_LONG:
1473 <        result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1473 >        result := Round(AdjustScale(Int64(PLong(SQLData)^),
1474                                      Scale));
1475        SQL_INT64:
1476 <        result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1476 >        result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1477        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1478 <        result := Trunc(AsDouble);
1478 >        result := Round(AsDouble);
1479 >      SQL_DEC_FIXED,
1480 >      SQL_DEC16,
1481 >      SQL_DEC34,
1482 >      SQL_INT128:
1483 >        Result := BCDToInteger(GetAsBCD);
1484        else
1485 <        IBError(ibxeInvalidDataConversion, [nil]);
1485 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1486      end;
1487   end;
1488  
# Line 1178 | Line 1523 | end;
1523   {Copied from LazUTF8}
1524  
1525   function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1526 < const TopBitSetMask   = $8000; {%10000000}
1527 <      Top2BitsSetMask = $C000; {%11000000}
1528 <      Top3BitsSetMask = $E000; {%11100000}
1529 <      Top4BitsSetMask = $F000; {%11110000}
1530 <      Top5BitsSetMask = $F800; {%11111000}
1526 > const TopBitSetMask   = $80; {%10000000}
1527 >      Top2BitsSetMask = $C0; {%11000000}
1528 >      Top3BitsSetMask = $E0; {%11100000}
1529 >      Top4BitsSetMask = $F0; {%11110000}
1530 >      Top5BitsSetMask = $F8; {%11111000}
1531   begin
1532    case p^ of
1533    #0..#191: // %11000000
# Line 1222 | Line 1567 | end;
1567  
1568   {Returns the byte length of a UTF8 string with a fixed charwidth}
1569  
1570 < function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer;
1570 > function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1571   var i: integer;
1572      cplen: integer;
1573 +    s: AnsiString;
1574   begin
1575    Result := 0;
1576 <  for i := 1 to CharWidth do
1576 >  s := strpas(p);
1577 >  for i := 1 to FieldWidth do
1578    begin
1579      cplen := UTF8CodepointSizeFull(p);
1580      Inc(p,cplen);
# Line 1245 | Line 1592 | var
1592    sz: PByte;
1593    str_len: Integer;
1594    rs: RawByteString;
1595 +  aTimeZone: AnsiString;
1596 +  aDateTime: TDateTime;
1597 +  dstOffset: smallint;
1598   begin
1599    CheckActive;
1600    result := '';
# Line 1264 | Line 1614 | begin
1614          if (SQLType = SQL_TEXT) then
1615          begin
1616            if GetCodePage = cp_utf8 then
1617 <            str_len := GetStrLen(PAnsiChar(sz),GetSize,DataLength)
1617 >            str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1618            else
1619              str_len := DataLength
1620          end
# Line 1276 | Line 1626 | begin
1626          SetCodePage(rs,GetCodePage,false);
1627          Result := rs;
1628        end;
1629 +
1630        SQL_TYPE_DATE:
1631 <        result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1281 <      SQL_TYPE_TIME :
1282 <        result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1631 >        Result := DateToStr(GetAsDateTime);
1632        SQL_TIMESTAMP:
1633 <        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1633 >        Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1634 >      SQL_TYPE_TIME:
1635 >        Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1636 >      SQL_TIMESTAMP_TZ,
1637 >      SQL_TIMESTAMP_TZ_EX:
1638 >        with GetAttachment.GetTimeZoneServices do
1639 >        begin
1640 >          if GetTZTextOption = tzGMT then
1641 >            Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1642 >          else
1643 >          begin
1644 >            GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1645 >            if GetTZTextOption = tzOffset then
1646 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1647 >            else
1648 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1649 >          end;
1650 >        end;
1651 >      SQL_TIME_TZ,
1652 >      SQL_TIME_TZ_EX:
1653 >        with GetAttachment.GetTimeZoneServices do
1654 >        begin
1655 >          if GetTZTextOption = tzGMT then
1656 >             Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1657 >          else
1658 >          begin
1659 >            GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1660 >            if GetTZTextOption = tzOffset then
1661 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1662 >            else
1663 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1664 >          end;
1665 >        end;
1666 >
1667        SQL_SHORT, SQL_LONG:
1668          if Scale = 0 then
1669            result := IntToStr(AsLong)
# Line 1298 | Line 1680 | begin
1680            result := FloatToStr(AsDouble);
1681        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1682          result := FloatToStr(AsDouble);
1683 +
1684 +      SQL_DEC16,
1685 +      SQL_DEC34:
1686 +        result := BCDToStr(GetAsBCD);
1687 +
1688 +      SQL_DEC_FIXED,
1689 +      SQL_INT128:
1690 +        result := Int128ToStr(SQLData,scale);
1691 +
1692        else
1693          IBError(ibxeInvalidDataConversion, [nil]);
1694      end;
# Line 1316 | Line 1707 | begin
1707   end;
1708  
1709   function TSQLDataItem.GetAsVariant: Variant;
1710 + var ts: TDateTime;
1711 +  dstOffset: smallint;
1712 +    timezone: AnsiString;
1713   begin
1714    CheckActive;
1715    if IsNull then
# Line 1329 | Line 1723 | begin
1723          result := AsString;
1724        SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1725          result := AsDateTime;
1726 +      SQL_TIMESTAMP_TZ,
1727 +      SQL_TIME_TZ,
1728 +      SQL_TIMESTAMP_TZ_EX,
1729 +      SQL_TIME_TZ_EX:
1730 +        begin
1731 +          GetAsDateTime(ts,dstOffset,timezone);
1732 +          result := VarArrayOf([ts,dstOffset,timezone]);
1733 +        end;
1734        SQL_SHORT, SQL_LONG:
1735          if Scale = 0 then
1736            result := AsLong
# Line 1347 | Line 1749 | begin
1749          result := AsDouble;
1750        SQL_BOOLEAN:
1751          result := AsBoolean;
1752 +      SQL_DEC_FIXED,
1753 +      SQL_DEC16,
1754 +      SQL_DEC34,
1755 +      SQL_INT128:
1756 +        result := VarFmtBCDCreate(GetAsBcd);
1757        else
1758          IBError(ibxeInvalidDataConversion, [nil]);
1759      end;
# Line 1367 | Line 1774 | begin
1774      Result := Length(GetDateFormatStr(true));
1775    dfTime:
1776      Result := Length(GetTimeFormatStr);
1777 +  dfTimestampTZ:
1778 +    Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1779 +  dfTimeTZ:
1780 +    Result := Length(GetTimeFormatStr)+ 6;
1781    else
1782      Result := 0;
1783 +  end;end;
1784 +
1785 + function TSQLDataItem.GetAsBCD: tBCD;
1786 +
1787 + begin
1788 +  CheckActive;
1789 +  if IsNull then
1790 +   with Result do
1791 +   begin
1792 +     FillChar(Result,sizeof(Result),0);
1793 +     Precision := 1;
1794 +     exit;
1795 +   end;
1796 +
1797 +  case SQLType of
1798 +  SQL_DEC16,
1799 +  SQL_DEC34:
1800 +    with FFirebirdClientAPI do
1801 +      Result := SQLDecFloatDecode(SQLType,  SQLData);
1802 +
1803 +  SQL_DEC_FIXED,
1804 +  SQL_INT128:
1805 +    with FFirebirdClientAPI do
1806 +      Result := StrToBCD(Int128ToStr(SQLData,scale));
1807 +  else
1808 +    if not CurrToBCD(GetAsCurrency,Result) then
1809 +      IBError(ibxeBadBCDConversion,[]);
1810    end;
1811   end;
1812  
# Line 1460 | Line 1898 | begin
1898    Changed;
1899   end;
1900  
1901 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1902 + begin
1903 +  CheckActive;
1904 +  CheckTZSupport;
1905 +  if GetSQLDialect < 3 then
1906 +  begin
1907 +    AsDateTime := aValue;
1908 +    exit;
1909 +  end;
1910 +
1911 +  Changing;
1912 +  if IsNullable then
1913 +    IsNull := False;
1914 +
1915 +  SQLType := SQL_TIME_TZ;
1916 +  DataLength := SizeOf(ISC_TIME_TZ);
1917 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1918 +  Changed;
1919 + end;
1920 +
1921 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1922 + begin
1923 +  CheckActive;
1924 +  CheckTZSupport;
1925 +  if GetSQLDialect < 3 then
1926 +  begin
1927 +    AsDateTime := aValue;
1928 +    exit;
1929 +  end;
1930 +
1931 +  Changing;
1932 +  if IsNullable then
1933 +    IsNull := False;
1934 +
1935 +  SQLType := SQL_TIME_TZ;
1936 +  DataLength := SizeOf(ISC_TIME_TZ);
1937 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1938 +  Changed;
1939 + end;
1940 +
1941   procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1942   begin
1943    CheckActive;
# Line 1474 | Line 1952 | begin
1952    Changed;
1953   end;
1954  
1955 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1956 +  aTimeZoneID: TFBTimeZoneID);
1957 + begin
1958 +  CheckActive;
1959 +  CheckTZSupport;
1960 +  if IsNullable then
1961 +    IsNull := False;
1962 +
1963 +  Changing;
1964 +  SQLType := SQL_TIMESTAMP_TZ;
1965 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1966 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
1967 +  Changed;
1968 + end;
1969 +
1970 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
1971 +  );
1972 + begin
1973 +  CheckActive;
1974 +  CheckTZSupport;
1975 +  if IsNullable then
1976 +    IsNull := False;
1977 +
1978 +  Changing;
1979 +  SQLType := SQL_TIMESTAMP_TZ;
1980 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1981 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
1982 +  Changed;
1983 + end;
1984 +
1985 + procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
1986 + begin
1987 +  SetAsDateTime(aUTCTime,TimeZoneID_GMT);
1988 + end;
1989 +
1990   procedure TSQLDataItem.SetAsDouble(Value: Double);
1991   begin
1992    CheckActive;
# Line 1569 | Line 2082 | begin
2082    CheckActive;
2083    if VarIsNull(Value) then
2084      IsNull := True
2085 +  else
2086 +  if VarIsArray(Value) then {must be datetime plus timezone}
2087 +    SetAsDateTime(Value[0],AnsiString(Value[1]))
2088    else case VarType(Value) of
2089      varEmpty, varNull:
2090        IsNull := True;
# Line 1591 | Line 2107 | begin
2107        IBError(ibxeNotSupported, [nil]);
2108      varByRef, varDispatch, varError, varUnknown, varVariant:
2109        IBError(ibxeNotPermitted, [nil]);
2110 +    else
2111 +      if VarIsFmtBCD(Value) then
2112 +        SetAsBCD(VarToBCD(Value))
2113 +      else
2114 +        IBError(ibxeNotSupported, [nil]);
2115    end;
2116   end;
2117  
# Line 1608 | Line 2129 | begin
2129    Changed;
2130   end;
2131  
2132 + procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2133 + var C: Currency;
2134 + begin
2135 +  CheckActive;
2136 +  Changing;
2137 +  if IsNullable then
2138 +    IsNull := False;
2139 +
2140 +
2141 +  with FFirebirdClientAPI do
2142 +  if aValue.Precision <= 16 then
2143 +  begin
2144 +    if not HasDecFloatSupport then
2145 +      IBError(ibxeDecFloatNotSupported,[]);
2146 +
2147 +    SQLType := SQL_DEC16;
2148 +    DataLength := 8;
2149 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2150 +  end
2151 +  else
2152 +  if aValue.Precision <= 34 then
2153 +  begin
2154 +    if not HasDecFloatSupport then
2155 +      IBError(ibxeDecFloatNotSupported,[]);
2156 +
2157 +    SQLType := SQL_DEC34;
2158 +    DataLength := 16;
2159 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2160 +  end
2161 +  else
2162 +  if aValue.Precision <= 38 then
2163 +  begin
2164 +    if not HasInt128Support then
2165 +      IBError(ibxeInt128NotSupported,[]);
2166 +
2167 +    SQLType := SQL_INT128;
2168 +    DataLength := 16;
2169 +    StrToInt128(scale,BcdToStr(aValue),SQLData);
2170 +  end
2171 +  else
2172 +    IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2173 +
2174 +  Changed;
2175 + end;
2176 +
2177   procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
2178   begin
2179    CheckActive;
# Line 1638 | Line 2204 | begin
2204      IBError(ibxeStatementNotPrepared, [nil]);
2205   end;
2206  
2207 + function TColumnMetaData.GetAttachment: IAttachment;
2208 + begin
2209 +  Result := GetStatement.GetAttachment;
2210 + end;
2211 +
2212   function TColumnMetaData.SQLData: PByte;
2213   begin
2214    Result := FIBXSQLVAR.SQLData;
# Line 1742 | Line 2313 | end;
2313   function TColumnMetaData.GetSize: cardinal;
2314   begin
2315    CheckActive;
2316 <  result := FIBXSQLVAR.DataLength;
2316 >  result := FIBXSQLVAR.GetSize;
2317 > end;
2318 >
2319 > function TColumnMetaData.GetCharSetWidth: integer;
2320 > begin
2321 >  CheckActive;
2322 >  result := FIBXSQLVAR.GetCharSetWidth;
2323   end;
2324  
2325   function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
# Line 1847 | Line 2424 | end;
2424  
2425   var b: IBlob;
2426      dt: TDateTime;
2427 <    CurrValue: Currency;
2428 <    FloatValue: single;
2427 >    timezone: AnsiString;
2428 >    FloatValue: Double;
2429 >    Int64Value: Int64;
2430 >    BCDValue: TBCD;
2431 >    aScale: integer;
2432   begin
2433    CheckActive;
2434    if IsNullable then
2435      IsNull := False;
2436 <  case SQLTYPE of
2436 >  with FFirebirdClientAPI do
2437 >  case getColMetaData.SQLTYPE of
2438    SQL_BOOLEAN:
2439      if AnsiCompareText(Value,STrue) = 0 then
2440        AsBoolean := true
# Line 1864 | Line 2445 | begin
2445        IBError(ibxeInvalidDataConversion,[nil]);
2446  
2447    SQL_BLOB:
2448 +    if Length(Value) < GetAttachment.GetInlineBlobLimit then
2449 +      DoSetString
2450 +    else
2451      begin
2452        Changing;
2453        b := FIBXSQLVAR.CreateBlob;
# Line 1876 | Line 2460 | begin
2460    SQL_TEXT:
2461      DoSetString;
2462  
2463 <    SQL_SHORT,
2464 <    SQL_LONG,
2465 <    SQL_INT64:
2466 <      if TryStrToCurr(Value,CurrValue) then
2467 <        SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2468 <      else
2469 <        DoSetString;
2470 <
2471 <    SQL_D_FLOAT,
1888 <    SQL_DOUBLE,
1889 <    SQL_FLOAT:
2463 >  SQL_SHORT,
2464 >  SQL_LONG,
2465 >  SQL_INT64:
2466 >    {If the string contains an integer then convert and set directly}
2467 >    if TryStrToInt64(Value,Int64Value) then
2468 >      SetAsInt64(Int64Value)
2469 >    else
2470 >    if getColMetaData.getScale = 0 then {integer expected but non-integer string}
2471 >    begin
2472        if TryStrToFloat(Value,FloatValue) then
2473 <        SetAsDouble(FloatValue)
2473 >        {truncate it if the column is limited to an integer}
2474 >        SetAsInt64(Trunc(FloatValue))
2475        else
2476          DoSetString;
2477 +    end
2478 +    else
2479 +    if TryStrToFloat(Value,FloatValue) then
2480 +    begin
2481 +      aScale := getColMetaData.getScale;
2482 +      {Set as int64 with adjusted scale}
2483 +      SetAsNumeric(AdjustScaleFromDouble(FloatValue,aScale),aScale)
2484 +    end
2485 +    else
2486 +      DoSetString;
2487 +
2488 +  SQL_DEC_FIXED,
2489 +  SQL_DEC16,
2490 +  SQL_DEC34,
2491 +  SQL_INT128:
2492 +    if TryStrToBCD(Value,BCDValue) then
2493 +      SetAsBCD(BCDValue)
2494 +    else
2495 +      DoSetString;
2496  
2497 <    SQL_TIMESTAMP:
2497 >  SQL_D_FLOAT,
2498 >  SQL_DOUBLE,
2499 >  SQL_FLOAT:
2500 >    if TryStrToFloat(Value,FloatValue) then
2501 >      SetAsDouble(FloatValue)
2502 >    else
2503 >      DoSetString;
2504 >
2505 >  SQL_TIMESTAMP:
2506        if TryStrToDateTime(Value,dt) then
2507          SetAsDateTime(dt)
2508        else
2509          DoSetString;
2510  
2511 <    SQL_TYPE_DATE:
2511 >  SQL_TYPE_DATE:
2512        if TryStrToDateTime(Value,dt) then
2513          SetAsDate(dt)
2514        else
2515          DoSetString;
2516  
2517 <    SQL_TYPE_TIME:
2517 >  SQL_TYPE_TIME:
2518        if TryStrToDateTime(Value,dt) then
2519          SetAsTime(dt)
2520        else
2521          DoSetString;
2522  
2523 <    else
2524 <      IBError(ibxeInvalidDataConversion,[nil]);
2523 >  SQL_TIMESTAMP_TZ,
2524 >  SQL_TIMESTAMP_TZ_EX:
2525 >      if ParseDateTimeTZString(value,dt,timezone) then
2526 >        SetAsDateTime(dt,timezone)
2527 >      else
2528 >        DoSetString;
2529 >
2530 >  SQL_TIME_TZ,
2531 >  SQL_TIME_TZ_EX:
2532 >      if ParseDateTimeTZString(value,dt,timezone,true) then
2533 >        SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2534 >      else
2535 >        DoSetString;
2536 >
2537 >  else
2538 >    IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2539    end;
2540   end;
2541  
# Line 1949 | Line 2573 | begin
2573    IsNull := true;
2574   end;
2575  
2576 + function TSQLParam.getColMetadata: IParamMetaData;
2577 + begin
2578 +  Result := FIBXSQLVAR.getColMetadata;
2579 + end;
2580 +
2581   function TSQLParam.GetModified: boolean;
2582   begin
2583    CheckActive;
# Line 1962 | Line 2591 | begin
2591    Result := inherited GetAsPointer;
2592   end;
2593  
2594 + function TSQLParam.GetAsString: AnsiString;
2595 + var rs: RawByteString;
2596 + begin
2597 +  Result := '';
2598 +  if (SQLType = SQL_VARYING) and not IsNull then
2599 +  {SQLData points to start of string - default is to length word}
2600 +  begin
2601 +    CheckActive;
2602 +    SetString(rs,PAnsiChar(SQLData),DataLength);
2603 +    SetCodePage(rs,GetCodePage,false);
2604 +    Result := rs;
2605 +  end
2606 +  else
2607 +    Result := inherited GetAsString;
2608 + end;
2609 +
2610   procedure TSQLParam.SetName(Value: AnsiString);
2611   begin
2612    CheckActive;
# Line 2153 | Line 2798 | begin
2798    end;
2799   end;
2800  
2801 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2802 + var i: integer;
2803 +    OldSQLVar: TSQLVarData;
2804 + begin
2805 +  if FIBXSQLVAR.UniqueName then
2806 +    inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2807 +  else
2808 +  with FIBXSQLVAR.Parent do
2809 +  begin
2810 +    for i := 0 to Count - 1 do
2811 +      if Column[i].Name = Name then
2812 +      begin
2813 +        OldSQLVar := FIBXSQLVAR;
2814 +        FIBXSQLVAR := Column[i];
2815 +        try
2816 +          inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2817 +        finally
2818 +          FIBXSQLVAR := OldSQLVar;
2819 +        end;
2820 +      end;
2821 +  end;
2822 + end;
2823 +
2824 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2825 + var i: integer;
2826 +    OldSQLVar: TSQLVarData;
2827 + begin
2828 +  if FIBXSQLVAR.UniqueName then
2829 +    inherited SetAsTime(AValue,OnDate,aTimeZone)
2830 +  else
2831 +  with FIBXSQLVAR.Parent do
2832 +  begin
2833 +    for i := 0 to Count - 1 do
2834 +      if Column[i].Name = Name then
2835 +      begin
2836 +        OldSQLVar := FIBXSQLVAR;
2837 +        FIBXSQLVAR := Column[i];
2838 +        try
2839 +          inherited SetAsTime(AValue,OnDate,aTimeZone);
2840 +        finally
2841 +          FIBXSQLVAR := OldSQLVar;
2842 +        end;
2843 +      end;
2844 +  end;
2845 + end;
2846 +
2847 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2848 + begin
2849 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2850 + end;
2851 +
2852 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2853 + begin
2854 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2855 + end;
2856 +
2857   procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2858   var i: integer;
2859      OldSQLVar: TSQLVarData;
# Line 2176 | Line 2877 | begin
2877    end;
2878   end;
2879  
2880 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2881 +  );
2882 + var i: integer;
2883 +    OldSQLVar: TSQLVarData;
2884 + begin
2885 +  if FIBXSQLVAR.UniqueName then
2886 +    inherited SetAsDateTime(AValue,aTimeZoneID)
2887 +  else
2888 +  with FIBXSQLVAR.Parent do
2889 +  begin
2890 +    for i := 0 to Count - 1 do
2891 +      if Column[i].Name = Name then
2892 +      begin
2893 +        OldSQLVar := FIBXSQLVAR;
2894 +        FIBXSQLVAR := Column[i];
2895 +        try
2896 +          inherited SetAsDateTime(AValue,aTimeZoneID);
2897 +        finally
2898 +          FIBXSQLVAR := OldSQLVar;
2899 +        end;
2900 +      end;
2901 +  end;
2902 + end;
2903 +
2904 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2905 + var i: integer;
2906 +    OldSQLVar: TSQLVarData;
2907 + begin
2908 +  if FIBXSQLVAR.UniqueName then
2909 +    inherited SetAsDateTime(AValue,aTimeZone)
2910 +  else
2911 +  with FIBXSQLVAR.Parent do
2912 +  begin
2913 +    for i := 0 to Count - 1 do
2914 +      if Column[i].Name = Name then
2915 +      begin
2916 +        OldSQLVar := FIBXSQLVAR;
2917 +        FIBXSQLVAR := Column[i];
2918 +        try
2919 +          inherited SetAsDateTime(AValue,aTimeZone);
2920 +        finally
2921 +          FIBXSQLVAR := OldSQLVar;
2922 +        end;
2923 +      end;
2924 +  end;
2925 + end;
2926 +
2927   procedure TSQLParam.SetAsDouble(AValue: Double);
2928   var i: integer;
2929      OldSQLVar: TSQLVarData;
# Line 2356 | Line 3104 | begin
3104    FIBXSQLVAR.SetCharSetID(aValue);
3105   end;
3106  
3107 + procedure TSQLParam.SetAsBcd(aValue: tBCD);
3108 + var i: integer;
3109 +    OldSQLVar: TSQLVarData;
3110 + begin
3111 +  if FIBXSQLVAR.UniqueName then
3112 +    inherited SetAsBcd(AValue)
3113 +  else
3114 +  with FIBXSQLVAR.Parent do
3115 +  begin
3116 +    for i := 0 to Count - 1 do
3117 +      if Column[i].Name = Name then
3118 +      begin
3119 +        OldSQLVar := FIBXSQLVAR;
3120 +        FIBXSQLVAR := Column[i];
3121 +        try
3122 +          inherited SetAsBcd(AValue);
3123 +        finally
3124 +          FIBXSQLVAR := OldSQLVar;
3125 +        end;
3126 +      end;
3127 +  end;
3128 + end;
3129 +
3130   { TMetaData }
3131  
3132   procedure TMetaData.CheckActive;
# Line 2511 | Line 3282 | begin
3282    if not FResults.CheckStatementStatus(ssPrepared)  then
3283      IBError(ibxeStatementNotPrepared, [nil]);
3284  
3285 <  with GetTransaction as TFBTransaction do
3285 >  with GetTransaction do
3286    if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3287      IBError(ibxeInterfaceOutofDate,[nil]);
3288   end;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines