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 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

# Line 60 | Line 60
60   {                                                                        }
61   {************************************************************************}
62   unit FBSQLData;
63 + {$IFDEF MSWINDOWS}
64 + {$DEFINE WINDOWS}
65 + {$ENDIF}
66  
67   {$IFDEF FPC}
68 < {$mode objfpc}{$H+}
68 > {$mode delphi}
69   {$codepage UTF8}
70   {$interfaces COM}
71   {$ENDIF}
# Line 73 | 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  
76 { $define ALLOWDIALECT3PARAMNAMES}
77
78 {$ifndef ALLOWDIALECT3PARAMNAMES}
79
80 { Note on SQL Dialects and SQL Parameter Names
81  --------------------------------------------
82
83  Even when dialect 3 quoted format parameter names are not supported, IBX still processes
84  parameter names case insensitive. This does result in some additional overhead
85  due to a call to "AnsiUpperCase". This can be avoided by undefining
86  "UseCaseInSensitiveParamName" below.
87
88  Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
89  is defined. This will not give a useful result.
90 }
91 {$define UseCaseInSensitiveParamName}
92 {$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 +     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: String); virtual;
145 <     function SQLData: PChar; virtual; abstract;
144 >     procedure InternalSetAsString(Value: AnsiString); virtual;
145 >     function SQLData: PByte; virtual; abstract;
146       function GetDataLength: cardinal; virtual; abstract;
147       function GetCodePage: TSystemCodePage; virtual; abstract;
148       function getCharSetID: cardinal; virtual; abstract;
149 <     function Transliterate(s: string; CodePage: TSystemCodePage): RawByteString;
149 >     function Transliterate(s: AnsiString; CodePage: TSystemCodePage): RawByteString;
150       procedure SetScale(aValue: integer); virtual;
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: string; overload;
159 <     class function GetSQLTypeName(SQLType: short): string; overload;
160 <     function GetName: string; 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;
177       function GetAsPointer: Pointer;
178       function GetAsQuad: TISC_QUAD;
179       function GetAsShort: short;
180 <     function GetAsString: String; virtual;
180 >     function GetAsString: AnsiString; virtual;
181       function GetIsNull: Boolean; virtual;
182 <     function getIsNullable: boolean; virtual;
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);
204       procedure SetAsQuad(Value: TISC_QUAD);
205       procedure SetAsShort(Value: short); virtual;
206 <     procedure SetAsString(Value: String); virtual;
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: string); virtual;
212 >     procedure SetName(aValue: AnsiString); virtual;
213       property AsDate: TDateTime read GetAsDateTime write SetAsDate;
214       property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
215       property AsTime: TDateTime read GetAsDateTime write SetAsTime;
# Line 175 | Line 223 | type
223       property AsPointer: Pointer read GetAsPointer write SetAsPointer;
224       property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
225       property AsShort: short read GetAsShort write SetAsShort;
226 <     property AsString: String read GetAsString write SetAsString;
226 >     property AsString: AnsiString read GetAsString write SetAsString;
227       property AsVariant: Variant read GetAsVariant write SetAsVariant;
228       property Modified: Boolean read getModified;
229       property IsNull: Boolean read GetIsNull write SetIsNull;
# Line 192 | Line 240 | type
240  
241    TSQLDataArea = class
242    private
243 +    FCaseSensitiveParams: boolean;
244      function GetColumn(index: integer): TSQLVarData;
245      function GetCount: integer;
246    protected
247 <    FUniqueRelationName: string;
247 >    FUniqueRelationName: AnsiString;
248      FColumnList: array of TSQLVarData;
249      function GetStatement: IStatement; virtual; abstract;
250      function GetPrepareSeqNo: integer; virtual; abstract;
# Line 205 | Line 254 | type
254    public
255      procedure Initialize; virtual;
256      function IsInputDataArea: boolean; virtual; abstract; {Input to Database}
257 <    procedure PreprocessSQL(sSQL: string; GenerateParamNames: boolean;
258 <      var sProcessedSQL: string);
257 >    procedure PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
258 >      var sProcessedSQL: AnsiString);
259      function ColumnsInUseCount: integer; virtual;
260 <    function ColumnByName(Idx: string): TSQLVarData;
260 >    function ColumnByName(Idx: AnsiString): TSQLVarData;
261      function CheckStatementStatus(Request: TStatementStatus): boolean; virtual; abstract;
262      procedure GetData(index: integer; var IsNull: boolean; var len: short;
263 <      var data: PChar); virtual;
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: string read FUniqueRelationName;
270 >    property UniqueRelationName: AnsiString read FUniqueRelationName;
271      property Statement: IStatement read GetStatement;
272      property PrepareSeqNo: integer read GetPrepareSeqNo;
273      property TransactionSeqNo: integer read GetTransactionSeqNo;
# Line 227 | Line 278 | type
278    TSQLVarData = class
279    private
280      FParent: TSQLDataArea;
281 <    FName: string;
281 >    FName: AnsiString;
282      FIndex: integer;
283      FModified: boolean;
284      FUniqueName: boolean;
285      FVarString: RawByteString;
286      function GetStatement: IStatement;
287 <    procedure SetName(AValue: string);
287 >    procedure SetName(AValue: AnsiString);
288    protected
289      function GetSQLType: cardinal; virtual; abstract;
290      function GetSubtype: integer; virtual; abstract;
291 <    function GetAliasName: string;  virtual; abstract;
292 <    function GetFieldName: string; virtual; abstract;
293 <    function GetOwnerName: string;  virtual; abstract;
294 <    function GetRelationName: string;  virtual; abstract;
291 >    function GetAliasName: AnsiString;  virtual; abstract;
292 >    function GetFieldName: AnsiString; virtual; abstract;
293 >    function GetOwnerName: AnsiString;  virtual; abstract;
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: PChar;  virtual; abstract;
302 <    function GetDataLength: cardinal; virtual; abstract;
301 >    function GetSQLData: PByte;  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: PChar; len: cardinal); virtual; abstract;
306 >    procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
307      procedure SetScale(aValue: integer); virtual; abstract;
308      procedure SetDataLength(len: cardinal); virtual; abstract;
309      procedure SetSQLType(aValue: cardinal); virtual; abstract;
310      procedure SetCharSetID(aValue: cardinal); virtual; abstract;
311    public
312      constructor Create(aParent: TSQLDataArea; aIndex: integer);
313 <    procedure SetString(aValue: string);
313 >    procedure SetString(aValue: AnsiString);
314      procedure Changed; virtual;
315      procedure RowChange; virtual;
316      function GetAsArray(Array_ID: TISC_QUAD): IArray; virtual; abstract;
# Line 268 | Line 321 | type
321      procedure Initialize; virtual;
322  
323    public
324 <    property AliasName: string read GetAliasName;
325 <    property FieldName: string read GetFieldName;
326 <    property OwnerName: string read GetOwnerName;
327 <    property RelationName: string read GetRelationName;
324 >    property AliasName: AnsiString read GetAliasName;
325 >    property FieldName: AnsiString read GetFieldName;
326 >    property OwnerName: AnsiString read GetOwnerName;
327 >    property RelationName: AnsiString read GetRelationName;
328      property Parent: TSQLDataArea read FParent;
329      property Index: integer read FIndex;
330 <    property Name: string read FName write SetName;
330 >    property Name: AnsiString read FName write SetName;
331      property CharSetID: cardinal read GetCharSetID write SetCharSetID;
332      property SQLType: cardinal read GetSQLType write SetSQLType;
333      property SQLSubtype: integer read GetSubtype;
334 <    property SQLData: PChar read GetSQLData;
334 >    property SQLData: PByte read GetSQLData;
335      property DataLength: cardinal read GetDataLength write SetDataLength;
336      property IsNull: Boolean read GetIsNull write SetIsNull;
337      property IsNullable: Boolean read GetIsNullable write SetIsNullable;
# Line 296 | Line 349 | type
349      FIBXSQLVAR: TSQLVarData;
350      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
351      FPrepareSeqNo: integer;
299    FStatement: IStatement;
352      FChangeSeqNo: integer;
353    protected
354      procedure CheckActive; override;
355 <    function SQLData: PChar; override;
355 >    function GetAttachment: IAttachment; override;
356 >    function SQLData: PByte; override;
357      function GetDataLength: cardinal; override;
358      function GetCodePage: TSystemCodePage; override;
359  
# Line 308 | Line 361 | type
361      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
362      destructor Destroy; override;
363      function GetSQLDialect: integer; override;
311    property Statement: IStatement read FStatement;
364  
365    public
366      {IColumnMetaData}
367      function GetIndex: integer;
368      function GetSQLType: cardinal; override;
369      function getSubtype: integer;
370 <    function getRelationName: string;
371 <    function getOwnerName: string;
372 <    function getSQLName: string;    {Name of the column}
373 <    function getAliasName: string;  {Alias Name of column or Column Name if not alias}
374 <    function GetName: string; override;      {Disambiguated uppercase Field Name}
370 >    function getRelationName: AnsiString;
371 >    function getOwnerName: AnsiString;
372 >    function getSQLName: AnsiString;    {Name of the column}
373 >    function getAliasName: AnsiString;  {Alias Name of column or Column Name if not alias}
374 >    function GetName: AnsiString; override;      {Disambiguated uppercase Field Name}
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 <    property Name: string read GetName;
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;
405      function GetAsBlob(BPB: IBPB): IBlob; overload;
406 <    function GetAsString: String; override;
406 >    function GetAsString: AnsiString; override;
407      property AsBlob: IBlob read GetAsBlob;
408   end;
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;
416 <    procedure InternalSetAsString(Value: String); override;
416 >    procedure InternalSetAsString(Value: AnsiString); override;
417      procedure SetScale(aValue: integer); override;
418      procedure SetDataLength(len: cardinal); override;
419      procedure SetSQLType(aValue: cardinal); override;
# Line 361 | Line 421 | type
421      procedure Clear;
422      function GetModified: boolean; override;
423      function GetAsPointer: Pointer;
424 <    procedure SetName(Value: string); override;
424 >    procedure SetName(Value: AnsiString); override;
425      procedure SetIsNull(Value: Boolean);  override;
426      procedure SetIsNullable(Value: Boolean); override;
427      procedure SetAsArray(anArray: IArray);
# Line 372 | 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);
446      procedure SetAsShort(AValue: Short);
447 <    procedure SetAsString(AValue: String); override;
447 >    procedure SetAsString(AValue: AnsiString); override;
448      procedure SetAsVariant(AValue: Variant);
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 401 | Line 468 | type
468      destructor Destroy; override;
469    public
470      {IMetaData}
471 <    function GetUniqueRelationName: string;
471 >    function GetUniqueRelationName: AnsiString;
472      function getCount: integer;
473      function getColumnMetaData(index: integer): IColumnMetaData;
474 <    function ByName(Idx: String): IColumnMetaData;
474 >    function ByName(Idx: AnsiString): IColumnMetaData;
475    end;
476  
477    { TSQLParams }
# Line 423 | Line 490 | type
490      {ISQLParams}
491      function getCount: integer;
492      function getSQLParam(index: integer): ISQLParam;
493 <    function ByName(Idx: String): ISQLParam ;
493 >    function ByName(Idx: AnsiString): ISQLParam ;
494      function GetModified: Boolean;
495 +    function GetHasCaseSensitiveParams: Boolean;
496    end;
497  
498    { TResults }
# Line 443 | Line 511 | type
511       constructor Create(aResults: TSQLDataArea);
512        {IResults}
513       function getCount: integer;
514 <     function ByName(Idx: String): ISQLData;
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: PChar);
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, FBClientAPI, variants, IBUtils, FBTransaction;
524 > uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
525  
526   { TSQLDataArea }
527  
# Line 472 | Line 541 | procedure TSQLDataArea.SetUniqueRelation
541   var
542    i: Integer;
543    bUnique: Boolean;
544 <  RelationName: string;
544 >  RelationName: AnsiString;
545   begin
546    bUnique := True;
547    for i := 0 to ColumnsInUseCount - 1 do
# Line 503 | Line 572 | begin
572      Column[i].Initialize;
573   end;
574  
575 < procedure TSQLDataArea.PreprocessSQL(sSQL: string; GenerateParamNames: boolean;
576 <  var sProcessedSQL: string);
508 < var
509 <  cCurChar, cNextChar, cQuoteChar: Char;
510 <  sParamName: String;
511 <  j, i, iLenSQL, iSQLPos: Integer;
512 <  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
513 <  iParamSuffix: Integer;
514 <  slNames: TStrings;
515 <  StrBuffer: PChar;
516 <  found: boolean;
517 <
518 < const
519 <  DefaultState = 0;
520 <  CommentState = 1;
521 <  QuoteState = 2;
522 <  ParamState = 3;
523 <  ArrayDimState = 4;
524 < {$ifdef ALLOWDIALECT3PARAMNAMES}
525 <  ParamDefaultState = 0;
526 <  ParamQuoteState = 1;
527 <  {$endif}
575 > procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
576 >  var sProcessedSQL: AnsiString);
577  
578 <  procedure AddToProcessedSQL(cChar: Char);
530 <  begin
531 <    StrBuffer[iSQLPos] := cChar;
532 <    Inc(iSQLPos);
533 <  end;
578 > var slNames: TStrings;
579  
580 < begin
581 <  if not IsInputDataArea then
582 <    IBError(ibxeNotPermitted,[nil]);
583 <
584 <  sParamName := '';
540 <  iLenSQL := Length(sSQL);
541 <  GetMem(StrBuffer,iLenSQL + 1);
542 <  slNames := TStringList.Create;
543 <  try
544 <    { Do some initializations of variables }
545 <    iParamSuffix := 0;
546 <    cQuoteChar := '''';
547 <    i := 1;
548 <    iSQLPos := 0;
549 <    iCurState := DefaultState;
550 <    {$ifdef ALLOWDIALECT3PARAMNAMES}
551 <    iCurParamState := ParamDefaultState;
552 <    {$endif}
553 <    { Now, traverse through the SQL string, character by character,
554 <     picking out the parameters and formatting correctly for InterBase }
555 <    while (i <= iLenSQL) do begin
556 <      { Get the current token and a look-ahead }
557 <      cCurChar := sSQL[i];
558 <      if i = iLenSQL then
559 <        cNextChar := #0
560 <      else
561 <        cNextChar := sSQL[i + 1];
562 <      { Now act based on the current state }
563 <      case iCurState of
564 <        DefaultState:
565 <        begin
566 <          case cCurChar of
567 <            '''', '"':
568 <            begin
569 <              cQuoteChar := cCurChar;
570 <              iCurState := QuoteState;
571 <            end;
572 <            '?', ':':
573 <            begin
574 <              iCurState := ParamState;
575 <              AddToProcessedSQL('?');
576 <            end;
577 <            '/': if (cNextChar = '*') then
578 <            begin
579 <              AddToProcessedSQL(cCurChar);
580 <              Inc(i);
581 <              iCurState := CommentState;
582 <            end;
583 <            '[':
584 <            begin
585 <              AddToProcessedSQL(cCurChar);
586 <              Inc(i);
587 <              iCurState := ArrayDimState;
588 <            end;
589 <          end;
590 <        end;
591 <
592 <        ArrayDimState:
593 <        begin
594 <          case cCurChar of
595 <          ':',',','0'..'9',' ',#9,#10,#13:
596 <            begin
597 <              AddToProcessedSQL(cCurChar);
598 <              Inc(i);
599 <            end;
600 <          else
601 <            begin
602 <              AddToProcessedSQL(cCurChar);
603 <              Inc(i);
604 <              iCurState := DefaultState;
605 <            end;
606 <          end;
607 <        end;
608 <
609 <        CommentState:
610 <        begin
611 <          if (cNextChar = #0) then
612 <            IBError(ibxeSQLParseError, [SEOFInComment])
613 <          else if (cCurChar = '*') then begin
614 <            if (cNextChar = '/') then
615 <              iCurState := DefaultState;
616 <          end;
617 <        end;
618 <        QuoteState: begin
619 <          if cNextChar = #0 then
620 <            IBError(ibxeSQLParseError, [SEOFInString])
621 <          else if (cCurChar = cQuoteChar) then begin
622 <            if (cNextChar = cQuoteChar) then begin
623 <              AddToProcessedSQL(cCurChar);
624 <              Inc(i);
625 <            end else
626 <              iCurState := DefaultState;
627 <          end;
628 <        end;
629 <        ParamState:
630 <        begin
631 <          { collect the name of the parameter }
632 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
633 <          if iCurParamState = ParamDefaultState then
634 <          begin
635 <            if cCurChar = '"' then
636 <              iCurParamState := ParamQuoteState
637 <            else
638 <            {$endif}
639 <            if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
640 <                sParamName := sParamName + cCurChar
641 <            else if GenerateParamNames then
642 <            begin
643 <              sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
644 <              Inc(iParamSuffix);
645 <              iCurState := DefaultState;
646 <              slNames.AddObject(sParamName,self); //Note local convention
647 <                                                  //add pointer to self to mark entry
648 <              sParamName := '';
649 <            end
650 <            else
651 <              IBError(ibxeSQLParseError, [SParamNameExpected]);
652 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
653 <          end
654 <          else begin
655 <            { determine if Quoted parameter name is finished }
656 <            if cCurChar = '"' then
657 <            begin
658 <              Inc(i);
659 <              slNames.Add(sParamName);
660 <              SParamName := '';
661 <              iCurParamState := ParamDefaultState;
662 <              iCurState := DefaultState;
663 <            end
664 <            else
665 <              sParamName := sParamName + cCurChar
666 <          end;
667 <          {$endif}
668 <          { determine if the unquoted parameter name is finished }
669 <          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
670 <            (iCurState <> DefaultState) then
671 <          begin
672 <            if not (cNextChar in ['A'..'Z', 'a'..'z',
673 <                                  '0'..'9', '_', '$']) then begin
674 <              Inc(i);
675 <              iCurState := DefaultState;
676 <              slNames.Add(sParamName);
677 <              sParamName := '';
678 <            end;
679 <          end;
680 <        end;
681 <      end;
682 <      if (iCurState <> ParamState) and (i <= iLenSQL) then
683 <        AddToProcessedSQL(sSQL[i]);
684 <      Inc(i);
685 <    end;
686 <    AddToProcessedSQL(#0);
687 <    sProcessedSQL := strpas(StrBuffer);
580 >  procedure SetColumnNames(slNames: TStrings);
581 >  var i, j: integer;
582 >      found: boolean;
583 >  begin
584 >    found := false;
585      SetCount(slNames.Count);
586      for i := 0 to slNames.Count - 1 do
587      begin
# Line 705 | Line 602 | begin
602          Column[i].UniqueName := not found;
603        end;
604      end;
605 +  end;
606 +
607 + begin
608 +  if not IsInputDataArea then
609 +    IBError(ibxeNotPermitted,[nil]);
610 +
611 +  slNames := TStringList.Create;
612 +  try
613 +    sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
614 +    SetColumnNames(slNames);
615    finally
616      slNames.Free;
710    FreeMem(StrBuffer);
617    end;
618   end;
619  
# Line 716 | Line 622 | begin
622    Result := Count;
623   end;
624  
625 < function TSQLDataArea.ColumnByName(Idx: string): TSQLVarData;
625 > function TSQLDataArea.ColumnByName(Idx: AnsiString): TSQLVarData;
626   var
627 <  s: String;
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 736 | Line 642 | begin
642   end;
643  
644   procedure TSQLDataArea.GetData(index: integer; var IsNull: boolean;
645 <  var len: short; var data: PChar);
645 >  var len: short; var data: PByte);
646   begin
647    //Do Nothing
648   end;
# Line 755 | Line 661 | begin
661    Result := FParent.Statement;
662   end;
663  
664 < procedure TSQLVarData.SetName(AValue: string);
664 > procedure TSQLVarData.SetName(AValue: AnsiString);
665   begin
666 <  if FName = AValue then Exit;
761 <  {$ifdef UseCaseInSensitiveParamName}
762 <  if Parent.IsInputDataArea then
666 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
667      FName := AnsiUpperCase(AValue)
668    else
765  {$endif}
669      FName := AValue;
670   end;
671  
# Line 774 | Line 677 | begin
677    FUniqueName := true;
678   end;
679  
680 < procedure TSQLVarData.SetString(aValue: string);
680 > procedure TSQLVarData.SetString(aValue: AnsiString);
681   begin
682    {we take full advantage here of reference counted strings. When setting a string
683     value, a reference is kept in FVarString and a pointer to it placed in the
684 <   SQLVar. This avoids string copies. Note that PChar is guaranteed to point to
684 >   SQLVar. This avoids string copies. Note that PAnsiChar is guaranteed to point to
685     a zero byte when the string is empty, neatly avoiding a nil pointer error.}
686  
687    FVarString := aValue;
688    SQLType := SQL_TEXT;
689 <  SetSQLData(PChar(FVarString),Length(aValue));
689 >  Scale := 0;
690 >  SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
691   end;
692  
693   procedure TSQLVarData.Changed;
# Line 799 | Line 703 | end;
703  
704   procedure TSQLVarData.Initialize;
705  
706 <  function FindVarByName(idx: string; limit: integer): TSQLVarData;
706 >  function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
707    var
708      k: integer;
709    begin
# Line 814 | Line 718 | procedure TSQLVarData.Initialize;
718  
719   var
720    j, j_len: Integer;
721 <  st: String;
722 <  sBaseName: string;
721 >  st: AnsiString;
722 >  sBaseName: AnsiString;
723   begin
724    RowChange;
725  
# Line 902 | Line 806 | function TSQLDataItem.AdjustScaleToCurre
806   var
807    Scaling : Int64;
808    i : Integer;
809 <  FractionText, PadText, CurrText: string;
809 >  FractionText, PadText, CurrText: AnsiString;
810   begin
811    Result := 0;
812    Scaling := 1;
# Line 921 | Line 825 | begin
825        FractionText := IntToStr(abs(Value mod Scaling));
826        for i := Length(FractionText) to -aScale -1 do
827          PadText := '0' + PadText;
828 +      {$IF declared(DefaultFormatSettings)}
829 +      with DefaultFormatSettings do
830 +      {$ELSE}
831 +      {$IF declared(FormatSettings)}
832 +      with FormatSettings do
833 +      {$IFEND}
834 +      {$IFEND}
835        if Value < 0 then
836 <        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DefaultFormatSettings.DecimalSeparator + PadText + FractionText
836 >        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
837        else
838 <        CurrText := IntToStr(Abs(Value div Scaling)) + DefaultFormatSettings.DecimalSeparator + PadText + FractionText;
838 >        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
839        try
840          result := StrToCurr(CurrText);
841        except
# Line 936 | 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 996 | 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 1006 | Line 1026 | begin
1026    //Do nothing by default
1027   end;
1028  
1029 < procedure TSQLDataItem.InternalSetAsString(Value: String);
1029 > procedure TSQLDataItem.InternalSetAsString(Value: AnsiString);
1030   begin
1031    //Do nothing by default
1032   end;
1033  
1034 < function TSQLDataItem.Transliterate(s: string; CodePage: TSystemCodePage
1034 > function TSQLDataItem.Transliterate(s: AnsiString; CodePage: TSystemCodePage
1035    ): RawByteString;
1036   begin
1037    Result := s;
# Line 1034 | Line 1054 | begin
1054     //Do nothing by default
1055   end;
1056  
1057 < function TSQLDataItem.GetSQLTypeName: string;
1057 > constructor TSQLDataItem.Create(api: TFBClientAPI);
1058 > begin
1059 >  inherited Create;
1060 >  FFirebirdClientAPI := api;
1061 > end;
1062 >
1063 > function TSQLDataItem.GetSQLTypeName: AnsiString;
1064   begin
1065    Result := GetSQLTypeName(GetSQLType);
1066   end;
1067  
1068 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): string;
1068 > class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1069   begin
1070    Result := 'Unknown';
1071    case SQLType of
# Line 1050 | 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 1057 | 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 1100 | 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 1136 | 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 FirebirdClientAPI do
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 1185 | 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 1230 | 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 1269 | 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 TSQLDataItem.GetAsString: String;
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: PChar;
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 := '';
1495    { Check null, if so return a default string }
1496    if not IsNull then
1497 <  with FirebirdClientAPI do
1497 >  with FFirebirdClientAPI do
1498      case SQLType of
1499        SQL_BOOLEAN:
1500          if AsBoolean then
# Line 1292 | 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, sz, str_len);
1519 >        SetString(rs, PAnsiChar(sz), str_len);
1520          SetCodePage(rs,GetCodePage,false);
1521 <        if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1303 <          Result := TrimRight(rs)
1304 <        else
1305 <          Result := rs
1521 >        Result := rs;
1522        end;
1523 +
1524        SQL_TYPE_DATE:
1525 <        case GetSQLDialect of
1309 <          1 : result := DateTimeToStr(AsDateTime);
1310 <          3 : result := DateToStr(AsDateTime);
1311 <        end;
1312 <      SQL_TYPE_TIME :
1313 <        result := TimeToStr(AsDateTime);
1525 >        Result := DateToStr(GetAsDateTime);
1526        SQL_TIMESTAMP:
1527 <        result := FormatDateTime(FormatSettings.ShortDateFormat + ' ' +
1528 <                            FormatSettings.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 1330 | 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 1341 | 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 1361 | 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 1379 | 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 1389 | 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 1400 | Line 1715 | begin
1715    //ignore unless overridden
1716   end;
1717  
1718 < procedure TSQLDataItem.SetName(aValue: string);
1718 > procedure TSQLDataItem.SetName(aValue: AnsiString);
1719   begin
1720    //ignore unless overridden
1721   end;
# Line 1452 | Line 1767 | begin
1767  
1768    SQLType := SQL_TYPE_DATE;
1769    DataLength := SizeOf(ISC_DATE);
1770 <  with FirebirdClientAPI do
1770 >  with FFirebirdClientAPI do
1771      SQLEncodeDate(Value,SQLData);
1772    Changed;
1773   end;
# Line 1472 | Line 1787 | begin
1787  
1788    SQLType := SQL_TYPE_TIME;
1789    DataLength := SizeOf(ISC_TIME);
1790 <  with FirebirdClientAPI do
1790 >  with FFirebirdClientAPI do
1791      SQLEncodeTime(Value,SQLData);
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 1486 | Line 1841 | begin
1841    Changing;
1842    SQLType := SQL_TIMESTAMP;
1843    DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1844 <  with FirebirdClientAPI do
1844 >  with FFirebirdClientAPI do
1845      SQLEncodeDateTime(Value,SQLData);
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 1576 | Line 1966 | begin
1966    Changed;
1967   end;
1968  
1969 < procedure TSQLDataItem.SetAsString(Value: String);
1969 > procedure TSQLDataItem.SetAsString(Value: AnsiString);
1970   begin
1971    InternalSetAsString(Value);
1972   end;
# Line 1586 | 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 1608 | 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  
2012 + procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
2013 + begin
2014 +  CheckActive;
2015 +  Changing;
2016 +  if IsNullable then
2017 +    IsNull := False;
2018 +
2019 +  SQLType := SQL_INT64;
2020 +  Scale := aScale;
2021 +  DataLength := SizeOf(Int64);
2022 +  PInt64(SQLData)^ := Value;
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 1641 | Line 2098 | begin
2098      IBError(ibxeStatementNotPrepared, [nil]);
2099   end;
2100  
2101 < function TColumnMetaData.SQLData: PChar;
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;
2109   end;
# Line 1658 | Line 2120 | end;
2120  
2121   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2122   begin
2123 <  inherited Create;
2123 >  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
2124    FIBXSQLVAR := aIBXSQLVAR;
2125    FOwner := aOwner;
2126    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 1694 | Line 2156 | begin
2156    result := FIBXSQLVAR.SQLSubtype;
2157   end;
2158  
2159 < function TColumnMetaData.getRelationName: string;
2159 > function TColumnMetaData.getRelationName: AnsiString;
2160   begin
2161    CheckActive;
2162     result :=  FIBXSQLVAR.RelationName;
2163   end;
2164  
2165 < function TColumnMetaData.getOwnerName: string;
2165 > function TColumnMetaData.getOwnerName: AnsiString;
2166   begin
2167    CheckActive;
2168    result :=  FIBXSQLVAR.OwnerName;
2169   end;
2170  
2171 < function TColumnMetaData.getSQLName: string;
2171 > function TColumnMetaData.getSQLName: AnsiString;
2172   begin
2173    CheckActive;
2174    result :=  FIBXSQLVAR.FieldName;
2175   end;
2176  
2177 < function TColumnMetaData.getAliasName: string;
2177 > function TColumnMetaData.getAliasName: AnsiString;
2178   begin
2179    CheckActive;
2180    result := FIBXSQLVAR.AliasName;
2181   end;
2182  
2183 < function TColumnMetaData.GetName: string;
2183 > function TColumnMetaData.GetName: AnsiString;
2184   begin
2185    CheckActive;
2186    Result := FIBXSQLVAR. Name;
# Line 1745 | 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 1760 | 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 1779 | 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 1803 | Line 2289 | begin
2289    result := FIBXSQLVAR.GetAsBlob(AsQuad,BPB);
2290   end;
2291  
2292 < function TIBSQLData.GetAsString: String;
2292 > function TIBSQLData.GetAsString: AnsiString;
2293   begin
2294    CheckActive;
2295    Result := '';
# Line 1821 | Line 2307 | end;
2307  
2308   { TSQLParam }
2309  
2310 < procedure TSQLParam.InternalSetAsString(Value: String);
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 CompareText(Value,STrue) = 0 then
2331 >    if AnsiCompareText(Value,STrue) = 0 then
2332        AsBoolean := true
2333      else
2334 <    if CompareText(Value,SFalse) = 0 then
2334 >    if AnsiCompareText(Value,SFalse) = 0 then
2335        AsBoolean := false
2336      else
2337        IBError(ibxeInvalidDataConversion,[nil]);
# Line 1848 | Line 2347 | begin
2347  
2348    SQL_VARYING,
2349    SQL_TEXT:
2350 <    begin
1852 <      Changing;
1853 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1854 <      Changed;
1855 <    end;
2350 >    DoSetString;
2351  
2352      SQL_SHORT,
2353      SQL_LONG,
2354      SQL_INT64:
2355 <      SetAsInt64(StrToInt(Value));
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 <      SetAsDateTime(StrToDateTime(Value));
2369 >      if TryStrToDateTime(Value,dt) then
2370 >        SetAsDateTime(dt)
2371 >      else
2372 >        DoSetString;
2373  
2374      SQL_TYPE_DATE:
2375 <      SetAsDate(StrToDateTime(Value));
2375 >      if TryStrToDateTime(Value,dt) then
2376 >        SetAsDate(dt)
2377 >      else
2378 >        DoSetString;
2379  
2380      SQL_TYPE_TIME:
2381 <      SetAsTime(StrToDateTime(Value));
2381 >      if TryStrToDateTime(Value,dt) then
2382 >        SetAsTime(dt)
2383 >      else
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 1925 | Line 2453 | begin
2453    Result := inherited GetAsPointer;
2454   end;
2455  
2456 < procedure TSQLParam.SetName(Value: string);
2456 > procedure TSQLParam.SetName(Value: AnsiString);
2457   begin
2458    CheckActive;
2459    FIBXSQLVAR.Name := Value;
# Line 2116 | 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 2139 | 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 2231 | Line 2862 | begin
2862    end;
2863   end;
2864  
2865 < procedure TSQLParam.SetAsString(AValue: String);
2865 > procedure TSQLParam.SetAsString(AValue: AnsiString);
2866   var i: integer;
2867      OldSQLVar: TSQLVarData;
2868   begin
# Line 2319 | 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 2344 | Line 2998 | begin
2998    inherited Destroy;
2999   end;
3000  
3001 < function TMetaData.GetUniqueRelationName: string;
3001 > function TMetaData.GetUniqueRelationName: AnsiString;
3002   begin
3003    CheckActive;
3004    Result := FMetaData.UniqueRelationName;
# Line 2372 | Line 3026 | begin
3026    end;
3027   end;
3028  
3029 < function TMetaData.ByName(Idx: String): IColumnMetaData;
3029 > function TMetaData.ByName(Idx: AnsiString): IColumnMetaData;
3030   var aIBXSQLVAR: TSQLVarData;
3031   begin
3032    CheckActive;
# Line 2432 | Line 3086 | begin
3086    end;
3087   end;
3088  
3089 < function TSQLParams.ByName(Idx: String): ISQLParam;
3089 > function TSQLParams.ByName(Idx: AnsiString): ISQLParam;
3090   var aIBXSQLVAR: TSQLVarData;
3091   begin
3092    CheckActive;
# Line 2457 | 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 2469 | 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 2500 | Line 3162 | begin
3162    Result := FResults.Count;
3163   end;
3164  
3165 < function TResults.ByName(Idx: String): ISQLData;
3165 > function TResults.ByName(Idx: AnsiString): ISQLData;
3166   var col: TSQLVarData;
3167   begin
3168    Result := nil;
# Line 2532 | Line 3194 | begin
3194   end;
3195  
3196   procedure TResults.GetData(index: integer; var IsNull: boolean; var len: short;
3197 <  var data: PChar);
3197 >  var data: PByte);
3198   begin
3199    CheckActive;
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;
# Line 2548 | Line 3215 | begin
3215    RetainInterfaces := aValue;
3216   end;
3217  
2551
3218   end.
3219  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines