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.
Revision 353 by tony, Sat Oct 23 14:11:37 2021 UTC

# Line 76 | Line 76 | unit FBSQLData;
76    methods are needed for SQL parameters only. The string getters and setters
77    are virtual as SQLVar and Array encodings of string data is different.}
78  
79 { $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 +     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
132       function AdjustScale(Value: Int64; aScale: Integer): Double;
133       function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
134 +     function AdjustScaleToStr(Value: Int64; aScale: Integer): AnsiString;
135       function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
111     procedure SetAsInteger(AValue: Integer);
112  protected
136       function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
137       function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
138       procedure CheckActive; virtual;
139 +     procedure CheckTZSupport;
140 +     function GetAttachment: IAttachment; virtual; abstract;
141       function GetSQLDialect: integer; virtual; abstract;
142 +     function GetTimeZoneServices: IExTimeZoneServices; virtual;
143       procedure Changed; virtual;
144       procedure Changing; virtual;
145       procedure InternalSetAsString(Value: AnsiString); virtual;
# Line 126 | Line 152 | type
152       procedure SetDataLength(len: cardinal); virtual;
153       procedure SetSQLType(aValue: cardinal); virtual;
154       property DataLength: cardinal read GetDataLength write SetDataLength;
155 <
155 >     property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
156    public
157 <     function GetSQLType: cardinal; virtual; abstract;
157 >     constructor Create(api: TFBClientAPI);
158 >     function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
159       function GetSQLTypeName: AnsiString; overload;
160 <     class function GetSQLTypeName(SQLType: short): AnsiString; overload;
160 >     class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
161 >     function GetStrDataLength: short;
162       function GetName: AnsiString; virtual; abstract;
163 <     function GetScale: integer; virtual; abstract;
163 >     function GetScale: integer; virtual; abstract; {Current Field Data scale}
164       function GetAsBoolean: boolean;
165       function GetAsCurrency: Currency;
166       function GetAsInt64: Int64;
167 <     function GetAsDateTime: TDateTime;
167 >     function GetAsDateTime: TDateTime; overload;
168 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
169 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
170 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
171 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
172 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
173 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
174 >     function GetAsUTCDateTime: TDateTime;
175       function GetAsDouble: Double;
176       function GetAsFloat: Float;
177       function GetAsLong: Long;
# Line 145 | Line 180 | type
180       function GetAsShort: short;
181       function GetAsString: AnsiString; virtual;
182       function GetIsNull: Boolean; virtual;
183 <     function getIsNullable: boolean; virtual;
183 >     function GetIsNullable: boolean; virtual;
184       function GetAsVariant: Variant;
185       function GetModified: boolean; virtual;
186 +     function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
187 +     function GetAsBCD: tBCD;
188 +     function GetSize: cardinal; virtual; abstract;
189 +     function GetCharSetWidth: integer; virtual; abstract;
190       procedure SetAsBoolean(AValue: boolean); virtual;
191       procedure SetAsCurrency(Value: Currency); virtual;
192       procedure SetAsInt64(Value: Int64); virtual;
193       procedure SetAsDate(Value: TDateTime); virtual;
194       procedure SetAsLong(Value: Long); virtual;
195 <     procedure SetAsTime(Value: TDateTime); virtual;
196 <     procedure SetAsDateTime(Value: TDateTime);
195 >     procedure SetAsTime(Value: TDateTime); overload;
196 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime;aTimeZoneID: TFBTimeZoneID); overload;
197 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
198 >     procedure SetAsDateTime(Value: TDateTime); overload;
199 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
200 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
201 >     procedure SetAsUTCDateTime(aUTCTime: TDateTime);
202       procedure SetAsDouble(Value: Double); virtual;
203       procedure SetAsFloat(Value: Float); virtual;
204       procedure SetAsPointer(Value: Pointer);
# Line 162 | Line 206 | type
206       procedure SetAsShort(Value: short); virtual;
207       procedure SetAsString(Value: AnsiString); virtual;
208       procedure SetAsVariant(Value: Variant);
209 +     procedure SetAsNumeric(Value: Int64; aScale: integer); virtual;
210 +     procedure SetAsBcd(aValue: tBCD); virtual;
211       procedure SetIsNull(Value: Boolean); virtual;
212       procedure SetIsNullable(Value: Boolean); virtual;
213       procedure SetName(aValue: AnsiString); virtual;
# Line 195 | Line 241 | type
241  
242    TSQLDataArea = class
243    private
244 +    FCaseSensitiveParams: boolean;
245      function GetColumn(index: integer): TSQLVarData;
246      function GetCount: integer;
247    protected
# 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;
272      property UniqueRelationName: AnsiString read FUniqueRelationName;
# Line 235 | Line 285 | type
285      FModified: boolean;
286      FUniqueName: boolean;
287      FVarString: RawByteString;
288 +    FColMetaData: IParamMetaData;
289      function GetStatement: IStatement;
290      procedure SetName(AValue: AnsiString);
291    protected
292 +    function GetAttachment: IAttachment; virtual; abstract;
293      function GetSQLType: cardinal; virtual; abstract;
294      function GetSubtype: integer; virtual; abstract;
295      function GetAliasName: AnsiString;  virtual; abstract;
# Line 246 | Line 298 | type
298      function GetRelationName: AnsiString;  virtual; abstract;
299      function GetScale: integer; virtual; abstract;
300      function GetCharSetID: cardinal; virtual; abstract;
301 +    function GetCharSetWidth: integer; virtual; abstract;
302      function GetCodePage: TSystemCodePage; virtual; abstract;
303      function GetIsNull: Boolean;   virtual; abstract;
304      function GetIsNullable: boolean; virtual; abstract;
305      function GetSQLData: PByte;  virtual; abstract;
306 <    function GetDataLength: cardinal; virtual; abstract;
306 >    function GetDataLength: cardinal; virtual; abstract; {current field length}
307 >    function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
308 >    function GetDefaultTextSQLType: cardinal; virtual; abstract;
309      procedure SetIsNull(Value: Boolean); virtual; abstract;
310      procedure SetIsNullable(Value: Boolean);  virtual; abstract;
311      procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
# Line 258 | Line 313 | type
313      procedure SetDataLength(len: cardinal); virtual; abstract;
314      procedure SetSQLType(aValue: cardinal); virtual; abstract;
315      procedure SetCharSetID(aValue: cardinal); virtual; abstract;
316 +    procedure SetMetaSize(aValue: cardinal); virtual;
317    public
318      constructor Create(aParent: TSQLDataArea; aIndex: integer);
319      procedure SetString(aValue: AnsiString);
# Line 268 | Line 324 | type
324      function CreateBlob: IBlob; virtual; abstract;
325      function GetArrayMetaData: IArrayMetaData; virtual; abstract;
326      function GetBlobMetaData: IBlobMetaData; virtual; abstract;
327 +    function getColMetadata: IParamMetaData;
328      procedure Initialize; virtual;
329 +    procedure SaveMetaData;
330  
331    public
332      property AliasName: AnsiString read GetAliasName;
# Line 299 | Line 357 | type
357      FIBXSQLVAR: TSQLVarData;
358      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
359      FPrepareSeqNo: integer;
302    FStatement: IStatement;
360      FChangeSeqNo: integer;
361    protected
362      procedure CheckActive; override;
363 +    function GetAttachment: IAttachment; override;
364      function SQLData: PByte; override;
365      function GetDataLength: cardinal; override;
366      function GetCodePage: TSystemCodePage; override;
# Line 311 | Line 369 | type
369      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
370      destructor Destroy; override;
371      function GetSQLDialect: integer; override;
314    property Statement: IStatement read FStatement;
372  
373    public
374      {IColumnMetaData}
# Line 326 | Line 383 | type
383      function GetScale: integer; override;
384      function getCharSetID: cardinal; override;
385      function GetIsNullable: boolean; override;
386 <    function GetSize: cardinal;
386 >    function GetSize: cardinal; override;
387 >    function GetCharSetWidth: integer; override;
388      function GetArrayMetaData: IArrayMetaData;
389      function GetBlobMetaData: IBlobMetaData;
390 +    function GetStatement: IStatement;
391 +    function GetTransaction: ITransaction; virtual;
392      property Name: AnsiString read GetName;
393      property Size: cardinal read GetSize;
394      property CharSetID: cardinal read getCharSetID;
395      property SQLSubtype: integer read getSubtype;
396      property IsNullable: Boolean read GetIsNullable;
397 +  public
398 +    property Statement: IStatement read GetStatement;
399    end;
400  
401    { TIBSQLData }
402  
403    TIBSQLData = class(TColumnMetaData,ISQLData)
404 +  private
405 +    FTransaction: ITransaction;
406    protected
407      procedure CheckActive; override;
408    public
409 +    function GetTransaction: ITransaction; override;
410      function GetIsNull: Boolean; override;
411      function GetAsArray: IArray;
412      function GetAsBlob: IBlob; overload;
# Line 350 | Line 415 | type
415      property AsBlob: IBlob read GetAsBlob;
416   end;
417  
418 +  { TSQLParamMetaData }
419 +
420 +  TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
421 +  private
422 +    FSQLType: cardinal;
423 +    FSQLSubType: integer;
424 +    FScale: integer;
425 +    FCharSetID: cardinal;
426 +    FNullable: boolean;
427 +    FSize: cardinal;
428 +    FCodePage: TSystemCodePage;
429 +  public
430 +    constructor Create(src: TSQLVarData);
431 +    {IParamMetaData}
432 +    function GetSQLType: cardinal;
433 +    function GetSQLTypeName: AnsiString;
434 +    function getSubtype: integer;
435 +    function getScale: integer;
436 +    function getCharSetID: cardinal;
437 +    function getCodePage: TSystemCodePage;
438 +    function getIsNullable: boolean;
439 +    function GetSize: cardinal;
440 +    property SQLType: cardinal read GetSQLType;
441 +  end;
442 +
443    { TSQLParam }
444  
445 <  TSQLParam = class(TIBSQLData,ISQLParam)
445 >  TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
446    protected
447      procedure CheckActive; override;
448      procedure Changed; override;
# Line 362 | Line 452 | type
452      procedure SetSQLType(aValue: cardinal); override;
453    public
454      procedure Clear;
455 +    function getColMetadata: IParamMetaData;
456      function GetModified: boolean; override;
457      function GetAsPointer: Pointer;
458 +    function GetAsString: AnsiString; override;
459      procedure SetName(Value: AnsiString); override;
460      procedure SetIsNull(Value: Boolean);  override;
461      procedure SetIsNullable(Value: Boolean); override;
# Line 375 | Line 467 | type
467      procedure SetAsInt64(AValue: Int64);
468      procedure SetAsDate(AValue: TDateTime);
469      procedure SetAsLong(AValue: Long);
470 <    procedure SetAsTime(AValue: TDateTime);
471 <    procedure SetAsDateTime(AValue: TDateTime);
470 >    procedure SetAsTime(AValue: TDateTime); overload;
471 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
472 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
473 >    procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
474 >    procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
475 >    procedure SetAsDateTime(AValue: TDateTime); overload;
476 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
477 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
478      procedure SetAsDouble(AValue: Double);
479      procedure SetAsFloat(AValue: Float);
480      procedure SetAsPointer(AValue: Pointer);
# Line 386 | Line 484 | type
484      procedure SetAsBlob(aValue: IBlob);
485      procedure SetAsQuad(AValue: TISC_QUAD);
486      procedure SetCharSetID(aValue: cardinal);
487 +    procedure SetAsBcd(aValue: tBCD);
488  
489      property AsBlob: IBlob read GetAsBlob write SetAsBlob;
490      property IsNullable: Boolean read GetIsNullable write SetIsNullable;
# Line 428 | Line 527 | type
527      function getSQLParam(index: integer): ISQLParam;
528      function ByName(Idx: AnsiString): ISQLParam ;
529      function GetModified: Boolean;
530 +    function GetHasCaseSensitiveParams: Boolean;
531    end;
532  
533    { TResults }
# Line 449 | Line 549 | type
549       function ByName(Idx: AnsiString): ISQLData;
550       function getSQLData(index: integer): ISQLData;
551       procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
552 +     function GetStatement: IStatement;
553       function GetTransaction: ITransaction; virtual;
554       procedure SetRetainInterfaces(aValue: boolean);
555   end;
556  
557   implementation
558  
559 < uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
559 > uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
560 >
561 > { TSQLParamMetaData }
562 >
563 > constructor TSQLParamMetaData.Create(src: TSQLVarData);
564 > begin
565 >  inherited Create;
566 >  FSQLType := src.GetSQLType;
567 >  FSQLSubType := src.getSubtype;
568 >  FScale := src.GetScale;
569 >  FCharSetID := src.getCharSetID;
570 >  FNullable := src.GetIsNullable;
571 >  FSize := src.GetSize;
572 >  FCodePage := src.GetCodePage;
573 > end;
574 >
575 > function TSQLParamMetaData.GetSQLType: cardinal;
576 > begin
577 >  Result := FSQLType;
578 > end;
579 >
580 > function TSQLParamMetaData.GetSQLTypeName: AnsiString;
581 > begin
582 >  Result := TSQLDataItem.GetSQLTypeName(FSQLType);
583 > end;
584 >
585 > function TSQLParamMetaData.getSubtype: integer;
586 > begin
587 >  Result := FSQLSubType;
588 > end;
589  
590 + function TSQLParamMetaData.getScale: integer;
591 + begin
592 +  Result := FScale;
593 + end;
594 +
595 + function TSQLParamMetaData.getCharSetID: cardinal;
596 + begin
597 +  Result := FCharSetID;
598 + end;
599 +
600 + function TSQLParamMetaData.getCodePage: TSystemCodePage;
601 + begin
602 +  Result :=  FCodePage;
603 + end;
604 +
605 + function TSQLParamMetaData.getIsNullable: boolean;
606 + begin
607 +  Result :=  FNullable;
608 + end;
609 +
610 + function TSQLParamMetaData.GetSize: cardinal;
611 + begin
612 +  Result := FSize;
613 + end;
614  
615   { TSQLDataArea }
616  
# Line 509 | Line 663 | end;
663  
664   procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
665    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}
666  
667 <  procedure AddToProcessedSQL(cChar: AnsiChar);
534 <  begin
535 <    StrBuffer[iSQLPos] := byte(cChar);
536 <    Inc(iSQLPos);
537 <  end;
667 > var slNames: TStrings;
668  
669 < begin
670 <  if not IsInputDataArea then
671 <    IBError(ibxeNotPermitted,[nil]);
672 <
673 <  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;
595 <
596 <        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;
612 <
613 <        CommentState:
614 <        begin
615 <          if (cNextChar = #0) then
616 <            IBError(ibxeSQLParseError, [SEOFInComment])
617 <          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));
669 >  procedure SetColumnNames(slNames: TStrings);
670 >  var i, j: integer;
671 >      found: boolean;
672 >  begin
673 >    found := false;
674      SetCount(slNames.Count);
675      for i := 0 to slNames.Count - 1 do
676      begin
# Line 709 | Line 691 | begin
691          Column[i].UniqueName := not found;
692        end;
693      end;
694 +  end;
695 +
696 + begin
697 +  if not IsInputDataArea then
698 +    IBError(ibxeNotPermitted,[nil]);
699 +
700 +  slNames := TStringList.Create;
701 +  try
702 +    sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
703 +    SetColumnNames(slNames);
704    finally
705      slNames.Free;
714    FreeMem(StrBuffer);
706    end;
707   end;
708  
# Line 725 | Line 716 | var
716    s: AnsiString;
717    i: Integer;
718   begin
719 <  {$ifdef UseCaseInSensitiveParamName}
720 <   s := AnsiUpperCase(Idx);
721 <  {$else}
719 >  if not IsInputDataArea or not CaseSensitiveParams then
720 >   s := AnsiUpperCase(Idx)
721 >  else
722     s := Idx;
723 <  {$endif}
723 >
724    for i := 0 to Count - 1 do
725      if Column[i].Name = s then
726      begin
# Line 761 | Line 752 | end;
752  
753   procedure TSQLVarData.SetName(AValue: AnsiString);
754   begin
755 <  if FName = AValue then Exit;
765 <  {$ifdef UseCaseInSensitiveParamName}
766 <  if Parent.IsInputDataArea then
755 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
756      FName := AnsiUpperCase(AValue)
757    else
769  {$endif}
758      FName := AValue;
759   end;
760  
761 + procedure TSQLVarData.SetMetaSize(aValue: cardinal);
762 + begin
763 +  //Ignore
764 + end;
765 +
766 + procedure TSQLVarData.SaveMetaData;
767 + begin
768 +  FColMetaData := TSQLParamMetaData.Create(self);
769 + end;
770 +
771   constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
772   begin
773    inherited Create;
# Line 786 | Line 784 | begin
784     a zero byte when the string is empty, neatly avoiding a nil pointer error.}
785  
786    FVarString := aValue;
787 <  SQLType := SQL_TEXT;
787 >  if SQLType = SQL_BLOB then
788 >    SetMetaSize(GetAttachment.GetInlineBlobLimit);
789 >  SQLType := GetDefaultTextSQLType;
790 >  Scale := 0;
791    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
792   end;
793  
# Line 801 | Line 802 | begin
802    FVarString := '';
803   end;
804  
805 + function TSQLVarData.getColMetadata: IParamMetaData;
806 + begin
807 +  Result := FColMetaData;
808 + end;
809 +
810   procedure TSQLVarData.Initialize;
811  
812    function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
# Line 901 | Line 907 | begin
907      result := Val;
908   end;
909  
910 + function TSQLDataItem.AdjustScaleToStr(Value: Int64; aScale: Integer
911 +  ): AnsiString;
912 + var Scaling : AnsiString;
913 +    i: Integer;
914 + begin
915 +  Result := IntToStr(Value);
916 +  Scaling := '';
917 +  if aScale > 0 then
918 +  begin
919 +    for i := 1 to aScale do
920 +      Result := Result + '0';
921 +  end
922 +  else
923 +  if aScale < 0 then
924 +  {$IF declared(DefaultFormatSettings)}
925 +  with DefaultFormatSettings do
926 +  {$ELSE}
927 +  {$IF declared(FormatSettings)}
928 +  with FormatSettings do
929 +  {$IFEND}
930 +  {$IFEND}
931 +  begin
932 +    if Length(Result) > -aScale then
933 +      system.Insert(DecimalSeparator,Result,Length(Result) + aScale)
934 +    else
935 +    begin
936 +      Scaling := '0' + DecimalSeparator;
937 +      for i := -1 downto aScale + Length(Result) do
938 +        Scaling := Scaling + '0';
939 +      Result := Scaling + Result;
940 +    end;
941 +  end;
942 + end;
943 +
944   function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
945    ): Currency;
946   var
# Line 947 | Line 987 | begin
987        result := Value;
988   end;
989  
990 + function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): 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 +  case GetSQLDialect of
1000 +    1:
1001 +      if IncludeTime then
1002 +        result := ShortDateFormat + ' ' + LongTimeFormat
1003 +      else
1004 +        result := ShortDateFormat;
1005 +    3:
1006 +      result := ShortDateFormat;
1007 +  end;
1008 + end;
1009 +
1010 + function TSQLDataItem.GetTimeFormatStr: AnsiString;
1011 + begin
1012 +  {$IF declared(DefaultFormatSettings)}
1013 +  with DefaultFormatSettings do
1014 +  {$ELSE}
1015 +  {$IF declared(FormatSettings)}
1016 +  with FormatSettings do
1017 +  {$IFEND}
1018 +  {$IFEND}
1019 +    Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
1020 + end;
1021 +
1022 + function TSQLDataItem.GetTimestampFormatStr: AnsiString;
1023 + begin
1024 +  {$IF declared(DefaultFormatSettings)}
1025 +  with DefaultFormatSettings do
1026 +  {$ELSE}
1027 +  {$IF declared(FormatSettings)}
1028 +  with FormatSettings do
1029 +  {$IFEND}
1030 +  {$IFEND}
1031 +    Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
1032 + end;
1033 +
1034   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
1035   begin
1036    SetAsLong(aValue);
1037   end;
1038  
1039 + procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
1040 +  var dstOffset: smallint; var aTimezone: AnsiString;
1041 +  var aTimeZoneID: TFBTimeZoneID);
1042 + begin
1043 +  CheckActive;
1044 +  aDateTime := 0;
1045 +  dstOffset := 0;
1046 +  aTimezone := '';
1047 +  aTimeZoneID := TimeZoneID_GMT;
1048 +  if not IsNull then
1049 +    with FFirebirdClientAPI do
1050 +    case SQLType of
1051 +      SQL_TEXT, SQL_VARYING:
1052 +        if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
1053 +          IBError(ibxeInvalidDataConversion, [nil]);
1054 +      SQL_TYPE_DATE:
1055 +        aDateTime := SQLDecodeDate(SQLData);
1056 +      SQL_TYPE_TIME:
1057 +        aDateTime := SQLDecodeTime(SQLData);
1058 +      SQL_TIMESTAMP:
1059 +        aDateTime := SQLDecodeDateTime(SQLData);
1060 +      SQL_TIMESTAMP_TZ:
1061 +        begin
1062 +          GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
1063 +          aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
1064 +        end;
1065 +      SQL_TIMESTAMP_TZ_EX:
1066 +      begin
1067 +        GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
1068 +        aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
1069 +      end;
1070 +      SQL_TIME_TZ:
1071 +        with GetTimeZoneServices do
1072 +        begin
1073 +          DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1074 +          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1075 +        end;
1076 +      SQL_TIME_TZ_EX:
1077 +        with GetTimeZoneServices do
1078 +        begin
1079 +          DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1080 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1081 +        end;
1082 +      else
1083 +        IBError(ibxeInvalidDataConversion, [nil]);
1084 +    end;
1085 + end;
1086 +
1087   function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1088    ): Int64;
1089   var
# Line 1000 | Line 1132 | begin
1132    end
1133    else
1134      result := trunc(Value);
1135 + //  writeln('Adjusted ',Value,' to ',Result);
1136   end;
1137  
1138   procedure TSQLDataItem.CheckActive;
# Line 1007 | Line 1140 | begin
1140    //Do nothing by default
1141   end;
1142  
1143 + procedure TSQLDataItem.CheckTZSupport;
1144 + begin
1145 +  if not FFirebirdClientAPI.HasTimeZoneSupport then
1146 +    IBError(ibxeNoTimezoneSupport,[]);
1147 + end;
1148 +
1149 + function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1150 + begin
1151 +  if FTimeZoneServices = nil then
1152 +  begin
1153 +    if not GetAttachment.HasTimeZoneSupport then
1154 +      IBError(ibxeNoTimezoneSupport,[]);
1155 +    GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1156 +  end;
1157 +  Result := FTimeZoneServices;
1158 + end;
1159 +
1160   procedure TSQLDataItem.Changed;
1161   begin
1162    //Do nothing by default
# Line 1045 | Line 1195 | begin
1195     //Do nothing by default
1196   end;
1197  
1198 + constructor TSQLDataItem.Create(api: TFBClientAPI);
1199 + begin
1200 +  inherited Create;
1201 +  FFirebirdClientAPI := api;
1202 + end;
1203 +
1204   function TSQLDataItem.GetSQLTypeName: AnsiString;
1205   begin
1206    Result := GetSQLTypeName(GetSQLType);
1207   end;
1208  
1209 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1209 > class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1210   begin
1211    Result := 'Unknown';
1212    case SQLType of
# Line 1061 | Line 1217 | begin
1217    SQL_LONG:             Result := 'SQL_LONG';
1218    SQL_SHORT:            Result := 'SQL_SHORT';
1219    SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1220 +  SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1221 +  SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1222    SQL_BLOB:             Result := 'SQL_BLOB';
1223    SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1224    SQL_ARRAY:            Result := 'SQL_ARRAY';
# Line 1068 | Line 1226 | begin
1226    SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1227    SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1228    SQL_INT64:            Result := 'SQL_INT64';
1229 +  SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1230 +  SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1231 +  SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1232 +  SQL_DEC16:            Result := 'SQL_DEC16';
1233 +  SQL_DEC34:            Result := 'SQL_DEC34';
1234 +  SQL_INT128:           Result := 'SQL_INT128';
1235 +  SQL_NULL:             Result := 'SQL_NULL';
1236 +  SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1237    end;
1238   end;
1239  
1240 + function TSQLDataItem.GetStrDataLength: short;
1241 + begin
1242 +  with FFirebirdClientAPI do
1243 +  if SQLType = SQL_VARYING then
1244 +    Result := DecodeInteger(SQLData, 2)
1245 +  else
1246 +    Result := DataLength;
1247 + end;
1248 +
1249   function TSQLDataItem.GetAsBoolean: boolean;
1250   begin
1251    CheckActive;
# Line 1110 | Line 1285 | begin
1285            result := AdjustScaleToCurrency(PInt64(SQLData)^,
1286                                        Scale);
1287          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1288 <          result := Trunc(AsDouble);
1288 >          result := Round(AsDouble);
1289 >
1290 >        SQL_DEC_FIXED,
1291 >        SQL_DEC16,
1292 >        SQL_DEC34,
1293 >        SQL_INT128:
1294 >          if not BCDToCurr(GetAsBCD,Result) then
1295 >            IBError(ibxeInvalidDataConversion, [nil]);
1296 >
1297          else
1298            IBError(ibxeInvalidDataConversion, [nil]);
1299        end;
# Line 1140 | Line 1323 | begin
1323          result := AdjustScaleToInt64(PInt64(SQLData)^,
1324                                      Scale);
1325        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1326 <        result := Trunc(AsDouble);
1326 >        result := Round(AsDouble);
1327        else
1328          IBError(ibxeInvalidDataConversion, [nil]);
1329      end;
1330   end;
1331  
1332   function TSQLDataItem.GetAsDateTime: TDateTime;
1333 + var aTimezone: AnsiString;
1334 +    aTimeZoneID: TFBTimeZoneID;
1335 +    dstOffset: smallint;
1336 + begin
1337 +  InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1338 + end;
1339 +
1340 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1341 +  var dstOffset: smallint; var aTimezone: AnsiString);
1342 + var aTimeZoneID: TFBTimeZoneID;
1343 + begin
1344 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1345 + end;
1346 +
1347 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1348 +  var aTimezoneID: TFBTimeZoneID);
1349 + var aTimezone: AnsiString;
1350 + begin
1351 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1352 + end;
1353 +
1354 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1355 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1356 + var aTimeZone: AnsiString;
1357   begin
1358    CheckActive;
1359 <  result := 0;
1359 >  aTime := 0;
1360 >  dstOffset := 0;
1361    if not IsNull then
1362 <    with FirebirdClientAPI do
1362 >    with FFirebirdClientAPI do
1363      case SQLType of
1364 <      SQL_TEXT, SQL_VARYING: begin
1365 <        try
1366 <          result := StrToDate(AsString);
1367 <        except
1368 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1364 >      SQL_TIME_TZ:
1365 >        begin
1366 >          GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1367 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1368 >        end;
1369 >      SQL_TIME_TZ_EX:
1370 >        begin
1371 >          GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1372 >          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1373          end;
1374 +    else
1375 +      IBError(ibxeInvalidDataConversion, [nil]);
1376 +    end;
1377 + end;
1378 +
1379 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1380 +  var aTimezone: AnsiString; OnDate: TDateTime);
1381 + begin
1382 +  CheckActive;
1383 +  aTime := 0;
1384 +  dstOffset := 0;
1385 +  if not IsNull then
1386 +    with FFirebirdClientAPI do
1387 +    case SQLType of
1388 +      SQL_TIME_TZ:
1389 +        GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1390 +      SQL_TIME_TZ_EX:
1391 +        GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1392 +    else
1393 +      IBError(ibxeInvalidDataConversion, [nil]);
1394 +    end;
1395 + end;
1396 +
1397 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1398 +  var aTimezoneID: TFBTimeZoneID);
1399 + begin
1400 +  GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1401 + end;
1402 +
1403 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1404 +  var aTimezone: AnsiString);
1405 + begin
1406 +  GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1407 + end;
1408 +
1409 + function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1410 + var aTimezone: AnsiString;
1411 + begin
1412 +  CheckActive;
1413 +  result := 0;
1414 +  aTimezone := '';
1415 +  if not IsNull then
1416 +    with FFirebirdClientAPI do
1417 +    case SQLType of
1418 +      SQL_TEXT, SQL_VARYING:
1419 +      begin
1420 +        if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1421 +          IBError(ibxeInvalidDataConversion, [nil]);
1422 +        Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1423        end;
1424        SQL_TYPE_DATE:
1425          result := SQLDecodeDate(SQLData);
1426 <      SQL_TYPE_TIME:
1426 >      SQL_TYPE_TIME,
1427 >      SQL_TIME_TZ,
1428 >      SQL_TIME_TZ_EX:
1429          result := SQLDecodeTime(SQLData);
1430 <      SQL_TIMESTAMP:
1430 >      SQL_TIMESTAMP,
1431 >      SQL_TIMESTAMP_TZ,
1432 >      SQL_TIMESTAMP_TZ_EX:
1433          result := SQLDecodeDateTime(SQLData);
1434        else
1435          IBError(ibxeInvalidDataConversion, [nil]);
1436 <    end;
1436 >      end;
1437   end;
1438  
1439   function TSQLDataItem.GetAsDouble: Double;
# Line 1196 | Line 1461 | begin
1461          result := PFloat(SQLData)^;
1462        SQL_DOUBLE, SQL_D_FLOAT:
1463          result := PDouble(SQLData)^;
1464 +      SQL_DEC_FIXED,
1465 +      SQL_DEC16,
1466 +      SQL_DEC34,
1467 +      SQL_INT128:
1468 +        Result := BCDToDouble(GetAsBCD);
1469        else
1470          IBError(ibxeInvalidDataConversion, [nil]);
1471      end;
# Line 1232 | Line 1502 | begin
1502          end;
1503        end;
1504        SQL_SHORT:
1505 <        result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1505 >        result := Round(AdjustScale(Int64(PShort(SQLData)^),
1506                                      Scale));
1507        SQL_LONG:
1508 <        result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1508 >        result := Round(AdjustScale(Int64(PLong(SQLData)^),
1509                                      Scale));
1510        SQL_INT64:
1511 <        result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1511 >        result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1512        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1513 <        result := Trunc(AsDouble);
1513 >        result := Round(AsDouble);
1514 >      SQL_DEC_FIXED,
1515 >      SQL_DEC16,
1516 >      SQL_DEC34,
1517 >      SQL_INT128:
1518 >        Result := BCDToInteger(GetAsBCD);
1519        else
1520 <        IBError(ibxeInvalidDataConversion, [nil]);
1520 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1521      end;
1522   end;
1523  
# Line 1280 | Line 1555 | begin
1555    end;
1556   end;
1557  
1558 + {Copied from LazUTF8}
1559 +
1560 + function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1561 + const TopBitSetMask   = $80; {%10000000}
1562 +      Top2BitsSetMask = $C0; {%11000000}
1563 +      Top3BitsSetMask = $E0; {%11100000}
1564 +      Top4BitsSetMask = $F0; {%11110000}
1565 +      Top5BitsSetMask = $F8; {%11111000}
1566 + begin
1567 +  case p^ of
1568 +  #0..#191: // %11000000
1569 +    // regular single byte character (#0 is a character, this is Pascal ;)
1570 +    Result:=1;
1571 +  #192..#223: // p^ and %11100000 = %11000000
1572 +    begin
1573 +      // could be 2 byte character
1574 +      if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1575 +        Result:=2
1576 +      else
1577 +        Result:=1;
1578 +    end;
1579 +  #224..#239: // p^ and %11110000 = %11100000
1580 +    begin
1581 +      // could be 3 byte character
1582 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1583 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1584 +        Result:=3
1585 +      else
1586 +        Result:=1;
1587 +    end;
1588 +  #240..#247: // p^ and %11111000 = %11110000
1589 +    begin
1590 +      // could be 4 byte character
1591 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1592 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1593 +      and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1594 +        Result:=4
1595 +      else
1596 +        Result:=1;
1597 +    end;
1598 +  else
1599 +    Result:=1;
1600 +  end;
1601 + end;
1602 +
1603 + {Returns the byte length of a UTF8 string with a fixed charwidth}
1604 +
1605 + function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1606 + var i: integer;
1607 +    cplen: integer;
1608 +    s: AnsiString;
1609 + begin
1610 +  Result := 0;
1611 +  s := strpas(p);
1612 +  for i := 1 to FieldWidth do
1613 +  begin
1614 +    cplen := UTF8CodepointSizeFull(p);
1615 +    Inc(p,cplen);
1616 +    Inc(Result,cplen);
1617 +    if Result >= MaxDataLength then
1618 +    begin
1619 +      Result := MaxDataLength;
1620 +      Exit;
1621 +    end;
1622 +  end;
1623 + end;
1624  
1625   function TSQLDataItem.GetAsString: AnsiString;
1626   var
1627    sz: PByte;
1628    str_len: Integer;
1629    rs: RawByteString;
1630 +  aTimeZone: AnsiString;
1631 +  aDateTime: TDateTime;
1632 +  dstOffset: smallint;
1633   begin
1634    CheckActive;
1635    result := '';
1636    { Check null, if so return a default string }
1637    if not IsNull then
1638 <  with FirebirdClientAPI do
1638 >  with FFirebirdClientAPI do
1639      case SQLType of
1640        SQL_BOOLEAN:
1641          if AsBoolean then
# Line 1303 | Line 1647 | begin
1647        begin
1648          sz := SQLData;
1649          if (SQLType = SQL_TEXT) then
1650 <          str_len := DataLength
1650 >        begin
1651 >          if GetCodePage = cp_utf8 then
1652 >            str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1653 >          else
1654 >            str_len := DataLength
1655 >        end
1656          else begin
1657 <          str_len := DecodeInteger(SQLData, 2);
1657 >          str_len := DecodeInteger(sz, 2);
1658            Inc(sz, 2);
1659          end;
1660          SetString(rs, PAnsiChar(sz), str_len);
1661          SetCodePage(rs,GetCodePage,false);
1662 <        if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1314 <          Result := TrimRight(rs)
1315 <        else
1316 <          Result := rs
1662 >        Result := rs;
1663        end;
1664 +
1665        SQL_TYPE_DATE:
1666 <        case GetSQLDialect of
1320 <          1 : result := DateTimeToStr(AsDateTime);
1321 <          3 : result := DateToStr(AsDateTime);
1322 <        end;
1323 <      SQL_TYPE_TIME :
1324 <        result := TimeToStr(AsDateTime);
1666 >        Result := DateToStr(GetAsDateTime);
1667        SQL_TIMESTAMP:
1668 <      {$IF declared(DefaultFormatSettings)}
1669 <      with DefaultFormatSettings do
1670 <      {$ELSE}
1671 <      {$IF declared(FormatSettings)}
1672 <      with FormatSettings do
1673 <      {$IFEND}
1674 <      {$IFEND}
1675 <        result := FormatDateTime(ShortDateFormat + ' ' +
1676 <                            LongTimeFormat+'.zzz',AsDateTime);
1668 >        Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1669 >      SQL_TYPE_TIME:
1670 >        Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1671 >      SQL_TIMESTAMP_TZ,
1672 >      SQL_TIMESTAMP_TZ_EX:
1673 >        with GetAttachment.GetTimeZoneServices do
1674 >        begin
1675 >          if GetTZTextOption = tzGMT then
1676 >            Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1677 >          else
1678 >          begin
1679 >            GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1680 >            if GetTZTextOption = tzOffset then
1681 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1682 >            else
1683 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1684 >          end;
1685 >        end;
1686 >      SQL_TIME_TZ,
1687 >      SQL_TIME_TZ_EX:
1688 >        with GetAttachment.GetTimeZoneServices do
1689 >        begin
1690 >          if GetTZTextOption = tzGMT then
1691 >             Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1692 >          else
1693 >          begin
1694 >            GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1695 >            if GetTZTextOption = tzOffset then
1696 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1697 >            else
1698 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1699 >          end;
1700 >        end;
1701 >
1702        SQL_SHORT, SQL_LONG:
1703          if Scale = 0 then
1704            result := IntToStr(AsLong)
# Line 1348 | Line 1715 | begin
1715            result := FloatToStr(AsDouble);
1716        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1717          result := FloatToStr(AsDouble);
1718 +
1719 +      SQL_DEC16,
1720 +      SQL_DEC34:
1721 +        result := BCDToStr(GetAsBCD);
1722 +
1723 +      SQL_DEC_FIXED,
1724 +      SQL_INT128:
1725 +        result := Int128ToStr(SQLData,scale);
1726 +
1727        else
1728          IBError(ibxeInvalidDataConversion, [nil]);
1729      end;
# Line 1359 | Line 1735 | begin
1735    Result := false;
1736   end;
1737  
1738 < function TSQLDataItem.getIsNullable: boolean;
1738 > function TSQLDataItem.GetIsNullable: boolean;
1739   begin
1740    CheckActive;
1741    Result := false;
1742   end;
1743  
1744   function TSQLDataItem.GetAsVariant: Variant;
1745 + var ts: TDateTime;
1746 +  dstOffset: smallint;
1747 +    timezone: AnsiString;
1748   begin
1749    CheckActive;
1750    if IsNull then
# Line 1379 | Line 1758 | begin
1758          result := AsString;
1759        SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1760          result := AsDateTime;
1761 +      SQL_TIMESTAMP_TZ,
1762 +      SQL_TIME_TZ,
1763 +      SQL_TIMESTAMP_TZ_EX,
1764 +      SQL_TIME_TZ_EX:
1765 +        begin
1766 +          GetAsDateTime(ts,dstOffset,timezone);
1767 +          result := VarArrayOf([ts,dstOffset,timezone]);
1768 +        end;
1769        SQL_SHORT, SQL_LONG:
1770          if Scale = 0 then
1771            result := AsLong
# Line 1397 | Line 1784 | begin
1784          result := AsDouble;
1785        SQL_BOOLEAN:
1786          result := AsBoolean;
1787 +      SQL_DEC_FIXED,
1788 +      SQL_DEC16,
1789 +      SQL_DEC34,
1790 +      SQL_INT128:
1791 +        result := VarFmtBCDCreate(GetAsBcd);
1792        else
1793          IBError(ibxeInvalidDataConversion, [nil]);
1794      end;
# Line 1407 | Line 1799 | begin
1799    Result := false;
1800   end;
1801  
1802 + function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1803 +  ): integer;
1804 + begin
1805 +  case DateTimeFormat of
1806 +  dfTimestamp:
1807 +    Result := Length(GetTimestampFormatStr);
1808 +  dfDateTime:
1809 +    Result := Length(GetDateFormatStr(true));
1810 +  dfTime:
1811 +    Result := Length(GetTimeFormatStr);
1812 +  dfTimestampTZ:
1813 +    Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1814 +  dfTimeTZ:
1815 +    Result := Length(GetTimeFormatStr)+ 6;
1816 +  else
1817 +    Result := 0;
1818 +  end;end;
1819 +
1820 + function TSQLDataItem.GetAsBCD: tBCD;
1821 +
1822 + begin
1823 +  CheckActive;
1824 +  if IsNull then
1825 +   with Result do
1826 +   begin
1827 +     FillChar(Result,sizeof(Result),0);
1828 +     Precision := 1;
1829 +     exit;
1830 +   end;
1831 +
1832 +  case SQLType of
1833 +  SQL_DEC16,
1834 +  SQL_DEC34:
1835 +    with FFirebirdClientAPI do
1836 +      Result := SQLDecFloatDecode(SQLType,  SQLData);
1837 +
1838 +  SQL_DEC_FIXED,
1839 +  SQL_INT128:
1840 +    with FFirebirdClientAPI do
1841 +      Result := StrToBCD(Int128ToStr(SQLData,scale));
1842 +  else
1843 +    if not CurrToBCD(GetAsCurrency,Result) then
1844 +      IBError(ibxeBadBCDConversion,[]);
1845 +  end;
1846 + end;
1847 +
1848  
1849   procedure TSQLDataItem.SetIsNull(Value: Boolean);
1850   begin
# Line 1470 | Line 1908 | begin
1908  
1909    SQLType := SQL_TYPE_DATE;
1910    DataLength := SizeOf(ISC_DATE);
1911 <  with FirebirdClientAPI do
1911 >  with FFirebirdClientAPI do
1912      SQLEncodeDate(Value,SQLData);
1913    Changed;
1914   end;
# Line 1490 | Line 1928 | begin
1928  
1929    SQLType := SQL_TYPE_TIME;
1930    DataLength := SizeOf(ISC_TIME);
1931 <  with FirebirdClientAPI do
1931 >  with FFirebirdClientAPI do
1932      SQLEncodeTime(Value,SQLData);
1933    Changed;
1934   end;
1935  
1936 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1937 + begin
1938 +  CheckActive;
1939 +  CheckTZSupport;
1940 +  if GetSQLDialect < 3 then
1941 +  begin
1942 +    AsDateTime := aValue;
1943 +    exit;
1944 +  end;
1945 +
1946 +  Changing;
1947 +  if IsNullable then
1948 +    IsNull := False;
1949 +
1950 +  SQLType := SQL_TIME_TZ;
1951 +  DataLength := SizeOf(ISC_TIME_TZ);
1952 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1953 +  Changed;
1954 + end;
1955 +
1956 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1957 + begin
1958 +  CheckActive;
1959 +  CheckTZSupport;
1960 +  if GetSQLDialect < 3 then
1961 +  begin
1962 +    AsDateTime := aValue;
1963 +    exit;
1964 +  end;
1965 +
1966 +  Changing;
1967 +  if IsNullable then
1968 +    IsNull := False;
1969 +
1970 +  SQLType := SQL_TIME_TZ;
1971 +  DataLength := SizeOf(ISC_TIME_TZ);
1972 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1973 +  Changed;
1974 + end;
1975 +
1976   procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1977   begin
1978    CheckActive;
# Line 1504 | Line 1982 | begin
1982    Changing;
1983    SQLType := SQL_TIMESTAMP;
1984    DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1985 <  with FirebirdClientAPI do
1985 >  with FFirebirdClientAPI do
1986      SQLEncodeDateTime(Value,SQLData);
1987    Changed;
1988   end;
1989  
1990 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1991 +  aTimeZoneID: TFBTimeZoneID);
1992 + begin
1993 +  CheckActive;
1994 +  CheckTZSupport;
1995 +  if IsNullable then
1996 +    IsNull := False;
1997 +
1998 +  Changing;
1999 +  SQLType := SQL_TIMESTAMP_TZ;
2000 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
2001 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
2002 +  Changed;
2003 + end;
2004 +
2005 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
2006 +  );
2007 + begin
2008 +  CheckActive;
2009 +  CheckTZSupport;
2010 +  if IsNullable then
2011 +    IsNull := False;
2012 +
2013 +  Changing;
2014 +  SQLType := SQL_TIMESTAMP_TZ;
2015 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
2016 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
2017 +  Changed;
2018 + end;
2019 +
2020 + procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
2021 + begin
2022 +  SetAsDateTime(aUTCTime,TimeZoneID_GMT);
2023 + end;
2024 +
2025   procedure TSQLDataItem.SetAsDouble(Value: Double);
2026   begin
2027    CheckActive;
# Line 1604 | Line 2117 | begin
2117    CheckActive;
2118    if VarIsNull(Value) then
2119      IsNull := True
2120 +  else
2121 +  if VarIsArray(Value) then {must be datetime plus timezone}
2122 +    SetAsDateTime(Value[0],AnsiString(Value[1]))
2123    else case VarType(Value) of
2124      varEmpty, varNull:
2125        IsNull := True;
# Line 1626 | Line 2142 | begin
2142        IBError(ibxeNotSupported, [nil]);
2143      varByRef, varDispatch, varError, varUnknown, varVariant:
2144        IBError(ibxeNotPermitted, [nil]);
2145 +    else
2146 +      if VarIsFmtBCD(Value) then
2147 +        SetAsBCD(VarToBCD(Value))
2148 +      else
2149 +        IBError(ibxeNotSupported, [nil]);
2150    end;
2151   end;
2152  
2153 + procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
2154 + begin
2155 +  CheckActive;
2156 +  Changing;
2157 +  if IsNullable then
2158 +    IsNull := False;
2159 +
2160 +  SQLType := SQL_INT64;
2161 +  Scale := aScale;
2162 +  DataLength := SizeOf(Int64);
2163 +  PInt64(SQLData)^ := Value;
2164 +  Changed;
2165 + end;
2166 +
2167 + procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2168 + var C: Currency;
2169 + begin
2170 +  CheckActive;
2171 +  Changing;
2172 +  if IsNullable then
2173 +    IsNull := False;
2174 +
2175 +
2176 +  with FFirebirdClientAPI do
2177 +  if aValue.Precision <= 16 then
2178 +  begin
2179 +    if not HasDecFloatSupport then
2180 +      IBError(ibxeDecFloatNotSupported,[]);
2181 +
2182 +    SQLType := SQL_DEC16;
2183 +    DataLength := 8;
2184 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2185 +  end
2186 +  else
2187 +  if aValue.Precision <= 34 then
2188 +  begin
2189 +    if not HasDecFloatSupport then
2190 +      IBError(ibxeDecFloatNotSupported,[]);
2191 +
2192 +    SQLType := SQL_DEC34;
2193 +    DataLength := 16;
2194 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2195 +  end
2196 +  else
2197 +  if aValue.Precision <= 38 then
2198 +  begin
2199 +    if not HasInt128Support then
2200 +      IBError(ibxeInt128NotSupported,[]);
2201 +
2202 +    SQLType := SQL_INT128;
2203 +    DataLength := 16;
2204 +    StrToInt128(scale,BcdToStr(aValue),SQLData);
2205 +  end
2206 +  else
2207 +    IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2208 +
2209 +  Changed;
2210 + end;
2211 +
2212   procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
2213   begin
2214    CheckActive;
# Line 1659 | Line 2239 | begin
2239      IBError(ibxeStatementNotPrepared, [nil]);
2240   end;
2241  
2242 + function TColumnMetaData.GetAttachment: IAttachment;
2243 + begin
2244 +  Result := GetStatement.GetAttachment;
2245 + end;
2246 +
2247   function TColumnMetaData.SQLData: PByte;
2248   begin
2249    Result := FIBXSQLVAR.SQLData;
# Line 1676 | Line 2261 | end;
2261  
2262   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2263   begin
2264 <  inherited Create;
2264 >  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
2265    FIBXSQLVAR := aIBXSQLVAR;
2266    FOwner := aOwner;
2267    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 1763 | Line 2348 | end;
2348   function TColumnMetaData.GetSize: cardinal;
2349   begin
2350    CheckActive;
2351 <  result := FIBXSQLVAR.DataLength;
2351 >  result := FIBXSQLVAR.GetSize;
2352 > end;
2353 >
2354 > function TColumnMetaData.GetCharSetWidth: integer;
2355 > begin
2356 >  CheckActive;
2357 >  result := FIBXSQLVAR.GetCharSetWidth;
2358   end;
2359  
2360   function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
# Line 1778 | Line 2369 | begin
2369    result := FIBXSQLVAR.GetBlobMetaData;
2370   end;
2371  
2372 + function TColumnMetaData.GetStatement: IStatement;
2373 + begin
2374 +  Result := FIBXSQLVAR.GetStatement;
2375 + end;
2376 +
2377 + function TColumnMetaData.GetTransaction: ITransaction;
2378 + begin
2379 +  Result := GetStatement.GetTransaction;
2380 + end;
2381 +
2382   { TIBSQLData }
2383  
2384   procedure TIBSQLData.CheckActive;
# Line 1797 | Line 2398 | begin
2398      IBError(ibxeBOF,[nil]);
2399   end;
2400  
2401 + function TIBSQLData.GetTransaction: ITransaction;
2402 + begin
2403 +  if FTransaction = nil then
2404 +    Result := inherited GetTransaction
2405 +  else
2406 +    Result := FTransaction;
2407 + end;
2408 +
2409   function TIBSQLData.GetIsNull: Boolean;
2410   begin
2411    CheckActive;
# Line 1840 | Line 2449 | end;
2449   { TSQLParam }
2450  
2451   procedure TSQLParam.InternalSetAsString(Value: AnsiString);
2452 +
2453 + procedure DoSetString;
2454 + begin
2455 +  Changing;
2456 +  FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
2457 +  Changed;
2458 + end;
2459 +
2460   var b: IBlob;
2461 +    dt: TDateTime;
2462 +    timezone: AnsiString;
2463 +    Int64Value: Int64;
2464 +    BCDValue: TBCD;
2465 +    aScale: integer;
2466   begin
2467    CheckActive;
2468    if IsNullable then
2469      IsNull := False;
2470 <  case SQLTYPE of
2470 >  with FFirebirdClientAPI do
2471 >  case getColMetaData.SQLTYPE of
2472    SQL_BOOLEAN:
2473      if AnsiCompareText(Value,STrue) = 0 then
2474        AsBoolean := true
# Line 1856 | Line 2479 | begin
2479        IBError(ibxeInvalidDataConversion,[nil]);
2480  
2481    SQL_BLOB:
2482 +    if Length(Value) < GetAttachment.GetInlineBlobLimit then
2483 +      DoSetString
2484 +    else
2485      begin
2486        Changing;
2487        b := FIBXSQLVAR.CreateBlob;
# Line 1866 | Line 2492 | begin
2492  
2493    SQL_VARYING,
2494    SQL_TEXT:
2495 <    begin
1870 <      Changing;
1871 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1872 <      Changed;
1873 <    end;
2495 >    DoSetString;
2496  
2497 <    SQL_SHORT,
2498 <    SQL_LONG,
2499 <    SQL_INT64:
2500 <      SetAsInt64(StrToInt(Value));
2501 <
2502 <    SQL_D_FLOAT,
2503 <    SQL_DOUBLE,
1882 <    SQL_FLOAT:
1883 <      SetAsDouble(StrToFloat(Value));
2497 >  SQL_SHORT,
2498 >  SQL_LONG,
2499 >  SQL_INT64:
2500 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2501 >      SetAsNumeric(Int64Value,aScale)
2502 >    else
2503 >      DoSetString;
2504  
2505 <    SQL_TIMESTAMP:
2506 <      SetAsDateTime(StrToDateTime(Value));
2505 >  SQL_DEC_FIXED,
2506 >  SQL_DEC16,
2507 >  SQL_DEC34,
2508 >  SQL_INT128:
2509 >    if TryStrToBCD(Value,BCDValue) then
2510 >      SetAsBCD(BCDValue)
2511 >    else
2512 >      DoSetString;
2513  
2514 <    SQL_TYPE_DATE:
2515 <      SetAsDate(StrToDateTime(Value));
2514 >  SQL_D_FLOAT,
2515 >  SQL_DOUBLE,
2516 >  SQL_FLOAT:
2517 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2518 >      SetAsDouble(NumericToDouble(Int64Value,aScale))
2519 >    else
2520 >      DoSetString;
2521  
2522 <    SQL_TYPE_TIME:
2523 <      SetAsTime(StrToDateTime(Value));
2522 >  SQL_TIMESTAMP:
2523 >      if TryStrToDateTime(Value,dt) then
2524 >        SetAsDateTime(dt)
2525 >      else
2526 >        DoSetString;
2527  
2528 <    else
2529 <      IBError(ibxeInvalidDataConversion,[nil]);
2528 >  SQL_TYPE_DATE:
2529 >      if TryStrToDateTime(Value,dt) then
2530 >        SetAsDate(dt)
2531 >      else
2532 >        DoSetString;
2533 >
2534 >  SQL_TYPE_TIME:
2535 >      if TryStrToDateTime(Value,dt) then
2536 >        SetAsTime(dt)
2537 >      else
2538 >        DoSetString;
2539 >
2540 >  SQL_TIMESTAMP_TZ,
2541 >  SQL_TIMESTAMP_TZ_EX:
2542 >      if ParseDateTimeTZString(value,dt,timezone) then
2543 >        SetAsDateTime(dt,timezone)
2544 >      else
2545 >        DoSetString;
2546 >
2547 >  SQL_TIME_TZ,
2548 >  SQL_TIME_TZ_EX:
2549 >      if ParseDateTimeTZString(value,dt,timezone,true) then
2550 >        SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2551 >      else
2552 >        DoSetString;
2553 >
2554 >  else
2555 >    IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2556    end;
2557   end;
2558  
# Line 1930 | Line 2590 | begin
2590    IsNull := true;
2591   end;
2592  
2593 + function TSQLParam.getColMetadata: IParamMetaData;
2594 + begin
2595 +  Result := FIBXSQLVAR.getColMetadata;
2596 + end;
2597 +
2598   function TSQLParam.GetModified: boolean;
2599   begin
2600    CheckActive;
# Line 1943 | Line 2608 | begin
2608    Result := inherited GetAsPointer;
2609   end;
2610  
2611 + function TSQLParam.GetAsString: AnsiString;
2612 + var rs: RawByteString;
2613 + begin
2614 +  Result := '';
2615 +  if (SQLType = SQL_VARYING) and not IsNull then
2616 +  {SQLData points to start of string - default is to length word}
2617 +  begin
2618 +    CheckActive;
2619 +    SetString(rs,PAnsiChar(SQLData),DataLength);
2620 +    SetCodePage(rs,GetCodePage,false);
2621 +    Result := rs;
2622 +  end
2623 +  else
2624 +    Result := inherited GetAsString;
2625 + end;
2626 +
2627   procedure TSQLParam.SetName(Value: AnsiString);
2628   begin
2629    CheckActive;
# Line 2134 | Line 2815 | begin
2815    end;
2816   end;
2817  
2818 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2819 + var i: integer;
2820 +    OldSQLVar: TSQLVarData;
2821 + begin
2822 +  if FIBXSQLVAR.UniqueName then
2823 +    inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2824 +  else
2825 +  with FIBXSQLVAR.Parent do
2826 +  begin
2827 +    for i := 0 to Count - 1 do
2828 +      if Column[i].Name = Name then
2829 +      begin
2830 +        OldSQLVar := FIBXSQLVAR;
2831 +        FIBXSQLVAR := Column[i];
2832 +        try
2833 +          inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2834 +        finally
2835 +          FIBXSQLVAR := OldSQLVar;
2836 +        end;
2837 +      end;
2838 +  end;
2839 + end;
2840 +
2841 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2842 + var i: integer;
2843 +    OldSQLVar: TSQLVarData;
2844 + begin
2845 +  if FIBXSQLVAR.UniqueName then
2846 +    inherited SetAsTime(AValue,OnDate,aTimeZone)
2847 +  else
2848 +  with FIBXSQLVAR.Parent do
2849 +  begin
2850 +    for i := 0 to Count - 1 do
2851 +      if Column[i].Name = Name then
2852 +      begin
2853 +        OldSQLVar := FIBXSQLVAR;
2854 +        FIBXSQLVAR := Column[i];
2855 +        try
2856 +          inherited SetAsTime(AValue,OnDate,aTimeZone);
2857 +        finally
2858 +          FIBXSQLVAR := OldSQLVar;
2859 +        end;
2860 +      end;
2861 +  end;
2862 + end;
2863 +
2864 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2865 + begin
2866 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2867 + end;
2868 +
2869 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2870 + begin
2871 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2872 + end;
2873 +
2874   procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2875   var i: integer;
2876      OldSQLVar: TSQLVarData;
# Line 2157 | Line 2894 | begin
2894    end;
2895   end;
2896  
2897 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2898 +  );
2899 + var i: integer;
2900 +    OldSQLVar: TSQLVarData;
2901 + begin
2902 +  if FIBXSQLVAR.UniqueName then
2903 +    inherited SetAsDateTime(AValue,aTimeZoneID)
2904 +  else
2905 +  with FIBXSQLVAR.Parent do
2906 +  begin
2907 +    for i := 0 to Count - 1 do
2908 +      if Column[i].Name = Name then
2909 +      begin
2910 +        OldSQLVar := FIBXSQLVAR;
2911 +        FIBXSQLVAR := Column[i];
2912 +        try
2913 +          inherited SetAsDateTime(AValue,aTimeZoneID);
2914 +        finally
2915 +          FIBXSQLVAR := OldSQLVar;
2916 +        end;
2917 +      end;
2918 +  end;
2919 + end;
2920 +
2921 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2922 + var i: integer;
2923 +    OldSQLVar: TSQLVarData;
2924 + begin
2925 +  if FIBXSQLVAR.UniqueName then
2926 +    inherited SetAsDateTime(AValue,aTimeZone)
2927 +  else
2928 +  with FIBXSQLVAR.Parent do
2929 +  begin
2930 +    for i := 0 to Count - 1 do
2931 +      if Column[i].Name = Name then
2932 +      begin
2933 +        OldSQLVar := FIBXSQLVAR;
2934 +        FIBXSQLVAR := Column[i];
2935 +        try
2936 +          inherited SetAsDateTime(AValue,aTimeZone);
2937 +        finally
2938 +          FIBXSQLVAR := OldSQLVar;
2939 +        end;
2940 +      end;
2941 +  end;
2942 + end;
2943 +
2944   procedure TSQLParam.SetAsDouble(AValue: Double);
2945   var i: integer;
2946      OldSQLVar: TSQLVarData;
# Line 2337 | Line 3121 | begin
3121    FIBXSQLVAR.SetCharSetID(aValue);
3122   end;
3123  
3124 + procedure TSQLParam.SetAsBcd(aValue: tBCD);
3125 + var i: integer;
3126 +    OldSQLVar: TSQLVarData;
3127 + begin
3128 +  if FIBXSQLVAR.UniqueName then
3129 +    inherited SetAsBcd(AValue)
3130 +  else
3131 +  with FIBXSQLVAR.Parent do
3132 +  begin
3133 +    for i := 0 to Count - 1 do
3134 +      if Column[i].Name = Name then
3135 +      begin
3136 +        OldSQLVar := FIBXSQLVAR;
3137 +        FIBXSQLVAR := Column[i];
3138 +        try
3139 +          inherited SetAsBcd(AValue);
3140 +        finally
3141 +          FIBXSQLVAR := OldSQLVar;
3142 +        end;
3143 +      end;
3144 +  end;
3145 + end;
3146 +
3147   { TMetaData }
3148  
3149   procedure TMetaData.CheckActive;
# Line 2475 | Line 3282 | begin
3282      end;
3283   end;
3284  
3285 + function TSQLParams.GetHasCaseSensitiveParams: Boolean;
3286 + begin
3287 +  Result := FSQLParams.CaseSensitiveParams;
3288 + end;
3289 +
3290   { TResults }
3291  
3292   procedure TResults.CheckActive;
# Line 2487 | Line 3299 | begin
3299    if not FResults.CheckStatementStatus(ssPrepared)  then
3300      IBError(ibxeStatementNotPrepared, [nil]);
3301  
3302 <  with GetTransaction as TFBTransaction do
3302 >  with GetTransaction do
3303    if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3304      IBError(ibxeInterfaceOutofDate,[nil]);
3305   end;
3306  
3307   function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
3308 + var col: TIBSQLData;
3309   begin
3310    if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
3311      IBError(ibxeInvalidColumnIndex,[nil]);
3312  
3313    if not HasInterface(aIBXSQLVAR.Index) then
3314      AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3315 <  Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3315 >  col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3316 >  col.FTransaction := GetTransaction;
3317 >  Result := col;
3318   end;
3319  
3320   constructor TResults.Create(aResults: TSQLDataArea);
# Line 2556 | Line 3371 | begin
3371    FResults.GetData(index,IsNull, len,data);
3372   end;
3373  
3374 + function TResults.GetStatement: IStatement;
3375 + begin
3376 +  Result := FStatement;
3377 + end;
3378 +
3379   function TResults.GetTransaction: ITransaction;
3380   begin
3381    Result := FStatement.GetTransaction;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines