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 59 by tony, Mon Mar 13 09:51:56 2017 UTC vs.
ibx/branches/journaling/fbintf/client/FBSQLData.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 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);
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 196 | 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 218 | 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 236 | 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 +    FArrayIntf: IArray;
293 +    function GetAttachment: IAttachment; virtual; abstract;
294      function GetSQLType: cardinal; virtual; abstract;
295      function GetSubtype: integer; virtual; abstract;
296      function GetAliasName: AnsiString;  virtual; abstract;
# Line 247 | Line 299 | type
299      function GetRelationName: AnsiString;  virtual; abstract;
300      function GetScale: integer; virtual; abstract;
301      function GetCharSetID: cardinal; virtual; abstract;
302 +    function GetCharSetWidth: integer; virtual; abstract;
303      function GetCodePage: TSystemCodePage; virtual; abstract;
304      function GetIsNull: Boolean;   virtual; abstract;
305      function GetIsNullable: boolean; virtual; abstract;
306      function GetSQLData: PByte;  virtual; abstract;
307 <    function GetDataLength: cardinal; virtual; abstract;
307 >    function GetDataLength: cardinal; virtual; abstract; {current field length}
308 >    function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
309 >    function GetDefaultTextSQLType: cardinal; virtual; abstract;
310      procedure SetIsNull(Value: Boolean); virtual; abstract;
311      procedure SetIsNullable(Value: Boolean);  virtual; abstract;
312      procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
# Line 259 | Line 314 | type
314      procedure SetDataLength(len: cardinal); virtual; abstract;
315      procedure SetSQLType(aValue: cardinal); virtual; abstract;
316      procedure SetCharSetID(aValue: cardinal); virtual; abstract;
317 +    procedure SetMetaSize(aValue: cardinal); virtual;
318    public
319      constructor Create(aParent: TSQLDataArea; aIndex: integer);
320      procedure SetString(aValue: AnsiString);
321      procedure Changed; virtual;
322      procedure RowChange; virtual;
323 <    function GetAsArray(Array_ID: TISC_QUAD): IArray; virtual; abstract;
323 >    function GetAsArray: IArray; virtual; abstract;
324      function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; virtual; abstract;
325      function CreateBlob: IBlob; virtual; abstract;
326      function GetArrayMetaData: IArrayMetaData; virtual; abstract;
327      function GetBlobMetaData: IBlobMetaData; virtual; abstract;
328 +    function getColMetadata: IParamMetaData;
329      procedure Initialize; virtual;
330 +    procedure SaveMetaData;
331 +    procedure SetArray(AValue: IArray);
332  
333    public
334      property AliasName: AnsiString read GetAliasName;
# Line 300 | Line 359 | type
359      FIBXSQLVAR: TSQLVarData;
360      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
361      FPrepareSeqNo: integer;
303    FStatement: IStatement;
362      FChangeSeqNo: integer;
363    protected
364      procedure CheckActive; override;
365 +    function GetAttachment: IAttachment; override;
366      function SQLData: PByte; override;
367      function GetDataLength: cardinal; override;
368      function GetCodePage: TSystemCodePage; override;
# Line 312 | Line 371 | type
371      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
372      destructor Destroy; override;
373      function GetSQLDialect: integer; override;
315    property Statement: IStatement read FStatement;
374  
375    public
376      {IColumnMetaData}
# Line 327 | Line 385 | type
385      function GetScale: integer; override;
386      function getCharSetID: cardinal; override;
387      function GetIsNullable: boolean; override;
388 <    function GetSize: cardinal;
388 >    function GetSize: cardinal; override;
389 >    function GetCharSetWidth: integer; override;
390      function GetArrayMetaData: IArrayMetaData;
391      function GetBlobMetaData: IBlobMetaData;
392 +    function GetStatement: IStatement;
393 +    function GetTransaction: ITransaction; virtual;
394      property Name: AnsiString read GetName;
395      property Size: cardinal read GetSize;
396      property CharSetID: cardinal read getCharSetID;
397      property SQLSubtype: integer read getSubtype;
398      property IsNullable: Boolean read GetIsNullable;
399 +  public
400 +    property Statement: IStatement read GetStatement;
401    end;
402  
403    { TIBSQLData }
404  
405    TIBSQLData = class(TColumnMetaData,ISQLData)
406 +  private
407 +    FTransaction: ITransaction;
408    protected
409      procedure CheckActive; override;
410    public
411 +    function GetTransaction: ITransaction; override;
412      function GetIsNull: Boolean; override;
413      function GetAsArray: IArray;
414      function GetAsBlob: IBlob; overload;
# Line 351 | Line 417 | type
417      property AsBlob: IBlob read GetAsBlob;
418   end;
419  
420 +  { TSQLParamMetaData }
421 +
422 +  TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
423 +  private
424 +    FSQLType: cardinal;
425 +    FSQLSubType: integer;
426 +    FScale: integer;
427 +    FCharSetID: cardinal;
428 +    FNullable: boolean;
429 +    FSize: cardinal;
430 +    FCodePage: TSystemCodePage;
431 +  public
432 +    constructor Create(src: TSQLVarData);
433 +    {IParamMetaData}
434 +    function GetSQLType: cardinal;
435 +    function GetSQLTypeName: AnsiString;
436 +    function getSubtype: integer;
437 +    function getScale: integer;
438 +    function getCharSetID: cardinal;
439 +    function getCodePage: TSystemCodePage;
440 +    function getIsNullable: boolean;
441 +    function GetSize: cardinal;
442 +    property SQLType: cardinal read GetSQLType;
443 +  end;
444 +
445    { TSQLParam }
446  
447 <  TSQLParam = class(TIBSQLData,ISQLParam)
447 >  TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
448    protected
449      procedure CheckActive; override;
450      procedure Changed; override;
# Line 363 | Line 454 | type
454      procedure SetSQLType(aValue: cardinal); override;
455    public
456      procedure Clear;
457 +    function getColMetadata: IParamMetaData;
458      function GetModified: boolean; override;
459      function GetAsPointer: Pointer;
460 +    function GetAsString: AnsiString; override;
461      procedure SetName(Value: AnsiString); override;
462      procedure SetIsNull(Value: Boolean);  override;
463      procedure SetIsNullable(Value: Boolean); override;
# Line 376 | Line 469 | type
469      procedure SetAsInt64(AValue: Int64);
470      procedure SetAsDate(AValue: TDateTime);
471      procedure SetAsLong(AValue: Long);
472 <    procedure SetAsTime(AValue: TDateTime);
473 <    procedure SetAsDateTime(AValue: TDateTime);
472 >    procedure SetAsTime(AValue: TDateTime); overload;
473 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
474 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
475 >    procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
476 >    procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
477 >    procedure SetAsDateTime(AValue: TDateTime); overload;
478 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
479 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
480      procedure SetAsDouble(AValue: Double);
481      procedure SetAsFloat(AValue: Float);
482      procedure SetAsPointer(AValue: Pointer);
# Line 387 | Line 486 | type
486      procedure SetAsBlob(aValue: IBlob);
487      procedure SetAsQuad(AValue: TISC_QUAD);
488      procedure SetCharSetID(aValue: cardinal);
489 +    procedure SetAsBcd(aValue: tBCD);
490  
491      property AsBlob: IBlob read GetAsBlob write SetAsBlob;
492      property IsNullable: Boolean read GetIsNullable write SetIsNullable;
# Line 429 | Line 529 | type
529      function getSQLParam(index: integer): ISQLParam;
530      function ByName(Idx: AnsiString): ISQLParam ;
531      function GetModified: Boolean;
532 +    function GetHasCaseSensitiveParams: Boolean;
533    end;
534  
535    { TResults }
# Line 450 | Line 551 | type
551       function ByName(Idx: AnsiString): ISQLData;
552       function getSQLData(index: integer): ISQLData;
553       procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
554 +     function GetStatement: IStatement;
555       function GetTransaction: ITransaction; virtual;
556       procedure SetRetainInterfaces(aValue: boolean);
557   end;
558  
559   implementation
560  
561 < uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
561 > uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
562 >
563 > { TSQLParamMetaData }
564 >
565 > constructor TSQLParamMetaData.Create(src: TSQLVarData);
566 > begin
567 >  inherited Create;
568 >  FSQLType := src.GetSQLType;
569 >  FSQLSubType := src.getSubtype;
570 >  FScale := src.GetScale;
571 >  FCharSetID := src.getCharSetID;
572 >  FNullable := src.GetIsNullable;
573 >  FSize := src.GetSize;
574 >  FCodePage := src.GetCodePage;
575 > end;
576 >
577 > function TSQLParamMetaData.GetSQLType: cardinal;
578 > begin
579 >  Result := FSQLType;
580 > end;
581 >
582 > function TSQLParamMetaData.GetSQLTypeName: AnsiString;
583 > begin
584 >  Result := TSQLDataItem.GetSQLTypeName(FSQLType);
585 > end;
586  
587 + function TSQLParamMetaData.getSubtype: integer;
588 + begin
589 +  Result := FSQLSubType;
590 + end;
591 +
592 + function TSQLParamMetaData.getScale: integer;
593 + begin
594 +  Result := FScale;
595 + end;
596 +
597 + function TSQLParamMetaData.getCharSetID: cardinal;
598 + begin
599 +  Result := FCharSetID;
600 + end;
601 +
602 + function TSQLParamMetaData.getCodePage: TSystemCodePage;
603 + begin
604 +  Result :=  FCodePage;
605 + end;
606 +
607 + function TSQLParamMetaData.getIsNullable: boolean;
608 + begin
609 +  Result :=  FNullable;
610 + end;
611 +
612 + function TSQLParamMetaData.GetSize: cardinal;
613 + begin
614 +  Result := FSize;
615 + end;
616  
617   { TSQLDataArea }
618  
# Line 510 | Line 665 | end;
665  
666   procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
667    var sProcessedSQL: AnsiString);
513 var
514  cCurChar, cNextChar, cQuoteChar: AnsiChar;
515  sParamName: AnsiString;
516  j, i, iLenSQL, iSQLPos: Integer;
517  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
518  iParamSuffix: Integer;
519  slNames: TStrings;
520  StrBuffer: PByte;
521  found: boolean;
522
523 const
524  DefaultState = 0;
525  CommentState = 1;
526  QuoteState = 2;
527  ParamState = 3;
528  ArrayDimState = 4;
529 {$ifdef ALLOWDIALECT3PARAMNAMES}
530  ParamDefaultState = 0;
531  ParamQuoteState = 1;
532  {$endif}
533
534  procedure AddToProcessedSQL(cChar: AnsiChar);
535  begin
536    StrBuffer[iSQLPos] := byte(cChar);
537    Inc(iSQLPos);
538  end;
539
540 begin
541  if not IsInputDataArea then
542    IBError(ibxeNotPermitted,[nil]);
543
544  sParamName := '';
545  iLenSQL := Length(sSQL);
546  GetMem(StrBuffer,iLenSQL + 1);
547  slNames := TStringList.Create;
548  try
549    { Do some initializations of variables }
550    iParamSuffix := 0;
551    cQuoteChar := '''';
552    i := 1;
553    iSQLPos := 0;
554    iCurState := DefaultState;
555    {$ifdef ALLOWDIALECT3PARAMNAMES}
556    iCurParamState := ParamDefaultState;
557    {$endif}
558    { Now, traverse through the SQL string, character by character,
559     picking out the parameters and formatting correctly for InterBase }
560    while (i <= iLenSQL) do begin
561      { Get the current token and a look-ahead }
562      cCurChar := sSQL[i];
563      if i = iLenSQL then
564        cNextChar := #0
565      else
566        cNextChar := sSQL[i + 1];
567      { Now act based on the current state }
568      case iCurState of
569        DefaultState:
570        begin
571          case cCurChar of
572            '''', '"':
573            begin
574              cQuoteChar := cCurChar;
575              iCurState := QuoteState;
576            end;
577            '?', ':':
578            begin
579              iCurState := ParamState;
580              AddToProcessedSQL('?');
581            end;
582            '/': if (cNextChar = '*') then
583            begin
584              AddToProcessedSQL(cCurChar);
585              Inc(i);
586              iCurState := CommentState;
587            end;
588            '[':
589            begin
590              AddToProcessedSQL(cCurChar);
591              Inc(i);
592              iCurState := ArrayDimState;
593            end;
594          end;
595        end;
668  
669 <        ArrayDimState:
598 <        begin
599 <          case cCurChar of
600 <          ':',',','0'..'9',' ',#9,#10,#13:
601 <            begin
602 <              AddToProcessedSQL(cCurChar);
603 <              Inc(i);
604 <            end;
605 <          else
606 <            begin
607 <              AddToProcessedSQL(cCurChar);
608 <              Inc(i);
609 <              iCurState := DefaultState;
610 <            end;
611 <          end;
612 <        end;
669 > var slNames: TStrings;
670  
671 <        CommentState:
672 <        begin
673 <          if (cNextChar = #0) then
674 <            IBError(ibxeSQLParseError, [SEOFInComment])
675 <          else if (cCurChar = '*') then begin
619 <            if (cNextChar = '/') then
620 <              iCurState := DefaultState;
621 <          end;
622 <        end;
623 <        QuoteState: begin
624 <          if cNextChar = #0 then
625 <            IBError(ibxeSQLParseError, [SEOFInString])
626 <          else if (cCurChar = cQuoteChar) then begin
627 <            if (cNextChar = cQuoteChar) then begin
628 <              AddToProcessedSQL(cCurChar);
629 <              Inc(i);
630 <            end else
631 <              iCurState := DefaultState;
632 <          end;
633 <        end;
634 <        ParamState:
635 <        begin
636 <          { collect the name of the parameter }
637 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
638 <          if iCurParamState = ParamDefaultState then
639 <          begin
640 <            if cCurChar = '"' then
641 <              iCurParamState := ParamQuoteState
642 <            else
643 <            {$endif}
644 <            if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
645 <                sParamName := sParamName + cCurChar
646 <            else if GenerateParamNames then
647 <            begin
648 <              sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
649 <              Inc(iParamSuffix);
650 <              iCurState := DefaultState;
651 <              slNames.AddObject(sParamName,self); //Note local convention
652 <                                                  //add pointer to self to mark entry
653 <              sParamName := '';
654 <            end
655 <            else
656 <              IBError(ibxeSQLParseError, [SParamNameExpected]);
657 <          {$ifdef ALLOWDIALECT3PARAMNAMES}
658 <          end
659 <          else begin
660 <            { determine if Quoted parameter name is finished }
661 <            if cCurChar = '"' then
662 <            begin
663 <              Inc(i);
664 <              slNames.Add(sParamName);
665 <              SParamName := '';
666 <              iCurParamState := ParamDefaultState;
667 <              iCurState := DefaultState;
668 <            end
669 <            else
670 <              sParamName := sParamName + cCurChar
671 <          end;
672 <          {$endif}
673 <          { determine if the unquoted parameter name is finished }
674 <          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
675 <            (iCurState <> DefaultState) then
676 <          begin
677 <            if not (cNextChar in ['A'..'Z', 'a'..'z',
678 <                                  '0'..'9', '_', '$']) then begin
679 <              Inc(i);
680 <              iCurState := DefaultState;
681 <              slNames.Add(sParamName);
682 <              sParamName := '';
683 <            end;
684 <          end;
685 <        end;
686 <      end;
687 <      if (iCurState <> ParamState) and (i <= iLenSQL) then
688 <        AddToProcessedSQL(sSQL[i]);
689 <      Inc(i);
690 <    end;
691 <    AddToProcessedSQL(#0);
692 <    sProcessedSQL := strpas(PAnsiChar(StrBuffer));
671 >  procedure SetColumnNames(slNames: TStrings);
672 >  var i, j: integer;
673 >      found: boolean;
674 >  begin
675 >    found := false;
676      SetCount(slNames.Count);
677      for i := 0 to slNames.Count - 1 do
678      begin
# Line 710 | Line 693 | begin
693          Column[i].UniqueName := not found;
694        end;
695      end;
696 +  end;
697 +
698 + begin
699 +  if not IsInputDataArea then
700 +    IBError(ibxeNotPermitted,[nil]);
701 +
702 +  slNames := TStringList.Create;
703 +  try
704 +    sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
705 +    SetColumnNames(slNames);
706    finally
707      slNames.Free;
715    FreeMem(StrBuffer);
708    end;
709   end;
710  
# Line 726 | Line 718 | var
718    s: AnsiString;
719    i: Integer;
720   begin
721 <  {$ifdef UseCaseInSensitiveParamName}
722 <   s := AnsiUpperCase(Idx);
723 <  {$else}
721 >  if not IsInputDataArea or not CaseSensitiveParams then
722 >   s := AnsiUpperCase(Idx)
723 >  else
724     s := Idx;
725 <  {$endif}
725 >
726    for i := 0 to Count - 1 do
727      if Column[i].Name = s then
728      begin
# Line 762 | Line 754 | end;
754  
755   procedure TSQLVarData.SetName(AValue: AnsiString);
756   begin
757 <  if FName = AValue then Exit;
766 <  {$ifdef UseCaseInSensitiveParamName}
767 <  if Parent.IsInputDataArea then
757 >  if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
758      FName := AnsiUpperCase(AValue)
759    else
770  {$endif}
760      FName := AValue;
761   end;
762  
763 + procedure TSQLVarData.SetMetaSize(aValue: cardinal);
764 + begin
765 +  //Ignore
766 + end;
767 +
768 + procedure TSQLVarData.SaveMetaData;
769 + begin
770 +  FColMetaData := TSQLParamMetaData.Create(self);
771 + end;
772 +
773 + procedure TSQLVarData.SetArray(AValue: IArray);
774 + begin
775 +  FArrayIntf := AValue;
776 + end;
777 +
778   constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
779   begin
780    inherited Create;
# Line 787 | Line 791 | begin
791     a zero byte when the string is empty, neatly avoiding a nil pointer error.}
792  
793    FVarString := aValue;
794 <  SQLType := SQL_TEXT;
794 >  if SQLType = SQL_BLOB then
795 >    SetMetaSize(GetAttachment.GetInlineBlobLimit);
796 >  SQLType := GetDefaultTextSQLType;
797 >  Scale := 0;
798    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
799   end;
800  
# Line 798 | Line 805 | end;
805  
806   procedure TSQLVarData.RowChange;
807   begin
808 +  FArrayIntf := nil;
809    FModified := false;
810    FVarString := '';
811   end;
812  
813 + function TSQLVarData.getColMetadata: IParamMetaData;
814 + begin
815 +  Result := FColMetaData;
816 + end;
817 +
818   procedure TSQLVarData.Initialize;
819  
820    function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
# Line 902 | Line 915 | begin
915      result := Val;
916   end;
917  
918 + function TSQLDataItem.AdjustScaleToStr(Value: Int64; aScale: Integer
919 +  ): AnsiString;
920 + var Scaling : AnsiString;
921 +    i: Integer;
922 + begin
923 +  Result := IntToStr(Value);
924 +  Scaling := '';
925 +  if aScale > 0 then
926 +  begin
927 +    for i := 1 to aScale do
928 +      Result := Result + '0';
929 +  end
930 +  else
931 +  if aScale < 0 then
932 +  {$IF declared(DefaultFormatSettings)}
933 +  with DefaultFormatSettings do
934 +  {$ELSE}
935 +  {$IF declared(FormatSettings)}
936 +  with FormatSettings do
937 +  {$IFEND}
938 +  {$IFEND}
939 +  begin
940 +    if Length(Result) > -aScale then
941 +      system.Insert(DecimalSeparator,Result,Length(Result) + aScale)
942 +    else
943 +    begin
944 +      Scaling := '0' + DecimalSeparator;
945 +      for i := -1 downto aScale + Length(Result) do
946 +        Scaling := Scaling + '0';
947 +      Result := Scaling + Result;
948 +    end;
949 +  end;
950 + end;
951 +
952   function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
953    ): Currency;
954   var
# Line 948 | Line 995 | begin
995        result := Value;
996   end;
997  
998 + function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
999 + begin
1000 +  {$IF declared(DefaultFormatSettings)}
1001 +  with DefaultFormatSettings do
1002 +  {$ELSE}
1003 +  {$IF declared(FormatSettings)}
1004 +  with FormatSettings do
1005 +  {$IFEND}
1006 +  {$IFEND}
1007 +  case GetSQLDialect of
1008 +    1:
1009 +      if IncludeTime then
1010 +        result := ShortDateFormat + ' ' + LongTimeFormat
1011 +      else
1012 +        result := ShortDateFormat;
1013 +    3:
1014 +      result := ShortDateFormat;
1015 +  end;
1016 + end;
1017 +
1018 + function TSQLDataItem.GetTimeFormatStr: AnsiString;
1019 + begin
1020 +  {$IF declared(DefaultFormatSettings)}
1021 +  with DefaultFormatSettings do
1022 +  {$ELSE}
1023 +  {$IF declared(FormatSettings)}
1024 +  with FormatSettings do
1025 +  {$IFEND}
1026 +  {$IFEND}
1027 +    Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
1028 + end;
1029 +
1030 + function TSQLDataItem.GetTimestampFormatStr: AnsiString;
1031 + begin
1032 +  {$IF declared(DefaultFormatSettings)}
1033 +  with DefaultFormatSettings do
1034 +  {$ELSE}
1035 +  {$IF declared(FormatSettings)}
1036 +  with FormatSettings do
1037 +  {$IFEND}
1038 +  {$IFEND}
1039 +    Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
1040 + end;
1041 +
1042   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
1043   begin
1044    SetAsLong(aValue);
1045   end;
1046  
1047 + procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
1048 +  var dstOffset: smallint; var aTimezone: AnsiString;
1049 +  var aTimeZoneID: TFBTimeZoneID);
1050 + begin
1051 +  CheckActive;
1052 +  aDateTime := 0;
1053 +  dstOffset := 0;
1054 +  aTimezone := '';
1055 +  aTimeZoneID := TimeZoneID_GMT;
1056 +  if not IsNull then
1057 +    with FFirebirdClientAPI do
1058 +    case SQLType of
1059 +      SQL_TEXT, SQL_VARYING:
1060 +        if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
1061 +          IBError(ibxeInvalidDataConversion, [nil]);
1062 +      SQL_TYPE_DATE:
1063 +        aDateTime := SQLDecodeDate(SQLData);
1064 +      SQL_TYPE_TIME:
1065 +        aDateTime := SQLDecodeTime(SQLData);
1066 +      SQL_TIMESTAMP:
1067 +        aDateTime := SQLDecodeDateTime(SQLData);
1068 +      SQL_TIMESTAMP_TZ:
1069 +        begin
1070 +          GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
1071 +          aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
1072 +        end;
1073 +      SQL_TIMESTAMP_TZ_EX:
1074 +      begin
1075 +        GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
1076 +        aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
1077 +      end;
1078 +      SQL_TIME_TZ:
1079 +        with GetTimeZoneServices do
1080 +        begin
1081 +          DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1082 +          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1083 +        end;
1084 +      SQL_TIME_TZ_EX:
1085 +        with GetTimeZoneServices do
1086 +        begin
1087 +          DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1088 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1089 +        end;
1090 +      else
1091 +        IBError(ibxeInvalidDataConversion, [nil]);
1092 +    end;
1093 + end;
1094 +
1095   function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1096    ): Int64;
1097   var
# Line 1001 | Line 1140 | begin
1140    end
1141    else
1142      result := trunc(Value);
1143 + //  writeln('Adjusted ',Value,' to ',Result);
1144   end;
1145  
1146   procedure TSQLDataItem.CheckActive;
# Line 1008 | Line 1148 | begin
1148    //Do nothing by default
1149   end;
1150  
1151 + procedure TSQLDataItem.CheckTZSupport;
1152 + begin
1153 +  if not FFirebirdClientAPI.HasTimeZoneSupport then
1154 +    IBError(ibxeNoTimezoneSupport,[]);
1155 + end;
1156 +
1157 + function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1158 + begin
1159 +  if FTimeZoneServices = nil then
1160 +  begin
1161 +    if not GetAttachment.HasTimeZoneSupport then
1162 +      IBError(ibxeNoTimezoneSupport,[]);
1163 +    GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1164 +  end;
1165 +  Result := FTimeZoneServices;
1166 + end;
1167 +
1168   procedure TSQLDataItem.Changed;
1169   begin
1170    //Do nothing by default
# Line 1046 | Line 1203 | begin
1203     //Do nothing by default
1204   end;
1205  
1206 + constructor TSQLDataItem.Create(api: TFBClientAPI);
1207 + begin
1208 +  inherited Create;
1209 +  FFirebirdClientAPI := api;
1210 + end;
1211 +
1212   function TSQLDataItem.GetSQLTypeName: AnsiString;
1213   begin
1214    Result := GetSQLTypeName(GetSQLType);
1215   end;
1216  
1217 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1217 > class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1218   begin
1219    Result := 'Unknown';
1220    case SQLType of
# Line 1062 | Line 1225 | begin
1225    SQL_LONG:             Result := 'SQL_LONG';
1226    SQL_SHORT:            Result := 'SQL_SHORT';
1227    SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1228 +  SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1229 +  SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1230    SQL_BLOB:             Result := 'SQL_BLOB';
1231    SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1232    SQL_ARRAY:            Result := 'SQL_ARRAY';
# Line 1069 | Line 1234 | begin
1234    SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1235    SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1236    SQL_INT64:            Result := 'SQL_INT64';
1237 +  SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1238 +  SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1239 +  SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1240 +  SQL_DEC16:            Result := 'SQL_DEC16';
1241 +  SQL_DEC34:            Result := 'SQL_DEC34';
1242 +  SQL_INT128:           Result := 'SQL_INT128';
1243 +  SQL_NULL:             Result := 'SQL_NULL';
1244 +  SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1245    end;
1246   end;
1247  
1248 + function TSQLDataItem.GetStrDataLength: short;
1249 + begin
1250 +  with FFirebirdClientAPI do
1251 +  if SQLType = SQL_VARYING then
1252 +    Result := DecodeInteger(SQLData, 2)
1253 +  else
1254 +    Result := DataLength;
1255 + end;
1256 +
1257   function TSQLDataItem.GetAsBoolean: boolean;
1258   begin
1259    CheckActive;
# Line 1111 | Line 1293 | begin
1293            result := AdjustScaleToCurrency(PInt64(SQLData)^,
1294                                        Scale);
1295          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1296 <          result := Trunc(AsDouble);
1296 >          result := Round(AsDouble);
1297 >
1298 >        SQL_DEC_FIXED,
1299 >        SQL_DEC16,
1300 >        SQL_DEC34,
1301 >        SQL_INT128:
1302 >          if not BCDToCurr(GetAsBCD,Result) then
1303 >            IBError(ibxeInvalidDataConversion, [nil]);
1304 >
1305          else
1306            IBError(ibxeInvalidDataConversion, [nil]);
1307        end;
# Line 1141 | Line 1331 | begin
1331          result := AdjustScaleToInt64(PInt64(SQLData)^,
1332                                      Scale);
1333        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1334 <        result := Trunc(AsDouble);
1334 >        result := Round(AsDouble);
1335        else
1336          IBError(ibxeInvalidDataConversion, [nil]);
1337      end;
1338   end;
1339  
1340   function TSQLDataItem.GetAsDateTime: TDateTime;
1341 + var aTimezone: AnsiString;
1342 +    aTimeZoneID: TFBTimeZoneID;
1343 +    dstOffset: smallint;
1344 + begin
1345 +  InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1346 + end;
1347 +
1348 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1349 +  var dstOffset: smallint; var aTimezone: AnsiString);
1350 + var aTimeZoneID: TFBTimeZoneID;
1351 + begin
1352 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1353 + end;
1354 +
1355 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1356 +  var aTimezoneID: TFBTimeZoneID);
1357 + var aTimezone: AnsiString;
1358 + begin
1359 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1360 + end;
1361 +
1362 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1363 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1364 + var aTimeZone: AnsiString;
1365   begin
1366    CheckActive;
1367 <  result := 0;
1367 >  aTime := 0;
1368 >  dstOffset := 0;
1369    if not IsNull then
1370 <    with FirebirdClientAPI do
1370 >    with FFirebirdClientAPI do
1371      case SQLType of
1372 <      SQL_TEXT, SQL_VARYING: begin
1373 <        try
1374 <          result := StrToDate(AsString);
1375 <        except
1161 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1372 >      SQL_TIME_TZ:
1373 >        begin
1374 >          GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1375 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1376          end;
1377 +      SQL_TIME_TZ_EX:
1378 +        begin
1379 +          GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1380 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1381 +        end;
1382 +    else
1383 +      IBError(ibxeInvalidDataConversion, [nil]);
1384 +    end;
1385 + end;
1386 +
1387 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1388 +  var aTimezone: AnsiString; OnDate: TDateTime);
1389 + begin
1390 +  CheckActive;
1391 +  aTime := 0;
1392 +  dstOffset := 0;
1393 +  if not IsNull then
1394 +    with FFirebirdClientAPI do
1395 +    case SQLType of
1396 +      SQL_TIME_TZ:
1397 +        GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1398 +      SQL_TIME_TZ_EX:
1399 +        GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1400 +    else
1401 +      IBError(ibxeInvalidDataConversion, [nil]);
1402 +    end;
1403 + end;
1404 +
1405 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1406 +  var aTimezoneID: TFBTimeZoneID);
1407 + begin
1408 +  GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1409 + end;
1410 +
1411 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1412 +  var aTimezone: AnsiString);
1413 + begin
1414 +  GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1415 + end;
1416 +
1417 + function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1418 + var aTimezone: AnsiString;
1419 + begin
1420 +  CheckActive;
1421 +  result := 0;
1422 +  aTimezone := '';
1423 +  if not IsNull then
1424 +    with FFirebirdClientAPI do
1425 +    case SQLType of
1426 +      SQL_TEXT, SQL_VARYING:
1427 +      begin
1428 +        if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1429 +          IBError(ibxeInvalidDataConversion, [nil]);
1430 +        Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1431        end;
1432        SQL_TYPE_DATE:
1433          result := SQLDecodeDate(SQLData);
1434 <      SQL_TYPE_TIME:
1434 >      SQL_TYPE_TIME,
1435 >      SQL_TIME_TZ,
1436 >      SQL_TIME_TZ_EX:
1437          result := SQLDecodeTime(SQLData);
1438 <      SQL_TIMESTAMP:
1438 >      SQL_TIMESTAMP,
1439 >      SQL_TIMESTAMP_TZ,
1440 >      SQL_TIMESTAMP_TZ_EX:
1441          result := SQLDecodeDateTime(SQLData);
1442        else
1443          IBError(ibxeInvalidDataConversion, [nil]);
1444 <    end;
1444 >      end;
1445   end;
1446  
1447   function TSQLDataItem.GetAsDouble: Double;
# Line 1197 | Line 1469 | begin
1469          result := PFloat(SQLData)^;
1470        SQL_DOUBLE, SQL_D_FLOAT:
1471          result := PDouble(SQLData)^;
1472 +      SQL_DEC_FIXED,
1473 +      SQL_DEC16,
1474 +      SQL_DEC34,
1475 +      SQL_INT128:
1476 +        Result := BCDToDouble(GetAsBCD);
1477        else
1478          IBError(ibxeInvalidDataConversion, [nil]);
1479      end;
# Line 1233 | Line 1510 | begin
1510          end;
1511        end;
1512        SQL_SHORT:
1513 <        result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1513 >        result := Round(AdjustScale(Int64(PShort(SQLData)^),
1514                                      Scale));
1515        SQL_LONG:
1516 <        result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1516 >        result := Round(AdjustScale(Int64(PLong(SQLData)^),
1517                                      Scale));
1518        SQL_INT64:
1519 <        result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1519 >        result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1520        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1521 <        result := Trunc(AsDouble);
1521 >        result := Round(AsDouble);
1522 >      SQL_DEC_FIXED,
1523 >      SQL_DEC16,
1524 >      SQL_DEC34,
1525 >      SQL_INT128:
1526 >        Result := BCDToInteger(GetAsBCD);
1527        else
1528 <        IBError(ibxeInvalidDataConversion, [nil]);
1528 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1529      end;
1530   end;
1531  
# Line 1281 | Line 1563 | begin
1563    end;
1564   end;
1565  
1566 + {Copied from LazUTF8}
1567 +
1568 + function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1569 + const TopBitSetMask   = $80; {%10000000}
1570 +      Top2BitsSetMask = $C0; {%11000000}
1571 +      Top3BitsSetMask = $E0; {%11100000}
1572 +      Top4BitsSetMask = $F0; {%11110000}
1573 +      Top5BitsSetMask = $F8; {%11111000}
1574 + begin
1575 +  case p^ of
1576 +  #0..#191: // %11000000
1577 +    // regular single byte character (#0 is a character, this is Pascal ;)
1578 +    Result:=1;
1579 +  #192..#223: // p^ and %11100000 = %11000000
1580 +    begin
1581 +      // could be 2 byte character
1582 +      if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1583 +        Result:=2
1584 +      else
1585 +        Result:=1;
1586 +    end;
1587 +  #224..#239: // p^ and %11110000 = %11100000
1588 +    begin
1589 +      // could be 3 byte character
1590 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1591 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1592 +        Result:=3
1593 +      else
1594 +        Result:=1;
1595 +    end;
1596 +  #240..#247: // p^ and %11111000 = %11110000
1597 +    begin
1598 +      // could be 4 byte character
1599 +      if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1600 +      and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1601 +      and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1602 +        Result:=4
1603 +      else
1604 +        Result:=1;
1605 +    end;
1606 +  else
1607 +    Result:=1;
1608 +  end;
1609 + end;
1610 +
1611 + {Returns the byte length of a UTF8 string with a fixed charwidth}
1612 +
1613 + function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1614 + var i: integer;
1615 +    cplen: integer;
1616 + begin
1617 +  Result := 0;
1618 +  for i := 1 to FieldWidth do
1619 +  begin
1620 +    cplen := UTF8CodepointSizeFull(p);
1621 +    Inc(p,cplen);
1622 +    Inc(Result,cplen);
1623 +    if Result >= MaxDataLength then
1624 +    begin
1625 +      Result := MaxDataLength;
1626 +      Exit;
1627 +    end;
1628 +  end;
1629 + end;
1630  
1631   function TSQLDataItem.GetAsString: AnsiString;
1632   var
1633    sz: PByte;
1634    str_len: Integer;
1635    rs: RawByteString;
1636 +  aTimeZone: AnsiString;
1637 +  aDateTime: TDateTime;
1638 +  dstOffset: smallint;
1639   begin
1640    CheckActive;
1641    result := '';
1642    { Check null, if so return a default string }
1643    if not IsNull then
1644 <  with FirebirdClientAPI do
1644 >  with FFirebirdClientAPI do
1645      case SQLType of
1646        SQL_BOOLEAN:
1647          if AsBoolean then
# Line 1304 | Line 1653 | begin
1653        begin
1654          sz := SQLData;
1655          if (SQLType = SQL_TEXT) then
1656 <          str_len := DataLength
1656 >        begin
1657 >          if GetCodePage = cp_utf8 then
1658 >            str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1659 >          else
1660 >            str_len := DataLength
1661 >        end
1662          else begin
1663 <          str_len := DecodeInteger(SQLData, 2);
1663 >          str_len := DecodeInteger(sz, 2);
1664            Inc(sz, 2);
1665          end;
1666          SetString(rs, PAnsiChar(sz), str_len);
1667          SetCodePage(rs,GetCodePage,false);
1668 <        if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1315 <          Result := TrimRight(rs)
1316 <        else
1317 <          Result := rs
1668 >        Result := rs;
1669        end;
1670 +
1671        SQL_TYPE_DATE:
1672 <        case GetSQLDialect of
1321 <          1 : result := DateTimeToStr(AsDateTime);
1322 <          3 : result := DateToStr(AsDateTime);
1323 <        end;
1324 <      SQL_TYPE_TIME :
1325 <        result := TimeToStr(AsDateTime);
1672 >        Result := DateToStr(GetAsDateTime);
1673        SQL_TIMESTAMP:
1674 <      {$IF declared(DefaultFormatSettings)}
1675 <      with DefaultFormatSettings do
1676 <      {$ELSE}
1677 <      {$IF declared(FormatSettings)}
1678 <      with FormatSettings do
1679 <      {$IFEND}
1680 <      {$IFEND}
1681 <        result := FormatDateTime(ShortDateFormat + ' ' +
1682 <                            LongTimeFormat+'.zzz',AsDateTime);
1674 >        Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1675 >      SQL_TYPE_TIME:
1676 >        Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1677 >      SQL_TIMESTAMP_TZ,
1678 >      SQL_TIMESTAMP_TZ_EX:
1679 >        with GetAttachment.GetTimeZoneServices do
1680 >        begin
1681 >          if GetTZTextOption = tzGMT then
1682 >            Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1683 >          else
1684 >          begin
1685 >            GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1686 >            if GetTZTextOption = tzOffset then
1687 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1688 >            else
1689 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1690 >          end;
1691 >        end;
1692 >      SQL_TIME_TZ,
1693 >      SQL_TIME_TZ_EX:
1694 >        with GetAttachment.GetTimeZoneServices do
1695 >        begin
1696 >          if GetTZTextOption = tzGMT then
1697 >             Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1698 >          else
1699 >          begin
1700 >            GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1701 >            if GetTZTextOption = tzOffset then
1702 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1703 >            else
1704 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1705 >          end;
1706 >        end;
1707 >
1708        SQL_SHORT, SQL_LONG:
1709          if Scale = 0 then
1710            result := IntToStr(AsLong)
# Line 1349 | Line 1721 | begin
1721            result := FloatToStr(AsDouble);
1722        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1723          result := FloatToStr(AsDouble);
1724 +
1725 +      SQL_DEC16,
1726 +      SQL_DEC34:
1727 +        result := BCDToStr(GetAsBCD);
1728 +
1729 +      SQL_DEC_FIXED,
1730 +      SQL_INT128:
1731 +        result := Int128ToStr(SQLData,scale);
1732 +
1733        else
1734          IBError(ibxeInvalidDataConversion, [nil]);
1735      end;
# Line 1360 | Line 1741 | begin
1741    Result := false;
1742   end;
1743  
1744 < function TSQLDataItem.getIsNullable: boolean;
1744 > function TSQLDataItem.GetIsNullable: boolean;
1745   begin
1746    CheckActive;
1747    Result := false;
1748   end;
1749  
1750   function TSQLDataItem.GetAsVariant: Variant;
1751 + var ts: TDateTime;
1752 +  dstOffset: smallint;
1753 +    timezone: AnsiString;
1754   begin
1755    CheckActive;
1756    if IsNull then
# Line 1380 | Line 1764 | begin
1764          result := AsString;
1765        SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1766          result := AsDateTime;
1767 +      SQL_TIMESTAMP_TZ,
1768 +      SQL_TIME_TZ,
1769 +      SQL_TIMESTAMP_TZ_EX,
1770 +      SQL_TIME_TZ_EX:
1771 +        begin
1772 +          GetAsDateTime(ts,dstOffset,timezone);
1773 +          result := VarArrayOf([ts,dstOffset,timezone]);
1774 +        end;
1775        SQL_SHORT, SQL_LONG:
1776          if Scale = 0 then
1777            result := AsLong
# Line 1398 | Line 1790 | begin
1790          result := AsDouble;
1791        SQL_BOOLEAN:
1792          result := AsBoolean;
1793 +      SQL_DEC_FIXED,
1794 +      SQL_DEC16,
1795 +      SQL_DEC34,
1796 +      SQL_INT128:
1797 +        result := VarFmtBCDCreate(GetAsBcd);
1798        else
1799          IBError(ibxeInvalidDataConversion, [nil]);
1800      end;
# Line 1408 | Line 1805 | begin
1805    Result := false;
1806   end;
1807  
1808 + function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1809 +  ): integer;
1810 + begin
1811 +  case DateTimeFormat of
1812 +  dfTimestamp:
1813 +    Result := Length(GetTimestampFormatStr);
1814 +  dfDateTime:
1815 +    Result := Length(GetDateFormatStr(true));
1816 +  dfTime:
1817 +    Result := Length(GetTimeFormatStr);
1818 +  dfTimestampTZ:
1819 +    Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1820 +  dfTimeTZ:
1821 +    Result := Length(GetTimeFormatStr)+ 6;
1822 +  else
1823 +    Result := 0;
1824 +  end;end;
1825 +
1826 + function TSQLDataItem.GetAsBCD: tBCD;
1827 +
1828 + begin
1829 +  CheckActive;
1830 +  if IsNull then
1831 +   with Result do
1832 +   begin
1833 +     FillChar(Result,sizeof(Result),0);
1834 +     Precision := 1;
1835 +     exit;
1836 +   end;
1837 +
1838 +  case SQLType of
1839 +  SQL_DEC16,
1840 +  SQL_DEC34:
1841 +    with FFirebirdClientAPI do
1842 +      Result := SQLDecFloatDecode(SQLType,  SQLData);
1843 +
1844 +  SQL_DEC_FIXED,
1845 +  SQL_INT128:
1846 +    with FFirebirdClientAPI do
1847 +      Result := StrToBCD(Int128ToStr(SQLData,scale));
1848 +  else
1849 +    if not CurrToBCD(GetAsCurrency,Result) then
1850 +      IBError(ibxeBadBCDConversion,[]);
1851 +  end;
1852 + end;
1853 +
1854  
1855   procedure TSQLDataItem.SetIsNull(Value: Boolean);
1856   begin
# Line 1471 | Line 1914 | begin
1914  
1915    SQLType := SQL_TYPE_DATE;
1916    DataLength := SizeOf(ISC_DATE);
1917 <  with FirebirdClientAPI do
1917 >  with FFirebirdClientAPI do
1918      SQLEncodeDate(Value,SQLData);
1919    Changed;
1920   end;
# Line 1491 | Line 1934 | begin
1934  
1935    SQLType := SQL_TYPE_TIME;
1936    DataLength := SizeOf(ISC_TIME);
1937 <  with FirebirdClientAPI do
1937 >  with FFirebirdClientAPI do
1938      SQLEncodeTime(Value,SQLData);
1939    Changed;
1940   end;
1941  
1942 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1943 + begin
1944 +  CheckActive;
1945 +  CheckTZSupport;
1946 +  if GetSQLDialect < 3 then
1947 +  begin
1948 +    AsDateTime := aValue;
1949 +    exit;
1950 +  end;
1951 +
1952 +  Changing;
1953 +  if IsNullable then
1954 +    IsNull := False;
1955 +
1956 +  SQLType := SQL_TIME_TZ;
1957 +  DataLength := SizeOf(ISC_TIME_TZ);
1958 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1959 +  Changed;
1960 + end;
1961 +
1962 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1963 + begin
1964 +  CheckActive;
1965 +  CheckTZSupport;
1966 +  if GetSQLDialect < 3 then
1967 +  begin
1968 +    AsDateTime := aValue;
1969 +    exit;
1970 +  end;
1971 +
1972 +  Changing;
1973 +  if IsNullable then
1974 +    IsNull := False;
1975 +
1976 +  SQLType := SQL_TIME_TZ;
1977 +  DataLength := SizeOf(ISC_TIME_TZ);
1978 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1979 +  Changed;
1980 + end;
1981 +
1982   procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1983   begin
1984    CheckActive;
# Line 1505 | Line 1988 | begin
1988    Changing;
1989    SQLType := SQL_TIMESTAMP;
1990    DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1991 <  with FirebirdClientAPI do
1991 >  with FFirebirdClientAPI do
1992      SQLEncodeDateTime(Value,SQLData);
1993    Changed;
1994   end;
1995  
1996 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1997 +  aTimeZoneID: TFBTimeZoneID);
1998 + begin
1999 +  CheckActive;
2000 +  CheckTZSupport;
2001 +  if IsNullable then
2002 +    IsNull := False;
2003 +
2004 +  Changing;
2005 +  SQLType := SQL_TIMESTAMP_TZ;
2006 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
2007 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
2008 +  Changed;
2009 + end;
2010 +
2011 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
2012 +  );
2013 + begin
2014 +  CheckActive;
2015 +  CheckTZSupport;
2016 +  if IsNullable then
2017 +    IsNull := False;
2018 +
2019 +  Changing;
2020 +  SQLType := SQL_TIMESTAMP_TZ;
2021 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
2022 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
2023 +  Changed;
2024 + end;
2025 +
2026 + procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
2027 + begin
2028 +  SetAsDateTime(aUTCTime,TimeZoneID_GMT);
2029 + end;
2030 +
2031   procedure TSQLDataItem.SetAsDouble(Value: Double);
2032   begin
2033    CheckActive;
# Line 1605 | Line 2123 | begin
2123    CheckActive;
2124    if VarIsNull(Value) then
2125      IsNull := True
2126 +  else
2127 +  if VarIsArray(Value) then {must be datetime plus timezone}
2128 +    SetAsDateTime(Value[0],AnsiString(Value[1]))
2129    else case VarType(Value) of
2130      varEmpty, varNull:
2131        IsNull := True;
# Line 1627 | Line 2148 | begin
2148        IBError(ibxeNotSupported, [nil]);
2149      varByRef, varDispatch, varError, varUnknown, varVariant:
2150        IBError(ibxeNotPermitted, [nil]);
2151 +    else
2152 +      if VarIsFmtBCD(Value) then
2153 +        SetAsBCD(VarToBCD(Value))
2154 +      else
2155 +        IBError(ibxeNotSupported, [nil]);
2156    end;
2157   end;
2158  
# Line 1644 | Line 2170 | begin
2170    Changed;
2171   end;
2172  
2173 + procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2174 + begin
2175 +  CheckActive;
2176 +  Changing;
2177 +  if IsNullable then
2178 +    IsNull := False;
2179 +
2180 +
2181 +  with FFirebirdClientAPI do
2182 +  if aValue.Precision <= 16 then
2183 +  begin
2184 +    if not HasDecFloatSupport then
2185 +      IBError(ibxeDecFloatNotSupported,[]);
2186 +
2187 +    SQLType := SQL_DEC16;
2188 +    DataLength := 8;
2189 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2190 +  end
2191 +  else
2192 +  if aValue.Precision <= 34 then
2193 +  begin
2194 +    if not HasDecFloatSupport then
2195 +      IBError(ibxeDecFloatNotSupported,[]);
2196 +
2197 +    SQLType := SQL_DEC34;
2198 +    DataLength := 16;
2199 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2200 +  end
2201 +  else
2202 +  if aValue.Precision <= 38 then
2203 +  begin
2204 +    if not HasInt128Support then
2205 +      IBError(ibxeInt128NotSupported,[]);
2206 +
2207 +    SQLType := SQL_INT128;
2208 +    DataLength := 16;
2209 +    StrToInt128(scale,BcdToStr(aValue),SQLData);
2210 +  end
2211 +  else
2212 +    IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2213 +
2214 +  Changed;
2215 + end;
2216 +
2217   procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
2218   begin
2219    CheckActive;
# Line 1674 | Line 2244 | begin
2244      IBError(ibxeStatementNotPrepared, [nil]);
2245   end;
2246  
2247 + function TColumnMetaData.GetAttachment: IAttachment;
2248 + begin
2249 +  Result := GetStatement.GetAttachment;
2250 + end;
2251 +
2252   function TColumnMetaData.SQLData: PByte;
2253   begin
2254    Result := FIBXSQLVAR.SQLData;
# Line 1691 | Line 2266 | end;
2266  
2267   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2268   begin
2269 <  inherited Create;
2269 >  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
2270    FIBXSQLVAR := aIBXSQLVAR;
2271    FOwner := aOwner;
2272    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 1778 | Line 2353 | end;
2353   function TColumnMetaData.GetSize: cardinal;
2354   begin
2355    CheckActive;
2356 <  result := FIBXSQLVAR.DataLength;
2356 >  result := FIBXSQLVAR.GetSize;
2357 > end;
2358 >
2359 > function TColumnMetaData.GetCharSetWidth: integer;
2360 > begin
2361 >  CheckActive;
2362 >  result := FIBXSQLVAR.GetCharSetWidth;
2363   end;
2364  
2365   function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
# Line 1793 | Line 2374 | begin
2374    result := FIBXSQLVAR.GetBlobMetaData;
2375   end;
2376  
2377 + function TColumnMetaData.GetStatement: IStatement;
2378 + begin
2379 +  Result := FIBXSQLVAR.GetStatement;
2380 + end;
2381 +
2382 + function TColumnMetaData.GetTransaction: ITransaction;
2383 + begin
2384 +  Result := GetStatement.GetTransaction;
2385 + end;
2386 +
2387   { TIBSQLData }
2388  
2389   procedure TIBSQLData.CheckActive;
# Line 1812 | Line 2403 | begin
2403      IBError(ibxeBOF,[nil]);
2404   end;
2405  
2406 + function TIBSQLData.GetTransaction: ITransaction;
2407 + begin
2408 +  if FTransaction = nil then
2409 +    Result := inherited GetTransaction
2410 +  else
2411 +    Result := FTransaction;
2412 + end;
2413 +
2414   function TIBSQLData.GetIsNull: Boolean;
2415   begin
2416    CheckActive;
# Line 1821 | Line 2420 | end;
2420   function TIBSQLData.GetAsArray: IArray;
2421   begin
2422    CheckActive;
2423 <  result := FIBXSQLVAR.GetAsArray(AsQuad);
2423 >  result := FIBXSQLVAR.GetAsArray;
2424   end;
2425  
2426   function TIBSQLData.GetAsBlob: IBlob;
# Line 1855 | Line 2454 | end;
2454   { TSQLParam }
2455  
2456   procedure TSQLParam.InternalSetAsString(Value: AnsiString);
2457 +
2458 + procedure DoSetString;
2459 + begin
2460 +  Changing;
2461 +  FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
2462 +  Changed;
2463 + end;
2464 +
2465   var b: IBlob;
2466      dt: TDateTime;
2467 +    timezone: AnsiString;
2468 +    Int64Value: Int64;
2469 +    BCDValue: TBCD;
2470 +    aScale: integer;
2471   begin
2472    CheckActive;
2473    if IsNullable then
2474      IsNull := False;
2475 <  case SQLTYPE of
2475 >  with FFirebirdClientAPI do
2476 >  case getColMetaData.SQLTYPE of
2477    SQL_BOOLEAN:
2478      if AnsiCompareText(Value,STrue) = 0 then
2479        AsBoolean := true
# Line 1872 | Line 2484 | begin
2484        IBError(ibxeInvalidDataConversion,[nil]);
2485  
2486    SQL_BLOB:
2487 +    if Length(Value) < GetAttachment.GetInlineBlobLimit then
2488 +      DoSetString
2489 +    else
2490      begin
2491        Changing;
2492        b := FIBXSQLVAR.CreateBlob;
# Line 1882 | Line 2497 | begin
2497  
2498    SQL_VARYING,
2499    SQL_TEXT:
2500 <    begin
2501 <      Changing;
2502 <      FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
2503 <      Changed;
2504 <    end;
2500 >    DoSetString;
2501 >
2502 >  SQL_SHORT,
2503 >  SQL_LONG,
2504 >  SQL_INT64:
2505 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2506 >      SetAsNumeric(Int64Value,aScale)
2507 >    else
2508 >      DoSetString;
2509  
2510 <    SQL_SHORT,
2511 <    SQL_LONG,
2512 <    SQL_INT64:
2513 <      SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
2514 <
2515 <    SQL_D_FLOAT,
2516 <    SQL_DOUBLE,
2517 <    SQL_FLOAT:
1899 <      SetAsDouble(StrToFloat(Value));
2510 >  SQL_DEC_FIXED,
2511 >  SQL_DEC16,
2512 >  SQL_DEC34,
2513 >  SQL_INT128:
2514 >    if TryStrToBCD(Value,BCDValue) then
2515 >      SetAsBCD(BCDValue)
2516 >    else
2517 >      DoSetString;
2518  
2519 <    SQL_TIMESTAMP:
2519 >  SQL_D_FLOAT,
2520 >  SQL_DOUBLE,
2521 >  SQL_FLOAT:
2522 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2523 >      SetAsDouble(NumericToDouble(Int64Value,aScale))
2524 >    else
2525 >      DoSetString;
2526 >
2527 >  SQL_TIMESTAMP:
2528        if TryStrToDateTime(Value,dt) then
2529          SetAsDateTime(dt)
2530        else
2531 <        FIBXSQLVar.SetString(Value);
2531 >        DoSetString;
2532  
2533 <    SQL_TYPE_DATE:
2533 >  SQL_TYPE_DATE:
2534        if TryStrToDateTime(Value,dt) then
2535          SetAsDate(dt)
2536        else
2537 <        FIBXSQLVar.SetString(Value);
2537 >        DoSetString;
2538  
2539 <    SQL_TYPE_TIME:
2539 >  SQL_TYPE_TIME:
2540        if TryStrToDateTime(Value,dt) then
2541          SetAsTime(dt)
2542        else
2543 <        FIBXSQLVar.SetString(Value);
2543 >        DoSetString;
2544  
2545 <    else
2546 <      IBError(ibxeInvalidDataConversion,[nil]);
2545 >  SQL_TIMESTAMP_TZ,
2546 >  SQL_TIMESTAMP_TZ_EX:
2547 >      if ParseDateTimeTZString(value,dt,timezone) then
2548 >        SetAsDateTime(dt,timezone)
2549 >      else
2550 >        DoSetString;
2551 >
2552 >  SQL_TIME_TZ,
2553 >  SQL_TIME_TZ_EX:
2554 >      if ParseDateTimeTZString(value,dt,timezone,true) then
2555 >        SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2556 >      else
2557 >        DoSetString;
2558 >
2559 >  else
2560 >    IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2561    end;
2562   end;
2563  
# Line 1955 | Line 2595 | begin
2595    IsNull := true;
2596   end;
2597  
2598 + function TSQLParam.getColMetadata: IParamMetaData;
2599 + begin
2600 +  Result := FIBXSQLVAR.getColMetadata;
2601 + end;
2602 +
2603   function TSQLParam.GetModified: boolean;
2604   begin
2605    CheckActive;
# Line 1968 | Line 2613 | begin
2613    Result := inherited GetAsPointer;
2614   end;
2615  
2616 + function TSQLParam.GetAsString: AnsiString;
2617 + var rs: RawByteString;
2618 + begin
2619 +  Result := '';
2620 +  if (SQLType = SQL_VARYING) and not IsNull then
2621 +  {SQLData points to start of string - default is to length word}
2622 +  begin
2623 +    CheckActive;
2624 +    SetString(rs,PAnsiChar(SQLData),DataLength);
2625 +    SetCodePage(rs,GetCodePage,false);
2626 +    Result := rs;
2627 +  end
2628 +  else
2629 +    Result := inherited GetAsString;
2630 + end;
2631 +
2632   procedure TSQLParam.SetName(Value: AnsiString);
2633   begin
2634    CheckActive;
# Line 2013 | Line 2674 | begin
2674    if not FIBXSQLVAR.UniqueName then
2675      IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
2676  
2677 +  FIBXSQLVAR.SetArray(anArray); {save array interface}
2678    SetAsQuad(AnArray.GetArrayID);
2679   end;
2680  
# Line 2159 | Line 2821 | begin
2821    end;
2822   end;
2823  
2824 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2825 + var i: integer;
2826 +    OldSQLVar: TSQLVarData;
2827 + begin
2828 +  if FIBXSQLVAR.UniqueName then
2829 +    inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2830 +  else
2831 +  with FIBXSQLVAR.Parent do
2832 +  begin
2833 +    for i := 0 to Count - 1 do
2834 +      if Column[i].Name = Name then
2835 +      begin
2836 +        OldSQLVar := FIBXSQLVAR;
2837 +        FIBXSQLVAR := Column[i];
2838 +        try
2839 +          inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2840 +        finally
2841 +          FIBXSQLVAR := OldSQLVar;
2842 +        end;
2843 +      end;
2844 +  end;
2845 + end;
2846 +
2847 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2848 + var i: integer;
2849 +    OldSQLVar: TSQLVarData;
2850 + begin
2851 +  if FIBXSQLVAR.UniqueName then
2852 +    inherited SetAsTime(AValue,OnDate,aTimeZone)
2853 +  else
2854 +  with FIBXSQLVAR.Parent do
2855 +  begin
2856 +    for i := 0 to Count - 1 do
2857 +      if Column[i].Name = Name then
2858 +      begin
2859 +        OldSQLVar := FIBXSQLVAR;
2860 +        FIBXSQLVAR := Column[i];
2861 +        try
2862 +          inherited SetAsTime(AValue,OnDate,aTimeZone);
2863 +        finally
2864 +          FIBXSQLVAR := OldSQLVar;
2865 +        end;
2866 +      end;
2867 +  end;
2868 + end;
2869 +
2870 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2871 + begin
2872 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2873 + end;
2874 +
2875 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2876 + begin
2877 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2878 + end;
2879 +
2880   procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2881   var i: integer;
2882      OldSQLVar: TSQLVarData;
# Line 2182 | Line 2900 | begin
2900    end;
2901   end;
2902  
2903 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2904 +  );
2905 + var i: integer;
2906 +    OldSQLVar: TSQLVarData;
2907 + begin
2908 +  if FIBXSQLVAR.UniqueName then
2909 +    inherited SetAsDateTime(AValue,aTimeZoneID)
2910 +  else
2911 +  with FIBXSQLVAR.Parent do
2912 +  begin
2913 +    for i := 0 to Count - 1 do
2914 +      if Column[i].Name = Name then
2915 +      begin
2916 +        OldSQLVar := FIBXSQLVAR;
2917 +        FIBXSQLVAR := Column[i];
2918 +        try
2919 +          inherited SetAsDateTime(AValue,aTimeZoneID);
2920 +        finally
2921 +          FIBXSQLVAR := OldSQLVar;
2922 +        end;
2923 +      end;
2924 +  end;
2925 + end;
2926 +
2927 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2928 + var i: integer;
2929 +    OldSQLVar: TSQLVarData;
2930 + begin
2931 +  if FIBXSQLVAR.UniqueName then
2932 +    inherited SetAsDateTime(AValue,aTimeZone)
2933 +  else
2934 +  with FIBXSQLVAR.Parent do
2935 +  begin
2936 +    for i := 0 to Count - 1 do
2937 +      if Column[i].Name = Name then
2938 +      begin
2939 +        OldSQLVar := FIBXSQLVAR;
2940 +        FIBXSQLVAR := Column[i];
2941 +        try
2942 +          inherited SetAsDateTime(AValue,aTimeZone);
2943 +        finally
2944 +          FIBXSQLVAR := OldSQLVar;
2945 +        end;
2946 +      end;
2947 +  end;
2948 + end;
2949 +
2950   procedure TSQLParam.SetAsDouble(AValue: Double);
2951   var i: integer;
2952      OldSQLVar: TSQLVarData;
# Line 2362 | Line 3127 | begin
3127    FIBXSQLVAR.SetCharSetID(aValue);
3128   end;
3129  
3130 + procedure TSQLParam.SetAsBcd(aValue: tBCD);
3131 + var i: integer;
3132 +    OldSQLVar: TSQLVarData;
3133 + begin
3134 +  if FIBXSQLVAR.UniqueName then
3135 +    inherited SetAsBcd(AValue)
3136 +  else
3137 +  with FIBXSQLVAR.Parent do
3138 +  begin
3139 +    for i := 0 to Count - 1 do
3140 +      if Column[i].Name = Name then
3141 +      begin
3142 +        OldSQLVar := FIBXSQLVAR;
3143 +        FIBXSQLVAR := Column[i];
3144 +        try
3145 +          inherited SetAsBcd(AValue);
3146 +        finally
3147 +          FIBXSQLVAR := OldSQLVar;
3148 +        end;
3149 +      end;
3150 +  end;
3151 + end;
3152 +
3153   { TMetaData }
3154  
3155   procedure TMetaData.CheckActive;
# Line 2500 | Line 3288 | begin
3288      end;
3289   end;
3290  
3291 + function TSQLParams.GetHasCaseSensitiveParams: Boolean;
3292 + begin
3293 +  Result := FSQLParams.CaseSensitiveParams;
3294 + end;
3295 +
3296   { TResults }
3297  
3298   procedure TResults.CheckActive;
# Line 2512 | Line 3305 | begin
3305    if not FResults.CheckStatementStatus(ssPrepared)  then
3306      IBError(ibxeStatementNotPrepared, [nil]);
3307  
3308 <  with GetTransaction as TFBTransaction do
3308 >  with GetTransaction do
3309    if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3310      IBError(ibxeInterfaceOutofDate,[nil]);
3311   end;
3312  
3313   function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
3314 + var col: TIBSQLData;
3315   begin
3316    if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
3317      IBError(ibxeInvalidColumnIndex,[nil]);
3318  
3319    if not HasInterface(aIBXSQLVAR.Index) then
3320      AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3321 <  Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3321 >  col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3322 >  col.FTransaction := GetTransaction;
3323 >  Result := col;
3324   end;
3325  
3326   constructor TResults.Create(aResults: TSQLDataArea);
# Line 2581 | Line 3377 | begin
3377    FResults.GetData(index,IsNull, len,data);
3378   end;
3379  
3380 + function TResults.GetStatement: IStatement;
3381 + begin
3382 +  Result := FStatement;
3383 + end;
3384 +
3385   function TResults.GetTransaction: ITransaction;
3386   begin
3387    Result := FStatement.GetTransaction;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines