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 291 by tony, Fri Apr 17 10:26:08 2020 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (file contents), Revision 391 by tony, Thu Jan 27 16:34:24 2022 UTC

# Line 80 | Line 80 | unit FBSQLData;
80   interface
81  
82   uses
83 <  Classes, SysUtils, IBExternals, IBHeader, 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
100     function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
101     function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
132       procedure CheckActive; virtual;
133 +     procedure CheckTZSupport;
134 +     function GetAttachment: IAttachment; virtual; abstract;
135 +     function GetTransaction: ITransaction; virtual; abstract;
136       function GetSQLDialect: integer; virtual; abstract;
137 +     function GetTimeZoneServices: IExTimeZoneServices; virtual;
138       procedure Changed; virtual;
139       procedure Changing; virtual;
140       procedure InternalSetAsString(Value: AnsiString); virtual;
# Line 113 | Line 147 | type
147       procedure SetDataLength(len: cardinal); virtual;
148       procedure SetSQLType(aValue: cardinal); virtual;
149       property DataLength: cardinal read GetDataLength write SetDataLength;
150 <
150 >     property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
151    public
152       constructor Create(api: TFBClientAPI);
153 <     function GetSQLType: cardinal; virtual; abstract;
153 >     function CanChangeMetaData: boolean; virtual;
154 >     function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
155       function GetSQLTypeName: AnsiString; overload;
156 <     class function GetSQLTypeName(SQLType: short): AnsiString; overload;
156 >     class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
157       function GetStrDataLength: short;
158 +     function getColMetadata: IParamMetaData; virtual; abstract;
159       function GetName: AnsiString; virtual; abstract;
160 <     function GetScale: integer; virtual; abstract;
160 >     function GetScale: integer; virtual; abstract; {Current Field Data scale}
161       function GetAsBoolean: boolean;
162       function GetAsCurrency: Currency;
163       function GetAsInt64: Int64;
164 <     function GetAsDateTime: TDateTime;
164 >     function GetAsDateTime: TDateTime; overload;
165 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
166 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
167 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
168 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
169 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
170 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
171 >     function GetAsUTCDateTime: TDateTime;
172       function GetAsDouble: Double;
173       function GetAsFloat: Float;
174       function GetAsLong: Long;
# Line 133 | Line 176 | type
176       function GetAsQuad: TISC_QUAD;
177       function GetAsShort: short;
178       function GetAsString: AnsiString; virtual;
179 +     function GetAsNumeric: IFBNumeric;
180       function GetIsNull: Boolean; virtual;
181       function GetIsNullable: boolean; virtual;
182       function GetAsVariant: Variant;
183       function GetModified: boolean; virtual;
184       function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
185 +     function GetAsBCD: tBCD;
186 +     function GetSize: cardinal; virtual; abstract;
187 +     function GetCharSetWidth: integer; virtual; abstract;
188       procedure SetAsBoolean(AValue: boolean); virtual;
189       procedure SetAsCurrency(Value: Currency); virtual;
190       procedure SetAsInt64(Value: Int64); virtual;
191       procedure SetAsDate(Value: TDateTime); virtual;
192       procedure SetAsLong(Value: Long); virtual;
193 <     procedure SetAsTime(Value: TDateTime); virtual;
194 <     procedure SetAsDateTime(Value: TDateTime);
193 >     procedure SetAsTime(Value: TDateTime); overload;
194 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime;aTimeZoneID: TFBTimeZoneID); overload;
195 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
196 >     procedure SetAsDateTime(Value: TDateTime); overload;
197 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
198 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
199 >     procedure SetAsUTCDateTime(aUTCTime: TDateTime);
200       procedure SetAsDouble(Value: Double); virtual;
201       procedure SetAsFloat(Value: Float); virtual;
202       procedure SetAsPointer(Value: Pointer);
# Line 152 | Line 204 | type
204       procedure SetAsShort(Value: short); virtual;
205       procedure SetAsString(Value: AnsiString); virtual;
206       procedure SetAsVariant(Value: Variant);
207 <     procedure SetAsNumeric(Value: Int64; aScale: integer);
207 >     procedure SetAsNumeric(Value: IFBNumeric); virtual;
208 >     procedure SetAsBcd(aValue: tBCD); virtual;
209       procedure SetIsNull(Value: Boolean); virtual;
210       procedure SetIsNullable(Value: Boolean); virtual;
211       procedure SetName(aValue: AnsiString); virtual;
# Line 193 | Line 246 | type
246      FUniqueRelationName: AnsiString;
247      FColumnList: array of TSQLVarData;
248      function GetStatement: IStatement; virtual; abstract;
249 +    function GetAttachment: IAttachment; virtual;
250 +    function GetTransaction: ITransaction; virtual;
251      function GetPrepareSeqNo: integer; virtual; abstract;
252      function GetTransactionSeqNo: integer; virtual; abstract;
253      procedure SetCount(aValue: integer); virtual; abstract;
# Line 211 | 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;
271 >    property Column[index: integer]: TSQLVarData read GetColumn; default;
272      property UniqueRelationName: AnsiString read FUniqueRelationName;
273      property Statement: IStatement read GetStatement;
274 +    property Attachment: IAttachment read GetAttachment;
275      property PrepareSeqNo: integer read GetPrepareSeqNo;
276 +    property Transaction: ITransaction read GetTransaction;
277      property TransactionSeqNo: integer read GetTransactionSeqNo;
278    end;
279  
# Line 229 | Line 287 | type
287      FModified: boolean;
288      FUniqueName: boolean;
289      FVarString: RawByteString;
290 +    FColMetaData: IParamMetaData;
291      function GetStatement: IStatement;
292      procedure SetName(AValue: AnsiString);
293    protected
294 +    FArrayIntf: IArray;
295 +    function GetAttachment: IAttachment;
296 +    function GetTransaction: ITransaction;
297      function GetSQLType: cardinal; virtual; abstract;
298      function GetSubtype: integer; virtual; abstract;
299      function GetAliasName: AnsiString;  virtual; abstract;
# Line 240 | Line 302 | type
302      function GetRelationName: AnsiString;  virtual; abstract;
303      function GetScale: integer; virtual; abstract;
304      function GetCharSetID: cardinal; virtual; abstract;
305 <    function GetCodePage: TSystemCodePage; virtual; abstract;
305 >    function GetCharSetWidth: integer;
306 >    function GetCodePage: TSystemCodePage;
307      function GetIsNull: Boolean;   virtual; abstract;
308      function GetIsNullable: boolean; virtual; abstract;
309      function GetSQLData: PByte;  virtual; abstract;
310 <    function GetDataLength: cardinal; virtual; abstract;
310 >    function GetDataLength: cardinal; virtual; abstract; {current field length}
311 >    function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
312 >    function GetDefaultTextSQLType: cardinal; virtual; abstract;
313 >    procedure InternalSetSQLType(aValue: cardinal); virtual; abstract;
314 >    procedure InternalSetScale(aValue: integer); virtual; abstract;
315 >    procedure InternalSetDataLength(len: cardinal); virtual; abstract;
316      procedure SetIsNull(Value: Boolean); virtual; abstract;
317      procedure SetIsNullable(Value: Boolean);  virtual; abstract;
318      procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
319 <    procedure SetScale(aValue: integer); virtual; abstract;
320 <    procedure SetDataLength(len: cardinal); virtual; abstract;
321 <    procedure SetSQLType(aValue: cardinal); virtual; abstract;
319 >    procedure SetScale(aValue: integer);
320 >    procedure SetDataLength(len: cardinal);
321 >    procedure SetSQLType(aValue: cardinal);
322      procedure SetCharSetID(aValue: cardinal); virtual; abstract;
323 +    procedure SetMetaSize(aValue: cardinal); virtual;
324    public
325      constructor Create(aParent: TSQLDataArea; aIndex: integer);
326 +    function CanChangeMetaData: boolean;
327      procedure SetString(aValue: AnsiString);
328      procedure Changed; virtual;
329      procedure RowChange; virtual;
330 <    function GetAsArray(Array_ID: TISC_QUAD): IArray; virtual; abstract;
330 >    function GetAsArray: IArray; virtual; abstract;
331      function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; virtual; abstract;
332      function CreateBlob: IBlob; virtual; abstract;
333      function GetArrayMetaData: IArrayMetaData; virtual; abstract;
334      function GetBlobMetaData: IBlobMetaData; virtual; abstract;
335 +    function getColMetadata: IParamMetaData;
336      procedure Initialize; virtual;
337 +    procedure SaveMetaData;
338 +    procedure SetArray(AValue: IArray);
339  
340    public
341      property AliasName: AnsiString read GetAliasName;
# Line 273 | Line 346 | type
346      property Index: integer read FIndex;
347      property Name: AnsiString read FName write SetName;
348      property CharSetID: cardinal read GetCharSetID write SetCharSetID;
349 +    property CodePage: TSystemCodePage read GetCodePage;
350      property SQLType: cardinal read GetSQLType write SetSQLType;
351      property SQLSubtype: integer read GetSubtype;
352      property SQLData: PByte read GetSQLData;
# Line 288 | Line 362 | type
362  
363    { TColumnMetaData }
364  
365 <  TColumnMetaData = class(TSQLDataItem,IColumnMetaData)
365 >  TColumnMetaData = class(TSQLDataItem,IColumnMetaData,IParamMetaData)
366    private
367      FIBXSQLVAR: TSQLVarData;
368      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
# Line 304 | Line 378 | type
378      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
379      destructor Destroy; override;
380      function GetSQLDialect: integer; override;
381 +    function getColMetadata: IParamMetaData; override;
382  
383    public
384      {IColumnMetaData}
# Line 318 | Line 393 | type
393      function GetScale: integer; override;
394      function getCharSetID: cardinal; override;
395      function GetIsNullable: boolean; override;
396 <    function GetSize: cardinal;
396 >    function GetSize: cardinal; override;
397 >    function GetCharSetWidth: integer; override;
398      function GetArrayMetaData: IArrayMetaData;
399      function GetBlobMetaData: IBlobMetaData;
400      function GetStatement: IStatement;
401 <    function GetTransaction: ITransaction; virtual;
401 >    function GetTransaction: ITransaction; override;
402 >    function GetAttachment: IAttachment; override;
403      property Name: AnsiString read GetName;
404      property Size: cardinal read GetSize;
405      property CharSetID: cardinal read getCharSetID;
# Line 335 | Line 412 | type
412    { TIBSQLData }
413  
414    TIBSQLData = class(TColumnMetaData,ISQLData)
338  private
339    FTransaction: ITransaction;
415    protected
416      procedure CheckActive; override;
417    public
343    function GetTransaction: ITransaction; override;
418      function GetIsNull: Boolean; override;
419      function GetAsArray: IArray;
420      function GetAsBlob: IBlob; overload;
# Line 349 | Line 423 | type
423      property AsBlob: IBlob read GetAsBlob;
424   end;
425  
426 +  { TSQLParamMetaData }
427 +
428 +  TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
429 +  private
430 +    FSQLType: cardinal;
431 +    FSQLSubType: integer;
432 +    FScale: integer;
433 +    FCharSetID: cardinal;
434 +    FNullable: boolean;
435 +    FSize: cardinal;
436 +    FCodePage: TSystemCodePage;
437 +  public
438 +    constructor Create(src: TSQLVarData);
439 +    {IParamMetaData}
440 +    function GetSQLType: cardinal;
441 +    function GetSQLTypeName: AnsiString;
442 +    function getSubtype: integer;
443 +    function getScale: integer;
444 +    function getCharSetID: cardinal;
445 +    function getCodePage: TSystemCodePage;
446 +    function getIsNullable: boolean;
447 +    function GetSize: cardinal;
448 +    property SQLType: cardinal read GetSQLType;
449 +  end;
450 +
451    { TSQLParam }
452  
453 <  TSQLParam = class(TIBSQLData,ISQLParam)
453 >  TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
454    protected
455      procedure CheckActive; override;
456      procedure Changed; override;
# Line 361 | Line 460 | type
460      procedure SetSQLType(aValue: cardinal); override;
461    public
462      procedure Clear;
463 +    function CanChangeMetaData: boolean; override;
464 +    function getColMetadata: IParamMetaData; override;
465      function GetModified: boolean; override;
466      function GetAsPointer: Pointer;
467 +    function GetAsString: AnsiString; override;
468      procedure SetName(Value: AnsiString); override;
469      procedure SetIsNull(Value: Boolean);  override;
470      procedure SetIsNullable(Value: Boolean); override;
# Line 374 | Line 476 | type
476      procedure SetAsInt64(AValue: Int64);
477      procedure SetAsDate(AValue: TDateTime);
478      procedure SetAsLong(AValue: Long);
479 <    procedure SetAsTime(AValue: TDateTime);
480 <    procedure SetAsDateTime(AValue: TDateTime);
479 >    procedure SetAsTime(AValue: TDateTime); overload;
480 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
481 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
482 >    procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
483 >    procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
484 >    procedure SetAsDateTime(AValue: TDateTime); overload;
485 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
486 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
487      procedure SetAsDouble(AValue: Double);
488      procedure SetAsFloat(AValue: Float);
489      procedure SetAsPointer(AValue: Pointer);
# Line 385 | Line 493 | type
493      procedure SetAsBlob(aValue: IBlob);
494      procedure SetAsQuad(AValue: TISC_QUAD);
495      procedure SetCharSetID(aValue: cardinal);
496 +    procedure SetAsBcd(aValue: tBCD);
497 +    procedure SetAsNumeric(aValue: IFBNumeric);
498  
499      property AsBlob: IBlob read GetAsBlob write SetAsBlob;
500      property IsNullable: Boolean read GetIsNullable write SetIsNullable;
# Line 425 | Line 535 | type
535      {ISQLParams}
536      function getCount: integer;
537      function getSQLParam(index: integer): ISQLParam;
538 <    function ByName(Idx: AnsiString): ISQLParam ;
538 >    function ParamExists(Idx: AnsiString): boolean;
539 >    function ByName(Idx: AnsiString): ISQLParam ; virtual;
540      function GetModified: Boolean;
541      function GetHasCaseSensitiveParams: Boolean;
542 +    function GetStatement: IStatement;
543 +    function GetTransaction: ITransaction;
544 +    function GetAttachment: IAttachment;
545 +    procedure Clear;
546    end;
547  
548    { TResults }
# Line 446 | Line 561 | type
561       constructor Create(aResults: TSQLDataArea);
562        {IResults}
563       function getCount: integer;
564 <     function ByName(Idx: AnsiString): ISQLData;
564 >     function ByName(Idx: AnsiString): ISQLData; virtual;
565 >     function FieldExists(Idx: AnsiString): boolean;
566       function getSQLData(index: integer): ISQLData;
567       procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
568       function GetStatement: IStatement;
569 <     function GetTransaction: ITransaction; virtual;
569 >     function GetTransaction: ITransaction;
570 >     function GetAttachment: IAttachment;
571       procedure SetRetainInterfaces(aValue: boolean);
572   end;
573  
574   implementation
575  
576 < uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
576 > uses FBMessages, variants, IBUtils, FBTransaction, FBNumeric, DateUtils;
577 >
578 > { TSQLParamMetaData }
579 >
580 > constructor TSQLParamMetaData.Create(src: TSQLVarData);
581 > begin
582 >  inherited Create;
583 >  FSQLType := src.GetSQLType;
584 >  FSQLSubType := src.getSubtype;
585 >  FScale := src.GetScale;
586 >  FCharSetID := src.getCharSetID;
587 >  FNullable := src.GetIsNullable;
588 >  FSize := src.GetSize;
589 >  FCodePage := src.GetCodePage;
590 > end;
591 >
592 > function TSQLParamMetaData.GetSQLType: cardinal;
593 > begin
594 >  Result := FSQLType;
595 > end;
596 >
597 > function TSQLParamMetaData.GetSQLTypeName: AnsiString;
598 > begin
599 >  Result := TSQLDataItem.GetSQLTypeName(FSQLType);
600 > end;
601 >
602 > function TSQLParamMetaData.getSubtype: integer;
603 > begin
604 >  Result := FSQLSubType;
605 > end;
606 >
607 > function TSQLParamMetaData.getScale: integer;
608 > begin
609 >  Result := FScale;
610 > end;
611 >
612 > function TSQLParamMetaData.getCharSetID: cardinal;
613 > begin
614 >  Result := FCharSetID;
615 > end;
616 >
617 > function TSQLParamMetaData.getCodePage: TSystemCodePage;
618 > begin
619 >  Result :=  FCodePage;
620 > end;
621 >
622 > function TSQLParamMetaData.getIsNullable: boolean;
623 > begin
624 >  Result :=  FNullable;
625 > end;
626 >
627 > function TSQLParamMetaData.GetSize: cardinal;
628 > begin
629 >  Result := FSize;
630 > end;
631  
632   { TSQLDataArea }
633  
# Line 472 | Line 643 | begin
643    Result := Length(FColumnList);
644   end;
645  
646 + function TSQLDataArea.GetTransaction: ITransaction;
647 + begin
648 +  Result := GetStatement.GetTransaction;
649 + end;
650 +
651 + function TSQLDataArea.GetAttachment: IAttachment;
652 + begin
653 +  Result := GetStatement.GetAttachment;
654 + end;
655 +
656   procedure TSQLDataArea.SetUniqueRelationName;
657   var
658    i: Integer;
# Line 604 | Line 785 | begin
785      FName := AValue;
786   end;
787  
788 + function TSQLVarData.GetAttachment: IAttachment;
789 + begin
790 +  Result := Parent.Attachment;
791 + end;
792 +
793 + function TSQLVarData.GetTransaction: ITransaction;
794 + begin
795 +  Result := Parent.Transaction;
796 + end;
797 +
798 + function TSQLVarData.GetCharSetWidth: integer;
799 + begin
800 +  result := 1;
801 +  GetAttachment.CharSetWidth(GetCharSetID,result);
802 + end;
803 +
804 + function TSQLVarData.GetCodePage: TSystemCodePage;
805 + begin
806 +  result := CP_NONE;
807 +  GetAttachment.CharSetID2CodePage(GetCharSetID,result);
808 + end;
809 +
810 + procedure TSQLVarData.SetScale(aValue: integer);
811 + begin
812 +  if aValue = Scale then
813 +    Exit;
814 +  if not CanChangeMetaData  then
815 +    IBError(ibxeScaleCannotBeChanged,[]);
816 +  InternalSetScale(aValue);
817 + end;
818 +
819 + procedure TSQLVarData.SetDataLength(len: cardinal);
820 + begin
821 +  if len = DataLength then
822 +    Exit;
823 +  InternalSetDataLength(len);
824 + end;
825 +
826 + procedure TSQLVarData.SetSQLType(aValue: cardinal);
827 + begin
828 +  if aValue = SQLType then
829 +    Exit;
830 +  if not CanChangeMetaData then
831 +    IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(SQLType),
832 +                                          TSQLDataItem.GetSQLTypeName(aValue)]);
833 +  InternalSetSQLType(aValue);
834 + end;
835 +
836 + procedure TSQLVarData.SetMetaSize(aValue: cardinal);
837 + begin
838 +  //Ignore
839 + end;
840 +
841 + procedure TSQLVarData.SaveMetaData;
842 + begin
843 +  FColMetaData := TSQLParamMetaData.Create(self);
844 + end;
845 +
846 + procedure TSQLVarData.SetArray(AValue: IArray);
847 + begin
848 +  FArrayIntf := AValue;
849 + end;
850 +
851   constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
852   begin
853    inherited Create;
# Line 612 | Line 856 | begin
856    FUniqueName := true;
857   end;
858  
859 + function TSQLVarData.CanChangeMetaData: boolean;
860 + begin
861 +  Result := Parent.CanChangeMetaData;
862 + end;
863 +
864   procedure TSQLVarData.SetString(aValue: AnsiString);
865   begin
866    {we take full advantage here of reference counted strings. When setting a string
# Line 620 | Line 869 | begin
869     a zero byte when the string is empty, neatly avoiding a nil pointer error.}
870  
871    FVarString := aValue;
872 <  SQLType := SQL_TEXT;
872 >  if SQLType = SQL_BLOB then
873 >    SetMetaSize(GetAttachment.GetInlineBlobLimit);
874 >  if CanChangeMetaData then
875 >    SQLType := GetDefaultTextSQLType;
876    Scale := 0;
877 +  if  (SQLType <> SQL_VARYING) and (SQLType <> SQL_TEXT) then
878 +    IBError(ibxeUnableTosetaTextType,[Index,Name,TSQLDataItem.GetSQLTypeName(SQLType)]);
879 +  if not CanChangeMetaData and (Length(aValue) > GetSize) then
880 +    IBError(ibxeStringOverflow,[Length(aValue),DataLength]);
881    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
882   end;
883  
# Line 632 | Line 888 | end;
888  
889   procedure TSQLVarData.RowChange;
890   begin
891 +  FArrayIntf := nil;
892    FModified := false;
893    FVarString := '';
894   end;
895  
896 + function TSQLVarData.getColMetadata: IParamMetaData;
897 + begin
898 +  Result := FColMetaData;
899 + end;
900 +
901   procedure TSQLVarData.Initialize;
902  
903    function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
# Line 695 | Line 957 | end;
957  
958   {TSQLDataItem}
959  
698 function TSQLDataItem.AdjustScale(Value: Int64; aScale: Integer): Double;
699 var
700  Scaling : Int64;
701  i: Integer;
702  Val: Double;
703 begin
704  Scaling := 1; Val := Value;
705  if aScale > 0 then
706  begin
707    for i := 1 to aScale do
708      Scaling := Scaling * 10;
709    result := Val * Scaling;
710  end
711  else
712    if aScale < 0 then
713    begin
714      for i := -1 downto aScale do
715        Scaling := Scaling * 10;
716      result := Val / Scaling;
717    end
718    else
719      result := Val;
720 end;
721
722 function TSQLDataItem.AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
723 var
724  Scaling : Int64;
725  i: Integer;
726  Val: Int64;
727 begin
728  Scaling := 1; Val := Value;
729  if aScale > 0 then begin
730    for i := 1 to aScale do Scaling := Scaling * 10;
731    result := Val * Scaling;
732  end else if aScale < 0 then begin
733    for i := -1 downto aScale do Scaling := Scaling * 10;
734    result := Val div Scaling;
735  end else
736    result := Val;
737 end;
738
739 function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
740  ): Currency;
741 var
742  Scaling : Int64;
743  i : Integer;
744  FractionText, PadText, CurrText: AnsiString;
745 begin
746  Result := 0;
747  Scaling := 1;
748  PadText := '';
749  if aScale > 0 then
750  begin
751    for i := 1 to aScale do
752      Scaling := Scaling * 10;
753    result := Value * Scaling;
754  end
755  else
756    if aScale < 0 then
757    begin
758      for i := -1 downto aScale do
759        Scaling := Scaling * 10;
760      FractionText := IntToStr(abs(Value mod Scaling));
761      for i := Length(FractionText) to -aScale -1 do
762        PadText := '0' + PadText;
763      {$IF declared(DefaultFormatSettings)}
764      with DefaultFormatSettings do
765      {$ELSE}
766      {$IF declared(FormatSettings)}
767      with FormatSettings do
768      {$IFEND}
769      {$IFEND}
770      if Value < 0 then
771        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
772      else
773        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
774      try
775        result := StrToCurr(CurrText);
776      except
777        on E: Exception do
778          IBError(ibxeInvalidDataConversion, [nil]);
779      end;
780    end
781    else
782      result := Value;
783 end;
784
960   function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
961   begin
962    {$IF declared(DefaultFormatSettings)}
# Line 811 | Line 986 | begin
986    with FormatSettings do
987    {$IFEND}
988    {$IFEND}
989 <    Result := LongTimeFormat;
989 >    Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
990   end;
991  
992   function TSQLDataItem.GetTimestampFormatStr: AnsiString;
# Line 823 | Line 998 | begin
998    with FormatSettings do
999    {$IFEND}
1000    {$IFEND}
1001 <    Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
1001 >    Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
1002   end;
1003  
1004   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
# Line 831 | Line 1006 | begin
1006    SetAsLong(aValue);
1007   end;
1008  
1009 < function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1010 <  ): Int64;
1011 < var
837 <  Scaling : Int64;
838 <  i : Integer;
1009 > procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
1010 >  var dstOffset: smallint; var aTimezone: AnsiString;
1011 >  var aTimeZoneID: TFBTimeZoneID);
1012   begin
1013 <  Result := 0;
1014 <  Scaling := 1;
1015 <  if aScale < 0 then
1016 <  begin
1017 <    for i := -1 downto aScale do
1018 <      Scaling := Scaling * 10;
1019 <    result := trunc(Value * Scaling);
1020 <  end
1021 <  else
1022 <  if aScale > 0 then
1023 <  begin
1024 <    for i := 1 to aScale do
1025 <       Scaling := Scaling * 10;
1026 <    result := trunc(Value / Scaling);
1027 <  end
1028 <  else
1029 <    result := trunc(Value);
1013 >  CheckActive;
1014 >  aDateTime := 0;
1015 >  dstOffset := 0;
1016 >  aTimezone := '';
1017 >  aTimeZoneID := TimeZoneID_GMT;
1018 >  if not IsNull then
1019 >    with FFirebirdClientAPI do
1020 >    case SQLType of
1021 >      SQL_TEXT, SQL_VARYING:
1022 >        if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
1023 >          IBError(ibxeInvalidDataConversion, [nil]);
1024 >      SQL_TYPE_DATE:
1025 >        aDateTime := SQLDecodeDate(SQLData);
1026 >      SQL_TYPE_TIME:
1027 >        aDateTime := SQLDecodeTime(SQLData);
1028 >      SQL_TIMESTAMP:
1029 >        aDateTime := SQLDecodeDateTime(SQLData);
1030 >      SQL_TIMESTAMP_TZ:
1031 >        begin
1032 >          GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
1033 >          aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
1034 >        end;
1035 >      SQL_TIMESTAMP_TZ_EX:
1036 >      begin
1037 >        GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
1038 >        aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
1039 >      end;
1040 >      SQL_TIME_TZ:
1041 >        with GetTimeZoneServices do
1042 >        begin
1043 >          DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1044 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1045 >        end;
1046 >      SQL_TIME_TZ_EX:
1047 >        with GetTimeZoneServices do
1048 >        begin
1049 >          DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1050 >          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1051 >        end;
1052 >      else
1053 >        IBError(ibxeInvalidDataConversion, [nil]);
1054 >    end;
1055   end;
1056  
1057 < function TSQLDataItem.AdjustScaleFromDouble(Value: Double; aScale: Integer
860 <  ): Int64;
861 < var
862 <  Scaling : Int64;
863 <  i : Integer;
1057 > procedure TSQLDataItem.CheckActive;
1058   begin
1059 <  Result := 0;
866 <  Scaling := 1;
867 <  if aScale < 0 then
868 <  begin
869 <    for i := -1 downto aScale do
870 <      Scaling := Scaling * 10;
871 <    result := trunc(Value * Scaling);
872 <  end
873 <  else
874 <  if aScale > 0 then
875 <  begin
876 <    for i := 1 to aScale do
877 <       Scaling := Scaling * 10;
878 <    result := trunc(Value / Scaling);
879 <  end
880 <  else
881 <    result := trunc(Value);
1059 >  //Do nothing by default
1060   end;
1061  
1062 < procedure TSQLDataItem.CheckActive;
1062 > procedure TSQLDataItem.CheckTZSupport;
1063   begin
1064 <  //Do nothing by default
1064 >  if not FFirebirdClientAPI.HasTimeZoneSupport then
1065 >    IBError(ibxeNoTimezoneSupport,[]);
1066 > end;
1067 >
1068 > function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1069 > begin
1070 >  if FTimeZoneServices = nil then
1071 >  begin
1072 >    if not GetAttachment.HasTimeZoneSupport then
1073 >      IBError(ibxeNoTimezoneSupport,[]);
1074 >    GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1075 >  end;
1076 >  Result := FTimeZoneServices;
1077   end;
1078  
1079   procedure TSQLDataItem.Changed;
# Line 930 | Line 1120 | begin
1120    FFirebirdClientAPI := api;
1121   end;
1122  
1123 + function TSQLDataItem.CanChangeMetaData: boolean;
1124 + begin
1125 +  Result := false;
1126 + end;
1127 +
1128   function TSQLDataItem.GetSQLTypeName: AnsiString;
1129   begin
1130    Result := GetSQLTypeName(GetSQLType);
1131   end;
1132  
1133 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1133 > class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1134   begin
1135    Result := 'Unknown';
1136    case SQLType of
# Line 946 | Line 1141 | begin
1141    SQL_LONG:             Result := 'SQL_LONG';
1142    SQL_SHORT:            Result := 'SQL_SHORT';
1143    SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1144 +  SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1145 +  SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1146    SQL_BLOB:             Result := 'SQL_BLOB';
1147    SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1148    SQL_ARRAY:            Result := 'SQL_ARRAY';
# Line 953 | Line 1150 | begin
1150    SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1151    SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1152    SQL_INT64:            Result := 'SQL_INT64';
1153 +  SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1154 +  SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1155 +  SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1156 +  SQL_DEC16:            Result := 'SQL_DEC16';
1157 +  SQL_DEC34:            Result := 'SQL_DEC34';
1158 +  SQL_INT128:           Result := 'SQL_INT128';
1159 +  SQL_NULL:             Result := 'SQL_NULL';
1160 +  SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1161    end;
1162   end;
1163  
# Line 995 | Line 1200 | begin
1200            end;
1201          end;
1202          SQL_SHORT:
1203 <          result := AdjustScaleToCurrency(Int64(PShort(SQLData)^),
1204 <                                      Scale);
1203 >          result := NumericFromRawValues(Int64(PShort(SQLData)^),
1204 >                                      Scale).getAsCurrency;
1205          SQL_LONG:
1206 <          result := AdjustScaleToCurrency(Int64(PLong(SQLData)^),
1207 <                                      Scale);
1206 >          result := NumericFromRawValues(Int64(PLong(SQLData)^),
1207 >                                      Scale).getAsCurrency;
1208          SQL_INT64:
1209 <          result := AdjustScaleToCurrency(PInt64(SQLData)^,
1210 <                                      Scale);
1209 >          result := NumericFromRawValues(PInt64(SQLData)^,
1210 >                                      Scale).getAsCurrency;
1211          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1212 <          result := Trunc(AsDouble);
1212 >          result := Round(AsDouble);
1213 >
1214 >        SQL_DEC_FIXED,
1215 >        SQL_DEC16,
1216 >        SQL_DEC34,
1217 >        SQL_INT128:
1218 >          if not BCDToCurr(GetAsBCD,Result) then
1219 >            IBError(ibxeInvalidDataConversion, [nil]);
1220 >
1221          else
1222            IBError(ibxeInvalidDataConversion, [nil]);
1223        end;
# Line 1025 | Line 1238 | begin
1238          end;
1239        end;
1240        SQL_SHORT:
1241 <        result := AdjustScaleToInt64(Int64(PShort(SQLData)^),
1242 <                                    Scale);
1241 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1242 >                                    Scale).getAsInt64;
1243        SQL_LONG:
1244 <        result := AdjustScaleToInt64(Int64(PLong(SQLData)^),
1245 <                                    Scale);
1244 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1245 >                                    Scale).getAsInt64;
1246        SQL_INT64:
1247 <        result := AdjustScaleToInt64(PInt64(SQLData)^,
1248 <                                    Scale);
1247 >        result := NumericFromRawValues(PInt64(SQLData)^,
1248 >                                    Scale).getAsInt64;
1249        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1250 <        result := Trunc(AsDouble);
1250 >        result := Round(AsDouble);
1251        else
1252          IBError(ibxeInvalidDataConversion, [nil]);
1253      end;
1254   end;
1255  
1256   function TSQLDataItem.GetAsDateTime: TDateTime;
1257 + var aTimezone: AnsiString;
1258 +    aTimeZoneID: TFBTimeZoneID;
1259 +    dstOffset: smallint;
1260 + begin
1261 +  InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1262 + end;
1263 +
1264 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1265 +  var dstOffset: smallint; var aTimezone: AnsiString);
1266 + var aTimeZoneID: TFBTimeZoneID;
1267 + begin
1268 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1269 + end;
1270 +
1271 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1272 +  var aTimezoneID: TFBTimeZoneID);
1273 + var aTimezone: AnsiString;
1274 + begin
1275 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1276 + end;
1277 +
1278 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1279 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1280 + var aTimeZone: AnsiString;
1281   begin
1282    CheckActive;
1283 <  result := 0;
1283 >  aTime := 0;
1284 >  dstOffset := 0;
1285    if not IsNull then
1286      with FFirebirdClientAPI do
1287      case SQLType of
1288 <      SQL_TEXT, SQL_VARYING: begin
1289 <        try
1290 <          result := StrToDate(AsString);
1291 <        except
1054 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1288 >      SQL_TIME_TZ:
1289 >        begin
1290 >          GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1291 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1292          end;
1293 +      SQL_TIME_TZ_EX:
1294 +        begin
1295 +          GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1296 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1297 +        end;
1298 +    else
1299 +      IBError(ibxeInvalidDataConversion, [nil]);
1300 +    end;
1301 + end;
1302 +
1303 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1304 +  var aTimezone: AnsiString; OnDate: TDateTime);
1305 + begin
1306 +  CheckActive;
1307 +  aTime := 0;
1308 +  dstOffset := 0;
1309 +  if not IsNull then
1310 +    with FFirebirdClientAPI do
1311 +    case SQLType of
1312 +      SQL_TIME_TZ:
1313 +        GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1314 +      SQL_TIME_TZ_EX:
1315 +        GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1316 +    else
1317 +      IBError(ibxeInvalidDataConversion, [nil]);
1318 +    end;
1319 + end;
1320 +
1321 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1322 +  var aTimezoneID: TFBTimeZoneID);
1323 + begin
1324 +  GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1325 + end;
1326 +
1327 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1328 +  var aTimezone: AnsiString);
1329 + begin
1330 +  GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1331 + end;
1332 +
1333 + function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1334 + var aTimezone: AnsiString;
1335 + begin
1336 +  CheckActive;
1337 +  result := 0;
1338 +  aTimezone := '';
1339 +  if not IsNull then
1340 +    with FFirebirdClientAPI do
1341 +    case SQLType of
1342 +      SQL_TEXT, SQL_VARYING:
1343 +      begin
1344 +        if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1345 +          IBError(ibxeInvalidDataConversion, [nil]);
1346 +        Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1347        end;
1348        SQL_TYPE_DATE:
1349          result := SQLDecodeDate(SQLData);
1350 <      SQL_TYPE_TIME:
1350 >      SQL_TYPE_TIME,
1351 >      SQL_TIME_TZ,
1352 >      SQL_TIME_TZ_EX:
1353          result := SQLDecodeTime(SQLData);
1354 <      SQL_TIMESTAMP:
1354 >      SQL_TIMESTAMP,
1355 >      SQL_TIMESTAMP_TZ,
1356 >      SQL_TIMESTAMP_TZ_EX:
1357          result := SQLDecodeDateTime(SQLData);
1358        else
1359          IBError(ibxeInvalidDataConversion, [nil]);
1360 <    end;
1360 >      end;
1361   end;
1362  
1363   function TSQLDataItem.GetAsDouble: Double;
# Line 1079 | Line 1374 | begin
1374          end;
1375        end;
1376        SQL_SHORT:
1377 <        result := AdjustScale(Int64(PShort(SQLData)^),
1378 <                              Scale);
1377 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1378 >                              Scale).getAsDouble;
1379        SQL_LONG:
1380 <        result := AdjustScale(Int64(PLong(SQLData)^),
1381 <                              Scale);
1380 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1381 >                              Scale).getAsDouble;
1382        SQL_INT64:
1383 <        result := AdjustScale(PInt64(SQLData)^, Scale);
1383 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsDouble;
1384        SQL_FLOAT:
1385          result := PFloat(SQLData)^;
1386        SQL_DOUBLE, SQL_D_FLOAT:
1387          result := PDouble(SQLData)^;
1388 +      SQL_DEC_FIXED,
1389 +      SQL_DEC16,
1390 +      SQL_DEC34,
1391 +      SQL_INT128:
1392 +        Result := BCDToDouble(GetAsBCD);
1393        else
1394          IBError(ibxeInvalidDataConversion, [nil]);
1395      end;
# Line 1126 | Line 1426 | begin
1426          end;
1427        end;
1428        SQL_SHORT:
1429 <        result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1430 <                                    Scale));
1429 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1430 >                                    Scale).getAsInteger;
1431        SQL_LONG:
1432 <        result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1433 <                                    Scale));
1432 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1433 >                                    Scale).getAsInteger;
1434        SQL_INT64:
1435 <        result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1435 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsInteger;
1436 >
1437        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1438 <        result := Trunc(AsDouble);
1438 >        result := Round(AsDouble);
1439 >      SQL_DEC_FIXED,
1440 >      SQL_DEC16,
1441 >      SQL_DEC34,
1442 >      SQL_INT128:
1443 >        Result := BCDToInteger(GetAsBCD);
1444        else
1445 <        IBError(ibxeInvalidDataConversion, [nil]);
1445 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1446      end;
1447   end;
1448  
# Line 1174 | Line 1480 | begin
1480    end;
1481   end;
1482  
1483 + {Copied from LazUTF8}
1484 +
1485 + function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1486 + const TopBitSetMask   = $80; {%10000000}
1487 +      Top2BitsSetMask = $C0; {%11000000}
1488 +      Top3BitsSetMask = $E0; {%11100000}
1489 +      Top4BitsSetMask = $F0; {%11110000}
1490 +      Top5BitsSetMask = $F8; {%11111000}
1491 + begin
1492 +  case p^ of
1493 +  #0..#191: // %11000000
1494 +    // regular single byte character (#0 is a character, this is Pascal ;)
1495 +    Result:=1;
1496 +  #192..#223: // p^ and %11100000 = %11000000
1497 +    begin
1498 +      // could be 2 byte character
1499 +      if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1500 +        Result:=2
1501 +      else
1502 +        Result:=1;
1503 +    end;
1504 +  #224..#239: // p^ and %11110000 = %11100000
1505 +    begin
1506 +      // could be 3 byte character
1507 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1508 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1509 +        Result:=3
1510 +      else
1511 +        Result:=1;
1512 +    end;
1513 +  #240..#247: // p^ and %11111000 = %11110000
1514 +    begin
1515 +      // could be 4 byte character
1516 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1517 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1518 +      and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1519 +        Result:=4
1520 +      else
1521 +        Result:=1;
1522 +    end;
1523 +  else
1524 +    Result:=1;
1525 +  end;
1526 + end;
1527 +
1528 + {Returns the byte length of a UTF8 string with a fixed charwidth}
1529 +
1530 + function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1531 + var i: integer;
1532 +    cplen: integer;
1533 + begin
1534 +  Result := 0;
1535 +  for i := 1 to FieldWidth do
1536 +  begin
1537 +    cplen := UTF8CodepointSizeFull(p);
1538 +    Inc(p,cplen);
1539 +    Inc(Result,cplen);
1540 +    if Result >= MaxDataLength then
1541 +    begin
1542 +      Result := MaxDataLength;
1543 +      Exit;
1544 +    end;
1545 +  end;
1546 + end;
1547  
1548   function TSQLDataItem.GetAsString: AnsiString;
1549   var
1550    sz: PByte;
1551    str_len: Integer;
1552    rs: RawByteString;
1553 +  aTimeZone: AnsiString;
1554 +  aDateTime: TDateTime;
1555 +  dstOffset: smallint;
1556   begin
1557    CheckActive;
1558    result := '';
# Line 1197 | Line 1570 | begin
1570        begin
1571          sz := SQLData;
1572          if (SQLType = SQL_TEXT) then
1573 <          str_len := DataLength
1573 >        begin
1574 >          if GetCodePage = cp_utf8 then
1575 >            str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1576 >          else
1577 >            str_len := DataLength
1578 >        end
1579          else begin
1580 <          str_len := DecodeInteger(SQLData, 2);
1580 >          str_len := DecodeInteger(sz, 2);
1581            Inc(sz, 2);
1582          end;
1583          SetString(rs, PAnsiChar(sz), str_len);
1584          SetCodePage(rs,GetCodePage,false);
1585 <        if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1208 <          Result := TrimRight(rs)
1209 <        else
1210 <          Result := rs
1585 >        Result := rs;
1586        end;
1587 +
1588        SQL_TYPE_DATE:
1589 <        result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1214 <      SQL_TYPE_TIME :
1215 <        result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1589 >        Result := DateToStr(GetAsDateTime);
1590        SQL_TIMESTAMP:
1591 <        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1591 >        Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1592 >      SQL_TYPE_TIME:
1593 >        Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1594 >      SQL_TIMESTAMP_TZ,
1595 >      SQL_TIMESTAMP_TZ_EX:
1596 >        with GetAttachment.GetTimeZoneServices do
1597 >        begin
1598 >          if GetTZTextOption = tzGMT then
1599 >            Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1600 >          else
1601 >          begin
1602 >            GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1603 >            if GetTZTextOption = tzOffset then
1604 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1605 >            else
1606 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1607 >          end;
1608 >        end;
1609 >      SQL_TIME_TZ,
1610 >      SQL_TIME_TZ_EX:
1611 >        with GetAttachment.GetTimeZoneServices do
1612 >        begin
1613 >          if GetTZTextOption = tzGMT then
1614 >             Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1615 >          else
1616 >          begin
1617 >            GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1618 >            if GetTZTextOption = tzOffset then
1619 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1620 >            else
1621 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1622 >          end;
1623 >        end;
1624 >
1625        SQL_SHORT, SQL_LONG:
1626          if Scale = 0 then
1627            result := IntToStr(AsLong)
# Line 1231 | Line 1638 | begin
1638            result := FloatToStr(AsDouble);
1639        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1640          result := FloatToStr(AsDouble);
1641 +
1642 +      SQL_DEC16,
1643 +      SQL_DEC34:
1644 +        result := BCDToStr(GetAsBCD);
1645 +
1646 +      SQL_DEC_FIXED,
1647 +      SQL_INT128:
1648 +        result := Int128ToStr(SQLData,scale);
1649 +
1650        else
1651 <        IBError(ibxeInvalidDataConversion, [nil]);
1651 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1652      end;
1653   end;
1654  
1655 + function TSQLDataItem.GetAsNumeric: IFBNumeric;
1656 + var aValue: Int64;
1657 + begin
1658 +  case SQLType of
1659 +   SQL_TEXT, SQL_VARYING:
1660 +     Result := StrToNumeric(GetAsString);
1661 +
1662 +   SQL_SHORT:
1663 +     Result := NumericFromRawValues(PShort(SQLData)^, Scale);
1664 +
1665 +   SQL_LONG:
1666 +     Result := NumericFromRawValues(PLong(SQLData)^, Scale);
1667 +
1668 +   SQL_INT64:
1669 +     Result := NumericFromRawValues(PInt64(SQLData)^, Scale);
1670 +
1671 +   SQL_DEC16,
1672 +   SQL_DEC34,
1673 +   SQL_DEC_FIXED,
1674 +   SQL_INT128:
1675 +     Result := BCDToNumeric(GetAsBCD);
1676 +
1677 +   else
1678 +     IBError(ibxeInvalidDataConversion, [nil]);
1679 +  end;
1680 + end;
1681 +
1682   function TSQLDataItem.GetIsNull: Boolean;
1683   begin
1684    CheckActive;
# Line 1249 | Line 1692 | begin
1692   end;
1693  
1694   function TSQLDataItem.GetAsVariant: Variant;
1695 + var ts: TDateTime;
1696 +  dstOffset: smallint;
1697 +    timezone: AnsiString;
1698   begin
1699    CheckActive;
1700    if IsNull then
# Line 1262 | Line 1708 | begin
1708          result := AsString;
1709        SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1710          result := AsDateTime;
1711 +      SQL_TIMESTAMP_TZ,
1712 +      SQL_TIME_TZ,
1713 +      SQL_TIMESTAMP_TZ_EX,
1714 +      SQL_TIME_TZ_EX:
1715 +        begin
1716 +          GetAsDateTime(ts,dstOffset,timezone);
1717 +          result := VarArrayOf([ts,dstOffset,timezone]);
1718 +        end;
1719        SQL_SHORT, SQL_LONG:
1720          if Scale = 0 then
1721            result := AsLong
# Line 1280 | Line 1734 | begin
1734          result := AsDouble;
1735        SQL_BOOLEAN:
1736          result := AsBoolean;
1737 +      SQL_DEC_FIXED,
1738 +      SQL_DEC16,
1739 +      SQL_DEC34,
1740 +      SQL_INT128:
1741 +        result := VarFmtBCDCreate(GetAsBcd);
1742        else
1743          IBError(ibxeInvalidDataConversion, [nil]);
1744      end;
# Line 1300 | Line 1759 | begin
1759      Result := Length(GetDateFormatStr(true));
1760    dfTime:
1761      Result := Length(GetTimeFormatStr);
1762 +  dfTimestampTZ:
1763 +    Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1764 +  dfTimeTZ:
1765 +    Result := Length(GetTimeFormatStr)+ 6;
1766    else
1767      Result := 0;
1768 +  end;end;
1769 +
1770 + function TSQLDataItem.GetAsBCD: tBCD;
1771 +
1772 + begin
1773 +  CheckActive;
1774 +  if IsNull then
1775 +   with Result do
1776 +   begin
1777 +     FillChar(Result,sizeof(Result),0);
1778 +     Precision := 1;
1779 +     exit;
1780 +   end;
1781 +
1782 +  case SQLType of
1783 +  SQL_DEC16,
1784 +  SQL_DEC34:
1785 +    with FFirebirdClientAPI do
1786 +      Result := SQLDecFloatDecode(SQLType,  SQLData);
1787 +
1788 +  SQL_DEC_FIXED,
1789 +  SQL_INT128:
1790 +    with FFirebirdClientAPI do
1791 +      Result := StrToBCD(Int128ToStr(SQLData,scale));
1792 +  else
1793 +    if not CurrToBCD(GetAsCurrency,Result) then
1794 +      IBError(ibxeBadBCDConversion,[]);
1795    end;
1796   end;
1797  
# Line 1327 | Line 1817 | begin
1817    if GetSQLDialect < 3 then
1818      AsDouble := Value
1819    else
1820 +  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> -4)) then
1821 +    SetAsNumeric(CurrToNumeric(Value))
1822 +  else
1823    begin
1824      Changing;
1825      if IsNullable then
# Line 1342 | Line 1835 | end;
1835   procedure TSQLDataItem.SetAsInt64(Value: Int64);
1836   begin
1837    CheckActive;
1838 <  Changing;
1839 <  if IsNullable then
1840 <    IsNull := False;
1838 >  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> 0)) then
1839 >    SetAsNumeric(IntToNumeric(Value))
1840 >  else
1841 >  begin
1842 >    Changing;
1843 >    if IsNullable then
1844 >      IsNull := False;
1845  
1846 <  SQLType := SQL_INT64;
1847 <  Scale := 0;
1848 <  DataLength := SizeOf(Int64);
1849 <  PInt64(SQLData)^ := Value;
1850 <  Changed;
1846 >    SQLType := SQL_INT64;
1847 >    Scale := 0;
1848 >    DataLength := SizeOf(Int64);
1849 >    PInt64(SQLData)^ := Value;
1850 >    Changed;
1851 >  end;
1852   end;
1853  
1854   procedure TSQLDataItem.SetAsDate(Value: TDateTime);
# Line 1393 | Line 1891 | begin
1891    Changed;
1892   end;
1893  
1894 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1895 + begin
1896 +  CheckActive;
1897 +  CheckTZSupport;
1898 +  if GetSQLDialect < 3 then
1899 +  begin
1900 +    AsDateTime := aValue;
1901 +    exit;
1902 +  end;
1903 +
1904 +  Changing;
1905 +  if IsNullable then
1906 +    IsNull := False;
1907 +
1908 +  SQLType := SQL_TIME_TZ;
1909 +  DataLength := SizeOf(ISC_TIME_TZ);
1910 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1911 +  Changed;
1912 + end;
1913 +
1914 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1915 + begin
1916 +  CheckActive;
1917 +  CheckTZSupport;
1918 +  if GetSQLDialect < 3 then
1919 +  begin
1920 +    AsDateTime := aValue;
1921 +    exit;
1922 +  end;
1923 +
1924 +  Changing;
1925 +  if IsNullable then
1926 +    IsNull := False;
1927 +
1928 +  SQLType := SQL_TIME_TZ;
1929 +  DataLength := SizeOf(ISC_TIME_TZ);
1930 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1931 +  Changed;
1932 + end;
1933 +
1934   procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1935   begin
1936    CheckActive;
# Line 1407 | Line 1945 | begin
1945    Changed;
1946   end;
1947  
1948 < procedure TSQLDataItem.SetAsDouble(Value: Double);
1948 > procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1949 >  aTimeZoneID: TFBTimeZoneID);
1950   begin
1951    CheckActive;
1952 +  CheckTZSupport;
1953    if IsNullable then
1954      IsNull := False;
1955  
1956    Changing;
1957 <  SQLType := SQL_DOUBLE;
1958 <  DataLength := SizeOf(Double);
1959 <  Scale := 0;
1420 <  PDouble(SQLData)^ := Value;
1957 >  SQLType := SQL_TIMESTAMP_TZ;
1958 >  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1959 >  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
1960    Changed;
1961   end;
1962  
1963 < procedure TSQLDataItem.SetAsFloat(Value: Float);
1963 > procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
1964 >  );
1965   begin
1966    CheckActive;
1967 +  CheckTZSupport;
1968    if IsNullable then
1969      IsNull := False;
1970  
1971    Changing;
1972 <  SQLType := SQL_FLOAT;
1973 <  DataLength := SizeOf(Float);
1974 <  Scale := 0;
1434 <  PSingle(SQLData)^ := Value;
1972 >  SQLType := SQL_TIMESTAMP_TZ;
1973 >  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1974 >  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
1975    Changed;
1976   end;
1977  
1978 + procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
1979 + begin
1980 +  SetAsDateTime(aUTCTime,TimeZoneID_GMT);
1981 + end;
1982 +
1983 + procedure TSQLDataItem.SetAsDouble(Value: Double);
1984 + begin
1985 +  CheckActive;
1986 +  if not CanChangeMetaData and (SQLType <> SQL_DOUBLE) then
1987 +    SetAsNumeric(DoubleToNumeric(Value))
1988 +  else
1989 +  begin
1990 +    if IsNullable then
1991 +      IsNull := False;
1992 +
1993 +    Changing;
1994 +    SQLType := SQL_DOUBLE;
1995 +    DataLength := SizeOf(Double);
1996 +    Scale := 0;
1997 +    PDouble(SQLData)^ := Value;
1998 +    Changed;
1999 +  end;
2000 + end;
2001 +
2002 + procedure TSQLDataItem.SetAsFloat(Value: Float);
2003 + begin
2004 +  CheckActive;
2005 +  if not CanChangeMetaData and (SQLType <> SQL_FLOAT) then
2006 +    SetAsNumeric(DoubleToNumeric(Value))
2007 +  else
2008 +  begin
2009 +    if IsNullable then
2010 +      IsNull := False;
2011 +
2012 +    Changing;
2013 +    SQLType := SQL_FLOAT;
2014 +    DataLength := SizeOf(Float);
2015 +    Scale := 0;
2016 +    PSingle(SQLData)^ := Value;
2017 +    Changed;
2018 +  end;
2019 + end;
2020 +
2021   procedure TSQLDataItem.SetAsLong(Value: Long);
2022   begin
2023    CheckActive;
2024 <  if IsNullable then
2025 <    IsNull := False;
2024 >  if not CanChangeMetaData and ((SQLType <> SQL_LONG) or (Scale <> 0)) then
2025 >    SetAsNumeric(IntToNumeric(Value))
2026 >  else
2027 >  begin
2028 >    if IsNullable then
2029 >      IsNull := False;
2030  
2031 <  Changing;
2032 <  SQLType := SQL_LONG;
2033 <  DataLength := SizeOf(Long);
2034 <  Scale := 0;
2035 <  PLong(SQLData)^ := Value;
2036 <  Changed;
2031 >    Changing;
2032 >    SQLType := SQL_LONG;
2033 >    DataLength := SizeOf(Long);
2034 >    Scale := 0;
2035 >    PLong(SQLData)^ := Value;
2036 >    Changed;
2037 >  end;
2038   end;
2039  
2040   procedure TSQLDataItem.SetAsPointer(Value: Pointer);
# Line 1481 | Line 2069 | end;
2069   procedure TSQLDataItem.SetAsShort(Value: short);
2070   begin
2071    CheckActive;
2072 <  Changing;
2073 <  if IsNullable then
2074 <    IsNull := False;
2072 >  if not CanChangeMetaData and ((SQLType <> SQL_SHORT) or (Scale <> 0)) then
2073 >    SetAsNumeric(IntToNumeric(Value))
2074 >  else
2075 >  begin
2076 >    Changing;
2077 >    if IsNullable then
2078 >      IsNull := False;
2079  
2080 <  SQLType := SQL_SHORT;
2081 <  DataLength := SizeOf(Short);
2082 <  Scale := 0;
2083 <  PShort(SQLData)^ := Value;
2084 <  Changed;
2080 >    SQLType := SQL_SHORT;
2081 >    DataLength := SizeOf(Short);
2082 >    Scale := 0;
2083 >    PShort(SQLData)^ := Value;
2084 >    Changed;
2085 >  end;
2086   end;
2087  
2088   procedure TSQLDataItem.SetAsString(Value: AnsiString);
# Line 1502 | Line 2095 | begin
2095    CheckActive;
2096    if VarIsNull(Value) then
2097      IsNull := True
2098 +  else
2099 +  if VarIsArray(Value) then {must be datetime plus timezone}
2100 +    SetAsDateTime(Value[0],AnsiString(Value[1]))
2101    else case VarType(Value) of
2102      varEmpty, varNull:
2103        IsNull := True;
2104 <    varSmallint, varInteger, varByte,
2105 <      varWord, varShortInt:
2106 <      AsLong := Value;
1511 <    varInt64:
1512 <      AsInt64 := Value;
2104 >    varSmallint, varInteger, varByte, varLongWord,
2105 >      varWord, varShortInt, varInt64:
2106 >        SetAsNumeric(IntToNumeric(Int64(Value)));
2107      varSingle, varDouble:
2108        AsDouble := Value;
2109      varCurrency:
2110 <      AsCurrency := Value;
2110 >      SetAsNumeric(CurrToNumeric(Currency(Value)));
2111      varBoolean:
2112        AsBoolean := Value;
2113      varDate:
# Line 1524 | Line 2118 | begin
2118        IBError(ibxeNotSupported, [nil]);
2119      varByRef, varDispatch, varError, varUnknown, varVariant:
2120        IBError(ibxeNotPermitted, [nil]);
2121 +    else
2122 +      if VarIsFmtBCD(Value) then
2123 +        SetAsBCD(VarToBCD(Value))
2124 +      else
2125 +        IBError(ibxeNotSupported, [nil]);
2126 +  end;
2127 + end;
2128 +
2129 + procedure TSQLDataItem.SetAsNumeric(Value: IFBNumeric);
2130 + begin
2131 +  CheckActive;
2132 +  Changing;
2133 +  if IsNullable then
2134 +    IsNull := False;
2135 +
2136 +  if CanChangeMetadata then
2137 +  begin
2138 +    {Restore original values}
2139 +    SQLType := getColMetadata.GetSQLType;
2140 +    Scale := getColMetadata.getScale;
2141 +    SetDataLength(getColMetadata.GetSize);
2142 +  end;
2143 +
2144 +  with FFirebirdClientAPI do
2145 +  case GetSQLType of
2146 +  SQL_LONG:
2147 +      PLong(SQLData)^ := SafeInteger(Value.AdjustScaleTo(Scale).getRawValue);
2148 +  SQL_SHORT:
2149 +    PShort(SQLData)^ := SafeSmallInt(Value.AdjustScaleTo(Scale).getRawValue);
2150 +  SQL_INT64:
2151 +    PInt64(SQLData)^ := Value.AdjustScaleTo(Scale).getRawValue;
2152 +  SQL_TEXT, SQL_VARYING:
2153 +   SetAsString(Value.getAsString);
2154 +  SQL_D_FLOAT,
2155 +  SQL_DOUBLE:
2156 +    PDouble(SQLData)^ := Value.getAsDouble;
2157 +  SQL_FLOAT:
2158 +    PSingle(SQLData)^ := Value.getAsDouble;
2159 +  SQL_DEC_FIXED,
2160 +  SQL_DEC16,
2161 +  SQL_DEC34:
2162 +     SQLDecFloatEncode(Value.getAsBCD,SQLType,SQLData);
2163 +  SQL_INT128:
2164 +    StrToInt128(Scale,Value.getAsString,SQLData);
2165 +  else
2166 +    IBError(ibxeInvalidDataConversion, [nil]);
2167    end;
2168 +  Changed;
2169   end;
2170  
2171 < procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
2171 > procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2172   begin
2173    CheckActive;
2174    Changing;
2175    if IsNullable then
2176      IsNull := False;
2177  
2178 <  SQLType := SQL_INT64;
2179 <  Scale := aScale;
2180 <  DataLength := SizeOf(Int64);
2181 <  PInt64(SQLData)^ := Value;
2178 >  if not CanChangeMetaData then
2179 >  begin
2180 >    SetAsNumeric(BCDToNumeric(aValue));
2181 >    Exit;
2182 >  end;
2183 >
2184 >  with FFirebirdClientAPI do
2185 >  if aValue.Precision <= 16 then
2186 >  begin
2187 >    if not HasDecFloatSupport then
2188 >      IBError(ibxeDecFloatNotSupported,[]);
2189 >
2190 >    SQLType := SQL_DEC16;
2191 >    DataLength := 8;
2192 >    SQLDecFloatEncode(aValue,SQLType,SQLData);
2193 >  end
2194 >  else
2195 >  if aValue.Precision <= 34 then
2196 >  begin
2197 >    if not HasDecFloatSupport then
2198 >      IBError(ibxeDecFloatNotSupported,[]);
2199 >
2200 >    SQLType := SQL_DEC34;
2201 >    DataLength := 16;
2202 >    SQLDecFloatEncode(aValue,SQLType,SQLData);
2203 >  end
2204 >  else
2205 >  if aValue.Precision <= 38 then
2206 >  begin
2207 >    if not HasInt128Support then
2208 >      IBError(ibxeInt128NotSupported,[]);
2209 >
2210 >    SQLType := SQL_INT128;
2211 >    DataLength := 16;
2212 >    StrToInt128(scale,BcdToStr(aValue),SQLData);
2213 >  end
2214 >  else
2215 >    IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2216 >
2217    Changed;
2218   end;
2219  
# Line 1571 | Line 2247 | begin
2247      IBError(ibxeStatementNotPrepared, [nil]);
2248   end;
2249  
2250 + function TColumnMetaData.GetAttachment: IAttachment;
2251 + begin
2252 +  Result := FIBXSQLVAR.GetAttachment;
2253 + end;
2254 +
2255   function TColumnMetaData.SQLData: PByte;
2256   begin
2257    Result := FIBXSQLVAR.SQLData;
# Line 1588 | Line 2269 | end;
2269  
2270   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2271   begin
2272 <  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
2272 >  inherited Create(aIBXSQLVAR.GetAttachment.getFirebirdAPI as TFBClientAPI);
2273    FIBXSQLVAR := aIBXSQLVAR;
2274    FOwner := aOwner;
2275    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 1604 | Line 2285 | end;
2285  
2286   function TColumnMetaData.GetSQLDialect: integer;
2287   begin
2288 <  Result := FIBXSQLVAR.Statement.GetSQLDialect;
2288 >  Result := FIBXSQLVAR.GetAttachment.GetSQLDialect;
2289 > end;
2290 >
2291 > function TColumnMetaData.getColMetadata: IParamMetaData;
2292 > begin
2293 >  Result := self;
2294   end;
2295  
2296   function TColumnMetaData.GetIndex: integer;
# Line 1675 | Line 2361 | end;
2361   function TColumnMetaData.GetSize: cardinal;
2362   begin
2363    CheckActive;
2364 <  result := FIBXSQLVAR.DataLength;
2364 >  result := FIBXSQLVAR.GetSize;
2365 > end;
2366 >
2367 > function TColumnMetaData.GetCharSetWidth: integer;
2368 > begin
2369 >  CheckActive;
2370 >  result := FIBXSQLVAR.GetCharSetWidth;
2371   end;
2372  
2373   function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
# Line 1697 | Line 2389 | end;
2389  
2390   function TColumnMetaData.GetTransaction: ITransaction;
2391   begin
2392 <  Result := GetStatement.GetTransaction;
2392 >  Result := FIBXSQLVAR.GetTransaction;
2393   end;
2394  
2395   { TIBSQLData }
# Line 1719 | Line 2411 | begin
2411      IBError(ibxeBOF,[nil]);
2412   end;
2413  
1722 function TIBSQLData.GetTransaction: ITransaction;
1723 begin
1724  if FTransaction = nil then
1725    Result := inherited GetTransaction
1726  else
1727    Result := FTransaction;
1728 end;
1729
2414   function TIBSQLData.GetIsNull: Boolean;
2415   begin
2416    CheckActive;
# Line 1736 | Line 2420 | end;
2420   function TIBSQLData.GetAsArray: IArray;
2421   begin
2422    CheckActive;
2423 <  result := FIBXSQLVAR.GetAsArray(AsQuad);
2423 >  result := FIBXSQLVAR.GetAsArray;
2424   end;
2425  
2426   function TIBSQLData.GetAsBlob: IBlob;
# Line 1780 | Line 2464 | end;
2464  
2465   var b: IBlob;
2466      dt: TDateTime;
2467 <    CurrValue: Currency;
2468 <    FloatValue: single;
2467 >    timezone: AnsiString;
2468 >    Int64Value: Int64;
2469 >    BCDValue: TBCD;
2470 >    aScale: integer;
2471   begin
2472    CheckActive;
2473    if IsNullable then
2474      IsNull := False;
2475 +  with FFirebirdClientAPI do
2476    case SQLTYPE of
2477    SQL_BOOLEAN:
2478      if AnsiCompareText(Value,STrue) = 0 then
# Line 1797 | Line 2484 | begin
2484        IBError(ibxeInvalidDataConversion,[nil]);
2485  
2486    SQL_BLOB:
2487 +    if Length(Value) < GetAttachment.GetInlineBlobLimit then
2488 +      DoSetString
2489 +    else
2490      begin
2491        Changing;
2492        b := FIBXSQLVAR.CreateBlob;
# Line 1809 | Line 2499 | begin
2499    SQL_TEXT:
2500      DoSetString;
2501  
2502 <    SQL_SHORT,
2503 <    SQL_LONG,
2504 <    SQL_INT64:
2505 <      if TryStrToCurr(Value,CurrValue) then
2506 <        SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2507 <      else
2508 <        DoSetString;
2502 >  SQL_SHORT,
2503 >  SQL_LONG,
2504 >  SQL_INT64:
2505 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2506 >      SetAsNumeric(NumericFromRawValues(Int64Value,aScale))
2507 >    else
2508 >      DoSetString;
2509  
2510 <    SQL_D_FLOAT,
2511 <    SQL_DOUBLE,
2512 <    SQL_FLOAT:
2513 <      if TryStrToFloat(Value,FloatValue) then
2514 <        SetAsDouble(FloatValue)
2515 <      else
2516 <        DoSetString;
2510 >  SQL_DEC_FIXED,
2511 >  SQL_DEC16,
2512 >  SQL_DEC34,
2513 >  SQL_INT128:
2514 >    if TryStrToBCD(Value,BCDValue) then
2515 >      SetAsNumeric(BCDToNumeric(BCDValue))
2516 >    else
2517 >      DoSetString;
2518 >
2519 >  SQL_D_FLOAT,
2520 >  SQL_DOUBLE,
2521 >  SQL_FLOAT:
2522 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2523 >      SetAsNumeric(NumericFromRawValues(Int64Value,AScale))
2524 >    else
2525 >      DoSetString;
2526  
2527 <    SQL_TIMESTAMP:
2527 >  SQL_TIMESTAMP:
2528        if TryStrToDateTime(Value,dt) then
2529          SetAsDateTime(dt)
2530        else
2531          DoSetString;
2532  
2533 <    SQL_TYPE_DATE:
2533 >  SQL_TYPE_DATE:
2534        if TryStrToDateTime(Value,dt) then
2535          SetAsDate(dt)
2536        else
2537          DoSetString;
2538  
2539 <    SQL_TYPE_TIME:
2539 >  SQL_TYPE_TIME:
2540        if TryStrToDateTime(Value,dt) then
2541          SetAsTime(dt)
2542        else
2543          DoSetString;
2544  
2545 <    else
2546 <      IBError(ibxeInvalidDataConversion,[nil]);
2545 >  SQL_TIMESTAMP_TZ,
2546 >  SQL_TIMESTAMP_TZ_EX:
2547 >      if ParseDateTimeTZString(value,dt,timezone) then
2548 >        SetAsDateTime(dt,timezone)
2549 >      else
2550 >        DoSetString;
2551 >
2552 >  SQL_TIME_TZ,
2553 >  SQL_TIME_TZ_EX:
2554 >      if ParseDateTimeTZString(value,dt,timezone,true) then
2555 >        SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2556 >      else
2557 >        DoSetString;
2558 >
2559 >  else
2560 >    IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2561    end;
2562   end;
2563  
# Line 1882 | Line 2595 | begin
2595    IsNull := true;
2596   end;
2597  
2598 + function TSQLParam.CanChangeMetaData: boolean;
2599 + begin
2600 +  Result := FIBXSQLVAR.CanChangeMetaData;
2601 + end;
2602 +
2603 + function TSQLParam.getColMetadata: IParamMetaData;
2604 + begin
2605 +  Result := FIBXSQLVAR.getColMetadata;
2606 + end;
2607 +
2608   function TSQLParam.GetModified: boolean;
2609   begin
2610    CheckActive;
# Line 1895 | Line 2618 | begin
2618    Result := inherited GetAsPointer;
2619   end;
2620  
2621 + function TSQLParam.GetAsString: AnsiString;
2622 + var rs: RawByteString;
2623 + begin
2624 +  Result := '';
2625 +  if (SQLType = SQL_VARYING) and not IsNull then
2626 +  {SQLData points to start of string - default is to length word}
2627 +  begin
2628 +    CheckActive;
2629 +    SetString(rs,PAnsiChar(SQLData),DataLength);
2630 +    SetCodePage(rs,GetCodePage,false);
2631 +    Result := rs;
2632 +  end
2633 +  else
2634 +    Result := inherited GetAsString;
2635 + end;
2636 +
2637   procedure TSQLParam.SetName(Value: AnsiString);
2638   begin
2639    CheckActive;
# Line 1940 | Line 2679 | begin
2679    if not FIBXSQLVAR.UniqueName then
2680      IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
2681  
2682 +  FIBXSQLVAR.SetArray(anArray); {save array interface}
2683    SetAsQuad(AnArray.GetArrayID);
2684   end;
2685  
# Line 2086 | Line 2826 | begin
2826    end;
2827   end;
2828  
2829 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2830 + var i: integer;
2831 +    OldSQLVar: TSQLVarData;
2832 + begin
2833 +  if FIBXSQLVAR.UniqueName then
2834 +    inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2835 +  else
2836 +  with FIBXSQLVAR.Parent do
2837 +  begin
2838 +    for i := 0 to Count - 1 do
2839 +      if Column[i].Name = Name then
2840 +      begin
2841 +        OldSQLVar := FIBXSQLVAR;
2842 +        FIBXSQLVAR := Column[i];
2843 +        try
2844 +          inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2845 +        finally
2846 +          FIBXSQLVAR := OldSQLVar;
2847 +        end;
2848 +      end;
2849 +  end;
2850 + end;
2851 +
2852 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2853 + var i: integer;
2854 +    OldSQLVar: TSQLVarData;
2855 + begin
2856 +  if FIBXSQLVAR.UniqueName then
2857 +    inherited SetAsTime(AValue,OnDate,aTimeZone)
2858 +  else
2859 +  with FIBXSQLVAR.Parent do
2860 +  begin
2861 +    for i := 0 to Count - 1 do
2862 +      if Column[i].Name = Name then
2863 +      begin
2864 +        OldSQLVar := FIBXSQLVAR;
2865 +        FIBXSQLVAR := Column[i];
2866 +        try
2867 +          inherited SetAsTime(AValue,OnDate,aTimeZone);
2868 +        finally
2869 +          FIBXSQLVAR := OldSQLVar;
2870 +        end;
2871 +      end;
2872 +  end;
2873 + end;
2874 +
2875 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2876 + begin
2877 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2878 + end;
2879 +
2880 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2881 + begin
2882 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2883 + end;
2884 +
2885   procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2886   var i: integer;
2887      OldSQLVar: TSQLVarData;
# Line 2109 | Line 2905 | begin
2905    end;
2906   end;
2907  
2908 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2909 +  );
2910 + var i: integer;
2911 +    OldSQLVar: TSQLVarData;
2912 + begin
2913 +  if FIBXSQLVAR.UniqueName then
2914 +    inherited SetAsDateTime(AValue,aTimeZoneID)
2915 +  else
2916 +  with FIBXSQLVAR.Parent do
2917 +  begin
2918 +    for i := 0 to Count - 1 do
2919 +      if Column[i].Name = Name then
2920 +      begin
2921 +        OldSQLVar := FIBXSQLVAR;
2922 +        FIBXSQLVAR := Column[i];
2923 +        try
2924 +          inherited SetAsDateTime(AValue,aTimeZoneID);
2925 +        finally
2926 +          FIBXSQLVAR := OldSQLVar;
2927 +        end;
2928 +      end;
2929 +  end;
2930 + end;
2931 +
2932 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2933 + var i: integer;
2934 +    OldSQLVar: TSQLVarData;
2935 + begin
2936 +  if FIBXSQLVAR.UniqueName then
2937 +    inherited SetAsDateTime(AValue,aTimeZone)
2938 +  else
2939 +  with FIBXSQLVAR.Parent do
2940 +  begin
2941 +    for i := 0 to Count - 1 do
2942 +      if Column[i].Name = Name then
2943 +      begin
2944 +        OldSQLVar := FIBXSQLVAR;
2945 +        FIBXSQLVAR := Column[i];
2946 +        try
2947 +          inherited SetAsDateTime(AValue,aTimeZone);
2948 +        finally
2949 +          FIBXSQLVAR := OldSQLVar;
2950 +        end;
2951 +      end;
2952 +  end;
2953 + end;
2954 +
2955   procedure TSQLParam.SetAsDouble(AValue: Double);
2956   var i: integer;
2957      OldSQLVar: TSQLVarData;
# Line 2289 | Line 3132 | begin
3132    FIBXSQLVAR.SetCharSetID(aValue);
3133   end;
3134  
3135 + procedure TSQLParam.SetAsBcd(aValue: tBCD);
3136 + var i: integer;
3137 +    OldSQLVar: TSQLVarData;
3138 + begin
3139 +  if FIBXSQLVAR.UniqueName then
3140 +    inherited SetAsBcd(AValue)
3141 +  else
3142 +  with FIBXSQLVAR.Parent do
3143 +  begin
3144 +    for i := 0 to Count - 1 do
3145 +      if Column[i].Name = Name then
3146 +      begin
3147 +        OldSQLVar := FIBXSQLVAR;
3148 +        FIBXSQLVAR := Column[i];
3149 +        try
3150 +          inherited SetAsBcd(AValue);
3151 +        finally
3152 +          FIBXSQLVAR := OldSQLVar;
3153 +        end;
3154 +      end;
3155 +  end;
3156 + end;
3157 +
3158 + procedure TSQLParam.SetAsNumeric(aValue: IFBNumeric);
3159 + var i: integer;
3160 +    OldSQLVar: TSQLVarData;
3161 + begin
3162 +  if FIBXSQLVAR.UniqueName then
3163 +    inherited SetAsNumeric(AValue)
3164 +  else
3165 +  with FIBXSQLVAR.Parent do
3166 +  begin
3167 +    for i := 0 to Count - 1 do
3168 +      if Column[i].Name = Name then
3169 +      begin
3170 +        OldSQLVar := FIBXSQLVAR;
3171 +        FIBXSQLVAR := Column[i];
3172 +        try
3173 +          inherited SetAsNumeric(AValue);
3174 +        finally
3175 +          FIBXSQLVAR := OldSQLVar;
3176 +        end;
3177 +      end;
3178 +  end;
3179 + end;
3180 +
3181   { TMetaData }
3182  
3183   procedure TMetaData.CheckActive;
# Line 2310 | Line 3199 | end;
3199  
3200   destructor TMetaData.Destroy;
3201   begin
3202 <  (FStatement as TInterfaceOwner).Remove(self);
3202 >  if FStatement <> nil then
3203 >    (FStatement as TInterfaceOwner).Remove(self);
3204    inherited Destroy;
3205   end;
3206  
# Line 2376 | Line 3266 | end;
3266  
3267   destructor TSQLParams.Destroy;
3268   begin
3269 <  (FStatement as TInterfaceOwner).Remove(self);
3269 >  if FStatement <> nil then
3270 >    (FStatement as TInterfaceOwner).Remove(self);
3271    inherited Destroy;
3272   end;
3273  
# Line 2402 | Line 3293 | begin
3293    end;
3294   end;
3295  
3296 + function TSQLParams.ParamExists(Idx: AnsiString): boolean;
3297 + begin
3298 +  CheckActive;
3299 +  Result := FSQLParams.ColumnByName(Idx) <> nil;
3300 + end;
3301 +
3302   function TSQLParams.ByName(Idx: AnsiString): ISQLParam;
3303   var aIBXSQLVAR: TSQLVarData;
3304   begin
# Line 2432 | Line 3329 | begin
3329    Result := FSQLParams.CaseSensitiveParams;
3330   end;
3331  
3332 + function TSQLParams.GetStatement: IStatement;
3333 + begin
3334 +  Result := FSQLParams.GetStatement;
3335 + end;
3336 +
3337 + function TSQLParams.GetTransaction: ITransaction;
3338 + begin
3339 +  Result := FSQLParams.GetTransaction;
3340 + end;
3341 +
3342 + function TSQLParams.GetAttachment: IAttachment;
3343 + begin
3344 +  Result := FSQLParams.GetAttachment;
3345 + end;
3346 +
3347 + procedure TSQLParams.Clear;
3348 + var i: integer;
3349 + begin
3350 +  for i := 0 to getCount - 1 do
3351 +    getSQLParam(i).Clear;
3352 + end;
3353 +
3354   { TResults }
3355  
3356   procedure TResults.CheckActive;
# Line 2444 | Line 3363 | begin
3363    if not FResults.CheckStatementStatus(ssPrepared)  then
3364      IBError(ibxeStatementNotPrepared, [nil]);
3365  
3366 <  with GetTransaction as TFBTransaction do
3366 >  with GetTransaction do
3367    if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3368      IBError(ibxeInterfaceOutofDate,[nil]);
3369   end;
# Line 2456 | Line 3375 | begin
3375      IBError(ibxeInvalidColumnIndex,[nil]);
3376  
3377    if not HasInterface(aIBXSQLVAR.Index) then
3378 <    AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3379 <  col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3380 <  col.FTransaction := GetTransaction;
3378 >  begin
3379 >    col := TIBSQLData.Create(self,aIBXSQLVAR);
3380 >    AddInterface(aIBXSQLVAR.Index, col);
3381 >  end
3382 >  else
3383 >    col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3384    Result := col;
3385   end;
3386  
# Line 2496 | Line 3418 | begin
3418    end;
3419   end;
3420  
3421 + function TResults.FieldExists(Idx: AnsiString): boolean;
3422 + begin
3423 +  Result :=  FResults.ColumnByName(Idx) <> nil;
3424 + end;
3425 +
3426   function TResults.getSQLData(index: integer): ISQLData;
3427   begin
3428    CheckActive;
# Line 2523 | Line 3450 | end;
3450  
3451   function TResults.GetTransaction: ITransaction;
3452   begin
3453 <  Result := FStatement.GetTransaction;
3453 >  Result := FResults.GetTransaction;
3454 > end;
3455 >
3456 > function TResults.GetAttachment: IAttachment;
3457 > begin
3458 >  Result := FResults.GetAttachment;
3459   end;
3460  
3461   procedure TResults.SetRetainInterfaces(aValue: boolean);

Comparing:
ibx/trunk/fbintf/client/FBSQLData.pas (property svn:eol-style), Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (property svn:eol-style), Revision 391 by tony, Thu Jan 27 16:34:24 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines