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 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (file contents), Revision 379 by tony, Mon Jan 10 10:08:03 2022 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 { $define ALLOWDIALECT3PARAMNAMES}
80
81 {$ifndef ALLOWDIALECT3PARAMNAMES}
82
83 { Note on SQL Dialects and SQL Parameter Names
84  --------------------------------------------
85
86  Even when dialect 3 quoted format parameter names are not supported, IBX still processes
87  parameter names case insensitive. This does result in some additional overhead
88  due to a call to "AnsiUpperCase". This can be avoided by undefining
89  "UseCaseInSensitiveParamName" below.
90
91  Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
92  is defined. This will not give a useful result.
93 }
94 {$define UseCaseInSensitiveParamName}
95 {$endif}
79  
80   interface
81  
82   uses
83 <  Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor;
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 <     function AdjustScale(Value: Int64; aScale: Integer): Double;
124 <     function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
125 <     function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
123 >     FFirebirdClientAPI: TFBClientAPI;
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
113     function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
114     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 126 | 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 <     function GetSQLType: cardinal; virtual; abstract;
152 >     constructor Create(api: TFBClientAPI);
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 144 | 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;
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 162 | Line 204 | type
204       procedure SetAsShort(Value: short); virtual;
205       procedure SetAsString(Value: AnsiString); virtual;
206       procedure SetAsVariant(Value: Variant);
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 195 | Line 239 | type
239  
240    TSQLDataArea = class
241    private
242 +    FCaseSensitiveParams: boolean;
243      function GetColumn(index: integer): TSQLVarData;
244      function GetCount: integer;
245    protected
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 217 | Line 264 | type
264        var data: PByte); virtual;
265      procedure RowChange;
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 235 | 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 246 | 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 279 | 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 294 | 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;
302    FStatement: IStatement;
370      FChangeSeqNo: integer;
371    protected
372      procedure CheckActive; override;
# Line 311 | 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 326 | 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 350 | 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 362 | 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 375 | 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 386 | 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 426 | Line 535 | type
535      {ISQLParams}
536      function getCount: integer;
537      function getSQLParam(index: integer): ISQLParam;
538 <    function ByName(Idx: AnsiString): ISQLParam ;
538 >    function ByName(Idx: AnsiString): ISQLParam ; virtual;
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 446 | Line 560 | type
560       constructor Create(aResults: TSQLDataArea);
561        {IResults}
562       function getCount: integer;
563 <     function ByName(Idx: AnsiString): ISQLData;
563 >     function ByName(Idx: AnsiString): ISQLData; virtual;
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, FBClientAPI, variants, IBUtils, FBTransaction;
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 472 | 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 509 | Line 688 | end;
688  
689   procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
690    var sProcessedSQL: AnsiString);
512 var
513  cCurChar, cNextChar, cQuoteChar: AnsiChar;
514  sParamName: AnsiString;
515  j, i, iLenSQL, iSQLPos: Integer;
516  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
517  iParamSuffix: Integer;
518  slNames: TStrings;
519  StrBuffer: PByte;
520  found: boolean;
521
522 const
523  DefaultState = 0;
524  CommentState = 1;
525  QuoteState = 2;
526  ParamState = 3;
527  ArrayDimState = 4;
528 {$ifdef ALLOWDIALECT3PARAMNAMES}
529  ParamDefaultState = 0;
530  ParamQuoteState = 1;
531  {$endif}
532
533  procedure AddToProcessedSQL(cChar: AnsiChar);
534  begin
535    StrBuffer[iSQLPos] := byte(cChar);
536    Inc(iSQLPos);
537  end;
538
539 begin
540  if not IsInputDataArea then
541    IBError(ibxeNotPermitted,[nil]);
542
543  sParamName := '';
544  iLenSQL := Length(sSQL);
545  GetMem(StrBuffer,iLenSQL + 1);
546  slNames := TStringList.Create;
547  try
548    { Do some initializations of variables }
549    iParamSuffix := 0;
550    cQuoteChar := '''';
551    i := 1;
552    iSQLPos := 0;
553    iCurState := DefaultState;
554    {$ifdef ALLOWDIALECT3PARAMNAMES}
555    iCurParamState := ParamDefaultState;
556    {$endif}
557    { Now, traverse through the SQL string, character by character,
558     picking out the parameters and formatting correctly for InterBase }
559    while (i <= iLenSQL) do begin
560      { Get the current token and a look-ahead }
561      cCurChar := sSQL[i];
562      if i = iLenSQL then
563        cNextChar := #0
564      else
565        cNextChar := sSQL[i + 1];
566      { Now act based on the current state }
567      case iCurState of
568        DefaultState:
569        begin
570          case cCurChar of
571            '''', '"':
572            begin
573              cQuoteChar := cCurChar;
574              iCurState := QuoteState;
575            end;
576            '?', ':':
577            begin
578              iCurState := ParamState;
579              AddToProcessedSQL('?');
580            end;
581            '/': if (cNextChar = '*') then
582            begin
583              AddToProcessedSQL(cCurChar);
584              Inc(i);
585              iCurState := CommentState;
586            end;
587            '[':
588            begin
589              AddToProcessedSQL(cCurChar);
590              Inc(i);
591              iCurState := ArrayDimState;
592            end;
593          end;
594        end;
691  
692 <        ArrayDimState:
597 <        begin
598 <          case cCurChar of
599 <          ':',',','0'..'9',' ',#9,#10,#13:
600 <            begin
601 <              AddToProcessedSQL(cCurChar);
602 <              Inc(i);
603 <            end;
604 <          else
605 <            begin
606 <              AddToProcessedSQL(cCurChar);
607 <              Inc(i);
608 <              iCurState := DefaultState;
609 <            end;
610 <          end;
611 <        end;
692 > var slNames: TStrings;
693  
694 <        CommentState:
695 <        begin
696 <          if (cNextChar = #0) then
697 <            IBError(ibxeSQLParseError, [SEOFInComment])
698 <          else if (cCurChar = '*') then begin
618 <            if (cNextChar = '/') then
619 <              iCurState := DefaultState;
620 <          end;
621 <        end;
622 <        QuoteState: begin
623 <          if cNextChar = #0 then
624 <            IBError(ibxeSQLParseError, [SEOFInString])
625 <          else if (cCurChar = cQuoteChar) then begin
626 <            if (cNextChar = cQuoteChar) then begin
627 <              AddToProcessedSQL(cCurChar);
628 <              Inc(i);
629 <            end else
630 <              iCurState := DefaultState;
631 <          end;
632 <        end;
633 <        ParamState:
634 <        begin
635 <          { collect the name of the parameter }
636 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
637 <          if iCurParamState = ParamDefaultState then
638 <          begin
639 <            if cCurChar = '"' then
640 <              iCurParamState := ParamQuoteState
641 <            else
642 <            {$endif}
643 <            if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
644 <                sParamName := sParamName + cCurChar
645 <            else if GenerateParamNames then
646 <            begin
647 <              sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
648 <              Inc(iParamSuffix);
649 <              iCurState := DefaultState;
650 <              slNames.AddObject(sParamName,self); //Note local convention
651 <                                                  //add pointer to self to mark entry
652 <              sParamName := '';
653 <            end
654 <            else
655 <              IBError(ibxeSQLParseError, [SParamNameExpected]);
656 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
657 <          end
658 <          else begin
659 <            { determine if Quoted parameter name is finished }
660 <            if cCurChar = '"' then
661 <            begin
662 <              Inc(i);
663 <              slNames.Add(sParamName);
664 <              SParamName := '';
665 <              iCurParamState := ParamDefaultState;
666 <              iCurState := DefaultState;
667 <            end
668 <            else
669 <              sParamName := sParamName + cCurChar
670 <          end;
671 <          {$endif}
672 <          { determine if the unquoted parameter name is finished }
673 <          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
674 <            (iCurState <> DefaultState) then
675 <          begin
676 <            if not (cNextChar in ['A'..'Z', 'a'..'z',
677 <                                  '0'..'9', '_', '$']) then begin
678 <              Inc(i);
679 <              iCurState := DefaultState;
680 <              slNames.Add(sParamName);
681 <              sParamName := '';
682 <            end;
683 <          end;
684 <        end;
685 <      end;
686 <      if (iCurState <> ParamState) and (i <= iLenSQL) then
687 <        AddToProcessedSQL(sSQL[i]);
688 <      Inc(i);
689 <    end;
690 <    AddToProcessedSQL(#0);
691 <    sProcessedSQL := strpas(PAnsiChar(StrBuffer));
694 >  procedure SetColumnNames(slNames: TStrings);
695 >  var i, j: integer;
696 >      found: boolean;
697 >  begin
698 >    found := false;
699      SetCount(slNames.Count);
700      for i := 0 to slNames.Count - 1 do
701      begin
# Line 709 | Line 716 | begin
716          Column[i].UniqueName := not found;
717        end;
718      end;
719 +  end;
720 +
721 + begin
722 +  if not IsInputDataArea then
723 +    IBError(ibxeNotPermitted,[nil]);
724 +
725 +  slNames := TStringList.Create;
726 +  try
727 +    sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
728 +    SetColumnNames(slNames);
729    finally
730      slNames.Free;
714    FreeMem(StrBuffer);
731    end;
732   end;
733  
# Line 725 | Line 741 | var
741    s: AnsiString;
742    i: Integer;
743   begin
744 <  {$ifdef UseCaseInSensitiveParamName}
745 <   s := AnsiUpperCase(Idx);
746 <  {$else}
744 >  if not IsInputDataArea or not CaseSensitiveParams then
745 >   s := AnsiUpperCase(Idx)
746 >  else
747     s := Idx;
748 <  {$endif}
748 >
749    for i := 0 to Count - 1 do
750      if Column[i].Name = s then
751      begin
# Line 761 | Line 777 | end;
777  
778   procedure TSQLVarData.SetName(AValue: AnsiString);
779   begin
780 <  if FName = AValue then Exit;
765 <  {$ifdef UseCaseInSensitiveParamName}
766 <  if Parent.IsInputDataArea then
780 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
781      FName := AnsiUpperCase(AValue)
782    else
769  {$endif}
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 778 | 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 786 | 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 >  if not CanChangeMetaData and (Length(aValue) > GetSize) then
878 >    IBError(ibxeStringOverflow,[Length(aValue),DataLength]);
879    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
880   end;
881  
# Line 797 | Line 886 | end;
886  
887   procedure TSQLVarData.RowChange;
888   begin
889 +  FArrayIntf := nil;
890    FModified := false;
891    FVarString := '';
892   end;
893  
894 + function TSQLVarData.getColMetadata: IParamMetaData;
895 + begin
896 +  Result := FColMetaData;
897 + end;
898 +
899   procedure TSQLVarData.Initialize;
900  
901    function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
# Line 860 | Line 955 | end;
955  
956   {TSQLDataItem}
957  
958 < function TSQLDataItem.AdjustScale(Value: Int64; aScale: Integer): Double;
864 < var
865 <  Scaling : Int64;
866 <  i: Integer;
867 <  Val: Double;
958 > function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
959   begin
960 <  Scaling := 1; Val := Value;
961 <  if aScale > 0 then
962 <  begin
963 <    for i := 1 to aScale do
964 <      Scaling := Scaling * 10;
965 <    result := Val * Scaling;
966 <  end
967 <  else
968 <    if aScale < 0 then
969 <    begin
970 <      for i := -1 downto aScale do
971 <        Scaling := Scaling * 10;
972 <      result := Val / Scaling;
973 <    end
974 <    else
975 <      result := Val;
960 >  {$IF declared(DefaultFormatSettings)}
961 >  with DefaultFormatSettings do
962 >  {$ELSE}
963 >  {$IF declared(FormatSettings)}
964 >  with FormatSettings do
965 >  {$IFEND}
966 >  {$IFEND}
967 >  case GetSQLDialect of
968 >    1:
969 >      if IncludeTime then
970 >        result := ShortDateFormat + ' ' + LongTimeFormat
971 >      else
972 >        result := ShortDateFormat;
973 >    3:
974 >      result := ShortDateFormat;
975 >  end;
976   end;
977  
978 < function TSQLDataItem.AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
979 < var
980 <  Scaling : Int64;
981 <  i: Integer;
982 <  Val: Int64;
978 > function TSQLDataItem.GetTimeFormatStr: AnsiString;
979 > begin
980 >  {$IF declared(DefaultFormatSettings)}
981 >  with DefaultFormatSettings do
982 >  {$ELSE}
983 >  {$IF declared(FormatSettings)}
984 >  with FormatSettings do
985 >  {$IFEND}
986 >  {$IFEND}
987 >    Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
988 > end;
989 >
990 > function TSQLDataItem.GetTimestampFormatStr: AnsiString;
991 > begin
992 >  {$IF declared(DefaultFormatSettings)}
993 >  with DefaultFormatSettings do
994 >  {$ELSE}
995 >  {$IF declared(FormatSettings)}
996 >  with FormatSettings do
997 >  {$IFEND}
998 >  {$IFEND}
999 >    Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
1000 > end;
1001 >
1002 > procedure TSQLDataItem.SetAsInteger(AValue: Integer);
1003   begin
1004 <  Scaling := 1; Val := Value;
894 <  if aScale > 0 then begin
895 <    for i := 1 to aScale do Scaling := Scaling * 10;
896 <    result := Val * Scaling;
897 <  end else if aScale < 0 then begin
898 <    for i := -1 downto aScale do Scaling := Scaling * 10;
899 <    result := Val div Scaling;
900 <  end else
901 <    result := Val;
1004 >  SetAsLong(aValue);
1005   end;
1006  
1007 < function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
1008 <  ): Currency;
1009 < var
907 <  Scaling : Int64;
908 <  i : Integer;
909 <  FractionText, PadText, CurrText: AnsiString;
1007 > procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
1008 >  var dstOffset: smallint; var aTimezone: AnsiString;
1009 >  var aTimeZoneID: TFBTimeZoneID);
1010   begin
1011 <  Result := 0;
1012 <  Scaling := 1;
1013 <  PadText := '';
1014 <  if aScale > 0 then
1015 <  begin
1016 <    for i := 1 to aScale do
1017 <      Scaling := Scaling * 10;
1018 <    result := Value * Scaling;
1019 <  end
1020 <  else
921 <    if aScale < 0 then
922 <    begin
923 <      for i := -1 downto aScale do
924 <        Scaling := Scaling * 10;
925 <      FractionText := IntToStr(abs(Value mod Scaling));
926 <      for i := Length(FractionText) to -aScale -1 do
927 <        PadText := '0' + PadText;
928 <      {$IF declared(DefaultFormatSettings)}
929 <      with DefaultFormatSettings do
930 <      {$ELSE}
931 <      {$IF declared(FormatSettings)}
932 <      with FormatSettings do
933 <      {$IFEND}
934 <      {$IFEND}
935 <      if Value < 0 then
936 <        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
937 <      else
938 <        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
939 <      try
940 <        result := StrToCurr(CurrText);
941 <      except
942 <        on E: Exception do
1011 >  CheckActive;
1012 >  aDateTime := 0;
1013 >  dstOffset := 0;
1014 >  aTimezone := '';
1015 >  aTimeZoneID := TimeZoneID_GMT;
1016 >  if not IsNull then
1017 >    with FFirebirdClientAPI do
1018 >    case SQLType of
1019 >      SQL_TEXT, SQL_VARYING:
1020 >        if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
1021            IBError(ibxeInvalidDataConversion, [nil]);
1022 +      SQL_TYPE_DATE:
1023 +        aDateTime := SQLDecodeDate(SQLData);
1024 +      SQL_TYPE_TIME:
1025 +        aDateTime := SQLDecodeTime(SQLData);
1026 +      SQL_TIMESTAMP:
1027 +        aDateTime := SQLDecodeDateTime(SQLData);
1028 +      SQL_TIMESTAMP_TZ:
1029 +        begin
1030 +          GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
1031 +          aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
1032 +        end;
1033 +      SQL_TIMESTAMP_TZ_EX:
1034 +      begin
1035 +        GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
1036 +        aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
1037        end;
1038 <    end
1039 <    else
1040 <      result := Value;
1038 >      SQL_TIME_TZ:
1039 >        with GetTimeZoneServices do
1040 >        begin
1041 >          DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1042 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1043 >        end;
1044 >      SQL_TIME_TZ_EX:
1045 >        with GetTimeZoneServices do
1046 >        begin
1047 >          DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1048 >          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1049 >        end;
1050 >      else
1051 >        IBError(ibxeInvalidDataConversion, [nil]);
1052 >    end;
1053   end;
1054  
1055 < procedure TSQLDataItem.SetAsInteger(AValue: Integer);
1055 > procedure TSQLDataItem.CheckActive;
1056   begin
1057 <  SetAsLong(aValue);
1057 >  //Do nothing by default
1058   end;
1059  
1060 < function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
956 <  ): Int64;
957 < var
958 <  Scaling : Int64;
959 <  i : Integer;
1060 > procedure TSQLDataItem.CheckTZSupport;
1061   begin
1062 <  Result := 0;
1063 <  Scaling := 1;
963 <  if aScale < 0 then
964 <  begin
965 <    for i := -1 downto aScale do
966 <      Scaling := Scaling * 10;
967 <    result := trunc(Value * Scaling);
968 <  end
969 <  else
970 <  if aScale > 0 then
971 <  begin
972 <    for i := 1 to aScale do
973 <       Scaling := Scaling * 10;
974 <    result := trunc(Value / Scaling);
975 <  end
976 <  else
977 <    result := trunc(Value);
1062 >  if not FFirebirdClientAPI.HasTimeZoneSupport then
1063 >    IBError(ibxeNoTimezoneSupport,[]);
1064   end;
1065  
1066 < function TSQLDataItem.AdjustScaleFromDouble(Value: Double; aScale: Integer
981 <  ): Int64;
982 < var
983 <  Scaling : Int64;
984 <  i : Integer;
1066 > function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1067   begin
1068 <  Result := 0;
987 <  Scaling := 1;
988 <  if aScale < 0 then
989 <  begin
990 <    for i := -1 downto aScale do
991 <      Scaling := Scaling * 10;
992 <    result := trunc(Value * Scaling);
993 <  end
994 <  else
995 <  if aScale > 0 then
1068 >  if FTimeZoneServices = nil then
1069    begin
1070 <    for i := 1 to aScale do
1071 <       Scaling := Scaling * 10;
1072 <    result := trunc(Value / Scaling);
1073 <  end
1074 <  else
1002 <    result := trunc(Value);
1003 < end;
1004 <
1005 < procedure TSQLDataItem.CheckActive;
1006 < begin
1007 <  //Do nothing by default
1070 >    if not GetAttachment.HasTimeZoneSupport then
1071 >      IBError(ibxeNoTimezoneSupport,[]);
1072 >    GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1073 >  end;
1074 >  Result := FTimeZoneServices;
1075   end;
1076  
1077   procedure TSQLDataItem.Changed;
# Line 1045 | Line 1112 | begin
1112     //Do nothing by default
1113   end;
1114  
1115 + constructor TSQLDataItem.Create(api: TFBClientAPI);
1116 + begin
1117 +  inherited Create;
1118 +  FFirebirdClientAPI := api;
1119 + end;
1120 +
1121 + function TSQLDataItem.CanChangeMetaData: boolean;
1122 + begin
1123 +  Result := false;
1124 + end;
1125 +
1126   function TSQLDataItem.GetSQLTypeName: AnsiString;
1127   begin
1128    Result := GetSQLTypeName(GetSQLType);
1129   end;
1130  
1131 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1131 > class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1132   begin
1133    Result := 'Unknown';
1134    case SQLType of
# Line 1061 | Line 1139 | begin
1139    SQL_LONG:             Result := 'SQL_LONG';
1140    SQL_SHORT:            Result := 'SQL_SHORT';
1141    SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1142 +  SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1143 +  SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1144    SQL_BLOB:             Result := 'SQL_BLOB';
1145    SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1146    SQL_ARRAY:            Result := 'SQL_ARRAY';
# Line 1068 | Line 1148 | begin
1148    SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1149    SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1150    SQL_INT64:            Result := 'SQL_INT64';
1151 +  SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1152 +  SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1153 +  SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1154 +  SQL_DEC16:            Result := 'SQL_DEC16';
1155 +  SQL_DEC34:            Result := 'SQL_DEC34';
1156 +  SQL_INT128:           Result := 'SQL_INT128';
1157 +  SQL_NULL:             Result := 'SQL_NULL';
1158 +  SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1159    end;
1160   end;
1161  
1162 + function TSQLDataItem.GetStrDataLength: short;
1163 + begin
1164 +  with FFirebirdClientAPI do
1165 +  if SQLType = SQL_VARYING then
1166 +    Result := DecodeInteger(SQLData, 2)
1167 +  else
1168 +    Result := DataLength;
1169 + end;
1170 +
1171   function TSQLDataItem.GetAsBoolean: boolean;
1172   begin
1173    CheckActive;
# Line 1101 | Line 1198 | begin
1198            end;
1199          end;
1200          SQL_SHORT:
1201 <          result := AdjustScaleToCurrency(Int64(PShort(SQLData)^),
1202 <                                      Scale);
1201 >          result := NumericFromRawValues(Int64(PShort(SQLData)^),
1202 >                                      Scale).getAsCurrency;
1203          SQL_LONG:
1204 <          result := AdjustScaleToCurrency(Int64(PLong(SQLData)^),
1205 <                                      Scale);
1204 >          result := NumericFromRawValues(Int64(PLong(SQLData)^),
1205 >                                      Scale).getAsCurrency;
1206          SQL_INT64:
1207 <          result := AdjustScaleToCurrency(PInt64(SQLData)^,
1208 <                                      Scale);
1207 >          result := NumericFromRawValues(PInt64(SQLData)^,
1208 >                                      Scale).getAsCurrency;
1209          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1210 <          result := Trunc(AsDouble);
1210 >          result := Round(AsDouble);
1211 >
1212 >        SQL_DEC_FIXED,
1213 >        SQL_DEC16,
1214 >        SQL_DEC34,
1215 >        SQL_INT128:
1216 >          if not BCDToCurr(GetAsBCD,Result) then
1217 >            IBError(ibxeInvalidDataConversion, [nil]);
1218 >
1219          else
1220            IBError(ibxeInvalidDataConversion, [nil]);
1221        end;
# Line 1131 | Line 1236 | begin
1236          end;
1237        end;
1238        SQL_SHORT:
1239 <        result := AdjustScaleToInt64(Int64(PShort(SQLData)^),
1240 <                                    Scale);
1239 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1240 >                                    Scale).getAsInt64;
1241        SQL_LONG:
1242 <        result := AdjustScaleToInt64(Int64(PLong(SQLData)^),
1243 <                                    Scale);
1242 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1243 >                                    Scale).getAsInt64;
1244        SQL_INT64:
1245 <        result := AdjustScaleToInt64(PInt64(SQLData)^,
1246 <                                    Scale);
1245 >        result := NumericFromRawValues(PInt64(SQLData)^,
1246 >                                    Scale).getAsInt64;
1247        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1248 <        result := Trunc(AsDouble);
1248 >        result := Round(AsDouble);
1249        else
1250          IBError(ibxeInvalidDataConversion, [nil]);
1251      end;
1252   end;
1253  
1254   function TSQLDataItem.GetAsDateTime: TDateTime;
1255 + var aTimezone: AnsiString;
1256 +    aTimeZoneID: TFBTimeZoneID;
1257 +    dstOffset: smallint;
1258 + begin
1259 +  InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1260 + end;
1261 +
1262 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1263 +  var dstOffset: smallint; var aTimezone: AnsiString);
1264 + var aTimeZoneID: TFBTimeZoneID;
1265 + begin
1266 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1267 + end;
1268 +
1269 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1270 +  var aTimezoneID: TFBTimeZoneID);
1271 + var aTimezone: AnsiString;
1272 + begin
1273 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1274 + end;
1275 +
1276 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1277 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1278 + var aTimeZone: AnsiString;
1279   begin
1280    CheckActive;
1281 <  result := 0;
1281 >  aTime := 0;
1282 >  dstOffset := 0;
1283    if not IsNull then
1284 <    with FirebirdClientAPI do
1284 >    with FFirebirdClientAPI do
1285      case SQLType of
1286 <      SQL_TEXT, SQL_VARYING: begin
1287 <        try
1288 <          result := StrToDate(AsString);
1289 <        except
1290 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1286 >      SQL_TIME_TZ:
1287 >        begin
1288 >          GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1289 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1290 >        end;
1291 >      SQL_TIME_TZ_EX:
1292 >        begin
1293 >          GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1294 >          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1295          end;
1296 +    else
1297 +      IBError(ibxeInvalidDataConversion, [nil]);
1298 +    end;
1299 + end;
1300 +
1301 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1302 +  var aTimezone: AnsiString; OnDate: TDateTime);
1303 + begin
1304 +  CheckActive;
1305 +  aTime := 0;
1306 +  dstOffset := 0;
1307 +  if not IsNull then
1308 +    with FFirebirdClientAPI do
1309 +    case SQLType of
1310 +      SQL_TIME_TZ:
1311 +        GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1312 +      SQL_TIME_TZ_EX:
1313 +        GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1314 +    else
1315 +      IBError(ibxeInvalidDataConversion, [nil]);
1316 +    end;
1317 + end;
1318 +
1319 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1320 +  var aTimezoneID: TFBTimeZoneID);
1321 + begin
1322 +  GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1323 + end;
1324 +
1325 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1326 +  var aTimezone: AnsiString);
1327 + begin
1328 +  GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1329 + end;
1330 +
1331 + function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1332 + var aTimezone: AnsiString;
1333 + begin
1334 +  CheckActive;
1335 +  result := 0;
1336 +  aTimezone := '';
1337 +  if not IsNull then
1338 +    with FFirebirdClientAPI do
1339 +    case SQLType of
1340 +      SQL_TEXT, SQL_VARYING:
1341 +      begin
1342 +        if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1343 +          IBError(ibxeInvalidDataConversion, [nil]);
1344 +        Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1345        end;
1346        SQL_TYPE_DATE:
1347          result := SQLDecodeDate(SQLData);
1348 <      SQL_TYPE_TIME:
1348 >      SQL_TYPE_TIME,
1349 >      SQL_TIME_TZ,
1350 >      SQL_TIME_TZ_EX:
1351          result := SQLDecodeTime(SQLData);
1352 <      SQL_TIMESTAMP:
1352 >      SQL_TIMESTAMP,
1353 >      SQL_TIMESTAMP_TZ,
1354 >      SQL_TIMESTAMP_TZ_EX:
1355          result := SQLDecodeDateTime(SQLData);
1356        else
1357          IBError(ibxeInvalidDataConversion, [nil]);
1358 <    end;
1358 >      end;
1359   end;
1360  
1361   function TSQLDataItem.GetAsDouble: Double;
# Line 1185 | Line 1372 | begin
1372          end;
1373        end;
1374        SQL_SHORT:
1375 <        result := AdjustScale(Int64(PShort(SQLData)^),
1376 <                              Scale);
1375 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1376 >                              Scale).getAsDouble;
1377        SQL_LONG:
1378 <        result := AdjustScale(Int64(PLong(SQLData)^),
1379 <                              Scale);
1378 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1379 >                              Scale).getAsDouble;
1380        SQL_INT64:
1381 <        result := AdjustScale(PInt64(SQLData)^, Scale);
1381 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsDouble;
1382        SQL_FLOAT:
1383          result := PFloat(SQLData)^;
1384        SQL_DOUBLE, SQL_D_FLOAT:
1385          result := PDouble(SQLData)^;
1386 +      SQL_DEC_FIXED,
1387 +      SQL_DEC16,
1388 +      SQL_DEC34,
1389 +      SQL_INT128:
1390 +        Result := BCDToDouble(GetAsBCD);
1391        else
1392          IBError(ibxeInvalidDataConversion, [nil]);
1393      end;
# Line 1232 | Line 1424 | begin
1424          end;
1425        end;
1426        SQL_SHORT:
1427 <        result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1428 <                                    Scale));
1427 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1428 >                                    Scale).getAsInteger;
1429        SQL_LONG:
1430 <        result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1431 <                                    Scale));
1430 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1431 >                                    Scale).getAsInteger;
1432        SQL_INT64:
1433 <        result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1433 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsInteger;
1434 >
1435        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1436 <        result := Trunc(AsDouble);
1436 >        result := Round(AsDouble);
1437 >      SQL_DEC_FIXED,
1438 >      SQL_DEC16,
1439 >      SQL_DEC34,
1440 >      SQL_INT128:
1441 >        Result := BCDToInteger(GetAsBCD);
1442        else
1443 <        IBError(ibxeInvalidDataConversion, [nil]);
1443 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1444      end;
1445   end;
1446  
# Line 1280 | Line 1478 | begin
1478    end;
1479   end;
1480  
1481 + {Copied from LazUTF8}
1482 +
1483 + function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1484 + const TopBitSetMask   = $80; {%10000000}
1485 +      Top2BitsSetMask = $C0; {%11000000}
1486 +      Top3BitsSetMask = $E0; {%11100000}
1487 +      Top4BitsSetMask = $F0; {%11110000}
1488 +      Top5BitsSetMask = $F8; {%11111000}
1489 + begin
1490 +  case p^ of
1491 +  #0..#191: // %11000000
1492 +    // regular single byte character (#0 is a character, this is Pascal ;)
1493 +    Result:=1;
1494 +  #192..#223: // p^ and %11100000 = %11000000
1495 +    begin
1496 +      // could be 2 byte character
1497 +      if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1498 +        Result:=2
1499 +      else
1500 +        Result:=1;
1501 +    end;
1502 +  #224..#239: // p^ and %11110000 = %11100000
1503 +    begin
1504 +      // could be 3 byte character
1505 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1506 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1507 +        Result:=3
1508 +      else
1509 +        Result:=1;
1510 +    end;
1511 +  #240..#247: // p^ and %11111000 = %11110000
1512 +    begin
1513 +      // could be 4 byte character
1514 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1515 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1516 +      and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1517 +        Result:=4
1518 +      else
1519 +        Result:=1;
1520 +    end;
1521 +  else
1522 +    Result:=1;
1523 +  end;
1524 + end;
1525 +
1526 + {Returns the byte length of a UTF8 string with a fixed charwidth}
1527 +
1528 + function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1529 + var i: integer;
1530 +    cplen: integer;
1531 + begin
1532 +  Result := 0;
1533 +  for i := 1 to FieldWidth do
1534 +  begin
1535 +    cplen := UTF8CodepointSizeFull(p);
1536 +    Inc(p,cplen);
1537 +    Inc(Result,cplen);
1538 +    if Result >= MaxDataLength then
1539 +    begin
1540 +      Result := MaxDataLength;
1541 +      Exit;
1542 +    end;
1543 +  end;
1544 + end;
1545  
1546   function TSQLDataItem.GetAsString: AnsiString;
1547   var
1548    sz: PByte;
1549    str_len: Integer;
1550    rs: RawByteString;
1551 +  aTimeZone: AnsiString;
1552 +  aDateTime: TDateTime;
1553 +  dstOffset: smallint;
1554   begin
1555    CheckActive;
1556    result := '';
1557    { Check null, if so return a default string }
1558    if not IsNull then
1559 <  with FirebirdClientAPI do
1559 >  with FFirebirdClientAPI do
1560      case SQLType of
1561        SQL_BOOLEAN:
1562          if AsBoolean then
# Line 1303 | Line 1568 | begin
1568        begin
1569          sz := SQLData;
1570          if (SQLType = SQL_TEXT) then
1571 <          str_len := DataLength
1571 >        begin
1572 >          if GetCodePage = cp_utf8 then
1573 >            str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1574 >          else
1575 >            str_len := DataLength
1576 >        end
1577          else begin
1578 <          str_len := DecodeInteger(SQLData, 2);
1578 >          str_len := DecodeInteger(sz, 2);
1579            Inc(sz, 2);
1580          end;
1581          SetString(rs, PAnsiChar(sz), str_len);
1582          SetCodePage(rs,GetCodePage,false);
1583 <        if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1314 <          Result := TrimRight(rs)
1315 <        else
1316 <          Result := rs
1583 >        Result := rs;
1584        end;
1585 +
1586        SQL_TYPE_DATE:
1587 <        case GetSQLDialect of
1320 <          1 : result := DateTimeToStr(AsDateTime);
1321 <          3 : result := DateToStr(AsDateTime);
1322 <        end;
1323 <      SQL_TYPE_TIME :
1324 <        result := TimeToStr(AsDateTime);
1587 >        Result := DateToStr(GetAsDateTime);
1588        SQL_TIMESTAMP:
1589 <      {$IF declared(DefaultFormatSettings)}
1590 <      with DefaultFormatSettings do
1591 <      {$ELSE}
1592 <      {$IF declared(FormatSettings)}
1593 <      with FormatSettings do
1594 <      {$IFEND}
1595 <      {$IFEND}
1596 <        result := FormatDateTime(ShortDateFormat + ' ' +
1597 <                            LongTimeFormat+'.zzz',AsDateTime);
1589 >        Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1590 >      SQL_TYPE_TIME:
1591 >        Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1592 >      SQL_TIMESTAMP_TZ,
1593 >      SQL_TIMESTAMP_TZ_EX:
1594 >        with GetAttachment.GetTimeZoneServices do
1595 >        begin
1596 >          if GetTZTextOption = tzGMT then
1597 >            Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1598 >          else
1599 >          begin
1600 >            GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1601 >            if GetTZTextOption = tzOffset then
1602 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1603 >            else
1604 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1605 >          end;
1606 >        end;
1607 >      SQL_TIME_TZ,
1608 >      SQL_TIME_TZ_EX:
1609 >        with GetAttachment.GetTimeZoneServices do
1610 >        begin
1611 >          if GetTZTextOption = tzGMT then
1612 >             Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1613 >          else
1614 >          begin
1615 >            GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1616 >            if GetTZTextOption = tzOffset then
1617 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1618 >            else
1619 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1620 >          end;
1621 >        end;
1622 >
1623        SQL_SHORT, SQL_LONG:
1624          if Scale = 0 then
1625            result := IntToStr(AsLong)
# Line 1348 | Line 1636 | begin
1636            result := FloatToStr(AsDouble);
1637        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1638          result := FloatToStr(AsDouble);
1639 +
1640 +      SQL_DEC16,
1641 +      SQL_DEC34:
1642 +        result := BCDToStr(GetAsBCD);
1643 +
1644 +      SQL_DEC_FIXED,
1645 +      SQL_INT128:
1646 +        result := Int128ToStr(SQLData,scale);
1647 +
1648        else
1649 <        IBError(ibxeInvalidDataConversion, [nil]);
1649 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1650      end;
1651   end;
1652  
1653 + function TSQLDataItem.GetAsNumeric: IFBNumeric;
1654 + var aValue: Int64;
1655 + begin
1656 +  case SQLType of
1657 +   SQL_TEXT, SQL_VARYING:
1658 +     Result := NewNumeric(GetAsString);
1659 +
1660 +   SQL_SHORT:
1661 +     Result := NumericFromRawValues(PShort(SQLData)^, Scale);
1662 +
1663 +   SQL_LONG:
1664 +     Result := NumericFromRawValues(PLong(SQLData)^, Scale);
1665 +
1666 +   SQL_INT64:
1667 +     Result := NumericFromRawValues(PInt64(SQLData)^, Scale);
1668 +
1669 +   SQL_DEC16,
1670 +   SQL_DEC34,
1671 +   SQL_DEC_FIXED,
1672 +   SQL_INT128:
1673 +     Result := NewNumeric(GetAsBCD);
1674 +
1675 +   else
1676 +     IBError(ibxeInvalidDataConversion, [nil]);
1677 +  end;
1678 + end;
1679 +
1680   function TSQLDataItem.GetIsNull: Boolean;
1681   begin
1682    CheckActive;
1683    Result := false;
1684   end;
1685  
1686 < function TSQLDataItem.getIsNullable: boolean;
1686 > function TSQLDataItem.GetIsNullable: boolean;
1687   begin
1688    CheckActive;
1689    Result := false;
1690   end;
1691  
1692   function TSQLDataItem.GetAsVariant: Variant;
1693 + var ts: TDateTime;
1694 +  dstOffset: smallint;
1695 +    timezone: AnsiString;
1696   begin
1697    CheckActive;
1698    if IsNull then
# Line 1379 | Line 1706 | begin
1706          result := AsString;
1707        SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1708          result := AsDateTime;
1709 +      SQL_TIMESTAMP_TZ,
1710 +      SQL_TIME_TZ,
1711 +      SQL_TIMESTAMP_TZ_EX,
1712 +      SQL_TIME_TZ_EX:
1713 +        begin
1714 +          GetAsDateTime(ts,dstOffset,timezone);
1715 +          result := VarArrayOf([ts,dstOffset,timezone]);
1716 +        end;
1717        SQL_SHORT, SQL_LONG:
1718          if Scale = 0 then
1719            result := AsLong
# Line 1397 | Line 1732 | begin
1732          result := AsDouble;
1733        SQL_BOOLEAN:
1734          result := AsBoolean;
1735 +      SQL_DEC_FIXED,
1736 +      SQL_DEC16,
1737 +      SQL_DEC34,
1738 +      SQL_INT128:
1739 +        result := VarFmtBCDCreate(GetAsBcd);
1740        else
1741          IBError(ibxeInvalidDataConversion, [nil]);
1742      end;
# Line 1407 | Line 1747 | begin
1747    Result := false;
1748   end;
1749  
1750 + function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1751 +  ): integer;
1752 + begin
1753 +  case DateTimeFormat of
1754 +  dfTimestamp:
1755 +    Result := Length(GetTimestampFormatStr);
1756 +  dfDateTime:
1757 +    Result := Length(GetDateFormatStr(true));
1758 +  dfTime:
1759 +    Result := Length(GetTimeFormatStr);
1760 +  dfTimestampTZ:
1761 +    Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1762 +  dfTimeTZ:
1763 +    Result := Length(GetTimeFormatStr)+ 6;
1764 +  else
1765 +    Result := 0;
1766 +  end;end;
1767 +
1768 + function TSQLDataItem.GetAsBCD: tBCD;
1769 +
1770 + begin
1771 +  CheckActive;
1772 +  if IsNull then
1773 +   with Result do
1774 +   begin
1775 +     FillChar(Result,sizeof(Result),0);
1776 +     Precision := 1;
1777 +     exit;
1778 +   end;
1779 +
1780 +  case SQLType of
1781 +  SQL_DEC16,
1782 +  SQL_DEC34:
1783 +    with FFirebirdClientAPI do
1784 +      Result := SQLDecFloatDecode(SQLType,  SQLData);
1785 +
1786 +  SQL_DEC_FIXED,
1787 +  SQL_INT128:
1788 +    with FFirebirdClientAPI do
1789 +      Result := StrToBCD(Int128ToStr(SQLData,scale));
1790 +  else
1791 +    if not CurrToBCD(GetAsCurrency,Result) then
1792 +      IBError(ibxeBadBCDConversion,[]);
1793 +  end;
1794 + end;
1795 +
1796  
1797   procedure TSQLDataItem.SetIsNull(Value: Boolean);
1798   begin
# Line 1429 | Line 1815 | begin
1815    if GetSQLDialect < 3 then
1816      AsDouble := Value
1817    else
1818 +  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> -4)) then
1819 +    SetAsNumeric(NewNumeric(Value))
1820 +  else
1821    begin
1822      Changing;
1823      if IsNullable then
# Line 1444 | Line 1833 | end;
1833   procedure TSQLDataItem.SetAsInt64(Value: Int64);
1834   begin
1835    CheckActive;
1836 <  Changing;
1837 <  if IsNullable then
1838 <    IsNull := False;
1836 >  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> 0)) then
1837 >    SetAsNumeric(NewNumeric(Value))
1838 >  else
1839 >  begin
1840 >    Changing;
1841 >    if IsNullable then
1842 >      IsNull := False;
1843  
1844 <  SQLType := SQL_INT64;
1845 <  Scale := 0;
1846 <  DataLength := SizeOf(Int64);
1847 <  PInt64(SQLData)^ := Value;
1848 <  Changed;
1844 >    SQLType := SQL_INT64;
1845 >    Scale := 0;
1846 >    DataLength := SizeOf(Int64);
1847 >    PInt64(SQLData)^ := Value;
1848 >    Changed;
1849 >  end;
1850   end;
1851  
1852   procedure TSQLDataItem.SetAsDate(Value: TDateTime);
# Line 1470 | Line 1864 | begin
1864  
1865    SQLType := SQL_TYPE_DATE;
1866    DataLength := SizeOf(ISC_DATE);
1867 <  with FirebirdClientAPI do
1867 >  with FFirebirdClientAPI do
1868      SQLEncodeDate(Value,SQLData);
1869    Changed;
1870   end;
# Line 1490 | Line 1884 | begin
1884  
1885    SQLType := SQL_TYPE_TIME;
1886    DataLength := SizeOf(ISC_TIME);
1887 <  with FirebirdClientAPI do
1887 >  with FFirebirdClientAPI do
1888      SQLEncodeTime(Value,SQLData);
1889    Changed;
1890   end;
1891  
1892 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1893 + begin
1894 +  CheckActive;
1895 +  CheckTZSupport;
1896 +  if GetSQLDialect < 3 then
1897 +  begin
1898 +    AsDateTime := aValue;
1899 +    exit;
1900 +  end;
1901 +
1902 +  Changing;
1903 +  if IsNullable then
1904 +    IsNull := False;
1905 +
1906 +  SQLType := SQL_TIME_TZ;
1907 +  DataLength := SizeOf(ISC_TIME_TZ);
1908 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1909 +  Changed;
1910 + end;
1911 +
1912 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1913 + begin
1914 +  CheckActive;
1915 +  CheckTZSupport;
1916 +  if GetSQLDialect < 3 then
1917 +  begin
1918 +    AsDateTime := aValue;
1919 +    exit;
1920 +  end;
1921 +
1922 +  Changing;
1923 +  if IsNullable then
1924 +    IsNull := False;
1925 +
1926 +  SQLType := SQL_TIME_TZ;
1927 +  DataLength := SizeOf(ISC_TIME_TZ);
1928 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1929 +  Changed;
1930 + end;
1931 +
1932   procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1933   begin
1934    CheckActive;
# Line 1504 | Line 1938 | begin
1938    Changing;
1939    SQLType := SQL_TIMESTAMP;
1940    DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1941 <  with FirebirdClientAPI do
1941 >  with FFirebirdClientAPI do
1942      SQLEncodeDateTime(Value,SQLData);
1943    Changed;
1944   end;
1945  
1946 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1947 +  aTimeZoneID: TFBTimeZoneID);
1948 + begin
1949 +  CheckActive;
1950 +  CheckTZSupport;
1951 +  if IsNullable then
1952 +    IsNull := False;
1953 +
1954 +  Changing;
1955 +  SQLType := SQL_TIMESTAMP_TZ;
1956 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1957 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
1958 +  Changed;
1959 + end;
1960 +
1961 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
1962 +  );
1963 + begin
1964 +  CheckActive;
1965 +  CheckTZSupport;
1966 +  if IsNullable then
1967 +    IsNull := False;
1968 +
1969 +  Changing;
1970 +  SQLType := SQL_TIMESTAMP_TZ;
1971 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1972 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
1973 +  Changed;
1974 + end;
1975 +
1976 + procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
1977 + begin
1978 +  SetAsDateTime(aUTCTime,TimeZoneID_GMT);
1979 + end;
1980 +
1981   procedure TSQLDataItem.SetAsDouble(Value: Double);
1982   begin
1983    CheckActive;
# Line 1540 | Line 2009 | end;
2009   procedure TSQLDataItem.SetAsLong(Value: Long);
2010   begin
2011    CheckActive;
2012 <  if IsNullable then
2013 <    IsNull := False;
2012 >  if not CanChangeMetaData and ((SQLType <> SQL_LONG) or (Scale <> 0)) then
2013 >    SetAsNumeric(NewNumeric(Value))
2014 >  else
2015 >  begin
2016 >    if IsNullable then
2017 >      IsNull := False;
2018  
2019 <  Changing;
2020 <  SQLType := SQL_LONG;
2021 <  DataLength := SizeOf(Long);
2022 <  Scale := 0;
2023 <  PLong(SQLData)^ := Value;
2024 <  Changed;
2019 >    Changing;
2020 >    SQLType := SQL_LONG;
2021 >    DataLength := SizeOf(Long);
2022 >    Scale := 0;
2023 >    PLong(SQLData)^ := Value;
2024 >    Changed;
2025 >  end;
2026   end;
2027  
2028   procedure TSQLDataItem.SetAsPointer(Value: Pointer);
# Line 1583 | Line 2057 | end;
2057   procedure TSQLDataItem.SetAsShort(Value: short);
2058   begin
2059    CheckActive;
2060 <  Changing;
2061 <  if IsNullable then
2062 <    IsNull := False;
2060 >  if not CanChangeMetaData and ((SQLType <> SQL_SHORT) or (Scale <> 0)) then
2061 >    SetAsNumeric(NewNumeric(Value))
2062 >  else
2063 >  begin
2064 >    Changing;
2065 >    if IsNullable then
2066 >      IsNull := False;
2067  
2068 <  SQLType := SQL_SHORT;
2069 <  DataLength := SizeOf(Short);
2070 <  Scale := 0;
2071 <  PShort(SQLData)^ := Value;
2072 <  Changed;
2068 >    SQLType := SQL_SHORT;
2069 >    DataLength := SizeOf(Short);
2070 >    Scale := 0;
2071 >    PShort(SQLData)^ := Value;
2072 >    Changed;
2073 >  end;
2074   end;
2075  
2076   procedure TSQLDataItem.SetAsString(Value: AnsiString);
# Line 1604 | Line 2083 | begin
2083    CheckActive;
2084    if VarIsNull(Value) then
2085      IsNull := True
2086 +  else
2087 +  if VarIsArray(Value) then {must be datetime plus timezone}
2088 +    SetAsDateTime(Value[0],AnsiString(Value[1]))
2089    else case VarType(Value) of
2090      varEmpty, varNull:
2091        IsNull := True;
2092      varSmallint, varInteger, varByte,
2093 <      varWord, varShortInt:
2094 <      AsLong := Value;
1613 <    varInt64:
1614 <      AsInt64 := Value;
2093 >      varWord, varShortInt, varInt64:
2094 >        SetAsNumeric(NewNumeric(Int64(Value)));
2095      varSingle, varDouble:
2096        AsDouble := Value;
2097      varCurrency:
2098 <      AsCurrency := Value;
2098 >      SetAsNumeric(NewNumeric(Currency(Value)));
2099      varBoolean:
2100        AsBoolean := Value;
2101      varDate:
# Line 1626 | Line 2106 | begin
2106        IBError(ibxeNotSupported, [nil]);
2107      varByRef, varDispatch, varError, varUnknown, varVariant:
2108        IBError(ibxeNotPermitted, [nil]);
2109 +    else
2110 +      if VarIsFmtBCD(Value) then
2111 +        SetAsBCD(VarToBCD(Value))
2112 +      else
2113 +        IBError(ibxeNotSupported, [nil]);
2114 +  end;
2115 + end;
2116 +
2117 + procedure TSQLDataItem.SetAsNumeric(Value: IFBNumeric);
2118 + begin
2119 +  CheckActive;
2120 +  Changing;
2121 +  if IsNullable then
2122 +    IsNull := False;
2123 +
2124 +  if CanChangeMetadata then
2125 +  begin
2126 +    {Restore original values}
2127 +    SQLType := getColMetadata.GetSQLType;
2128 +    Scale := getColMetadata.getScale;
2129 +    SetDataLength(getColMetadata.GetSize);
2130 +  end;
2131 +
2132 +  with FFirebirdClientAPI do
2133 +  case GetSQLType of
2134 +  SQL_LONG:
2135 +      PLong(SQLData)^ := SafeInteger(Value.clone(Scale).getRawValue);
2136 +  SQL_SHORT:
2137 +    PShort(SQLData)^ := SafeSmallInt(Value.clone(Scale).getRawValue);
2138 +  SQL_INT64:
2139 +    PInt64(SQLData)^ := Value.clone(Scale).getRawValue;
2140 +  SQL_TEXT, SQL_VARYING:
2141 +   SetAsString(Value.getAsString);
2142 +  SQL_D_FLOAT,
2143 +  SQL_DOUBLE:
2144 +    PDouble(SQLData)^ := Value.getAsDouble;
2145 +  SQL_FLOAT:
2146 +    PSingle(SQLData)^ := Value.getAsDouble;
2147 +  SQL_DEC_FIXED,
2148 +  SQL_DEC16,
2149 +  SQL_DEC34:
2150 +     SQLDecFloatEncode(Value.getAsBCD,SQLType,SQLData);
2151 +  SQL_INT128:
2152 +    StrToInt128(Scale,Value.getAsString,SQLData);
2153 +  else
2154 +    IBError(ibxeInvalidDataConversion, [nil]);
2155 +  end;
2156 +  Changed;
2157 + end;
2158 +
2159 + procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2160 + begin
2161 +  CheckActive;
2162 +  Changing;
2163 +  if IsNullable then
2164 +    IsNull := False;
2165 +
2166 +  if not CanChangeMetaData then
2167 +  begin
2168 +    SetAsNumeric(NewNumeric(aValue));
2169 +    Exit;
2170    end;
2171 +
2172 +  with FFirebirdClientAPI do
2173 +  if aValue.Precision <= 16 then
2174 +  begin
2175 +    if not HasDecFloatSupport then
2176 +      IBError(ibxeDecFloatNotSupported,[]);
2177 +
2178 +    SQLType := SQL_DEC16;
2179 +    DataLength := 8;
2180 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2181 +  end
2182 +  else
2183 +  if aValue.Precision <= 34 then
2184 +  begin
2185 +    if not HasDecFloatSupport then
2186 +      IBError(ibxeDecFloatNotSupported,[]);
2187 +
2188 +    SQLType := SQL_DEC34;
2189 +    DataLength := 16;
2190 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2191 +  end
2192 +  else
2193 +  if aValue.Precision <= 38 then
2194 +  begin
2195 +    if not HasInt128Support then
2196 +      IBError(ibxeInt128NotSupported,[]);
2197 +
2198 +    SQLType := SQL_INT128;
2199 +    DataLength := 16;
2200 +    StrToInt128(scale,BcdToStr(aValue),SQLData);
2201 +  end
2202 +  else
2203 +    IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2204 +
2205 +  Changed;
2206   end;
2207  
2208   procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
# Line 1659 | Line 2235 | begin
2235      IBError(ibxeStatementNotPrepared, [nil]);
2236   end;
2237  
2238 + function TColumnMetaData.GetAttachment: IAttachment;
2239 + begin
2240 +  Result := FIBXSQLVAR.GetAttachment;
2241 + end;
2242 +
2243   function TColumnMetaData.SQLData: PByte;
2244   begin
2245    Result := FIBXSQLVAR.SQLData;
# Line 1676 | Line 2257 | end;
2257  
2258   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2259   begin
2260 <  inherited Create;
2260 >  inherited Create(aIBXSQLVAR.GetAttachment.getFirebirdAPI as TFBClientAPI);
2261    FIBXSQLVAR := aIBXSQLVAR;
2262    FOwner := aOwner;
2263    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 1692 | Line 2273 | end;
2273  
2274   function TColumnMetaData.GetSQLDialect: integer;
2275   begin
2276 <  Result := FIBXSQLVAR.Statement.GetSQLDialect;
2276 >  Result := FIBXSQLVAR.GetAttachment.GetSQLDialect;
2277 > end;
2278 >
2279 > function TColumnMetaData.getColMetadata: IParamMetaData;
2280 > begin
2281 >  Result := self;
2282   end;
2283  
2284   function TColumnMetaData.GetIndex: integer;
# Line 1763 | Line 2349 | end;
2349   function TColumnMetaData.GetSize: cardinal;
2350   begin
2351    CheckActive;
2352 <  result := FIBXSQLVAR.DataLength;
2352 >  result := FIBXSQLVAR.GetSize;
2353 > end;
2354 >
2355 > function TColumnMetaData.GetCharSetWidth: integer;
2356 > begin
2357 >  CheckActive;
2358 >  result := FIBXSQLVAR.GetCharSetWidth;
2359   end;
2360  
2361   function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
# Line 1778 | Line 2370 | begin
2370    result := FIBXSQLVAR.GetBlobMetaData;
2371   end;
2372  
2373 + function TColumnMetaData.GetStatement: IStatement;
2374 + begin
2375 +  Result := FIBXSQLVAR.GetStatement;
2376 + end;
2377 +
2378 + function TColumnMetaData.GetTransaction: ITransaction;
2379 + begin
2380 +  Result := FIBXSQLVAR.GetTransaction;
2381 + end;
2382 +
2383   { TIBSQLData }
2384  
2385   procedure TIBSQLData.CheckActive;
# Line 1806 | Line 2408 | end;
2408   function TIBSQLData.GetAsArray: IArray;
2409   begin
2410    CheckActive;
2411 <  result := FIBXSQLVAR.GetAsArray(AsQuad);
2411 >  result := FIBXSQLVAR.GetAsArray;
2412   end;
2413  
2414   function TIBSQLData.GetAsBlob: IBlob;
# Line 1840 | Line 2442 | end;
2442   { TSQLParam }
2443  
2444   procedure TSQLParam.InternalSetAsString(Value: AnsiString);
2445 +
2446 + procedure DoSetString;
2447 + begin
2448 +  Changing;
2449 +  FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
2450 +  Changed;
2451 + end;
2452 +
2453   var b: IBlob;
2454 +    dt: TDateTime;
2455 +    timezone: AnsiString;
2456 +    Int64Value: Int64;
2457 +    BCDValue: TBCD;
2458 +    aScale: integer;
2459   begin
2460    CheckActive;
2461    if IsNullable then
2462      IsNull := False;
2463 +  with FFirebirdClientAPI do
2464    case SQLTYPE of
2465    SQL_BOOLEAN:
2466      if AnsiCompareText(Value,STrue) = 0 then
# Line 1856 | Line 2472 | begin
2472        IBError(ibxeInvalidDataConversion,[nil]);
2473  
2474    SQL_BLOB:
2475 +    if Length(Value) < GetAttachment.GetInlineBlobLimit then
2476 +      DoSetString
2477 +    else
2478      begin
2479        Changing;
2480        b := FIBXSQLVAR.CreateBlob;
# Line 1866 | Line 2485 | begin
2485  
2486    SQL_VARYING,
2487    SQL_TEXT:
2488 <    begin
1870 <      Changing;
1871 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1872 <      Changed;
1873 <    end;
2488 >    DoSetString;
2489  
2490 <    SQL_SHORT,
2491 <    SQL_LONG,
2492 <    SQL_INT64:
2493 <      SetAsInt64(StrToInt(Value));
2494 <
2495 <    SQL_D_FLOAT,
2496 <    SQL_DOUBLE,
1882 <    SQL_FLOAT:
1883 <      SetAsDouble(StrToFloat(Value));
2490 >  SQL_SHORT,
2491 >  SQL_LONG,
2492 >  SQL_INT64:
2493 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2494 >      SetAsNumeric(NumericFromRawValues(Int64Value,aScale))
2495 >    else
2496 >      DoSetString;
2497  
2498 <    SQL_TIMESTAMP:
2499 <      SetAsDateTime(StrToDateTime(Value));
2498 >  SQL_DEC_FIXED,
2499 >  SQL_DEC16,
2500 >  SQL_DEC34,
2501 >  SQL_INT128:
2502 >    if TryStrToBCD(Value,BCDValue) then
2503 >      SetAsNumeric(NewNumeric(BCDValue))
2504 >    else
2505 >      DoSetString;
2506  
2507 <    SQL_TYPE_DATE:
2508 <      SetAsDate(StrToDateTime(Value));
2507 >  SQL_D_FLOAT,
2508 >  SQL_DOUBLE,
2509 >  SQL_FLOAT:
2510 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2511 >      SetAsNumeric(NumericFromRawValues(Int64Value,AScale))
2512 >    else
2513 >      DoSetString;
2514  
2515 <    SQL_TYPE_TIME:
2516 <      SetAsTime(StrToDateTime(Value));
2515 >  SQL_TIMESTAMP:
2516 >      if TryStrToDateTime(Value,dt) then
2517 >        SetAsDateTime(dt)
2518 >      else
2519 >        DoSetString;
2520  
2521 <    else
2522 <      IBError(ibxeInvalidDataConversion,[nil]);
2521 >  SQL_TYPE_DATE:
2522 >      if TryStrToDateTime(Value,dt) then
2523 >        SetAsDate(dt)
2524 >      else
2525 >        DoSetString;
2526 >
2527 >  SQL_TYPE_TIME:
2528 >      if TryStrToDateTime(Value,dt) then
2529 >        SetAsTime(dt)
2530 >      else
2531 >        DoSetString;
2532 >
2533 >  SQL_TIMESTAMP_TZ,
2534 >  SQL_TIMESTAMP_TZ_EX:
2535 >      if ParseDateTimeTZString(value,dt,timezone) then
2536 >        SetAsDateTime(dt,timezone)
2537 >      else
2538 >        DoSetString;
2539 >
2540 >  SQL_TIME_TZ,
2541 >  SQL_TIME_TZ_EX:
2542 >      if ParseDateTimeTZString(value,dt,timezone,true) then
2543 >        SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2544 >      else
2545 >        DoSetString;
2546 >
2547 >  else
2548 >    IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2549    end;
2550   end;
2551  
# Line 1930 | Line 2583 | begin
2583    IsNull := true;
2584   end;
2585  
2586 + function TSQLParam.CanChangeMetaData: boolean;
2587 + begin
2588 +  Result := FIBXSQLVAR.CanChangeMetaData;
2589 + end;
2590 +
2591 + function TSQLParam.getColMetadata: IParamMetaData;
2592 + begin
2593 +  Result := FIBXSQLVAR.getColMetadata;
2594 + end;
2595 +
2596   function TSQLParam.GetModified: boolean;
2597   begin
2598    CheckActive;
# Line 1943 | Line 2606 | begin
2606    Result := inherited GetAsPointer;
2607   end;
2608  
2609 + function TSQLParam.GetAsString: AnsiString;
2610 + var rs: RawByteString;
2611 + begin
2612 +  Result := '';
2613 +  if (SQLType = SQL_VARYING) and not IsNull then
2614 +  {SQLData points to start of string - default is to length word}
2615 +  begin
2616 +    CheckActive;
2617 +    SetString(rs,PAnsiChar(SQLData),DataLength);
2618 +    SetCodePage(rs,GetCodePage,false);
2619 +    Result := rs;
2620 +  end
2621 +  else
2622 +    Result := inherited GetAsString;
2623 + end;
2624 +
2625   procedure TSQLParam.SetName(Value: AnsiString);
2626   begin
2627    CheckActive;
# Line 1988 | Line 2667 | begin
2667    if not FIBXSQLVAR.UniqueName then
2668      IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
2669  
2670 +  FIBXSQLVAR.SetArray(anArray); {save array interface}
2671    SetAsQuad(AnArray.GetArrayID);
2672   end;
2673  
# Line 2134 | Line 2814 | begin
2814    end;
2815   end;
2816  
2817 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2818 + var i: integer;
2819 +    OldSQLVar: TSQLVarData;
2820 + begin
2821 +  if FIBXSQLVAR.UniqueName then
2822 +    inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2823 +  else
2824 +  with FIBXSQLVAR.Parent do
2825 +  begin
2826 +    for i := 0 to Count - 1 do
2827 +      if Column[i].Name = Name then
2828 +      begin
2829 +        OldSQLVar := FIBXSQLVAR;
2830 +        FIBXSQLVAR := Column[i];
2831 +        try
2832 +          inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2833 +        finally
2834 +          FIBXSQLVAR := OldSQLVar;
2835 +        end;
2836 +      end;
2837 +  end;
2838 + end;
2839 +
2840 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2841 + var i: integer;
2842 +    OldSQLVar: TSQLVarData;
2843 + begin
2844 +  if FIBXSQLVAR.UniqueName then
2845 +    inherited SetAsTime(AValue,OnDate,aTimeZone)
2846 +  else
2847 +  with FIBXSQLVAR.Parent do
2848 +  begin
2849 +    for i := 0 to Count - 1 do
2850 +      if Column[i].Name = Name then
2851 +      begin
2852 +        OldSQLVar := FIBXSQLVAR;
2853 +        FIBXSQLVAR := Column[i];
2854 +        try
2855 +          inherited SetAsTime(AValue,OnDate,aTimeZone);
2856 +        finally
2857 +          FIBXSQLVAR := OldSQLVar;
2858 +        end;
2859 +      end;
2860 +  end;
2861 + end;
2862 +
2863 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2864 + begin
2865 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2866 + end;
2867 +
2868 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2869 + begin
2870 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2871 + end;
2872 +
2873   procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2874   var i: integer;
2875      OldSQLVar: TSQLVarData;
# Line 2157 | Line 2893 | begin
2893    end;
2894   end;
2895  
2896 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2897 +  );
2898 + var i: integer;
2899 +    OldSQLVar: TSQLVarData;
2900 + begin
2901 +  if FIBXSQLVAR.UniqueName then
2902 +    inherited SetAsDateTime(AValue,aTimeZoneID)
2903 +  else
2904 +  with FIBXSQLVAR.Parent do
2905 +  begin
2906 +    for i := 0 to Count - 1 do
2907 +      if Column[i].Name = Name then
2908 +      begin
2909 +        OldSQLVar := FIBXSQLVAR;
2910 +        FIBXSQLVAR := Column[i];
2911 +        try
2912 +          inherited SetAsDateTime(AValue,aTimeZoneID);
2913 +        finally
2914 +          FIBXSQLVAR := OldSQLVar;
2915 +        end;
2916 +      end;
2917 +  end;
2918 + end;
2919 +
2920 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2921 + var i: integer;
2922 +    OldSQLVar: TSQLVarData;
2923 + begin
2924 +  if FIBXSQLVAR.UniqueName then
2925 +    inherited SetAsDateTime(AValue,aTimeZone)
2926 +  else
2927 +  with FIBXSQLVAR.Parent do
2928 +  begin
2929 +    for i := 0 to Count - 1 do
2930 +      if Column[i].Name = Name then
2931 +      begin
2932 +        OldSQLVar := FIBXSQLVAR;
2933 +        FIBXSQLVAR := Column[i];
2934 +        try
2935 +          inherited SetAsDateTime(AValue,aTimeZone);
2936 +        finally
2937 +          FIBXSQLVAR := OldSQLVar;
2938 +        end;
2939 +      end;
2940 +  end;
2941 + end;
2942 +
2943   procedure TSQLParam.SetAsDouble(AValue: Double);
2944   var i: integer;
2945      OldSQLVar: TSQLVarData;
# Line 2337 | Line 3120 | begin
3120    FIBXSQLVAR.SetCharSetID(aValue);
3121   end;
3122  
3123 + procedure TSQLParam.SetAsBcd(aValue: tBCD);
3124 + var i: integer;
3125 +    OldSQLVar: TSQLVarData;
3126 + begin
3127 +  if FIBXSQLVAR.UniqueName then
3128 +    inherited SetAsBcd(AValue)
3129 +  else
3130 +  with FIBXSQLVAR.Parent do
3131 +  begin
3132 +    for i := 0 to Count - 1 do
3133 +      if Column[i].Name = Name then
3134 +      begin
3135 +        OldSQLVar := FIBXSQLVAR;
3136 +        FIBXSQLVAR := Column[i];
3137 +        try
3138 +          inherited SetAsBcd(AValue);
3139 +        finally
3140 +          FIBXSQLVAR := OldSQLVar;
3141 +        end;
3142 +      end;
3143 +  end;
3144 + end;
3145 +
3146 + procedure TSQLParam.SetAsNumeric(aValue: IFBNumeric);
3147 + var i: integer;
3148 +    OldSQLVar: TSQLVarData;
3149 + begin
3150 +  if FIBXSQLVAR.UniqueName then
3151 +    inherited SetAsNumeric(AValue)
3152 +  else
3153 +  with FIBXSQLVAR.Parent do
3154 +  begin
3155 +    for i := 0 to Count - 1 do
3156 +      if Column[i].Name = Name then
3157 +      begin
3158 +        OldSQLVar := FIBXSQLVAR;
3159 +        FIBXSQLVAR := Column[i];
3160 +        try
3161 +          inherited SetAsNumeric(AValue);
3162 +        finally
3163 +          FIBXSQLVAR := OldSQLVar;
3164 +        end;
3165 +      end;
3166 +  end;
3167 + end;
3168 +
3169   { TMetaData }
3170  
3171   procedure TMetaData.CheckActive;
# Line 2358 | Line 3187 | end;
3187  
3188   destructor TMetaData.Destroy;
3189   begin
3190 <  (FStatement as TInterfaceOwner).Remove(self);
3190 >  if FStatement <> nil then
3191 >    (FStatement as TInterfaceOwner).Remove(self);
3192    inherited Destroy;
3193   end;
3194  
# Line 2424 | Line 3254 | end;
3254  
3255   destructor TSQLParams.Destroy;
3256   begin
3257 <  (FStatement as TInterfaceOwner).Remove(self);
3257 >  if FStatement <> nil then
3258 >    (FStatement as TInterfaceOwner).Remove(self);
3259    inherited Destroy;
3260   end;
3261  
# Line 2475 | Line 3306 | begin
3306      end;
3307   end;
3308  
3309 + function TSQLParams.GetHasCaseSensitiveParams: Boolean;
3310 + begin
3311 +  Result := FSQLParams.CaseSensitiveParams;
3312 + end;
3313 +
3314 + function TSQLParams.GetStatement: IStatement;
3315 + begin
3316 +  Result := FSQLParams.GetStatement;
3317 + end;
3318 +
3319 + function TSQLParams.GetTransaction: ITransaction;
3320 + begin
3321 +  Result := FSQLParams.GetTransaction;
3322 + end;
3323 +
3324 + function TSQLParams.GetAttachment: IAttachment;
3325 + begin
3326 +  Result := FSQLParams.GetAttachment;
3327 + end;
3328 +
3329 + procedure TSQLParams.Clear;
3330 + var i: integer;
3331 + begin
3332 +  for i := 0 to getCount - 1 do
3333 +    getSQLParam(i).Clear;
3334 + end;
3335 +
3336   { TResults }
3337  
3338   procedure TResults.CheckActive;
# Line 2487 | Line 3345 | begin
3345    if not FResults.CheckStatementStatus(ssPrepared)  then
3346      IBError(ibxeStatementNotPrepared, [nil]);
3347  
3348 <  with GetTransaction as TFBTransaction do
3348 >  with GetTransaction do
3349    if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3350      IBError(ibxeInterfaceOutofDate,[nil]);
3351   end;
3352  
3353   function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
3354 + var col: TIBSQLData;
3355   begin
3356    if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
3357      IBError(ibxeInvalidColumnIndex,[nil]);
3358  
3359    if not HasInterface(aIBXSQLVAR.Index) then
3360 <    AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3361 <  Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3360 >  begin
3361 >    col := TIBSQLData.Create(self,aIBXSQLVAR);
3362 >    AddInterface(aIBXSQLVAR.Index, col);
3363 >  end
3364 >  else
3365 >    col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3366 >  Result := col;
3367   end;
3368  
3369   constructor TResults.Create(aResults: TSQLDataArea);
# Line 2556 | Line 3420 | begin
3420    FResults.GetData(index,IsNull, len,data);
3421   end;
3422  
3423 + function TResults.GetStatement: IStatement;
3424 + begin
3425 +  Result := FStatement;
3426 + end;
3427 +
3428   function TResults.GetTransaction: ITransaction;
3429   begin
3430 <  Result := FStatement.GetTransaction;
3430 >  Result := FResults.GetTransaction;
3431 > end;
3432 >
3433 > function TResults.GetAttachment: IAttachment;
3434 > begin
3435 >  Result := FResults.GetAttachment;
3436   end;
3437  
3438   procedure TResults.SetRetainInterfaces(aValue: boolean);

Comparing:
ibx/trunk/fbintf/client/FBSQLData.pas (property svn:eol-style), Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (property svn:eol-style), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines