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 309 by tony, Tue Jul 21 08:00:42 2020 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

# Line 80 | Line 80 | unit FBSQLData;
80   interface
81  
82   uses
83 <  Classes, SysUtils, IBExternals, IBHeader, {$IFDEF WINDOWS} Windows, {$ENDIF} IB,  FBActivityMonitor, FBClientAPI;
83 >  Classes, SysUtils, IBExternals, {$IFDEF WINDOWS} Windows, {$ENDIF} IB,  FBActivityMonitor, FBClientAPI,
84 >  FmtBCD;
85  
86   type
87  
88 <  { TSQLDataItem }
88 >   {The IExTimeZoneServices is only available in FB4 and onwards}
89 >
90 >   IExTimeZoneServices = interface(ITimeZoneServices)
91 >   ['{789c2eeb-c4a7-4fed-837e-0cbdef775904}']
92 >   {encode/decode - used to encode/decode the wire protocol}
93 >   procedure EncodeTimestampTZ(timestamp: TDateTime; timezoneID: TFBTimeZoneID;
94 >     bufptr: PByte); overload;
95 >   procedure EncodeTimestampTZ(timestamp: TDateTime; timezone: AnsiString;
96 >       bufptr: PByte); overload;
97 >   procedure EncodeTimeTZ(time: TDateTime; timezoneID: TFBTimeZoneID; OnDate: TDateTime;
98 >     bufptr: PByte); overload;
99 >   procedure EncodeTimeTZ(time: TDateTime; timezone: AnsiString; OnDate: TDateTime;
100 >     bufptr: PByte); overload;
101 >   procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime;
102 >     var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
103 >   procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime;
104 >     var dstOffset: smallint; var timezone: AnsiString); overload;
105 >   procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime;
106 >     var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
107 >   procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime;
108 >     var dstOffset: smallint; var timezone: AnsiString); overload;
109 >   procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
110 >     var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
111 >   procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
112 >     var dstOffset: smallint; var timezone: AnsiString); overload;
113 >   procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
114 >     var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
115 >   procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
116 >     var dstOffset: smallint; var timezone: AnsiString); overload;
117 >   end;
118 >
119 >   { TSQLDataItem }
120  
121    TSQLDataItem = class(TFBInterfacedObject)
122    private
123       FFirebirdClientAPI: TFBClientAPI;
124 +     FTimeZoneServices: IExTimeZoneServices;
125       function AdjustScale(Value: Int64; aScale: Integer): Double;
126       function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
127       function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
95     function GetTimestampFormatStr: AnsiString;
128       function GetDateFormatStr(IncludeTime: boolean): AnsiString;
129       function GetTimeFormatStr: AnsiString;
130 +     function GetTimestampFormatStr: AnsiString;
131       procedure SetAsInteger(AValue: Integer);
132 +     procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
133 +       var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID);
134    protected
135       function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
136       function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
137       procedure CheckActive; virtual;
138 +     procedure CheckTZSupport;
139 +     function GetAttachment: IAttachment; virtual; abstract;
140       function GetSQLDialect: integer; virtual; abstract;
141 +     function GetTimeZoneServices: IExTimeZoneServices; virtual;
142       procedure Changed; virtual;
143       procedure Changing; virtual;
144       procedure InternalSetAsString(Value: AnsiString); virtual;
# Line 113 | Line 151 | type
151       procedure SetDataLength(len: cardinal); virtual;
152       procedure SetSQLType(aValue: cardinal); virtual;
153       property DataLength: cardinal read GetDataLength write SetDataLength;
154 <
154 >     property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
155    public
156       constructor Create(api: TFBClientAPI);
157       function GetSQLType: cardinal; virtual; abstract;
# Line 125 | Line 163 | type
163       function GetAsBoolean: boolean;
164       function GetAsCurrency: Currency;
165       function GetAsInt64: Int64;
166 <     function GetAsDateTime: TDateTime;
166 >     function GetAsDateTime: TDateTime; overload;
167 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
168 >     procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
169 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
170 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
171 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
172 >     procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
173 >     function GetAsUTCDateTime: TDateTime;
174       function GetAsDouble: Double;
175       function GetAsFloat: Float;
176       function GetAsLong: Long;
# Line 138 | Line 183 | type
183       function GetAsVariant: Variant;
184       function GetModified: boolean; virtual;
185       function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
186 +     function GetAsBCD: tBCD;
187       function GetSize: cardinal; virtual; abstract;
188       function GetCharSetWidth: integer; virtual; abstract;
189       procedure SetAsBoolean(AValue: boolean); virtual;
# Line 145 | Line 191 | type
191       procedure SetAsInt64(Value: Int64); virtual;
192       procedure SetAsDate(Value: TDateTime); virtual;
193       procedure SetAsLong(Value: Long); virtual;
194 <     procedure SetAsTime(Value: TDateTime); virtual;
195 <     procedure SetAsDateTime(Value: TDateTime);
194 >     procedure SetAsTime(Value: TDateTime); overload;
195 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime;aTimeZoneID: TFBTimeZoneID); overload;
196 >     procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
197 >     procedure SetAsDateTime(Value: TDateTime); overload;
198 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
199 >     procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
200 >     procedure SetAsUTCDateTime(aUTCTime: TDateTime);
201       procedure SetAsDouble(Value: Double); virtual;
202       procedure SetAsFloat(Value: Float); virtual;
203       procedure SetAsPointer(Value: Pointer);
# Line 155 | Line 206 | type
206       procedure SetAsString(Value: AnsiString); virtual;
207       procedure SetAsVariant(Value: Variant);
208       procedure SetAsNumeric(Value: Int64; aScale: integer);
209 +     procedure SetAsBcd(aValue: tBCD); virtual;
210       procedure SetIsNull(Value: Boolean); virtual;
211       procedure SetIsNullable(Value: Boolean); virtual;
212       procedure SetName(aValue: AnsiString); virtual;
# Line 247 | Line 299 | type
299      function GetIsNull: Boolean;   virtual; abstract;
300      function GetIsNullable: boolean; virtual; abstract;
301      function GetSQLData: PByte;  virtual; abstract;
302 <    function GetDataLength: cardinal; virtual; abstract;
302 >    function GetDataLength: cardinal; virtual; abstract; {current field length}
303 >    function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
304      procedure SetIsNull(Value: Boolean); virtual; abstract;
305      procedure SetIsNullable(Value: Boolean);  virtual; abstract;
306      procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
# Line 299 | Line 352 | type
352      FChangeSeqNo: integer;
353    protected
354      procedure CheckActive; override;
355 +    function GetAttachment: IAttachment; override;
356      function SQLData: PByte; override;
357      function GetDataLength: cardinal; override;
358      function GetCodePage: TSystemCodePage; override;
# Line 355 | Line 409 | type
409  
410    { TSQLParam }
411  
412 <  TSQLParam = class(TIBSQLData,ISQLParam)
412 >  TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
413    protected
414      procedure CheckActive; override;
415      procedure Changed; override;
# Line 378 | Line 432 | type
432      procedure SetAsInt64(AValue: Int64);
433      procedure SetAsDate(AValue: TDateTime);
434      procedure SetAsLong(AValue: Long);
435 <    procedure SetAsTime(AValue: TDateTime);
436 <    procedure SetAsDateTime(AValue: TDateTime);
435 >    procedure SetAsTime(AValue: TDateTime); overload;
436 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
437 >    procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
438 >    procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
439 >    procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
440 >    procedure SetAsDateTime(AValue: TDateTime); overload;
441 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
442 >    procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
443      procedure SetAsDouble(AValue: Double);
444      procedure SetAsFloat(AValue: Float);
445      procedure SetAsPointer(AValue: Pointer);
# Line 389 | Line 449 | type
449      procedure SetAsBlob(aValue: IBlob);
450      procedure SetAsQuad(AValue: TISC_QUAD);
451      procedure SetCharSetID(aValue: cardinal);
452 +    procedure SetAsBcd(aValue: tBCD);
453  
454      property AsBlob: IBlob read GetAsBlob write SetAsBlob;
455      property IsNullable: Boolean read GetIsNullable write SetIsNullable;
# Line 815 | Line 876 | begin
876    with FormatSettings do
877    {$IFEND}
878    {$IFEND}
879 <    Result := LongTimeFormat;
879 >    Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
880   end;
881  
882   function TSQLDataItem.GetTimestampFormatStr: AnsiString;
# Line 827 | Line 888 | begin
888    with FormatSettings do
889    {$IFEND}
890    {$IFEND}
891 <    Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
891 >    Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
892   end;
893  
894   procedure TSQLDataItem.SetAsInteger(AValue: Integer);
# Line 835 | Line 896 | begin
896    SetAsLong(aValue);
897   end;
898  
899 + procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
900 +  var dstOffset: smallint; var aTimezone: AnsiString;
901 +  var aTimeZoneID: TFBTimeZoneID);
902 + begin
903 +  CheckActive;
904 +  aDateTime := 0;
905 +  dstOffset := 0;
906 +  aTimezone := '';
907 +  aTimeZoneID := TimeZoneID_GMT;
908 +  if not IsNull then
909 +    with FFirebirdClientAPI do
910 +    case SQLType of
911 +      SQL_TEXT, SQL_VARYING:
912 +        if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
913 +          IBError(ibxeInvalidDataConversion, [nil]);
914 +      SQL_TYPE_DATE:
915 +        aDateTime := SQLDecodeDate(SQLData);
916 +      SQL_TYPE_TIME:
917 +        aDateTime := SQLDecodeTime(SQLData);
918 +      SQL_TIMESTAMP:
919 +        aDateTime := SQLDecodeDateTime(SQLData);
920 +      SQL_TIMESTAMP_TZ:
921 +        begin
922 +          GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
923 +          aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
924 +        end;
925 +      SQL_TIMESTAMP_TZ_EX:
926 +      begin
927 +        GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
928 +        aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
929 +      end;
930 +      SQL_TIME_TZ:
931 +        with GetTimeZoneServices do
932 +        begin
933 +          DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
934 +          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
935 +        end;
936 +      SQL_TIME_TZ_EX:
937 +        with GetTimeZoneServices do
938 +        begin
939 +          DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
940 +          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
941 +        end;
942 +      else
943 +        IBError(ibxeInvalidDataConversion, [nil]);
944 +    end;
945 + end;
946 +
947   function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
948    ): Int64;
949   var
# Line 890 | Line 999 | begin
999    //Do nothing by default
1000   end;
1001  
1002 + procedure TSQLDataItem.CheckTZSupport;
1003 + begin
1004 +  if not FFirebirdClientAPI.HasTimeZoneSupport then
1005 +    IBError(ibxeNoTimezoneSupport,[]);
1006 + end;
1007 +
1008 + function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1009 + begin
1010 +  if FTimeZoneServices = nil then
1011 +  begin
1012 +    if not GetAttachment.HasTimeZoneSupport then
1013 +      IBError(ibxeNoTimezoneSupport,[]);
1014 +    GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1015 +  end;
1016 +  Result := FTimeZoneServices;
1017 + end;
1018 +
1019   procedure TSQLDataItem.Changed;
1020   begin
1021    //Do nothing by default
# Line 950 | Line 1076 | begin
1076    SQL_LONG:             Result := 'SQL_LONG';
1077    SQL_SHORT:            Result := 'SQL_SHORT';
1078    SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1079 +  SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1080 +  SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1081    SQL_BLOB:             Result := 'SQL_BLOB';
1082    SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1083    SQL_ARRAY:            Result := 'SQL_ARRAY';
# Line 957 | Line 1085 | begin
1085    SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1086    SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1087    SQL_INT64:            Result := 'SQL_INT64';
1088 +  SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1089 +  SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1090 +  SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1091 +  SQL_DEC16:            Result := 'SQL_DEC16';
1092 +  SQL_DEC34:            Result := 'SQL_DEC34';
1093 +  SQL_INT128:           Result := 'SQL_INT128';
1094 +  SQL_NULL:             Result := 'SQL_NULL';
1095 +  SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1096    end;
1097   end;
1098  
# Line 1009 | Line 1145 | begin
1145                                        Scale);
1146          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1147            result := Trunc(AsDouble);
1148 +
1149 +        SQL_DEC_FIXED,
1150 +        SQL_DEC16,
1151 +        SQL_DEC34,
1152 +        SQL_INT128:
1153 +          if not BCDToCurr(GetAsBCD,Result) then
1154 +            IBError(ibxeInvalidDataConversion, [nil]);
1155 +
1156          else
1157            IBError(ibxeInvalidDataConversion, [nil]);
1158        end;
# Line 1045 | Line 1189 | begin
1189   end;
1190  
1191   function TSQLDataItem.GetAsDateTime: TDateTime;
1192 + var aTimezone: AnsiString;
1193 +    aTimeZoneID: TFBTimeZoneID;
1194 +    dstOffset: smallint;
1195 + begin
1196 +  InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1197 + end;
1198 +
1199 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1200 +  var dstOffset: smallint; var aTimezone: AnsiString);
1201 + var aTimeZoneID: TFBTimeZoneID;
1202 + begin
1203 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1204 + end;
1205 +
1206 + procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1207 +  var aTimezoneID: TFBTimeZoneID);
1208 + var aTimezone: AnsiString;
1209 + begin
1210 +  InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1211 + end;
1212 +
1213 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1214 +  var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1215 + var aTimeZone: AnsiString;
1216   begin
1217    CheckActive;
1218 <  result := 0;
1218 >  aTime := 0;
1219 >  dstOffset := 0;
1220    if not IsNull then
1221      with FFirebirdClientAPI do
1222      case SQLType of
1223 <      SQL_TEXT, SQL_VARYING: begin
1224 <        try
1225 <          result := StrToDate(AsString);
1226 <        except
1227 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1223 >      SQL_TIME_TZ:
1224 >        begin
1225 >          GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1226 >          aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1227 >        end;
1228 >      SQL_TIME_TZ_EX:
1229 >        begin
1230 >          GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1231 >          aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1232          end;
1233 +    else
1234 +      IBError(ibxeInvalidDataConversion, [nil]);
1235 +    end;
1236 + end;
1237 +
1238 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1239 +  var aTimezone: AnsiString; OnDate: TDateTime);
1240 + begin
1241 +  CheckActive;
1242 +  aTime := 0;
1243 +  dstOffset := 0;
1244 +  if not IsNull then
1245 +    with FFirebirdClientAPI do
1246 +    case SQLType of
1247 +      SQL_TIME_TZ:
1248 +        GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1249 +      SQL_TIME_TZ_EX:
1250 +        GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1251 +    else
1252 +      IBError(ibxeInvalidDataConversion, [nil]);
1253 +    end;
1254 + end;
1255 +
1256 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1257 +  var aTimezoneID: TFBTimeZoneID);
1258 + begin
1259 +  GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1260 + end;
1261 +
1262 + procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1263 +  var aTimezone: AnsiString);
1264 + begin
1265 +  GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1266 + end;
1267 +
1268 + function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1269 + var aTimezone: AnsiString;
1270 + begin
1271 +  CheckActive;
1272 +  result := 0;
1273 +  aTimezone := '';
1274 +  if not IsNull then
1275 +    with FFirebirdClientAPI do
1276 +    case SQLType of
1277 +      SQL_TEXT, SQL_VARYING:
1278 +      begin
1279 +        if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1280 +          IBError(ibxeInvalidDataConversion, [nil]);
1281 +        Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1282        end;
1283        SQL_TYPE_DATE:
1284          result := SQLDecodeDate(SQLData);
1285 <      SQL_TYPE_TIME:
1285 >      SQL_TYPE_TIME,
1286 >      SQL_TIME_TZ,
1287 >      SQL_TIME_TZ_EX:
1288          result := SQLDecodeTime(SQLData);
1289 <      SQL_TIMESTAMP:
1289 >      SQL_TIMESTAMP,
1290 >      SQL_TIMESTAMP_TZ,
1291 >      SQL_TIMESTAMP_TZ_EX:
1292          result := SQLDecodeDateTime(SQLData);
1293        else
1294          IBError(ibxeInvalidDataConversion, [nil]);
1295 <    end;
1295 >      end;
1296   end;
1297  
1298   function TSQLDataItem.GetAsDouble: Double;
# Line 1094 | Line 1320 | begin
1320          result := PFloat(SQLData)^;
1321        SQL_DOUBLE, SQL_D_FLOAT:
1322          result := PDouble(SQLData)^;
1323 +      SQL_DEC_FIXED,
1324 +      SQL_DEC16,
1325 +      SQL_DEC34,
1326 +      SQL_INT128:
1327 +        Result := BCDToDouble(GetAsBCD);
1328        else
1329          IBError(ibxeInvalidDataConversion, [nil]);
1330      end;
# Line 1139 | Line 1370 | begin
1370          result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1371        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1372          result := Trunc(AsDouble);
1373 +      SQL_DEC_FIXED,
1374 +      SQL_DEC16,
1375 +      SQL_DEC34,
1376 +      SQL_INT128:
1377 +        Result := BCDToInteger(GetAsBCD);
1378        else
1379 <        IBError(ibxeInvalidDataConversion, [nil]);
1379 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1380      end;
1381   end;
1382  
# Line 1225 | Line 1461 | end;
1461  
1462   {Returns the byte length of a UTF8 string with a fixed charwidth}
1463  
1464 < function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer;
1464 > function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1465   var i: integer;
1466      cplen: integer;
1467      s: AnsiString;
1468   begin
1469    Result := 0;
1470    s := strpas(p);
1471 <  for i := 1 to CharWidth do
1471 >  for i := 1 to FieldWidth do
1472    begin
1473      cplen := UTF8CodepointSizeFull(p);
1474      Inc(p,cplen);
# Line 1250 | Line 1486 | var
1486    sz: PByte;
1487    str_len: Integer;
1488    rs: RawByteString;
1489 +  aTimeZone: AnsiString;
1490 +  aDateTime: TDateTime;
1491 +  dstOffset: smallint;
1492   begin
1493    CheckActive;
1494    result := '';
# Line 1281 | Line 1520 | begin
1520          SetCodePage(rs,GetCodePage,false);
1521          Result := rs;
1522        end;
1523 +
1524        SQL_TYPE_DATE:
1525 <        result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1286 <      SQL_TYPE_TIME :
1287 <        result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1525 >        Result := DateToStr(GetAsDateTime);
1526        SQL_TIMESTAMP:
1527 <        result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1527 >        Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1528 >      SQL_TYPE_TIME:
1529 >        Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1530 >      SQL_TIMESTAMP_TZ,
1531 >      SQL_TIMESTAMP_TZ_EX:
1532 >        with GetAttachment.GetTimeZoneServices do
1533 >        begin
1534 >          if GetTZTextOption = tzGMT then
1535 >            Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1536 >          else
1537 >          begin
1538 >            GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1539 >            if GetTZTextOption = tzOffset then
1540 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1541 >            else
1542 >              Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1543 >          end;
1544 >        end;
1545 >      SQL_TIME_TZ,
1546 >      SQL_TIME_TZ_EX:
1547 >        with GetAttachment.GetTimeZoneServices do
1548 >        begin
1549 >          if GetTZTextOption = tzGMT then
1550 >             Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1551 >          else
1552 >          begin
1553 >            GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1554 >            if GetTZTextOption = tzOffset then
1555 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1556 >            else
1557 >              Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1558 >          end;
1559 >        end;
1560 >
1561        SQL_SHORT, SQL_LONG:
1562          if Scale = 0 then
1563            result := IntToStr(AsLong)
# Line 1303 | Line 1574 | begin
1574            result := FloatToStr(AsDouble);
1575        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1576          result := FloatToStr(AsDouble);
1577 +
1578 +      SQL_DEC16,
1579 +      SQL_DEC34:
1580 +        result := BCDToStr(GetAsBCD);
1581 +
1582 +      SQL_DEC_FIXED,
1583 +      SQL_INT128:
1584 +        result := Int128ToStr(SQLData,scale);
1585 +
1586        else
1587          IBError(ibxeInvalidDataConversion, [nil]);
1588      end;
# Line 1321 | Line 1601 | begin
1601   end;
1602  
1603   function TSQLDataItem.GetAsVariant: Variant;
1604 + var ts: TDateTime;
1605 +  dstOffset: smallint;
1606 +    timezone: AnsiString;
1607   begin
1608    CheckActive;
1609    if IsNull then
# Line 1334 | Line 1617 | begin
1617          result := AsString;
1618        SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1619          result := AsDateTime;
1620 +      SQL_TIMESTAMP_TZ,
1621 +      SQL_TIME_TZ,
1622 +      SQL_TIMESTAMP_TZ_EX,
1623 +      SQL_TIME_TZ_EX:
1624 +        begin
1625 +          GetAsDateTime(ts,dstOffset,timezone);
1626 +          result := VarArrayOf([ts,dstOffset,timezone]);
1627 +        end;
1628        SQL_SHORT, SQL_LONG:
1629          if Scale = 0 then
1630            result := AsLong
# Line 1352 | Line 1643 | begin
1643          result := AsDouble;
1644        SQL_BOOLEAN:
1645          result := AsBoolean;
1646 +      SQL_DEC_FIXED,
1647 +      SQL_DEC16,
1648 +      SQL_DEC34,
1649 +      SQL_INT128:
1650 +        result := VarFmtBCDCreate(GetAsBcd);
1651        else
1652          IBError(ibxeInvalidDataConversion, [nil]);
1653      end;
# Line 1372 | Line 1668 | begin
1668      Result := Length(GetDateFormatStr(true));
1669    dfTime:
1670      Result := Length(GetTimeFormatStr);
1671 +  dfTimestampTZ:
1672 +    Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1673 +  dfTimeTZ:
1674 +    Result := Length(GetTimeFormatStr)+ 6;
1675    else
1676      Result := 0;
1677 +  end;end;
1678 +
1679 + function TSQLDataItem.GetAsBCD: tBCD;
1680 +
1681 + begin
1682 +  CheckActive;
1683 +  if IsNull then
1684 +   with Result do
1685 +   begin
1686 +     FillChar(Result,sizeof(Result),0);
1687 +     Precision := 1;
1688 +     exit;
1689 +   end;
1690 +
1691 +  case SQLType of
1692 +  SQL_DEC16,
1693 +  SQL_DEC34:
1694 +    with FFirebirdClientAPI do
1695 +      Result := SQLDecFloatDecode(SQLType,  SQLData);
1696 +
1697 +  SQL_DEC_FIXED,
1698 +  SQL_INT128:
1699 +    with FFirebirdClientAPI do
1700 +      Result := StrToBCD(Int128ToStr(SQLData,scale));
1701 +  else
1702 +    if not CurrToBCD(GetAsCurrency,Result) then
1703 +      IBError(ibxeBadBCDConversion,[]);
1704    end;
1705   end;
1706  
# Line 1465 | Line 1792 | begin
1792    Changed;
1793   end;
1794  
1795 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1796 + begin
1797 +  CheckActive;
1798 +  CheckTZSupport;
1799 +  if GetSQLDialect < 3 then
1800 +  begin
1801 +    AsDateTime := aValue;
1802 +    exit;
1803 +  end;
1804 +
1805 +  Changing;
1806 +  if IsNullable then
1807 +    IsNull := False;
1808 +
1809 +  SQLType := SQL_TIME_TZ;
1810 +  DataLength := SizeOf(ISC_TIME_TZ);
1811 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1812 +  Changed;
1813 + end;
1814 +
1815 + procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1816 + begin
1817 +  CheckActive;
1818 +  CheckTZSupport;
1819 +  if GetSQLDialect < 3 then
1820 +  begin
1821 +    AsDateTime := aValue;
1822 +    exit;
1823 +  end;
1824 +
1825 +  Changing;
1826 +  if IsNullable then
1827 +    IsNull := False;
1828 +
1829 +  SQLType := SQL_TIME_TZ;
1830 +  DataLength := SizeOf(ISC_TIME_TZ);
1831 +  GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1832 +  Changed;
1833 + end;
1834 +
1835   procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1836   begin
1837    CheckActive;
# Line 1479 | Line 1846 | begin
1846    Changed;
1847   end;
1848  
1849 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1850 +  aTimeZoneID: TFBTimeZoneID);
1851 + begin
1852 +  CheckActive;
1853 +  CheckTZSupport;
1854 +  if IsNullable then
1855 +    IsNull := False;
1856 +
1857 +  Changing;
1858 +  SQLType := SQL_TIMESTAMP_TZ;
1859 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1860 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
1861 +  Changed;
1862 + end;
1863 +
1864 + procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
1865 +  );
1866 + begin
1867 +  CheckActive;
1868 +  CheckTZSupport;
1869 +  if IsNullable then
1870 +    IsNull := False;
1871 +
1872 +  Changing;
1873 +  SQLType := SQL_TIMESTAMP_TZ;
1874 +  DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1875 +  GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
1876 +  Changed;
1877 + end;
1878 +
1879 + procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
1880 + begin
1881 +  SetAsDateTime(aUTCTime,TimeZoneID_GMT);
1882 + end;
1883 +
1884   procedure TSQLDataItem.SetAsDouble(Value: Double);
1885   begin
1886    CheckActive;
# Line 1574 | Line 1976 | begin
1976    CheckActive;
1977    if VarIsNull(Value) then
1978      IsNull := True
1979 +  else
1980 +  if VarIsArray(Value) then {must be datetime plus timezone}
1981 +    SetAsDateTime(Value[0],AnsiString(Value[1]))
1982    else case VarType(Value) of
1983      varEmpty, varNull:
1984        IsNull := True;
# Line 1596 | Line 2001 | begin
2001        IBError(ibxeNotSupported, [nil]);
2002      varByRef, varDispatch, varError, varUnknown, varVariant:
2003        IBError(ibxeNotPermitted, [nil]);
2004 +    else
2005 +      if VarIsFmtBCD(Value) then
2006 +        SetAsBCD(VarToBCD(Value))
2007 +      else
2008 +        IBError(ibxeNotSupported, [nil]);
2009    end;
2010   end;
2011  
# Line 1613 | Line 2023 | begin
2023    Changed;
2024   end;
2025  
2026 + procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2027 + var C: Currency;
2028 + begin
2029 +  CheckActive;
2030 +  Changing;
2031 +  if IsNullable then
2032 +    IsNull := False;
2033 +
2034 +
2035 +  with FFirebirdClientAPI do
2036 +  if aValue.Precision <= 16 then
2037 +  begin
2038 +    if not HasDecFloatSupport then
2039 +      IBError(ibxeDecFloatNotSupported,[]);
2040 +
2041 +    SQLType := SQL_DEC16;
2042 +    DataLength := 8;
2043 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2044 +  end
2045 +  else
2046 +  if aValue.Precision <= 34 then
2047 +  begin
2048 +    if not HasDecFloatSupport then
2049 +      IBError(ibxeDecFloatNotSupported,[]);
2050 +
2051 +    SQLType := SQL_DEC34;
2052 +    DataLength := 16;
2053 +    SQLDecFloatEncode(aValue,SQLType,SQLData);
2054 +  end
2055 +  else
2056 +  if aValue.Precision <= 38 then
2057 +  begin
2058 +    if not HasInt128Support then
2059 +      IBError(ibxeInt128NotSupported,[]);
2060 +
2061 +    SQLType := SQL_INT128;
2062 +    DataLength := 16;
2063 +    StrToInt128(scale,BcdToStr(aValue),SQLData);
2064 +  end
2065 +  else
2066 +    IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2067 +
2068 +  Changed;
2069 + end;
2070 +
2071   procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
2072   begin
2073    CheckActive;
# Line 1643 | Line 2098 | begin
2098      IBError(ibxeStatementNotPrepared, [nil]);
2099   end;
2100  
2101 + function TColumnMetaData.GetAttachment: IAttachment;
2102 + begin
2103 +  Result := GetStatement.GetAttachment;
2104 + end;
2105 +
2106   function TColumnMetaData.SQLData: PByte;
2107   begin
2108    Result := FIBXSQLVAR.SQLData;
# Line 1747 | Line 2207 | end;
2207   function TColumnMetaData.GetSize: cardinal;
2208   begin
2209    CheckActive;
2210 <  result := FIBXSQLVAR.DataLength;
2210 >  result := FIBXSQLVAR.GetSize;
2211   end;
2212  
2213   function TColumnMetaData.GetCharSetWidth: integer;
# Line 1860 | Line 2320 | var b: IBlob;
2320      dt: TDateTime;
2321      CurrValue: Currency;
2322      FloatValue: single;
2323 +    timezone: AnsiString;
2324   begin
2325    CheckActive;
2326    if IsNullable then
2327      IsNull := False;
2328 +  with FFirebirdClientAPI do
2329    case SQLTYPE of
2330    SQL_BOOLEAN:
2331      if AnsiCompareText(Value,STrue) = 0 then
# Line 1921 | Line 2383 | begin
2383        else
2384          DoSetString;
2385  
2386 +    SQL_TIMESTAMP_TZ:
2387 +      if ParseDateTimeTZString(value,dt,timezone) then
2388 +        SetAsDateTime(dt,timezone)
2389 +      else
2390 +        DoSetString;
2391 +
2392 +    SQL_TIME_TZ:
2393 +      if ParseDateTimeTZString(value,dt,timezone,true) then
2394 +        SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2395 +      else
2396 +        DoSetString;
2397 +
2398 +    SQL_DEC_FIXED,
2399 +    SQL_DEC16,
2400 +    SQL_DEC34,
2401 +    SQL_INT128:
2402 +      SetAsBCD(StrToBCD(Value));
2403 +
2404      else
2405        IBError(ibxeInvalidDataConversion,[nil]);
2406    end;
# Line 2164 | Line 2644 | begin
2644    end;
2645   end;
2646  
2647 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2648 + var i: integer;
2649 +    OldSQLVar: TSQLVarData;
2650 + begin
2651 +  if FIBXSQLVAR.UniqueName then
2652 +    inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2653 +  else
2654 +  with FIBXSQLVAR.Parent do
2655 +  begin
2656 +    for i := 0 to Count - 1 do
2657 +      if Column[i].Name = Name then
2658 +      begin
2659 +        OldSQLVar := FIBXSQLVAR;
2660 +        FIBXSQLVAR := Column[i];
2661 +        try
2662 +          inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2663 +        finally
2664 +          FIBXSQLVAR := OldSQLVar;
2665 +        end;
2666 +      end;
2667 +  end;
2668 + end;
2669 +
2670 + procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2671 + var i: integer;
2672 +    OldSQLVar: TSQLVarData;
2673 + begin
2674 +  if FIBXSQLVAR.UniqueName then
2675 +    inherited SetAsTime(AValue,OnDate,aTimeZone)
2676 +  else
2677 +  with FIBXSQLVAR.Parent do
2678 +  begin
2679 +    for i := 0 to Count - 1 do
2680 +      if Column[i].Name = Name then
2681 +      begin
2682 +        OldSQLVar := FIBXSQLVAR;
2683 +        FIBXSQLVAR := Column[i];
2684 +        try
2685 +          inherited SetAsTime(AValue,OnDate,aTimeZone);
2686 +        finally
2687 +          FIBXSQLVAR := OldSQLVar;
2688 +        end;
2689 +      end;
2690 +  end;
2691 + end;
2692 +
2693 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2694 + begin
2695 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2696 + end;
2697 +
2698 + procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2699 + begin
2700 +  SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2701 + end;
2702 +
2703   procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2704   var i: integer;
2705      OldSQLVar: TSQLVarData;
# Line 2187 | Line 2723 | begin
2723    end;
2724   end;
2725  
2726 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2727 +  );
2728 + var i: integer;
2729 +    OldSQLVar: TSQLVarData;
2730 + begin
2731 +  if FIBXSQLVAR.UniqueName then
2732 +    inherited SetAsDateTime(AValue,aTimeZoneID)
2733 +  else
2734 +  with FIBXSQLVAR.Parent do
2735 +  begin
2736 +    for i := 0 to Count - 1 do
2737 +      if Column[i].Name = Name then
2738 +      begin
2739 +        OldSQLVar := FIBXSQLVAR;
2740 +        FIBXSQLVAR := Column[i];
2741 +        try
2742 +          inherited SetAsDateTime(AValue,aTimeZoneID);
2743 +        finally
2744 +          FIBXSQLVAR := OldSQLVar;
2745 +        end;
2746 +      end;
2747 +  end;
2748 + end;
2749 +
2750 + procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2751 + var i: integer;
2752 +    OldSQLVar: TSQLVarData;
2753 + begin
2754 +  if FIBXSQLVAR.UniqueName then
2755 +    inherited SetAsDateTime(AValue,aTimeZone)
2756 +  else
2757 +  with FIBXSQLVAR.Parent do
2758 +  begin
2759 +    for i := 0 to Count - 1 do
2760 +      if Column[i].Name = Name then
2761 +      begin
2762 +        OldSQLVar := FIBXSQLVAR;
2763 +        FIBXSQLVAR := Column[i];
2764 +        try
2765 +          inherited SetAsDateTime(AValue,aTimeZone);
2766 +        finally
2767 +          FIBXSQLVAR := OldSQLVar;
2768 +        end;
2769 +      end;
2770 +  end;
2771 + end;
2772 +
2773   procedure TSQLParam.SetAsDouble(AValue: Double);
2774   var i: integer;
2775      OldSQLVar: TSQLVarData;
# Line 2367 | Line 2950 | begin
2950    FIBXSQLVAR.SetCharSetID(aValue);
2951   end;
2952  
2953 + procedure TSQLParam.SetAsBcd(aValue: tBCD);
2954 + var i: integer;
2955 +    OldSQLVar: TSQLVarData;
2956 + begin
2957 +  if FIBXSQLVAR.UniqueName then
2958 +    inherited SetAsBcd(AValue)
2959 +  else
2960 +  with FIBXSQLVAR.Parent do
2961 +  begin
2962 +    for i := 0 to Count - 1 do
2963 +      if Column[i].Name = Name then
2964 +      begin
2965 +        OldSQLVar := FIBXSQLVAR;
2966 +        FIBXSQLVAR := Column[i];
2967 +        try
2968 +          inherited SetAsBcd(AValue);
2969 +        finally
2970 +          FIBXSQLVAR := OldSQLVar;
2971 +        end;
2972 +      end;
2973 +  end;
2974 + end;
2975 +
2976   { TMetaData }
2977  
2978   procedure TMetaData.CheckActive;
# Line 2522 | Line 3128 | begin
3128    if not FResults.CheckStatementStatus(ssPrepared)  then
3129      IBError(ibxeStatementNotPrepared, [nil]);
3130  
3131 <  with GetTransaction as TFBTransaction do
3131 >  with GetTransaction do
3132    if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3133      IBError(ibxeInterfaceOutofDate,[nil]);
3134   end;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines