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 270 by tony, Fri Jan 18 11:10:37 2019 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (file contents), Revision 371 by tony, Wed Jan 5 15:21:22 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 132 | 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 151 | 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 192 | 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 210 | 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 228 | 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 239 | 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 272 | 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 287 | 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}
369      FPrepareSeqNo: integer;
295    FStatement: IStatement;
370      FChangeSeqNo: integer;
371    protected
372      procedure CheckActive; override;
# Line 304 | Line 378 | type
378      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
379      destructor Destroy; override;
380      function GetSQLDialect: integer; override;
381 <    property Statement: IStatement read FStatement;
381 >    function getColMetadata: IParamMetaData; override;
382  
383    public
384      {IColumnMetaData}
# Line 319 | 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; override;
402 +    function GetAttachment: IAttachment; override;
403      property Name: AnsiString read GetName;
404      property Size: cardinal read GetSize;
405      property CharSetID: cardinal read getCharSetID;
406      property SQLSubtype: integer read getSubtype;
407      property IsNullable: Boolean read GetIsNullable;
408 +  public
409 +    property Statement: IStatement read GetStatement;
410    end;
411  
412    { TIBSQLData }
# Line 343 | 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 355 | 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 368 | 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 379 | 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 421 | Line 537 | type
537      function getSQLParam(index: integer): ISQLParam;
538      function ByName(Idx: AnsiString): ISQLParam ;
539      function GetModified: Boolean;
540 +    function GetHasCaseSensitiveParams: Boolean;
541 +    function GetStatement: IStatement;
542 +    function GetTransaction: ITransaction;
543 +    function GetAttachment: IAttachment;
544 +    procedure Clear;
545    end;
546  
547    { TResults }
# Line 442 | Line 563 | type
563       function ByName(Idx: AnsiString): ISQLData;
564       function getSQLData(index: integer): ISQLData;
565       procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
566 <     function GetTransaction: ITransaction; virtual;
566 >     function GetStatement: IStatement;
567 >     function GetTransaction: ITransaction;
568 >     function GetAttachment: IAttachment;
569       procedure SetRetainInterfaces(aValue: boolean);
570   end;
571  
572   implementation
573  
574 < uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
574 > uses FBMessages, variants, IBUtils, FBTransaction, FBNumeric, DateUtils;
575 >
576 > { TSQLParamMetaData }
577 >
578 > constructor TSQLParamMetaData.Create(src: TSQLVarData);
579 > begin
580 >  inherited Create;
581 >  FSQLType := src.GetSQLType;
582 >  FSQLSubType := src.getSubtype;
583 >  FScale := src.GetScale;
584 >  FCharSetID := src.getCharSetID;
585 >  FNullable := src.GetIsNullable;
586 >  FSize := src.GetSize;
587 >  FCodePage := src.GetCodePage;
588 > end;
589 >
590 > function TSQLParamMetaData.GetSQLType: cardinal;
591 > begin
592 >  Result := FSQLType;
593 > end;
594 >
595 > function TSQLParamMetaData.GetSQLTypeName: AnsiString;
596 > begin
597 >  Result := TSQLDataItem.GetSQLTypeName(FSQLType);
598 > end;
599 >
600 > function TSQLParamMetaData.getSubtype: integer;
601 > begin
602 >  Result := FSQLSubType;
603 > end;
604 >
605 > function TSQLParamMetaData.getScale: integer;
606 > begin
607 >  Result := FScale;
608 > end;
609 >
610 > function TSQLParamMetaData.getCharSetID: cardinal;
611 > begin
612 >  Result := FCharSetID;
613 > end;
614 >
615 > function TSQLParamMetaData.getCodePage: TSystemCodePage;
616 > begin
617 >  Result :=  FCodePage;
618 > end;
619 >
620 > function TSQLParamMetaData.getIsNullable: boolean;
621 > begin
622 >  Result :=  FNullable;
623 > end;
624 >
625 > function TSQLParamMetaData.GetSize: cardinal;
626 > begin
627 >  Result := FSize;
628 > end;
629  
630   { TSQLDataArea }
631  
# Line 464 | Line 641 | begin
641    Result := Length(FColumnList);
642   end;
643  
644 + function TSQLDataArea.GetTransaction: ITransaction;
645 + begin
646 +  Result := GetStatement.GetTransaction;
647 + end;
648 +
649 + function TSQLDataArea.GetAttachment: IAttachment;
650 + begin
651 +  Result := GetStatement.GetAttachment;
652 + end;
653 +
654   procedure TSQLDataArea.SetUniqueRelationName;
655   var
656    i: Integer;
# Line 596 | Line 783 | begin
783      FName := AValue;
784   end;
785  
786 + function TSQLVarData.GetAttachment: IAttachment;
787 + begin
788 +  Result := Parent.Attachment;
789 + end;
790 +
791 + function TSQLVarData.GetTransaction: ITransaction;
792 + begin
793 +  Result := Parent.Transaction;
794 + end;
795 +
796 + function TSQLVarData.GetCharSetWidth: integer;
797 + begin
798 +  result := 1;
799 +  GetAttachment.CharSetWidth(GetCharSetID,result);
800 + end;
801 +
802 + function TSQLVarData.GetCodePage: TSystemCodePage;
803 + begin
804 +  result := CP_NONE;
805 +  GetAttachment.CharSetID2CodePage(GetCharSetID,result);
806 + end;
807 +
808 + procedure TSQLVarData.SetScale(aValue: integer);
809 + begin
810 +  if aValue = Scale then
811 +    Exit;
812 +  if not CanChangeMetaData  then
813 +    IBError(ibxeScaleCannotBeChanged,[]);
814 +  InternalSetScale(aValue);
815 + end;
816 +
817 + procedure TSQLVarData.SetDataLength(len: cardinal);
818 + begin
819 +  if len = DataLength then
820 +    Exit;
821 +  InternalSetDataLength(len);
822 + end;
823 +
824 + procedure TSQLVarData.SetSQLType(aValue: cardinal);
825 + begin
826 +  if aValue = SQLType then
827 +    Exit;
828 +  if not CanChangeMetaData then
829 +    IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(SQLType),
830 +                                          TSQLDataItem.GetSQLTypeName(aValue)]);
831 +  InternalSetSQLType(aValue);
832 + end;
833 +
834 + procedure TSQLVarData.SetMetaSize(aValue: cardinal);
835 + begin
836 +  //Ignore
837 + end;
838 +
839 + procedure TSQLVarData.SaveMetaData;
840 + begin
841 +  FColMetaData := TSQLParamMetaData.Create(self);
842 + end;
843 +
844 + procedure TSQLVarData.SetArray(AValue: IArray);
845 + begin
846 +  FArrayIntf := AValue;
847 + end;
848 +
849   constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
850   begin
851    inherited Create;
# Line 604 | Line 854 | begin
854    FUniqueName := true;
855   end;
856  
857 + function TSQLVarData.CanChangeMetaData: boolean;
858 + begin
859 +  Result := Parent.CanChangeMetaData;
860 + end;
861 +
862   procedure TSQLVarData.SetString(aValue: AnsiString);
863   begin
864    {we take full advantage here of reference counted strings. When setting a string
# Line 612 | Line 867 | begin
867     a zero byte when the string is empty, neatly avoiding a nil pointer error.}
868  
869    FVarString := aValue;
870 <  SQLType := SQL_TEXT;
870 >  if SQLType = SQL_BLOB then
871 >    SetMetaSize(GetAttachment.GetInlineBlobLimit);
872 >  if CanChangeMetaData then
873 >    SQLType := GetDefaultTextSQLType;
874    Scale := 0;
875 +  if  (SQLType <> SQL_VARYING) and (SQLType <> SQL_TEXT) then
876 +    IBError(ibxeUnableTosetaTextType,[Index,Name,TSQLDataItem.GetSQLTypeName(SQLType)]);
877    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
878   end;
879  
# Line 624 | Line 884 | end;
884  
885   procedure TSQLVarData.RowChange;
886   begin
887 +  FArrayIntf := nil;
888    FModified := false;
889    FVarString := '';
890   end;
891  
892 + function TSQLVarData.getColMetadata: IParamMetaData;
893 + begin
894 +  Result := FColMetaData;
895 + end;
896 +
897   procedure TSQLVarData.Initialize;
898  
899    function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
# Line 687 | Line 953 | end;
953  
954   {TSQLDataItem}
955  
690 function TSQLDataItem.AdjustScale(Value: Int64; aScale: Integer): Double;
691 var
692  Scaling : Int64;
693  i: Integer;
694  Val: Double;
695 begin
696  Scaling := 1; Val := Value;
697  if aScale > 0 then
698  begin
699    for i := 1 to aScale do
700      Scaling := Scaling * 10;
701    result := Val * Scaling;
702  end
703  else
704    if aScale < 0 then
705    begin
706      for i := -1 downto aScale do
707        Scaling := Scaling * 10;
708      result := Val / Scaling;
709    end
710    else
711      result := Val;
712 end;
713
714 function TSQLDataItem.AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
715 var
716  Scaling : Int64;
717  i: Integer;
718  Val: Int64;
719 begin
720  Scaling := 1; Val := Value;
721  if aScale > 0 then begin
722    for i := 1 to aScale do Scaling := Scaling * 10;
723    result := Val * Scaling;
724  end else if aScale < 0 then begin
725    for i := -1 downto aScale do Scaling := Scaling * 10;
726    result := Val div Scaling;
727  end else
728    result := Val;
729 end;
730
731 function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
732  ): Currency;
733 var
734  Scaling : Int64;
735  i : Integer;
736  FractionText, PadText, CurrText: AnsiString;
737 begin
738  Result := 0;
739  Scaling := 1;
740  PadText := '';
741  if aScale > 0 then
742  begin
743    for i := 1 to aScale do
744      Scaling := Scaling * 10;
745    result := Value * Scaling;
746  end
747  else
748    if aScale < 0 then
749    begin
750      for i := -1 downto aScale do
751        Scaling := Scaling * 10;
752      FractionText := IntToStr(abs(Value mod Scaling));
753      for i := Length(FractionText) to -aScale -1 do
754        PadText := '0' + PadText;
755      {$IF declared(DefaultFormatSettings)}
756      with DefaultFormatSettings do
757      {$ELSE}
758      {$IF declared(FormatSettings)}
759      with FormatSettings do
760      {$IFEND}
761      {$IFEND}
762      if Value < 0 then
763        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
764      else
765        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
766      try
767        result := StrToCurr(CurrText);
768      except
769        on E: Exception do
770          IBError(ibxeInvalidDataConversion, [nil]);
771      end;
772    end
773    else
774      result := Value;
775 end;
776
956   function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
957   begin
958    {$IF declared(DefaultFormatSettings)}
# Line 803 | Line 982 | begin
982    with FormatSettings do
983    {$IFEND}
984    {$IFEND}
985 <    Result := LongTimeFormat;
985 >    Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
986   end;
987  
988   function TSQLDataItem.GetTimestampFormatStr: AnsiString;
# Line 815 | Line 994 | begin
994    with FormatSettings do
995    {$IFEND}
996    {$IFEND}
997 <    Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
997 >    Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
998   end;
999  
1000   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
# Line 823 | Line 1002 | begin
1002    SetAsLong(aValue);
1003   end;
1004  
1005 < function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1006 <  ): Int64;
1007 < var
829 <  Scaling : Int64;
830 <  i : Integer;
1005 > procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
1006 >  var dstOffset: smallint; var aTimezone: AnsiString;
1007 >  var aTimeZoneID: TFBTimeZoneID);
1008   begin
1009 <  Result := 0;
1010 <  Scaling := 1;
1011 <  if aScale < 0 then
1012 <  begin
1013 <    for i := -1 downto aScale do
1014 <      Scaling := Scaling * 10;
1015 <    result := trunc(Value * Scaling);
1016 <  end
1017 <  else
1018 <  if aScale > 0 then
1019 <  begin
1020 <    for i := 1 to aScale do
1021 <       Scaling := Scaling * 10;
1022 <    result := trunc(Value / Scaling);
1023 <  end
1024 <  else
1025 <    result := trunc(Value);
1009 >  CheckActive;
1010 >  aDateTime := 0;
1011 >  dstOffset := 0;
1012 >  aTimezone := '';
1013 >  aTimeZoneID := TimeZoneID_GMT;
1014 >  if not IsNull then
1015 >    with FFirebirdClientAPI do
1016 >    case SQLType of
1017 >      SQL_TEXT, SQL_VARYING:
1018 >        if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
1019 >          IBError(ibxeInvalidDataConversion, [nil]);
1020 >      SQL_TYPE_DATE:
1021 >        aDateTime := SQLDecodeDate(SQLData);
1022 >      SQL_TYPE_TIME:
1023 >        aDateTime := SQLDecodeTime(SQLData);
1024 >      SQL_TIMESTAMP:
1025 >        aDateTime := SQLDecodeDateTime(SQLData);
1026 >      SQL_TIMESTAMP_TZ:
1027 >        begin
1028 >          GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
1029 >          aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
1030 >        end;
1031 >      SQL_TIMESTAMP_TZ_EX:
1032 >      begin
1033 >        GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
1034 >        aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
1035 >      end;
1036 >      SQL_TIME_TZ:
1037 >        with GetTimeZoneServices do
1038 >        begin
1039 >          DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1040 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1041 >        end;
1042 >      SQL_TIME_TZ_EX:
1043 >        with GetTimeZoneServices do
1044 >        begin
1045 >          DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1046 >          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1047 >        end;
1048 >      else
1049 >        IBError(ibxeInvalidDataConversion, [nil]);
1050 >    end;
1051   end;
1052  
1053 < function TSQLDataItem.AdjustScaleFromDouble(Value: Double; aScale: Integer
852 <  ): Int64;
853 < var
854 <  Scaling : Int64;
855 <  i : Integer;
1053 > procedure TSQLDataItem.CheckActive;
1054   begin
1055 <  Result := 0;
858 <  Scaling := 1;
859 <  if aScale < 0 then
860 <  begin
861 <    for i := -1 downto aScale do
862 <      Scaling := Scaling * 10;
863 <    result := trunc(Value * Scaling);
864 <  end
865 <  else
866 <  if aScale > 0 then
867 <  begin
868 <    for i := 1 to aScale do
869 <       Scaling := Scaling * 10;
870 <    result := trunc(Value / Scaling);
871 <  end
872 <  else
873 <    result := trunc(Value);
1055 >  //Do nothing by default
1056   end;
1057  
1058 < procedure TSQLDataItem.CheckActive;
1058 > procedure TSQLDataItem.CheckTZSupport;
1059   begin
1060 <  //Do nothing by default
1060 >  if not FFirebirdClientAPI.HasTimeZoneSupport then
1061 >    IBError(ibxeNoTimezoneSupport,[]);
1062 > end;
1063 >
1064 > function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1065 > begin
1066 >  if FTimeZoneServices = nil then
1067 >  begin
1068 >    if not GetAttachment.HasTimeZoneSupport then
1069 >      IBError(ibxeNoTimezoneSupport,[]);
1070 >    GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1071 >  end;
1072 >  Result := FTimeZoneServices;
1073   end;
1074  
1075   procedure TSQLDataItem.Changed;
# Line 922 | Line 1116 | begin
1116    FFirebirdClientAPI := api;
1117   end;
1118  
1119 + function TSQLDataItem.CanChangeMetaData: boolean;
1120 + begin
1121 +  Result := false;
1122 + end;
1123 +
1124   function TSQLDataItem.GetSQLTypeName: AnsiString;
1125   begin
1126    Result := GetSQLTypeName(GetSQLType);
1127   end;
1128  
1129 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1129 > class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1130   begin
1131    Result := 'Unknown';
1132    case SQLType of
# Line 938 | Line 1137 | begin
1137    SQL_LONG:             Result := 'SQL_LONG';
1138    SQL_SHORT:            Result := 'SQL_SHORT';
1139    SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1140 +  SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1141 +  SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1142    SQL_BLOB:             Result := 'SQL_BLOB';
1143    SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1144    SQL_ARRAY:            Result := 'SQL_ARRAY';
# Line 945 | Line 1146 | begin
1146    SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1147    SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1148    SQL_INT64:            Result := 'SQL_INT64';
1149 +  SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1150 +  SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1151 +  SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1152 +  SQL_DEC16:            Result := 'SQL_DEC16';
1153 +  SQL_DEC34:            Result := 'SQL_DEC34';
1154 +  SQL_INT128:           Result := 'SQL_INT128';
1155 +  SQL_NULL:             Result := 'SQL_NULL';
1156 +  SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1157    end;
1158   end;
1159  
1160 + function TSQLDataItem.GetStrDataLength: short;
1161 + begin
1162 +  with FFirebirdClientAPI do
1163 +  if SQLType = SQL_VARYING then
1164 +    Result := DecodeInteger(SQLData, 2)
1165 +  else
1166 +    Result := DataLength;
1167 + end;
1168 +
1169   function TSQLDataItem.GetAsBoolean: boolean;
1170   begin
1171    CheckActive;
# Line 978 | Line 1196 | begin
1196            end;
1197          end;
1198          SQL_SHORT:
1199 <          result := AdjustScaleToCurrency(Int64(PShort(SQLData)^),
1200 <                                      Scale);
1199 >          result := NumericFromRawValues(Int64(PShort(SQLData)^),
1200 >                                      Scale).getAsCurrency;
1201          SQL_LONG:
1202 <          result := AdjustScaleToCurrency(Int64(PLong(SQLData)^),
1203 <                                      Scale);
1202 >          result := NumericFromRawValues(Int64(PLong(SQLData)^),
1203 >                                      Scale).getAsCurrency;
1204          SQL_INT64:
1205 <          result := AdjustScaleToCurrency(PInt64(SQLData)^,
1206 <                                      Scale);
1205 >          result := NumericFromRawValues(PInt64(SQLData)^,
1206 >                                      Scale).getAsCurrency;
1207          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1208 <          result := Trunc(AsDouble);
1208 >          result := Round(AsDouble);
1209 >
1210 >        SQL_DEC_FIXED,
1211 >        SQL_DEC16,
1212 >        SQL_DEC34,
1213 >        SQL_INT128:
1214 >          if not BCDToCurr(GetAsBCD,Result) then
1215 >            IBError(ibxeInvalidDataConversion, [nil]);
1216 >
1217          else
1218            IBError(ibxeInvalidDataConversion, [nil]);
1219        end;
# Line 1008 | Line 1234 | begin
1234          end;
1235        end;
1236        SQL_SHORT:
1237 <        result := AdjustScaleToInt64(Int64(PShort(SQLData)^),
1238 <                                    Scale);
1237 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1238 >                                    Scale).getAsInt64;
1239        SQL_LONG:
1240 <        result := AdjustScaleToInt64(Int64(PLong(SQLData)^),
1241 <                                    Scale);
1240 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1241 >                                    Scale).getAsInt64;
1242        SQL_INT64:
1243 <        result := AdjustScaleToInt64(PInt64(SQLData)^,
1244 <                                    Scale);
1243 >        result := NumericFromRawValues(PInt64(SQLData)^,
1244 >                                    Scale).getAsInt64;
1245        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1246 <        result := Trunc(AsDouble);
1246 >        result := Round(AsDouble);
1247        else
1248          IBError(ibxeInvalidDataConversion, [nil]);
1249      end;
1250   end;
1251  
1252   function TSQLDataItem.GetAsDateTime: TDateTime;
1253 + var aTimezone: AnsiString;
1254 +    aTimeZoneID: TFBTimeZoneID;
1255 +    dstOffset: smallint;
1256 + begin
1257 +  InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1258 + end;
1259 +
1260 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1261 +  var dstOffset: smallint; var aTimezone: AnsiString);
1262 + var aTimeZoneID: TFBTimeZoneID;
1263 + begin
1264 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1265 + end;
1266 +
1267 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1268 +  var aTimezoneID: TFBTimeZoneID);
1269 + var aTimezone: AnsiString;
1270 + begin
1271 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1272 + end;
1273 +
1274 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1275 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1276 + var aTimeZone: AnsiString;
1277   begin
1278    CheckActive;
1279 <  result := 0;
1279 >  aTime := 0;
1280 >  dstOffset := 0;
1281    if not IsNull then
1282      with FFirebirdClientAPI do
1283      case SQLType of
1284 <      SQL_TEXT, SQL_VARYING: begin
1285 <        try
1286 <          result := StrToDate(AsString);
1287 <        except
1037 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1284 >      SQL_TIME_TZ:
1285 >        begin
1286 >          GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1287 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1288          end;
1289 +      SQL_TIME_TZ_EX:
1290 +        begin
1291 +          GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1292 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1293 +        end;
1294 +    else
1295 +      IBError(ibxeInvalidDataConversion, [nil]);
1296 +    end;
1297 + end;
1298 +
1299 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1300 +  var aTimezone: AnsiString; OnDate: TDateTime);
1301 + begin
1302 +  CheckActive;
1303 +  aTime := 0;
1304 +  dstOffset := 0;
1305 +  if not IsNull then
1306 +    with FFirebirdClientAPI do
1307 +    case SQLType of
1308 +      SQL_TIME_TZ:
1309 +        GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1310 +      SQL_TIME_TZ_EX:
1311 +        GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1312 +    else
1313 +      IBError(ibxeInvalidDataConversion, [nil]);
1314 +    end;
1315 + end;
1316 +
1317 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1318 +  var aTimezoneID: TFBTimeZoneID);
1319 + begin
1320 +  GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1321 + end;
1322 +
1323 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1324 +  var aTimezone: AnsiString);
1325 + begin
1326 +  GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1327 + end;
1328 +
1329 + function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1330 + var aTimezone: AnsiString;
1331 + begin
1332 +  CheckActive;
1333 +  result := 0;
1334 +  aTimezone := '';
1335 +  if not IsNull then
1336 +    with FFirebirdClientAPI do
1337 +    case SQLType of
1338 +      SQL_TEXT, SQL_VARYING:
1339 +      begin
1340 +        if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1341 +          IBError(ibxeInvalidDataConversion, [nil]);
1342 +        Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1343        end;
1344        SQL_TYPE_DATE:
1345          result := SQLDecodeDate(SQLData);
1346 <      SQL_TYPE_TIME:
1346 >      SQL_TYPE_TIME,
1347 >      SQL_TIME_TZ,
1348 >      SQL_TIME_TZ_EX:
1349          result := SQLDecodeTime(SQLData);
1350 <      SQL_TIMESTAMP:
1350 >      SQL_TIMESTAMP,
1351 >      SQL_TIMESTAMP_TZ,
1352 >      SQL_TIMESTAMP_TZ_EX:
1353          result := SQLDecodeDateTime(SQLData);
1354        else
1355          IBError(ibxeInvalidDataConversion, [nil]);
1356 <    end;
1356 >      end;
1357   end;
1358  
1359   function TSQLDataItem.GetAsDouble: Double;
# Line 1062 | Line 1370 | begin
1370          end;
1371        end;
1372        SQL_SHORT:
1373 <        result := AdjustScale(Int64(PShort(SQLData)^),
1374 <                              Scale);
1373 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1374 >                              Scale).getAsDouble;
1375        SQL_LONG:
1376 <        result := AdjustScale(Int64(PLong(SQLData)^),
1377 <                              Scale);
1376 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1377 >                              Scale).getAsDouble;
1378        SQL_INT64:
1379 <        result := AdjustScale(PInt64(SQLData)^, Scale);
1379 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsDouble;
1380        SQL_FLOAT:
1381          result := PFloat(SQLData)^;
1382        SQL_DOUBLE, SQL_D_FLOAT:
1383          result := PDouble(SQLData)^;
1384 +      SQL_DEC_FIXED,
1385 +      SQL_DEC16,
1386 +      SQL_DEC34,
1387 +      SQL_INT128:
1388 +        Result := BCDToDouble(GetAsBCD);
1389        else
1390          IBError(ibxeInvalidDataConversion, [nil]);
1391      end;
# Line 1109 | Line 1422 | begin
1422          end;
1423        end;
1424        SQL_SHORT:
1425 <        result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1426 <                                    Scale));
1425 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1426 >                                    Scale).getAsInteger;
1427        SQL_LONG:
1428 <        result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1429 <                                    Scale));
1428 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1429 >                                    Scale).getAsInteger;
1430        SQL_INT64:
1431 <        result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1431 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsInteger;
1432 >
1433        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1434 <        result := Trunc(AsDouble);
1434 >        result := Round(AsDouble);
1435 >      SQL_DEC_FIXED,
1436 >      SQL_DEC16,
1437 >      SQL_DEC34,
1438 >      SQL_INT128:
1439 >        Result := BCDToInteger(GetAsBCD);
1440        else
1441 <        IBError(ibxeInvalidDataConversion, [nil]);
1441 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1442      end;
1443   end;
1444  
# Line 1157 | Line 1476 | begin
1476    end;
1477   end;
1478  
1479 + {Copied from LazUTF8}
1480 +
1481 + function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1482 + const TopBitSetMask   = $80; {%10000000}
1483 +      Top2BitsSetMask = $C0; {%11000000}
1484 +      Top3BitsSetMask = $E0; {%11100000}
1485 +      Top4BitsSetMask = $F0; {%11110000}
1486 +      Top5BitsSetMask = $F8; {%11111000}
1487 + begin
1488 +  case p^ of
1489 +  #0..#191: // %11000000
1490 +    // regular single byte character (#0 is a character, this is Pascal ;)
1491 +    Result:=1;
1492 +  #192..#223: // p^ and %11100000 = %11000000
1493 +    begin
1494 +      // could be 2 byte character
1495 +      if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1496 +        Result:=2
1497 +      else
1498 +        Result:=1;
1499 +    end;
1500 +  #224..#239: // p^ and %11110000 = %11100000
1501 +    begin
1502 +      // could be 3 byte character
1503 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1504 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1505 +        Result:=3
1506 +      else
1507 +        Result:=1;
1508 +    end;
1509 +  #240..#247: // p^ and %11111000 = %11110000
1510 +    begin
1511 +      // could be 4 byte character
1512 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1513 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1514 +      and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1515 +        Result:=4
1516 +      else
1517 +        Result:=1;
1518 +    end;
1519 +  else
1520 +    Result:=1;
1521 +  end;
1522 + end;
1523 +
1524 + {Returns the byte length of a UTF8 string with a fixed charwidth}
1525 +
1526 + function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1527 + var i: integer;
1528 +    cplen: integer;
1529 + begin
1530 +  Result := 0;
1531 +  for i := 1 to FieldWidth do
1532 +  begin
1533 +    cplen := UTF8CodepointSizeFull(p);
1534 +    Inc(p,cplen);
1535 +    Inc(Result,cplen);
1536 +    if Result >= MaxDataLength then
1537 +    begin
1538 +      Result := MaxDataLength;
1539 +      Exit;
1540 +    end;
1541 +  end;
1542 + end;
1543  
1544   function TSQLDataItem.GetAsString: AnsiString;
1545   var
1546    sz: PByte;
1547    str_len: Integer;
1548    rs: RawByteString;
1549 +  aTimeZone: AnsiString;
1550 +  aDateTime: TDateTime;
1551 +  dstOffset: smallint;
1552   begin
1553    CheckActive;
1554    result := '';
# Line 1180 | Line 1566 | begin
1566        begin
1567          sz := SQLData;
1568          if (SQLType = SQL_TEXT) then
1569 <          str_len := DataLength
1569 >        begin
1570 >          if GetCodePage = cp_utf8 then
1571 >            str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1572 >          else
1573 >            str_len := DataLength
1574 >        end
1575          else begin
1576 <          str_len := DecodeInteger(SQLData, 2);
1576 >          str_len := DecodeInteger(sz, 2);
1577            Inc(sz, 2);
1578          end;
1579          SetString(rs, PAnsiChar(sz), str_len);
1580          SetCodePage(rs,GetCodePage,false);
1581 <        if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1191 <          Result := TrimRight(rs)
1192 <        else
1193 <          Result := rs
1581 >        Result := rs;
1582        end;
1583 +
1584        SQL_TYPE_DATE:
1585 <        result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1197 <      SQL_TYPE_TIME :
1198 <        result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1585 >        Result := DateToStr(GetAsDateTime);
1586        SQL_TIMESTAMP:
1587 <        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1587 >        Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1588 >      SQL_TYPE_TIME:
1589 >        Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1590 >      SQL_TIMESTAMP_TZ,
1591 >      SQL_TIMESTAMP_TZ_EX:
1592 >        with GetAttachment.GetTimeZoneServices do
1593 >        begin
1594 >          if GetTZTextOption = tzGMT then
1595 >            Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1596 >          else
1597 >          begin
1598 >            GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1599 >            if GetTZTextOption = tzOffset then
1600 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1601 >            else
1602 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1603 >          end;
1604 >        end;
1605 >      SQL_TIME_TZ,
1606 >      SQL_TIME_TZ_EX:
1607 >        with GetAttachment.GetTimeZoneServices do
1608 >        begin
1609 >          if GetTZTextOption = tzGMT then
1610 >             Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1611 >          else
1612 >          begin
1613 >            GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1614 >            if GetTZTextOption = tzOffset then
1615 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1616 >            else
1617 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1618 >          end;
1619 >        end;
1620 >
1621        SQL_SHORT, SQL_LONG:
1622          if Scale = 0 then
1623            result := IntToStr(AsLong)
# Line 1214 | Line 1634 | begin
1634            result := FloatToStr(AsDouble);
1635        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1636          result := FloatToStr(AsDouble);
1637 +
1638 +      SQL_DEC16,
1639 +      SQL_DEC34:
1640 +        result := BCDToStr(GetAsBCD);
1641 +
1642 +      SQL_DEC_FIXED,
1643 +      SQL_INT128:
1644 +        result := Int128ToStr(SQLData,scale);
1645 +
1646        else
1647 <        IBError(ibxeInvalidDataConversion, [nil]);
1647 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1648      end;
1649   end;
1650  
1651 + function TSQLDataItem.GetAsNumeric: IFBNumeric;
1652 + var aValue: Int64;
1653 + begin
1654 +  case SQLType of
1655 +   SQL_TEXT, SQL_VARYING:
1656 +     Result := NewNumeric(GetAsString);
1657 +
1658 +   SQL_SHORT:
1659 +     Result := NumericFromRawValues(PShort(SQLData)^, Scale);
1660 +
1661 +   SQL_LONG:
1662 +     Result := NumericFromRawValues(PLong(SQLData)^, Scale);
1663 +
1664 +   SQL_INT64:
1665 +     Result := NumericFromRawValues(PInt64(SQLData)^, Scale);
1666 +
1667 +   SQL_DEC16,
1668 +   SQL_DEC34,
1669 +   SQL_DEC_FIXED,
1670 +   SQL_INT128:
1671 +     Result := NewNumeric(GetAsBCD);
1672 +
1673 +   else
1674 +     IBError(ibxeInvalidDataConversion, [nil]);
1675 +  end;
1676 + end;
1677 +
1678   function TSQLDataItem.GetIsNull: Boolean;
1679   begin
1680    CheckActive;
# Line 1232 | Line 1688 | begin
1688   end;
1689  
1690   function TSQLDataItem.GetAsVariant: Variant;
1691 + var ts: TDateTime;
1692 +  dstOffset: smallint;
1693 +    timezone: AnsiString;
1694   begin
1695    CheckActive;
1696    if IsNull then
# Line 1245 | Line 1704 | begin
1704          result := AsString;
1705        SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1706          result := AsDateTime;
1707 +      SQL_TIMESTAMP_TZ,
1708 +      SQL_TIME_TZ,
1709 +      SQL_TIMESTAMP_TZ_EX,
1710 +      SQL_TIME_TZ_EX:
1711 +        begin
1712 +          GetAsDateTime(ts,dstOffset,timezone);
1713 +          result := VarArrayOf([ts,dstOffset,timezone]);
1714 +        end;
1715        SQL_SHORT, SQL_LONG:
1716          if Scale = 0 then
1717            result := AsLong
# Line 1263 | Line 1730 | begin
1730          result := AsDouble;
1731        SQL_BOOLEAN:
1732          result := AsBoolean;
1733 +      SQL_DEC_FIXED,
1734 +      SQL_DEC16,
1735 +      SQL_DEC34,
1736 +      SQL_INT128:
1737 +        result := VarFmtBCDCreate(GetAsBcd);
1738        else
1739          IBError(ibxeInvalidDataConversion, [nil]);
1740      end;
# Line 1283 | Line 1755 | begin
1755      Result := Length(GetDateFormatStr(true));
1756    dfTime:
1757      Result := Length(GetTimeFormatStr);
1758 +  dfTimestampTZ:
1759 +    Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1760 +  dfTimeTZ:
1761 +    Result := Length(GetTimeFormatStr)+ 6;
1762    else
1763      Result := 0;
1764 +  end;end;
1765 +
1766 + function TSQLDataItem.GetAsBCD: tBCD;
1767 +
1768 + begin
1769 +  CheckActive;
1770 +  if IsNull then
1771 +   with Result do
1772 +   begin
1773 +     FillChar(Result,sizeof(Result),0);
1774 +     Precision := 1;
1775 +     exit;
1776 +   end;
1777 +
1778 +  case SQLType of
1779 +  SQL_DEC16,
1780 +  SQL_DEC34:
1781 +    with FFirebirdClientAPI do
1782 +      Result := SQLDecFloatDecode(SQLType,  SQLData);
1783 +
1784 +  SQL_DEC_FIXED,
1785 +  SQL_INT128:
1786 +    with FFirebirdClientAPI do
1787 +      Result := StrToBCD(Int128ToStr(SQLData,scale));
1788 +  else
1789 +    if not CurrToBCD(GetAsCurrency,Result) then
1790 +      IBError(ibxeBadBCDConversion,[]);
1791    end;
1792   end;
1793  
# Line 1310 | Line 1813 | begin
1813    if GetSQLDialect < 3 then
1814      AsDouble := Value
1815    else
1816 +  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> -4)) then
1817 +    SetAsNumeric(NewNumeric(Value))
1818 +  else
1819    begin
1820      Changing;
1821      if IsNullable then
# Line 1325 | Line 1831 | end;
1831   procedure TSQLDataItem.SetAsInt64(Value: Int64);
1832   begin
1833    CheckActive;
1834 <  Changing;
1835 <  if IsNullable then
1836 <    IsNull := False;
1834 >  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> 0)) then
1835 >    SetAsNumeric(NewNumeric(Value))
1836 >  else
1837 >  begin
1838 >    Changing;
1839 >    if IsNullable then
1840 >      IsNull := False;
1841  
1842 <  SQLType := SQL_INT64;
1843 <  Scale := 0;
1844 <  DataLength := SizeOf(Int64);
1845 <  PInt64(SQLData)^ := Value;
1846 <  Changed;
1842 >    SQLType := SQL_INT64;
1843 >    Scale := 0;
1844 >    DataLength := SizeOf(Int64);
1845 >    PInt64(SQLData)^ := Value;
1846 >    Changed;
1847 >  end;
1848   end;
1849  
1850   procedure TSQLDataItem.SetAsDate(Value: TDateTime);
# Line 1376 | Line 1887 | begin
1887    Changed;
1888   end;
1889  
1890 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1891 + begin
1892 +  CheckActive;
1893 +  CheckTZSupport;
1894 +  if GetSQLDialect < 3 then
1895 +  begin
1896 +    AsDateTime := aValue;
1897 +    exit;
1898 +  end;
1899 +
1900 +  Changing;
1901 +  if IsNullable then
1902 +    IsNull := False;
1903 +
1904 +  SQLType := SQL_TIME_TZ;
1905 +  DataLength := SizeOf(ISC_TIME_TZ);
1906 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1907 +  Changed;
1908 + end;
1909 +
1910 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1911 + begin
1912 +  CheckActive;
1913 +  CheckTZSupport;
1914 +  if GetSQLDialect < 3 then
1915 +  begin
1916 +    AsDateTime := aValue;
1917 +    exit;
1918 +  end;
1919 +
1920 +  Changing;
1921 +  if IsNullable then
1922 +    IsNull := False;
1923 +
1924 +  SQLType := SQL_TIME_TZ;
1925 +  DataLength := SizeOf(ISC_TIME_TZ);
1926 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1927 +  Changed;
1928 + end;
1929 +
1930   procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1931   begin
1932    CheckActive;
# Line 1390 | Line 1941 | begin
1941    Changed;
1942   end;
1943  
1944 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1945 +  aTimeZoneID: TFBTimeZoneID);
1946 + begin
1947 +  CheckActive;
1948 +  CheckTZSupport;
1949 +  if IsNullable then
1950 +    IsNull := False;
1951 +
1952 +  Changing;
1953 +  SQLType := SQL_TIMESTAMP_TZ;
1954 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1955 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
1956 +  Changed;
1957 + end;
1958 +
1959 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
1960 +  );
1961 + begin
1962 +  CheckActive;
1963 +  CheckTZSupport;
1964 +  if IsNullable then
1965 +    IsNull := False;
1966 +
1967 +  Changing;
1968 +  SQLType := SQL_TIMESTAMP_TZ;
1969 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1970 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
1971 +  Changed;
1972 + end;
1973 +
1974 + procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
1975 + begin
1976 +  SetAsDateTime(aUTCTime,TimeZoneID_GMT);
1977 + end;
1978 +
1979   procedure TSQLDataItem.SetAsDouble(Value: Double);
1980   begin
1981    CheckActive;
# Line 1421 | Line 2007 | end;
2007   procedure TSQLDataItem.SetAsLong(Value: Long);
2008   begin
2009    CheckActive;
2010 <  if IsNullable then
2011 <    IsNull := False;
2010 >  if not CanChangeMetaData and ((SQLType <> SQL_LONG) or (Scale <> 0)) then
2011 >    SetAsNumeric(NewNumeric(Value))
2012 >  else
2013 >  begin
2014 >    if IsNullable then
2015 >      IsNull := False;
2016  
2017 <  Changing;
2018 <  SQLType := SQL_LONG;
2019 <  DataLength := SizeOf(Long);
2020 <  Scale := 0;
2021 <  PLong(SQLData)^ := Value;
2022 <  Changed;
2017 >    Changing;
2018 >    SQLType := SQL_LONG;
2019 >    DataLength := SizeOf(Long);
2020 >    Scale := 0;
2021 >    PLong(SQLData)^ := Value;
2022 >    Changed;
2023 >  end;
2024   end;
2025  
2026   procedure TSQLDataItem.SetAsPointer(Value: Pointer);
# Line 1464 | Line 2055 | end;
2055   procedure TSQLDataItem.SetAsShort(Value: short);
2056   begin
2057    CheckActive;
2058 <  Changing;
2059 <  if IsNullable then
2060 <    IsNull := False;
2058 >  if not CanChangeMetaData and ((SQLType <> SQL_SHORT) or (Scale <> 0)) then
2059 >    SetAsNumeric(NewNumeric(Value))
2060 >  else
2061 >  begin
2062 >    Changing;
2063 >    if IsNullable then
2064 >      IsNull := False;
2065  
2066 <  SQLType := SQL_SHORT;
2067 <  DataLength := SizeOf(Short);
2068 <  Scale := 0;
2069 <  PShort(SQLData)^ := Value;
2070 <  Changed;
2066 >    SQLType := SQL_SHORT;
2067 >    DataLength := SizeOf(Short);
2068 >    Scale := 0;
2069 >    PShort(SQLData)^ := Value;
2070 >    Changed;
2071 >  end;
2072   end;
2073  
2074   procedure TSQLDataItem.SetAsString(Value: AnsiString);
# Line 1485 | Line 2081 | begin
2081    CheckActive;
2082    if VarIsNull(Value) then
2083      IsNull := True
2084 +  else
2085 +  if VarIsArray(Value) then {must be datetime plus timezone}
2086 +    SetAsDateTime(Value[0],AnsiString(Value[1]))
2087    else case VarType(Value) of
2088      varEmpty, varNull:
2089        IsNull := True;
2090      varSmallint, varInteger, varByte,
2091 <      varWord, varShortInt:
2092 <      AsLong := Value;
1494 <    varInt64:
1495 <      AsInt64 := Value;
2091 >      varWord, varShortInt, varInt64:
2092 >        SetAsNumeric(NewNumeric(Int64(Value)));
2093      varSingle, varDouble:
2094        AsDouble := Value;
2095      varCurrency:
2096 <      AsCurrency := Value;
2096 >      SetAsNumeric(NewNumeric(Currency(Value)));
2097      varBoolean:
2098        AsBoolean := Value;
2099      varDate:
# Line 1507 | Line 2104 | begin
2104        IBError(ibxeNotSupported, [nil]);
2105      varByRef, varDispatch, varError, varUnknown, varVariant:
2106        IBError(ibxeNotPermitted, [nil]);
2107 +    else
2108 +      if VarIsFmtBCD(Value) then
2109 +        SetAsBCD(VarToBCD(Value))
2110 +      else
2111 +        IBError(ibxeNotSupported, [nil]);
2112 +  end;
2113 + end;
2114 +
2115 + procedure TSQLDataItem.SetAsNumeric(Value: IFBNumeric);
2116 + begin
2117 +  CheckActive;
2118 +  Changing;
2119 +  if IsNullable then
2120 +    IsNull := False;
2121 +
2122 +  if CanChangeMetadata then
2123 +  begin
2124 +    {Restore original values}
2125 +    SQLType := getColMetadata.GetSQLType;
2126 +    Scale := getColMetadata.getScale;
2127 +    SetDataLength(getColMetadata.GetSize);
2128 +  end;
2129 +
2130 +  with FFirebirdClientAPI do
2131 +  case GetSQLType of
2132 +  SQL_LONG:
2133 +      PLong(SQLData)^ := SafeInteger(Value.clone(Scale).getRawValue);
2134 +  SQL_SHORT:
2135 +    PShort(SQLData)^ := SafeSmallInt(Value.clone(Scale).getRawValue);
2136 +  SQL_INT64:
2137 +    PInt64(SQLData)^ := Value.clone(Scale).getRawValue;
2138 +  SQL_TEXT, SQL_VARYING:
2139 +   SetAsString(Value.getAsString);
2140 +  SQL_D_FLOAT,
2141 +  SQL_DOUBLE:
2142 +    PDouble(SQLData)^ := Value.getAsDouble;
2143 +  SQL_FLOAT:
2144 +    PSingle(SQLData)^ := Value.getAsDouble;
2145 +  SQL_DEC_FIXED,
2146 +  SQL_DEC16,
2147 +  SQL_DEC34:
2148 +     SQLDecFloatEncode(Value.getAsBCD,SQLType,SQLData);
2149 +  SQL_INT128:
2150 +    StrToInt128(Scale,Value.getAsString,SQLData);
2151 +  else
2152 +    IBError(ibxeInvalidDataConversion, [nil]);
2153    end;
2154 +  Changed;
2155   end;
2156  
2157 < procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
2157 > procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2158   begin
2159    CheckActive;
2160    Changing;
2161    if IsNullable then
2162      IsNull := False;
2163  
2164 <  SQLType := SQL_INT64;
2165 <  Scale := aScale;
2166 <  DataLength := SizeOf(Int64);
2167 <  PInt64(SQLData)^ := Value;
2164 >  if not CanChangeMetaData then
2165 >  begin
2166 >    SetAsNumeric(NewNumeric(aValue));
2167 >    Exit;
2168 >  end;
2169 >
2170 >  with FFirebirdClientAPI do
2171 >  if aValue.Precision <= 16 then
2172 >  begin
2173 >    if not HasDecFloatSupport then
2174 >      IBError(ibxeDecFloatNotSupported,[]);
2175 >
2176 >    SQLType := SQL_DEC16;
2177 >    DataLength := 8;
2178 >    SQLDecFloatEncode(aValue,SQLType,SQLData);
2179 >  end
2180 >  else
2181 >  if aValue.Precision <= 34 then
2182 >  begin
2183 >    if not HasDecFloatSupport then
2184 >      IBError(ibxeDecFloatNotSupported,[]);
2185 >
2186 >    SQLType := SQL_DEC34;
2187 >    DataLength := 16;
2188 >    SQLDecFloatEncode(aValue,SQLType,SQLData);
2189 >  end
2190 >  else
2191 >  if aValue.Precision <= 38 then
2192 >  begin
2193 >    if not HasInt128Support then
2194 >      IBError(ibxeInt128NotSupported,[]);
2195 >
2196 >    SQLType := SQL_INT128;
2197 >    DataLength := 16;
2198 >    StrToInt128(scale,BcdToStr(aValue),SQLData);
2199 >  end
2200 >  else
2201 >    IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2202 >
2203    Changed;
2204   end;
2205  
# Line 1554 | Line 2233 | begin
2233      IBError(ibxeStatementNotPrepared, [nil]);
2234   end;
2235  
2236 + function TColumnMetaData.GetAttachment: IAttachment;
2237 + begin
2238 +  Result := FIBXSQLVAR.GetAttachment;
2239 + end;
2240 +
2241   function TColumnMetaData.SQLData: PByte;
2242   begin
2243    Result := FIBXSQLVAR.SQLData;
# Line 1571 | Line 2255 | end;
2255  
2256   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2257   begin
2258 <  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
2258 >  inherited Create(aIBXSQLVAR.GetAttachment.getFirebirdAPI as TFBClientAPI);
2259    FIBXSQLVAR := aIBXSQLVAR;
2260    FOwner := aOwner;
2261    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 1587 | Line 2271 | end;
2271  
2272   function TColumnMetaData.GetSQLDialect: integer;
2273   begin
2274 <  Result := FIBXSQLVAR.Statement.GetSQLDialect;
2274 >  Result := FIBXSQLVAR.GetAttachment.GetSQLDialect;
2275 > end;
2276 >
2277 > function TColumnMetaData.getColMetadata: IParamMetaData;
2278 > begin
2279 >  Result := self;
2280   end;
2281  
2282   function TColumnMetaData.GetIndex: integer;
# Line 1658 | Line 2347 | end;
2347   function TColumnMetaData.GetSize: cardinal;
2348   begin
2349    CheckActive;
2350 <  result := FIBXSQLVAR.DataLength;
2350 >  result := FIBXSQLVAR.GetSize;
2351 > end;
2352 >
2353 > function TColumnMetaData.GetCharSetWidth: integer;
2354 > begin
2355 >  CheckActive;
2356 >  result := FIBXSQLVAR.GetCharSetWidth;
2357   end;
2358  
2359   function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
# Line 1673 | Line 2368 | begin
2368    result := FIBXSQLVAR.GetBlobMetaData;
2369   end;
2370  
2371 + function TColumnMetaData.GetStatement: IStatement;
2372 + begin
2373 +  Result := FIBXSQLVAR.GetStatement;
2374 + end;
2375 +
2376 + function TColumnMetaData.GetTransaction: ITransaction;
2377 + begin
2378 +  Result := FIBXSQLVAR.GetTransaction;
2379 + end;
2380 +
2381   { TIBSQLData }
2382  
2383   procedure TIBSQLData.CheckActive;
# Line 1701 | Line 2406 | end;
2406   function TIBSQLData.GetAsArray: IArray;
2407   begin
2408    CheckActive;
2409 <  result := FIBXSQLVAR.GetAsArray(AsQuad);
2409 >  result := FIBXSQLVAR.GetAsArray;
2410   end;
2411  
2412   function TIBSQLData.GetAsBlob: IBlob;
# Line 1745 | Line 2450 | end;
2450  
2451   var b: IBlob;
2452      dt: TDateTime;
2453 <    CurrValue: Currency;
2454 <    FloatValue: single;
2453 >    timezone: AnsiString;
2454 >    Int64Value: Int64;
2455 >    BCDValue: TBCD;
2456 >    aScale: integer;
2457   begin
2458    CheckActive;
2459    if IsNullable then
2460      IsNull := False;
2461 +  with FFirebirdClientAPI do
2462    case SQLTYPE of
2463    SQL_BOOLEAN:
2464      if AnsiCompareText(Value,STrue) = 0 then
# Line 1762 | Line 2470 | begin
2470        IBError(ibxeInvalidDataConversion,[nil]);
2471  
2472    SQL_BLOB:
2473 +    if Length(Value) < GetAttachment.GetInlineBlobLimit then
2474 +      DoSetString
2475 +    else
2476      begin
2477        Changing;
2478        b := FIBXSQLVAR.CreateBlob;
# Line 1774 | Line 2485 | begin
2485    SQL_TEXT:
2486      DoSetString;
2487  
2488 <    SQL_SHORT,
2489 <    SQL_LONG,
2490 <    SQL_INT64:
2491 <      if TryStrToCurr(Value,CurrValue) then
2492 <        SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2493 <      else
2494 <        DoSetString;
2488 >  SQL_SHORT,
2489 >  SQL_LONG,
2490 >  SQL_INT64:
2491 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2492 >      SetAsNumeric(NumericFromRawValues(Int64Value,aScale))
2493 >    else
2494 >      DoSetString;
2495  
2496 <    SQL_D_FLOAT,
2497 <    SQL_DOUBLE,
2498 <    SQL_FLOAT:
2499 <      if TryStrToFloat(Value,FloatValue) then
2500 <        SetAsDouble(FloatValue)
2501 <      else
2502 <        DoSetString;
2496 >  SQL_DEC_FIXED,
2497 >  SQL_DEC16,
2498 >  SQL_DEC34,
2499 >  SQL_INT128:
2500 >    if TryStrToBCD(Value,BCDValue) then
2501 >      SetAsNumeric(NewNumeric(BCDValue))
2502 >    else
2503 >      DoSetString;
2504  
2505 <    SQL_TIMESTAMP:
2505 >  SQL_D_FLOAT,
2506 >  SQL_DOUBLE,
2507 >  SQL_FLOAT:
2508 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2509 >      SetAsNumeric(NumericFromRawValues(Int64Value,AScale))
2510 >    else
2511 >      DoSetString;
2512 >
2513 >  SQL_TIMESTAMP:
2514        if TryStrToDateTime(Value,dt) then
2515          SetAsDateTime(dt)
2516        else
2517          DoSetString;
2518  
2519 <    SQL_TYPE_DATE:
2519 >  SQL_TYPE_DATE:
2520        if TryStrToDateTime(Value,dt) then
2521          SetAsDate(dt)
2522        else
2523          DoSetString;
2524  
2525 <    SQL_TYPE_TIME:
2525 >  SQL_TYPE_TIME:
2526        if TryStrToDateTime(Value,dt) then
2527          SetAsTime(dt)
2528        else
2529          DoSetString;
2530  
2531 <    else
2532 <      IBError(ibxeInvalidDataConversion,[nil]);
2531 >  SQL_TIMESTAMP_TZ,
2532 >  SQL_TIMESTAMP_TZ_EX:
2533 >      if ParseDateTimeTZString(value,dt,timezone) then
2534 >        SetAsDateTime(dt,timezone)
2535 >      else
2536 >        DoSetString;
2537 >
2538 >  SQL_TIME_TZ,
2539 >  SQL_TIME_TZ_EX:
2540 >      if ParseDateTimeTZString(value,dt,timezone,true) then
2541 >        SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2542 >      else
2543 >        DoSetString;
2544 >
2545 >  else
2546 >    IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2547    end;
2548   end;
2549  
# Line 1847 | Line 2581 | begin
2581    IsNull := true;
2582   end;
2583  
2584 + function TSQLParam.CanChangeMetaData: boolean;
2585 + begin
2586 +  Result := FIBXSQLVAR.CanChangeMetaData;
2587 + end;
2588 +
2589 + function TSQLParam.getColMetadata: IParamMetaData;
2590 + begin
2591 +  Result := FIBXSQLVAR.getColMetadata;
2592 + end;
2593 +
2594   function TSQLParam.GetModified: boolean;
2595   begin
2596    CheckActive;
# Line 1860 | Line 2604 | begin
2604    Result := inherited GetAsPointer;
2605   end;
2606  
2607 + function TSQLParam.GetAsString: AnsiString;
2608 + var rs: RawByteString;
2609 + begin
2610 +  Result := '';
2611 +  if (SQLType = SQL_VARYING) and not IsNull then
2612 +  {SQLData points to start of string - default is to length word}
2613 +  begin
2614 +    CheckActive;
2615 +    SetString(rs,PAnsiChar(SQLData),DataLength);
2616 +    SetCodePage(rs,GetCodePage,false);
2617 +    Result := rs;
2618 +  end
2619 +  else
2620 +    Result := inherited GetAsString;
2621 + end;
2622 +
2623   procedure TSQLParam.SetName(Value: AnsiString);
2624   begin
2625    CheckActive;
# Line 1905 | Line 2665 | begin
2665    if not FIBXSQLVAR.UniqueName then
2666      IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
2667  
2668 +  FIBXSQLVAR.SetArray(anArray); {save array interface}
2669    SetAsQuad(AnArray.GetArrayID);
2670   end;
2671  
# Line 2051 | Line 2812 | begin
2812    end;
2813   end;
2814  
2815 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2816 + var i: integer;
2817 +    OldSQLVar: TSQLVarData;
2818 + begin
2819 +  if FIBXSQLVAR.UniqueName then
2820 +    inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2821 +  else
2822 +  with FIBXSQLVAR.Parent do
2823 +  begin
2824 +    for i := 0 to Count - 1 do
2825 +      if Column[i].Name = Name then
2826 +      begin
2827 +        OldSQLVar := FIBXSQLVAR;
2828 +        FIBXSQLVAR := Column[i];
2829 +        try
2830 +          inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2831 +        finally
2832 +          FIBXSQLVAR := OldSQLVar;
2833 +        end;
2834 +      end;
2835 +  end;
2836 + end;
2837 +
2838 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2839 + var i: integer;
2840 +    OldSQLVar: TSQLVarData;
2841 + begin
2842 +  if FIBXSQLVAR.UniqueName then
2843 +    inherited SetAsTime(AValue,OnDate,aTimeZone)
2844 +  else
2845 +  with FIBXSQLVAR.Parent do
2846 +  begin
2847 +    for i := 0 to Count - 1 do
2848 +      if Column[i].Name = Name then
2849 +      begin
2850 +        OldSQLVar := FIBXSQLVAR;
2851 +        FIBXSQLVAR := Column[i];
2852 +        try
2853 +          inherited SetAsTime(AValue,OnDate,aTimeZone);
2854 +        finally
2855 +          FIBXSQLVAR := OldSQLVar;
2856 +        end;
2857 +      end;
2858 +  end;
2859 + end;
2860 +
2861 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2862 + begin
2863 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2864 + end;
2865 +
2866 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2867 + begin
2868 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2869 + end;
2870 +
2871   procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2872   var i: integer;
2873      OldSQLVar: TSQLVarData;
# Line 2074 | Line 2891 | begin
2891    end;
2892   end;
2893  
2894 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2895 +  );
2896 + var i: integer;
2897 +    OldSQLVar: TSQLVarData;
2898 + begin
2899 +  if FIBXSQLVAR.UniqueName then
2900 +    inherited SetAsDateTime(AValue,aTimeZoneID)
2901 +  else
2902 +  with FIBXSQLVAR.Parent do
2903 +  begin
2904 +    for i := 0 to Count - 1 do
2905 +      if Column[i].Name = Name then
2906 +      begin
2907 +        OldSQLVar := FIBXSQLVAR;
2908 +        FIBXSQLVAR := Column[i];
2909 +        try
2910 +          inherited SetAsDateTime(AValue,aTimeZoneID);
2911 +        finally
2912 +          FIBXSQLVAR := OldSQLVar;
2913 +        end;
2914 +      end;
2915 +  end;
2916 + end;
2917 +
2918 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2919 + var i: integer;
2920 +    OldSQLVar: TSQLVarData;
2921 + begin
2922 +  if FIBXSQLVAR.UniqueName then
2923 +    inherited SetAsDateTime(AValue,aTimeZone)
2924 +  else
2925 +  with FIBXSQLVAR.Parent do
2926 +  begin
2927 +    for i := 0 to Count - 1 do
2928 +      if Column[i].Name = Name then
2929 +      begin
2930 +        OldSQLVar := FIBXSQLVAR;
2931 +        FIBXSQLVAR := Column[i];
2932 +        try
2933 +          inherited SetAsDateTime(AValue,aTimeZone);
2934 +        finally
2935 +          FIBXSQLVAR := OldSQLVar;
2936 +        end;
2937 +      end;
2938 +  end;
2939 + end;
2940 +
2941   procedure TSQLParam.SetAsDouble(AValue: Double);
2942   var i: integer;
2943      OldSQLVar: TSQLVarData;
# Line 2254 | Line 3118 | begin
3118    FIBXSQLVAR.SetCharSetID(aValue);
3119   end;
3120  
3121 + procedure TSQLParam.SetAsBcd(aValue: tBCD);
3122 + var i: integer;
3123 +    OldSQLVar: TSQLVarData;
3124 + begin
3125 +  if FIBXSQLVAR.UniqueName then
3126 +    inherited SetAsBcd(AValue)
3127 +  else
3128 +  with FIBXSQLVAR.Parent do
3129 +  begin
3130 +    for i := 0 to Count - 1 do
3131 +      if Column[i].Name = Name then
3132 +      begin
3133 +        OldSQLVar := FIBXSQLVAR;
3134 +        FIBXSQLVAR := Column[i];
3135 +        try
3136 +          inherited SetAsBcd(AValue);
3137 +        finally
3138 +          FIBXSQLVAR := OldSQLVar;
3139 +        end;
3140 +      end;
3141 +  end;
3142 + end;
3143 +
3144 + procedure TSQLParam.SetAsNumeric(aValue: IFBNumeric);
3145 + var i: integer;
3146 +    OldSQLVar: TSQLVarData;
3147 + begin
3148 +  if FIBXSQLVAR.UniqueName then
3149 +    inherited SetAsNumeric(AValue)
3150 +  else
3151 +  with FIBXSQLVAR.Parent do
3152 +  begin
3153 +    for i := 0 to Count - 1 do
3154 +      if Column[i].Name = Name then
3155 +      begin
3156 +        OldSQLVar := FIBXSQLVAR;
3157 +        FIBXSQLVAR := Column[i];
3158 +        try
3159 +          inherited SetAsNumeric(AValue);
3160 +        finally
3161 +          FIBXSQLVAR := OldSQLVar;
3162 +        end;
3163 +      end;
3164 +  end;
3165 + end;
3166 +
3167   { TMetaData }
3168  
3169   procedure TMetaData.CheckActive;
# Line 2275 | Line 3185 | end;
3185  
3186   destructor TMetaData.Destroy;
3187   begin
3188 <  (FStatement as TInterfaceOwner).Remove(self);
3188 >  if FStatement <> nil then
3189 >    (FStatement as TInterfaceOwner).Remove(self);
3190    inherited Destroy;
3191   end;
3192  
# Line 2341 | Line 3252 | end;
3252  
3253   destructor TSQLParams.Destroy;
3254   begin
3255 <  (FStatement as TInterfaceOwner).Remove(self);
3255 >  if FStatement <> nil then
3256 >    (FStatement as TInterfaceOwner).Remove(self);
3257    inherited Destroy;
3258   end;
3259  
# Line 2392 | Line 3304 | begin
3304      end;
3305   end;
3306  
3307 + function TSQLParams.GetHasCaseSensitiveParams: Boolean;
3308 + begin
3309 +  Result := FSQLParams.CaseSensitiveParams;
3310 + end;
3311 +
3312 + function TSQLParams.GetStatement: IStatement;
3313 + begin
3314 +  Result := FSQLParams.GetStatement;
3315 + end;
3316 +
3317 + function TSQLParams.GetTransaction: ITransaction;
3318 + begin
3319 +  Result := FSQLParams.GetTransaction;
3320 + end;
3321 +
3322 + function TSQLParams.GetAttachment: IAttachment;
3323 + begin
3324 +  Result := FSQLParams.GetAttachment;
3325 + end;
3326 +
3327 + procedure TSQLParams.Clear;
3328 + var i: integer;
3329 + begin
3330 +  for i := 0 to getCount - 1 do
3331 +    getSQLParam(i).Clear;
3332 + end;
3333 +
3334   { TResults }
3335  
3336   procedure TResults.CheckActive;
# Line 2404 | Line 3343 | begin
3343    if not FResults.CheckStatementStatus(ssPrepared)  then
3344      IBError(ibxeStatementNotPrepared, [nil]);
3345  
3346 <  with GetTransaction as TFBTransaction do
3346 >  with GetTransaction do
3347    if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3348      IBError(ibxeInterfaceOutofDate,[nil]);
3349   end;
3350  
3351   function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
3352 + var col: TIBSQLData;
3353   begin
3354    if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
3355      IBError(ibxeInvalidColumnIndex,[nil]);
3356  
3357    if not HasInterface(aIBXSQLVAR.Index) then
3358 <    AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3359 <  Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3358 >  begin
3359 >    col := TIBSQLData.Create(self,aIBXSQLVAR);
3360 >    AddInterface(aIBXSQLVAR.Index, col);
3361 >  end
3362 >  else
3363 >    col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3364 >  Result := col;
3365   end;
3366  
3367   constructor TResults.Create(aResults: TSQLDataArea);
# Line 2473 | Line 3418 | begin
3418    FResults.GetData(index,IsNull, len,data);
3419   end;
3420  
3421 + function TResults.GetStatement: IStatement;
3422 + begin
3423 +  Result := FStatement;
3424 + end;
3425 +
3426   function TResults.GetTransaction: ITransaction;
3427   begin
3428 <  Result := FStatement.GetTransaction;
3428 >  Result := FResults.GetTransaction;
3429 > end;
3430 >
3431 > function TResults.GetAttachment: IAttachment;
3432 > begin
3433 >  Result := FResults.GetAttachment;
3434   end;
3435  
3436   procedure TResults.SetRetainInterfaces(aValue: boolean);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines