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

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents):
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

# Line 76 | Line 76 | unit FBSQLData;
76    methods are needed for SQL parameters only. The string getters and setters
77    are virtual as SQLVar and Array encodings of string data is different.}
78  
79 { Note on SQL Parameter Names
80  --------------------------------------------
81
82  IBX processes parameter names case insensitive. This does result in some additional
83  overhead due to a call to "AnsiUpperCase". This can be avoided by undefining
84  "UseCaseInSensitiveParamName" below.
85
86 }
87 {$define UseCaseInSensitiveParamName}
79  
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 +     FTimeZoneServices: IExTimeZoneServices;
125       function AdjustScale(Value: Int64; aScale: Integer): Double;
126       function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
127       function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
128 +     function GetDateFormatStr(IncludeTime: boolean): AnsiString;
129 +     function GetTimeFormatStr: AnsiString;
130 +     function GetTimestampFormatStr: AnsiString;
131       procedure SetAsInteger(AValue: Integer);
132 +     procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
133 +       var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID);
134    protected
135       function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
136       function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
137       procedure CheckActive; virtual;
138 +     procedure CheckTZSupport;
139 +     function GetAttachment: IAttachment; virtual; abstract;
140       function GetSQLDialect: integer; virtual; abstract;
141 +     function GetTimeZoneServices: IExTimeZoneServices; virtual;
142       procedure Changed; virtual;
143       procedure Changing; virtual;
144       procedure InternalSetAsString(Value: AnsiString); virtual;
# Line 119 | Line 151 | type
151       procedure SetDataLength(len: cardinal); virtual;
152       procedure SetSQLType(aValue: cardinal); virtual;
153       property DataLength: cardinal read GetDataLength write SetDataLength;
154 <
154 >     property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
155    public
156       constructor Create(api: TFBClientAPI);
157       function GetSQLType: cardinal; virtual; abstract;
158       function GetSQLTypeName: AnsiString; overload;
159       class function GetSQLTypeName(SQLType: short): AnsiString; overload;
160 +     function GetStrDataLength: short;
161       function GetName: AnsiString; virtual; abstract;
162       function GetScale: integer; virtual; abstract;
163       function GetAsBoolean: boolean;
164       function GetAsCurrency: Currency;
165       function GetAsInt64: Int64;
166 <     function GetAsDateTime: TDateTime;
166 >     function GetAsDateTime: TDateTime; overload;
167 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
168 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
169 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
170 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
171 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
172 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
173 >     function GetAsUTCDateTime: TDateTime;
174       function GetAsDouble: Double;
175       function GetAsFloat: Float;
176       function GetAsLong: Long;
# Line 142 | Line 182 | type
182       function GetIsNullable: boolean; virtual;
183       function GetAsVariant: Variant;
184       function GetModified: boolean; virtual;
185 +     function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
186 +     function GetAsBCD: tBCD;
187 +     function GetSize: cardinal; virtual; abstract;
188 +     function GetCharSetWidth: integer; virtual; abstract;
189       procedure SetAsBoolean(AValue: boolean); virtual;
190       procedure SetAsCurrency(Value: Currency); virtual;
191       procedure SetAsInt64(Value: Int64); virtual;
192       procedure SetAsDate(Value: TDateTime); virtual;
193       procedure SetAsLong(Value: Long); virtual;
194 <     procedure SetAsTime(Value: TDateTime); virtual;
195 <     procedure SetAsDateTime(Value: TDateTime);
194 >     procedure SetAsTime(Value: TDateTime); overload;
195 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime;aTimeZoneID: TFBTimeZoneID); overload;
196 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
197 >     procedure SetAsDateTime(Value: TDateTime); overload;
198 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
199 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
200 >     procedure SetAsUTCDateTime(aUTCTime: TDateTime);
201       procedure SetAsDouble(Value: Double); virtual;
202       procedure SetAsFloat(Value: Float); virtual;
203       procedure SetAsPointer(Value: Pointer);
# Line 157 | Line 206 | type
206       procedure SetAsString(Value: AnsiString); virtual;
207       procedure SetAsVariant(Value: Variant);
208       procedure SetAsNumeric(Value: Int64; aScale: integer);
209 +     procedure SetAsBcd(aValue: tBCD); virtual;
210       procedure SetIsNull(Value: Boolean); virtual;
211       procedure SetIsNullable(Value: Boolean); virtual;
212       procedure SetName(aValue: AnsiString); virtual;
# Line 190 | Line 240 | type
240  
241    TSQLDataArea = class
242    private
243 +    FCaseSensitiveParams: boolean;
244      function GetColumn(index: integer): TSQLVarData;
245      function GetCount: integer;
246    protected
# Line 212 | Line 263 | type
263        var data: PByte); virtual;
264      procedure RowChange;
265      function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
266 +    property CaseSensitiveParams: boolean read FCaseSensitiveParams
267 +                                            write FCaseSensitiveParams; {Only used when IsInputDataArea true}
268      property Count: integer read GetCount;
269      property Column[index: integer]: TSQLVarData read GetColumn;
270      property UniqueRelationName: AnsiString read FUniqueRelationName;
# Line 241 | Line 294 | type
294      function GetRelationName: AnsiString;  virtual; abstract;
295      function GetScale: integer; virtual; abstract;
296      function GetCharSetID: cardinal; virtual; abstract;
297 +    function GetCharSetWidth: integer; virtual; abstract;
298      function GetCodePage: TSystemCodePage; virtual; abstract;
299      function GetIsNull: Boolean;   virtual; abstract;
300      function GetIsNullable: boolean; virtual; abstract;
301      function GetSQLData: PByte;  virtual; abstract;
302 <    function GetDataLength: cardinal; virtual; abstract;
302 >    function GetDataLength: cardinal; virtual; abstract; {current field length}
303 >    function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
304      procedure SetIsNull(Value: Boolean); virtual; abstract;
305      procedure SetIsNullable(Value: Boolean);  virtual; abstract;
306      procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
# Line 294 | Line 349 | type
349      FIBXSQLVAR: TSQLVarData;
350      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
351      FPrepareSeqNo: integer;
297    FStatement: IStatement;
352      FChangeSeqNo: integer;
353    protected
354      procedure CheckActive; override;
355 +    function GetAttachment: IAttachment; override;
356      function SQLData: PByte; override;
357      function GetDataLength: cardinal; override;
358      function GetCodePage: TSystemCodePage; override;
# Line 306 | Line 361 | type
361      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
362      destructor Destroy; override;
363      function GetSQLDialect: integer; override;
309    property Statement: IStatement read FStatement;
364  
365    public
366      {IColumnMetaData}
# Line 321 | Line 375 | type
375      function GetScale: integer; override;
376      function getCharSetID: cardinal; override;
377      function GetIsNullable: boolean; override;
378 <    function GetSize: cardinal;
378 >    function GetSize: cardinal; override;
379 >    function GetCharSetWidth: integer; override;
380      function GetArrayMetaData: IArrayMetaData;
381      function GetBlobMetaData: IBlobMetaData;
382 +    function GetStatement: IStatement;
383 +    function GetTransaction: ITransaction; virtual;
384      property Name: AnsiString read GetName;
385      property Size: cardinal read GetSize;
386      property CharSetID: cardinal read getCharSetID;
387      property SQLSubtype: integer read getSubtype;
388      property IsNullable: Boolean read GetIsNullable;
389 +  public
390 +    property Statement: IStatement read GetStatement;
391    end;
392  
393    { TIBSQLData }
394  
395    TIBSQLData = class(TColumnMetaData,ISQLData)
396 +  private
397 +    FTransaction: ITransaction;
398    protected
399      procedure CheckActive; override;
400    public
401 +    function GetTransaction: ITransaction; override;
402      function GetIsNull: Boolean; override;
403      function GetAsArray: IArray;
404      function GetAsBlob: IBlob; overload;
# Line 347 | Line 409 | type
409  
410    { TSQLParam }
411  
412 <  TSQLParam = class(TIBSQLData,ISQLParam)
412 >  TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
413    protected
414      procedure CheckActive; override;
415      procedure Changed; override;
# Line 370 | Line 432 | type
432      procedure SetAsInt64(AValue: Int64);
433      procedure SetAsDate(AValue: TDateTime);
434      procedure SetAsLong(AValue: Long);
435 <    procedure SetAsTime(AValue: TDateTime);
436 <    procedure SetAsDateTime(AValue: TDateTime);
435 >    procedure SetAsTime(AValue: TDateTime); overload;
436 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
437 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
438 >    procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
439 >    procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
440 >    procedure SetAsDateTime(AValue: TDateTime); overload;
441 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
442 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
443      procedure SetAsDouble(AValue: Double);
444      procedure SetAsFloat(AValue: Float);
445      procedure SetAsPointer(AValue: Pointer);
# Line 381 | Line 449 | type
449      procedure SetAsBlob(aValue: IBlob);
450      procedure SetAsQuad(AValue: TISC_QUAD);
451      procedure SetCharSetID(aValue: cardinal);
452 +    procedure SetAsBcd(aValue: tBCD);
453  
454      property AsBlob: IBlob read GetAsBlob write SetAsBlob;
455      property IsNullable: Boolean read GetIsNullable write SetIsNullable;
# Line 423 | Line 492 | type
492      function getSQLParam(index: integer): ISQLParam;
493      function ByName(Idx: AnsiString): ISQLParam ;
494      function GetModified: Boolean;
495 +    function GetHasCaseSensitiveParams: Boolean;
496    end;
497  
498    { TResults }
# Line 444 | Line 514 | type
514       function ByName(Idx: AnsiString): ISQLData;
515       function getSQLData(index: integer): ISQLData;
516       procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
517 +     function GetStatement: IStatement;
518       function GetTransaction: ITransaction; virtual;
519       procedure SetRetainInterfaces(aValue: boolean);
520   end;
521  
522   implementation
523  
524 < uses FBMessages, variants, IBUtils, FBTransaction;
454 <
455 < type
456 <
457 <   { TSQLParamProcessor }
458 <
459 <   TSQLParamProcessor = class(TSQLwithNamedParamsTokeniser)
460 <   private
461 <   const
462 <     sIBXParam = 'IBXParam';  {do not localize}
463 <   private
464 <     FInString: AnsiString;
465 <     FIndex: integer;
466 <     function DoExecute(GenerateParamNames: boolean;
467 <       var slNames: TStrings): AnsiString;
468 <   protected
469 <     function GetChar: AnsiChar; override;
470 <   public
471 <     class function Execute(sSQL: AnsiString; GenerateParamNames: boolean;
472 <       var slNames: TStrings): AnsiString;
473 <   end;
474 <
475 < { TSQLParamProcessor }
476 <
477 < function TSQLParamProcessor.DoExecute(GenerateParamNames: boolean;
478 <  var slNames: TStrings): AnsiString;
479 < var token: TSQLTokens;
480 <    iParamSuffix: Integer;
481 < begin
482 <  Result := '';
483 <  iParamSuffix := 0;
484 <
485 <  while not EOF do
486 <  begin
487 <    token := GetNextToken;
488 <    case token of
489 <    sqltParam,
490 <    sqltQuotedParam:
491 <      begin
492 <        Result := Result + '?';
493 <        slNames.Add(TokenText);
494 <      end;
495 <
496 <    sqltPlaceHolder:
497 <      if GenerateParamNames then
498 <      begin
499 <        Inc(iParamSuffix);
500 <        slNames.AddObject(sIBXParam + IntToStr(iParamSuffix),self); //Note local convention
501 <                                            //add pointer to self to mark entry
502 <        Result := Result + '?';
503 <      end
504 <      else
505 <        IBError(ibxeSQLParseError, [SParamNameExpected]);
506 <
507 <    sqltQuotedString:
508 <      Result := Result + '''' + SQLSafeString(TokenText) + '''';
509 <
510 <    sqltIdentifierInDoubleQuotes:
511 <      Result := Result + '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
512 <
513 <    sqltComment:
514 <      Result := Result + '/*' + TokenText + '*/';
515 <
516 <    sqltCommentLine:
517 <      Result := Result + '//' + TokenText + LineEnding;
518 <
519 <    sqltEOL:
520 <      Result := Result + LineEnding;
521 <
522 <    else
523 <      Result := Result + TokenText;
524 <    end;
525 <  end;
526 < end;
527 <
528 < function TSQLParamProcessor.GetChar: AnsiChar;
529 < begin
530 <  if FIndex <= Length(FInString) then
531 <  begin
532 <    Result := FInString[FIndex];
533 <    Inc(FIndex);
534 <  end
535 <  else
536 <    Result := #0;
537 < end;
538 <
539 < class function TSQLParamProcessor.Execute(sSQL: AnsiString;
540 <  GenerateParamNames: boolean; var slNames: TStrings): AnsiString;
541 < begin
542 <  with self.Create do
543 <  try
544 <    FInString := sSQL;
545 <    FIndex := 1;
546 <    Result := DoExecute(GenerateParamNames,slNames);
547 <  finally
548 <    Free;
549 <  end;
550 < end;
551 <
524 > uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
525  
526   { TSQLDataArea }
527  
# Line 654 | Line 627 | var
627    s: AnsiString;
628    i: Integer;
629   begin
630 <  {$ifdef UseCaseInSensitiveParamName}
631 <   s := AnsiUpperCase(Idx);
632 <  {$else}
630 >  if not IsInputDataArea or not CaseSensitiveParams then
631 >   s := AnsiUpperCase(Idx)
632 >  else
633     s := Idx;
634 <  {$endif}
634 >
635    for i := 0 to Count - 1 do
636      if Column[i].Name = s then
637      begin
# Line 690 | Line 663 | end;
663  
664   procedure TSQLVarData.SetName(AValue: AnsiString);
665   begin
666 <  if FName = AValue then Exit;
694 <  {$ifdef UseCaseInSensitiveParamName}
695 <  if Parent.IsInputDataArea then
666 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
667      FName := AnsiUpperCase(AValue)
668    else
698  {$endif}
669      FName := AValue;
670   end;
671  
# Line 716 | Line 686 | begin
686  
687    FVarString := aValue;
688    SQLType := SQL_TEXT;
689 +  Scale := 0;
690    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
691   end;
692  
# Line 876 | Line 847 | begin
847        result := Value;
848   end;
849  
850 + function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
851 + begin
852 +  {$IF declared(DefaultFormatSettings)}
853 +  with DefaultFormatSettings do
854 +  {$ELSE}
855 +  {$IF declared(FormatSettings)}
856 +  with FormatSettings do
857 +  {$IFEND}
858 +  {$IFEND}
859 +  case GetSQLDialect of
860 +    1:
861 +      if IncludeTime then
862 +        result := ShortDateFormat + ' ' + LongTimeFormat
863 +      else
864 +        result := ShortDateFormat;
865 +    3:
866 +      result := ShortDateFormat;
867 +  end;
868 + end;
869 +
870 + function TSQLDataItem.GetTimeFormatStr: AnsiString;
871 + begin
872 +  {$IF declared(DefaultFormatSettings)}
873 +  with DefaultFormatSettings do
874 +  {$ELSE}
875 +  {$IF declared(FormatSettings)}
876 +  with FormatSettings do
877 +  {$IFEND}
878 +  {$IFEND}
879 +    Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
880 + end;
881 +
882 + function TSQLDataItem.GetTimestampFormatStr: AnsiString;
883 + begin
884 +  {$IF declared(DefaultFormatSettings)}
885 +  with DefaultFormatSettings do
886 +  {$ELSE}
887 +  {$IF declared(FormatSettings)}
888 +  with FormatSettings do
889 +  {$IFEND}
890 +  {$IFEND}
891 +    Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
892 + end;
893 +
894   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
895   begin
896    SetAsLong(aValue);
897   end;
898  
899 + procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
900 +  var dstOffset: smallint; var aTimezone: AnsiString;
901 +  var aTimeZoneID: TFBTimeZoneID);
902 + begin
903 +  CheckActive;
904 +  aDateTime := 0;
905 +  dstOffset := 0;
906 +  aTimezone := '';
907 +  aTimeZoneID := TimeZoneID_GMT;
908 +  if not IsNull then
909 +    with FFirebirdClientAPI do
910 +    case SQLType of
911 +      SQL_TEXT, SQL_VARYING:
912 +        if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
913 +          IBError(ibxeInvalidDataConversion, [nil]);
914 +      SQL_TYPE_DATE:
915 +        aDateTime := SQLDecodeDate(SQLData);
916 +      SQL_TYPE_TIME:
917 +        aDateTime := SQLDecodeTime(SQLData);
918 +      SQL_TIMESTAMP:
919 +        aDateTime := SQLDecodeDateTime(SQLData);
920 +      SQL_TIMESTAMP_TZ:
921 +        begin
922 +          GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
923 +          aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
924 +        end;
925 +      SQL_TIMESTAMP_TZ_EX:
926 +      begin
927 +        GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
928 +        aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
929 +      end;
930 +      SQL_TIME_TZ:
931 +        with GetTimeZoneServices do
932 +        begin
933 +          DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
934 +          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
935 +        end;
936 +      SQL_TIME_TZ_EX:
937 +        with GetTimeZoneServices do
938 +        begin
939 +          DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
940 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
941 +        end;
942 +      else
943 +        IBError(ibxeInvalidDataConversion, [nil]);
944 +    end;
945 + end;
946 +
947   function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
948    ): Int64;
949   var
# Line 936 | Line 999 | begin
999    //Do nothing by default
1000   end;
1001  
1002 + procedure TSQLDataItem.CheckTZSupport;
1003 + begin
1004 +  if not FFirebirdClientAPI.HasTimeZoneSupport then
1005 +    IBError(ibxeNoTimezoneSupport,[]);
1006 + end;
1007 +
1008 + function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1009 + begin
1010 +  if FTimeZoneServices = nil then
1011 +  begin
1012 +    if not GetAttachment.HasTimeZoneSupport then
1013 +      IBError(ibxeNoTimezoneSupport,[]);
1014 +    GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1015 +  end;
1016 +  Result := FTimeZoneServices;
1017 + end;
1018 +
1019   procedure TSQLDataItem.Changed;
1020   begin
1021    //Do nothing by default
# Line 996 | Line 1076 | begin
1076    SQL_LONG:             Result := 'SQL_LONG';
1077    SQL_SHORT:            Result := 'SQL_SHORT';
1078    SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1079 +  SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1080 +  SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1081    SQL_BLOB:             Result := 'SQL_BLOB';
1082    SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1083    SQL_ARRAY:            Result := 'SQL_ARRAY';
# Line 1003 | Line 1085 | begin
1085    SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1086    SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1087    SQL_INT64:            Result := 'SQL_INT64';
1088 +  SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1089 +  SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1090 +  SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1091 +  SQL_DEC16:            Result := 'SQL_DEC16';
1092 +  SQL_DEC34:            Result := 'SQL_DEC34';
1093 +  SQL_INT128:           Result := 'SQL_INT128';
1094 +  SQL_NULL:             Result := 'SQL_NULL';
1095 +  SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1096    end;
1097   end;
1098  
1099 + function TSQLDataItem.GetStrDataLength: short;
1100 + begin
1101 +  with FFirebirdClientAPI do
1102 +  if SQLType = SQL_VARYING then
1103 +    Result := DecodeInteger(SQLData, 2)
1104 +  else
1105 +    Result := DataLength;
1106 + end;
1107 +
1108   function TSQLDataItem.GetAsBoolean: boolean;
1109   begin
1110    CheckActive;
# Line 1046 | Line 1145 | begin
1145                                        Scale);
1146          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1147            result := Trunc(AsDouble);
1148 +
1149 +        SQL_DEC_FIXED,
1150 +        SQL_DEC16,
1151 +        SQL_DEC34,
1152 +        SQL_INT128:
1153 +          if not BCDToCurr(GetAsBCD,Result) then
1154 +            IBError(ibxeInvalidDataConversion, [nil]);
1155 +
1156          else
1157            IBError(ibxeInvalidDataConversion, [nil]);
1158        end;
# Line 1082 | Line 1189 | begin
1189   end;
1190  
1191   function TSQLDataItem.GetAsDateTime: TDateTime;
1192 + var aTimezone: AnsiString;
1193 +    aTimeZoneID: TFBTimeZoneID;
1194 +    dstOffset: smallint;
1195 + begin
1196 +  InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1197 + end;
1198 +
1199 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1200 +  var dstOffset: smallint; var aTimezone: AnsiString);
1201 + var aTimeZoneID: TFBTimeZoneID;
1202 + begin
1203 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1204 + end;
1205 +
1206 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1207 +  var aTimezoneID: TFBTimeZoneID);
1208 + var aTimezone: AnsiString;
1209 + begin
1210 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1211 + end;
1212 +
1213 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1214 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1215 + var aTimeZone: AnsiString;
1216   begin
1217    CheckActive;
1218 <  result := 0;
1218 >  aTime := 0;
1219 >  dstOffset := 0;
1220    if not IsNull then
1221      with FFirebirdClientAPI do
1222      case SQLType of
1223 <      SQL_TEXT, SQL_VARYING: begin
1224 <        try
1225 <          result := StrToDate(AsString);
1226 <        except
1227 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1223 >      SQL_TIME_TZ:
1224 >        begin
1225 >          GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1226 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1227 >        end;
1228 >      SQL_TIME_TZ_EX:
1229 >        begin
1230 >          GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1231 >          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1232          end;
1233 +    else
1234 +      IBError(ibxeInvalidDataConversion, [nil]);
1235 +    end;
1236 + end;
1237 +
1238 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1239 +  var aTimezone: AnsiString; OnDate: TDateTime);
1240 + begin
1241 +  CheckActive;
1242 +  aTime := 0;
1243 +  dstOffset := 0;
1244 +  if not IsNull then
1245 +    with FFirebirdClientAPI do
1246 +    case SQLType of
1247 +      SQL_TIME_TZ:
1248 +        GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1249 +      SQL_TIME_TZ_EX:
1250 +        GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1251 +    else
1252 +      IBError(ibxeInvalidDataConversion, [nil]);
1253 +    end;
1254 + end;
1255 +
1256 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1257 +  var aTimezoneID: TFBTimeZoneID);
1258 + begin
1259 +  GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1260 + end;
1261 +
1262 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1263 +  var aTimezone: AnsiString);
1264 + begin
1265 +  GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1266 + end;
1267 +
1268 + function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1269 + var aTimezone: AnsiString;
1270 + begin
1271 +  CheckActive;
1272 +  result := 0;
1273 +  aTimezone := '';
1274 +  if not IsNull then
1275 +    with FFirebirdClientAPI do
1276 +    case SQLType of
1277 +      SQL_TEXT, SQL_VARYING:
1278 +      begin
1279 +        if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1280 +          IBError(ibxeInvalidDataConversion, [nil]);
1281 +        Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1282        end;
1283        SQL_TYPE_DATE:
1284          result := SQLDecodeDate(SQLData);
1285 <      SQL_TYPE_TIME:
1285 >      SQL_TYPE_TIME,
1286 >      SQL_TIME_TZ,
1287 >      SQL_TIME_TZ_EX:
1288          result := SQLDecodeTime(SQLData);
1289 <      SQL_TIMESTAMP:
1289 >      SQL_TIMESTAMP,
1290 >      SQL_TIMESTAMP_TZ,
1291 >      SQL_TIMESTAMP_TZ_EX:
1292          result := SQLDecodeDateTime(SQLData);
1293        else
1294          IBError(ibxeInvalidDataConversion, [nil]);
1295 <    end;
1295 >      end;
1296   end;
1297  
1298   function TSQLDataItem.GetAsDouble: Double;
# Line 1131 | Line 1320 | begin
1320          result := PFloat(SQLData)^;
1321        SQL_DOUBLE, SQL_D_FLOAT:
1322          result := PDouble(SQLData)^;
1323 +      SQL_DEC_FIXED,
1324 +      SQL_DEC16,
1325 +      SQL_DEC34,
1326 +      SQL_INT128:
1327 +        Result := BCDToDouble(GetAsBCD);
1328        else
1329          IBError(ibxeInvalidDataConversion, [nil]);
1330      end;
# Line 1176 | Line 1370 | begin
1370          result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1371        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1372          result := Trunc(AsDouble);
1373 +      SQL_DEC_FIXED,
1374 +      SQL_DEC16,
1375 +      SQL_DEC34,
1376 +      SQL_INT128:
1377 +        Result := BCDToInteger(GetAsBCD);
1378        else
1379 <        IBError(ibxeInvalidDataConversion, [nil]);
1379 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1380      end;
1381   end;
1382  
# Line 1215 | Line 1414 | begin
1414    end;
1415   end;
1416  
1417 + {Copied from LazUTF8}
1418 +
1419 + function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1420 + const TopBitSetMask   = $80; {%10000000}
1421 +      Top2BitsSetMask = $C0; {%11000000}
1422 +      Top3BitsSetMask = $E0; {%11100000}
1423 +      Top4BitsSetMask = $F0; {%11110000}
1424 +      Top5BitsSetMask = $F8; {%11111000}
1425 + begin
1426 +  case p^ of
1427 +  #0..#191: // %11000000
1428 +    // regular single byte character (#0 is a character, this is Pascal ;)
1429 +    Result:=1;
1430 +  #192..#223: // p^ and %11100000 = %11000000
1431 +    begin
1432 +      // could be 2 byte character
1433 +      if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1434 +        Result:=2
1435 +      else
1436 +        Result:=1;
1437 +    end;
1438 +  #224..#239: // p^ and %11110000 = %11100000
1439 +    begin
1440 +      // could be 3 byte character
1441 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1442 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1443 +        Result:=3
1444 +      else
1445 +        Result:=1;
1446 +    end;
1447 +  #240..#247: // p^ and %11111000 = %11110000
1448 +    begin
1449 +      // could be 4 byte character
1450 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1451 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1452 +      and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1453 +        Result:=4
1454 +      else
1455 +        Result:=1;
1456 +    end;
1457 +  else
1458 +    Result:=1;
1459 +  end;
1460 + end;
1461 +
1462 + {Returns the byte length of a UTF8 string with a fixed charwidth}
1463 +
1464 + function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1465 + var i: integer;
1466 +    cplen: integer;
1467 +    s: AnsiString;
1468 + begin
1469 +  Result := 0;
1470 +  s := strpas(p);
1471 +  for i := 1 to FieldWidth do
1472 +  begin
1473 +    cplen := UTF8CodepointSizeFull(p);
1474 +    Inc(p,cplen);
1475 +    Inc(Result,cplen);
1476 +    if Result >= MaxDataLength then
1477 +    begin
1478 +      Result := MaxDataLength;
1479 +      Exit;
1480 +    end;
1481 +  end;
1482 + end;
1483  
1484   function TSQLDataItem.GetAsString: AnsiString;
1485   var
1486    sz: PByte;
1487    str_len: Integer;
1488    rs: RawByteString;
1489 +  aTimeZone: AnsiString;
1490 +  aDateTime: TDateTime;
1491 +  dstOffset: smallint;
1492   begin
1493    CheckActive;
1494    result := '';
# Line 1238 | Line 1506 | begin
1506        begin
1507          sz := SQLData;
1508          if (SQLType = SQL_TEXT) then
1509 <          str_len := DataLength
1509 >        begin
1510 >          if GetCodePage = cp_utf8 then
1511 >            str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1512 >          else
1513 >            str_len := DataLength
1514 >        end
1515          else begin
1516 <          str_len := DecodeInteger(SQLData, 2);
1516 >          str_len := DecodeInteger(sz, 2);
1517            Inc(sz, 2);
1518          end;
1519          SetString(rs, PAnsiChar(sz), str_len);
1520          SetCodePage(rs,GetCodePage,false);
1521 <        if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1249 <          Result := TrimRight(rs)
1250 <        else
1251 <          Result := rs
1521 >        Result := rs;
1522        end;
1523 +
1524        SQL_TYPE_DATE:
1525 <        case GetSQLDialect of
1255 <          1 : result := DateTimeToStr(AsDateTime);
1256 <          3 : result := DateToStr(AsDateTime);
1257 <        end;
1258 <      SQL_TYPE_TIME :
1259 <        result := TimeToStr(AsDateTime);
1525 >        Result := DateToStr(GetAsDateTime);
1526        SQL_TIMESTAMP:
1527 <      {$IF declared(DefaultFormatSettings)}
1528 <      with DefaultFormatSettings do
1529 <      {$ELSE}
1530 <      {$IF declared(FormatSettings)}
1531 <      with FormatSettings do
1532 <      {$IFEND}
1533 <      {$IFEND}
1534 <        result := FormatDateTime(ShortDateFormat + ' ' +
1535 <                            LongTimeFormat+'.zzz',AsDateTime);
1527 >        Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1528 >      SQL_TYPE_TIME:
1529 >        Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1530 >      SQL_TIMESTAMP_TZ,
1531 >      SQL_TIMESTAMP_TZ_EX:
1532 >        with GetAttachment.GetTimeZoneServices do
1533 >        begin
1534 >          if GetTZTextOption = tzGMT then
1535 >            Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1536 >          else
1537 >          begin
1538 >            GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1539 >            if GetTZTextOption = tzOffset then
1540 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1541 >            else
1542 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1543 >          end;
1544 >        end;
1545 >      SQL_TIME_TZ,
1546 >      SQL_TIME_TZ_EX:
1547 >        with GetAttachment.GetTimeZoneServices do
1548 >        begin
1549 >          if GetTZTextOption = tzGMT then
1550 >             Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1551 >          else
1552 >          begin
1553 >            GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1554 >            if GetTZTextOption = tzOffset then
1555 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1556 >            else
1557 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1558 >          end;
1559 >        end;
1560 >
1561        SQL_SHORT, SQL_LONG:
1562          if Scale = 0 then
1563            result := IntToStr(AsLong)
# Line 1283 | Line 1574 | begin
1574            result := FloatToStr(AsDouble);
1575        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1576          result := FloatToStr(AsDouble);
1577 +
1578 +      SQL_DEC16,
1579 +      SQL_DEC34:
1580 +        result := BCDToStr(GetAsBCD);
1581 +
1582 +      SQL_DEC_FIXED,
1583 +      SQL_INT128:
1584 +        result := Int128ToStr(SQLData,scale);
1585 +
1586        else
1587          IBError(ibxeInvalidDataConversion, [nil]);
1588      end;
# Line 1294 | Line 1594 | begin
1594    Result := false;
1595   end;
1596  
1597 < function TSQLDataItem.getIsNullable: boolean;
1597 > function TSQLDataItem.GetIsNullable: boolean;
1598   begin
1599    CheckActive;
1600    Result := false;
1601   end;
1602  
1603   function TSQLDataItem.GetAsVariant: Variant;
1604 + var ts: TDateTime;
1605 +  dstOffset: smallint;
1606 +    timezone: AnsiString;
1607   begin
1608    CheckActive;
1609    if IsNull then
# Line 1314 | Line 1617 | begin
1617          result := AsString;
1618        SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1619          result := AsDateTime;
1620 +      SQL_TIMESTAMP_TZ,
1621 +      SQL_TIME_TZ,
1622 +      SQL_TIMESTAMP_TZ_EX,
1623 +      SQL_TIME_TZ_EX:
1624 +        begin
1625 +          GetAsDateTime(ts,dstOffset,timezone);
1626 +          result := VarArrayOf([ts,dstOffset,timezone]);
1627 +        end;
1628        SQL_SHORT, SQL_LONG:
1629          if Scale = 0 then
1630            result := AsLong
# Line 1332 | Line 1643 | begin
1643          result := AsDouble;
1644        SQL_BOOLEAN:
1645          result := AsBoolean;
1646 +      SQL_DEC_FIXED,
1647 +      SQL_DEC16,
1648 +      SQL_DEC34,
1649 +      SQL_INT128:
1650 +        result := VarFmtBCDCreate(GetAsBcd);
1651        else
1652          IBError(ibxeInvalidDataConversion, [nil]);
1653      end;
# Line 1342 | Line 1658 | begin
1658    Result := false;
1659   end;
1660  
1661 + function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1662 +  ): integer;
1663 + begin
1664 +  case DateTimeFormat of
1665 +  dfTimestamp:
1666 +    Result := Length(GetTimestampFormatStr);
1667 +  dfDateTime:
1668 +    Result := Length(GetDateFormatStr(true));
1669 +  dfTime:
1670 +    Result := Length(GetTimeFormatStr);
1671 +  dfTimestampTZ:
1672 +    Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1673 +  dfTimeTZ:
1674 +    Result := Length(GetTimeFormatStr)+ 6;
1675 +  else
1676 +    Result := 0;
1677 +  end;end;
1678 +
1679 + function TSQLDataItem.GetAsBCD: tBCD;
1680 +
1681 + begin
1682 +  CheckActive;
1683 +  if IsNull then
1684 +   with Result do
1685 +   begin
1686 +     FillChar(Result,sizeof(Result),0);
1687 +     Precision := 1;
1688 +     exit;
1689 +   end;
1690 +
1691 +  case SQLType of
1692 +  SQL_DEC16,
1693 +  SQL_DEC34:
1694 +    with FFirebirdClientAPI do
1695 +      Result := SQLDecFloatDecode(SQLType,  SQLData);
1696 +
1697 +  SQL_DEC_FIXED,
1698 +  SQL_INT128:
1699 +    with FFirebirdClientAPI do
1700 +      Result := StrToBCD(Int128ToStr(SQLData,scale));
1701 +  else
1702 +    if not CurrToBCD(GetAsCurrency,Result) then
1703 +      IBError(ibxeBadBCDConversion,[]);
1704 +  end;
1705 + end;
1706 +
1707  
1708   procedure TSQLDataItem.SetIsNull(Value: Boolean);
1709   begin
# Line 1430 | Line 1792 | begin
1792    Changed;
1793   end;
1794  
1795 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1796 + begin
1797 +  CheckActive;
1798 +  CheckTZSupport;
1799 +  if GetSQLDialect < 3 then
1800 +  begin
1801 +    AsDateTime := aValue;
1802 +    exit;
1803 +  end;
1804 +
1805 +  Changing;
1806 +  if IsNullable then
1807 +    IsNull := False;
1808 +
1809 +  SQLType := SQL_TIME_TZ;
1810 +  DataLength := SizeOf(ISC_TIME_TZ);
1811 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1812 +  Changed;
1813 + end;
1814 +
1815 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1816 + begin
1817 +  CheckActive;
1818 +  CheckTZSupport;
1819 +  if GetSQLDialect < 3 then
1820 +  begin
1821 +    AsDateTime := aValue;
1822 +    exit;
1823 +  end;
1824 +
1825 +  Changing;
1826 +  if IsNullable then
1827 +    IsNull := False;
1828 +
1829 +  SQLType := SQL_TIME_TZ;
1830 +  DataLength := SizeOf(ISC_TIME_TZ);
1831 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1832 +  Changed;
1833 + end;
1834 +
1835   procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1836   begin
1837    CheckActive;
# Line 1444 | Line 1846 | begin
1846    Changed;
1847   end;
1848  
1849 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1850 +  aTimeZoneID: TFBTimeZoneID);
1851 + begin
1852 +  CheckActive;
1853 +  CheckTZSupport;
1854 +  if IsNullable then
1855 +    IsNull := False;
1856 +
1857 +  Changing;
1858 +  SQLType := SQL_TIMESTAMP_TZ;
1859 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1860 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
1861 +  Changed;
1862 + end;
1863 +
1864 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
1865 +  );
1866 + begin
1867 +  CheckActive;
1868 +  CheckTZSupport;
1869 +  if IsNullable then
1870 +    IsNull := False;
1871 +
1872 +  Changing;
1873 +  SQLType := SQL_TIMESTAMP_TZ;
1874 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1875 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
1876 +  Changed;
1877 + end;
1878 +
1879 + procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
1880 + begin
1881 +  SetAsDateTime(aUTCTime,TimeZoneID_GMT);
1882 + end;
1883 +
1884   procedure TSQLDataItem.SetAsDouble(Value: Double);
1885   begin
1886    CheckActive;
# Line 1539 | Line 1976 | begin
1976    CheckActive;
1977    if VarIsNull(Value) then
1978      IsNull := True
1979 +  else
1980 +  if VarIsArray(Value) then {must be datetime plus timezone}
1981 +    SetAsDateTime(Value[0],AnsiString(Value[1]))
1982    else case VarType(Value) of
1983      varEmpty, varNull:
1984        IsNull := True;
# Line 1561 | Line 2001 | begin
2001        IBError(ibxeNotSupported, [nil]);
2002      varByRef, varDispatch, varError, varUnknown, varVariant:
2003        IBError(ibxeNotPermitted, [nil]);
2004 +    else
2005 +      if VarIsFmtBCD(Value) then
2006 +        SetAsBCD(VarToBCD(Value))
2007 +      else
2008 +        IBError(ibxeNotSupported, [nil]);
2009    end;
2010   end;
2011  
# Line 1578 | Line 2023 | begin
2023    Changed;
2024   end;
2025  
2026 + procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2027 + var C: Currency;
2028 + begin
2029 +  CheckActive;
2030 +  Changing;
2031 +  if IsNullable then
2032 +    IsNull := False;
2033 +
2034 +
2035 +  with FFirebirdClientAPI do
2036 +  if aValue.Precision <= 16 then
2037 +  begin
2038 +    if not HasDecFloatSupport then
2039 +      IBError(ibxeDecFloatNotSupported,[]);
2040 +
2041 +    SQLType := SQL_DEC16;
2042 +    DataLength := 8;
2043 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2044 +  end
2045 +  else
2046 +  if aValue.Precision <= 34 then
2047 +  begin
2048 +    if not HasDecFloatSupport then
2049 +      IBError(ibxeDecFloatNotSupported,[]);
2050 +
2051 +    SQLType := SQL_DEC34;
2052 +    DataLength := 16;
2053 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2054 +  end
2055 +  else
2056 +  if aValue.Precision <= 38 then
2057 +  begin
2058 +    if not HasInt128Support then
2059 +      IBError(ibxeInt128NotSupported,[]);
2060 +
2061 +    SQLType := SQL_INT128;
2062 +    DataLength := 16;
2063 +    StrToInt128(scale,BcdToStr(aValue),SQLData);
2064 +  end
2065 +  else
2066 +    IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2067 +
2068 +  Changed;
2069 + end;
2070 +
2071   procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
2072   begin
2073    CheckActive;
# Line 1608 | Line 2098 | begin
2098      IBError(ibxeStatementNotPrepared, [nil]);
2099   end;
2100  
2101 + function TColumnMetaData.GetAttachment: IAttachment;
2102 + begin
2103 +  Result := GetStatement.GetAttachment;
2104 + end;
2105 +
2106   function TColumnMetaData.SQLData: PByte;
2107   begin
2108    Result := FIBXSQLVAR.SQLData;
# Line 1712 | Line 2207 | end;
2207   function TColumnMetaData.GetSize: cardinal;
2208   begin
2209    CheckActive;
2210 <  result := FIBXSQLVAR.DataLength;
2210 >  result := FIBXSQLVAR.GetSize;
2211 > end;
2212 >
2213 > function TColumnMetaData.GetCharSetWidth: integer;
2214 > begin
2215 >  CheckActive;
2216 >  result := FIBXSQLVAR.GetCharSetWidth;
2217   end;
2218  
2219   function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
# Line 1727 | Line 2228 | begin
2228    result := FIBXSQLVAR.GetBlobMetaData;
2229   end;
2230  
2231 + function TColumnMetaData.GetStatement: IStatement;
2232 + begin
2233 +  Result := FIBXSQLVAR.GetStatement;
2234 + end;
2235 +
2236 + function TColumnMetaData.GetTransaction: ITransaction;
2237 + begin
2238 +  Result := GetStatement.GetTransaction;
2239 + end;
2240 +
2241   { TIBSQLData }
2242  
2243   procedure TIBSQLData.CheckActive;
# Line 1746 | Line 2257 | begin
2257      IBError(ibxeBOF,[nil]);
2258   end;
2259  
2260 + function TIBSQLData.GetTransaction: ITransaction;
2261 + begin
2262 +  if FTransaction = nil then
2263 +    Result := inherited GetTransaction
2264 +  else
2265 +    Result := FTransaction;
2266 + end;
2267 +
2268   function TIBSQLData.GetIsNull: Boolean;
2269   begin
2270    CheckActive;
# Line 1789 | Line 2308 | end;
2308   { TSQLParam }
2309  
2310   procedure TSQLParam.InternalSetAsString(Value: AnsiString);
2311 +
2312 + procedure DoSetString;
2313 + begin
2314 +  Changing;
2315 +  FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
2316 +  Changed;
2317 + end;
2318 +
2319   var b: IBlob;
2320      dt: TDateTime;
2321 +    CurrValue: Currency;
2322 +    FloatValue: single;
2323 +    timezone: AnsiString;
2324   begin
2325    CheckActive;
2326    if IsNullable then
2327      IsNull := False;
2328 +  with FFirebirdClientAPI do
2329    case SQLTYPE of
2330    SQL_BOOLEAN:
2331      if AnsiCompareText(Value,STrue) = 0 then
# Line 1816 | Line 2347 | begin
2347  
2348    SQL_VARYING,
2349    SQL_TEXT:
2350 <    begin
1820 <      Changing;
1821 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1822 <      Changed;
1823 <    end;
2350 >    DoSetString;
2351  
2352      SQL_SHORT,
2353      SQL_LONG,
2354      SQL_INT64:
2355 <      SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
2355 >      if TryStrToCurr(Value,CurrValue) then
2356 >        SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2357 >      else
2358 >        DoSetString;
2359  
2360      SQL_D_FLOAT,
2361      SQL_DOUBLE,
2362      SQL_FLOAT:
2363 <      SetAsDouble(StrToFloat(Value));
2363 >      if TryStrToFloat(Value,FloatValue) then
2364 >        SetAsDouble(FloatValue)
2365 >      else
2366 >        DoSetString;
2367  
2368      SQL_TIMESTAMP:
2369        if TryStrToDateTime(Value,dt) then
2370          SetAsDateTime(dt)
2371        else
2372 <        FIBXSQLVar.SetString(Value);
2372 >        DoSetString;
2373  
2374      SQL_TYPE_DATE:
2375        if TryStrToDateTime(Value,dt) then
2376          SetAsDate(dt)
2377        else
2378 <        FIBXSQLVar.SetString(Value);
2378 >        DoSetString;
2379  
2380      SQL_TYPE_TIME:
2381        if TryStrToDateTime(Value,dt) then
2382          SetAsTime(dt)
2383        else
2384 <        FIBXSQLVar.SetString(Value);
2384 >        DoSetString;
2385 >
2386 >    SQL_TIMESTAMP_TZ:
2387 >      if ParseDateTimeTZString(value,dt,timezone) then
2388 >        SetAsDateTime(dt,timezone)
2389 >      else
2390 >        DoSetString;
2391 >
2392 >    SQL_TIME_TZ:
2393 >      if ParseDateTimeTZString(value,dt,timezone,true) then
2394 >        SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2395 >      else
2396 >        DoSetString;
2397 >
2398 >    SQL_DEC_FIXED,
2399 >    SQL_DEC16,
2400 >    SQL_DEC34,
2401 >    SQL_INT128:
2402 >      SetAsBCD(StrToBCD(Value));
2403  
2404      else
2405        IBError(ibxeInvalidDataConversion,[nil]);
# Line 2093 | Line 2644 | begin
2644    end;
2645   end;
2646  
2647 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2648 + var i: integer;
2649 +    OldSQLVar: TSQLVarData;
2650 + begin
2651 +  if FIBXSQLVAR.UniqueName then
2652 +    inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2653 +  else
2654 +  with FIBXSQLVAR.Parent do
2655 +  begin
2656 +    for i := 0 to Count - 1 do
2657 +      if Column[i].Name = Name then
2658 +      begin
2659 +        OldSQLVar := FIBXSQLVAR;
2660 +        FIBXSQLVAR := Column[i];
2661 +        try
2662 +          inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2663 +        finally
2664 +          FIBXSQLVAR := OldSQLVar;
2665 +        end;
2666 +      end;
2667 +  end;
2668 + end;
2669 +
2670 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2671 + var i: integer;
2672 +    OldSQLVar: TSQLVarData;
2673 + begin
2674 +  if FIBXSQLVAR.UniqueName then
2675 +    inherited SetAsTime(AValue,OnDate,aTimeZone)
2676 +  else
2677 +  with FIBXSQLVAR.Parent do
2678 +  begin
2679 +    for i := 0 to Count - 1 do
2680 +      if Column[i].Name = Name then
2681 +      begin
2682 +        OldSQLVar := FIBXSQLVAR;
2683 +        FIBXSQLVAR := Column[i];
2684 +        try
2685 +          inherited SetAsTime(AValue,OnDate,aTimeZone);
2686 +        finally
2687 +          FIBXSQLVAR := OldSQLVar;
2688 +        end;
2689 +      end;
2690 +  end;
2691 + end;
2692 +
2693 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2694 + begin
2695 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2696 + end;
2697 +
2698 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2699 + begin
2700 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2701 + end;
2702 +
2703   procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2704   var i: integer;
2705      OldSQLVar: TSQLVarData;
# Line 2116 | Line 2723 | begin
2723    end;
2724   end;
2725  
2726 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2727 +  );
2728 + var i: integer;
2729 +    OldSQLVar: TSQLVarData;
2730 + begin
2731 +  if FIBXSQLVAR.UniqueName then
2732 +    inherited SetAsDateTime(AValue,aTimeZoneID)
2733 +  else
2734 +  with FIBXSQLVAR.Parent do
2735 +  begin
2736 +    for i := 0 to Count - 1 do
2737 +      if Column[i].Name = Name then
2738 +      begin
2739 +        OldSQLVar := FIBXSQLVAR;
2740 +        FIBXSQLVAR := Column[i];
2741 +        try
2742 +          inherited SetAsDateTime(AValue,aTimeZoneID);
2743 +        finally
2744 +          FIBXSQLVAR := OldSQLVar;
2745 +        end;
2746 +      end;
2747 +  end;
2748 + end;
2749 +
2750 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2751 + var i: integer;
2752 +    OldSQLVar: TSQLVarData;
2753 + begin
2754 +  if FIBXSQLVAR.UniqueName then
2755 +    inherited SetAsDateTime(AValue,aTimeZone)
2756 +  else
2757 +  with FIBXSQLVAR.Parent do
2758 +  begin
2759 +    for i := 0 to Count - 1 do
2760 +      if Column[i].Name = Name then
2761 +      begin
2762 +        OldSQLVar := FIBXSQLVAR;
2763 +        FIBXSQLVAR := Column[i];
2764 +        try
2765 +          inherited SetAsDateTime(AValue,aTimeZone);
2766 +        finally
2767 +          FIBXSQLVAR := OldSQLVar;
2768 +        end;
2769 +      end;
2770 +  end;
2771 + end;
2772 +
2773   procedure TSQLParam.SetAsDouble(AValue: Double);
2774   var i: integer;
2775      OldSQLVar: TSQLVarData;
# Line 2296 | Line 2950 | begin
2950    FIBXSQLVAR.SetCharSetID(aValue);
2951   end;
2952  
2953 + procedure TSQLParam.SetAsBcd(aValue: tBCD);
2954 + var i: integer;
2955 +    OldSQLVar: TSQLVarData;
2956 + begin
2957 +  if FIBXSQLVAR.UniqueName then
2958 +    inherited SetAsBcd(AValue)
2959 +  else
2960 +  with FIBXSQLVAR.Parent do
2961 +  begin
2962 +    for i := 0 to Count - 1 do
2963 +      if Column[i].Name = Name then
2964 +      begin
2965 +        OldSQLVar := FIBXSQLVAR;
2966 +        FIBXSQLVAR := Column[i];
2967 +        try
2968 +          inherited SetAsBcd(AValue);
2969 +        finally
2970 +          FIBXSQLVAR := OldSQLVar;
2971 +        end;
2972 +      end;
2973 +  end;
2974 + end;
2975 +
2976   { TMetaData }
2977  
2978   procedure TMetaData.CheckActive;
# Line 2434 | Line 3111 | begin
3111      end;
3112   end;
3113  
3114 + function TSQLParams.GetHasCaseSensitiveParams: Boolean;
3115 + begin
3116 +  Result := FSQLParams.CaseSensitiveParams;
3117 + end;
3118 +
3119   { TResults }
3120  
3121   procedure TResults.CheckActive;
# Line 2446 | Line 3128 | begin
3128    if not FResults.CheckStatementStatus(ssPrepared)  then
3129      IBError(ibxeStatementNotPrepared, [nil]);
3130  
3131 <  with GetTransaction as TFBTransaction do
3131 >  with GetTransaction do
3132    if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3133      IBError(ibxeInterfaceOutofDate,[nil]);
3134   end;
3135  
3136   function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
3137 + var col: TIBSQLData;
3138   begin
3139    if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
3140      IBError(ibxeInvalidColumnIndex,[nil]);
3141  
3142    if not HasInterface(aIBXSQLVAR.Index) then
3143      AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3144 <  Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3144 >  col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3145 >  col.FTransaction := GetTransaction;
3146 >  Result := col;
3147   end;
3148  
3149   constructor TResults.Create(aResults: TSQLDataArea);
# Line 2515 | Line 3200 | begin
3200    FResults.GetData(index,IsNull, len,data);
3201   end;
3202  
3203 + function TResults.GetStatement: IStatement;
3204 + begin
3205 +  Result := FStatement;
3206 + end;
3207 +
3208   function TResults.GetTransaction: ITransaction;
3209   begin
3210    Result := FStatement.GetTransaction;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines