ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBSQLData.pas
(Generate patch)

Comparing:
ibx/trunk/fbintf/client/FBSQLData.pas (file contents), Revision 349 by tony, Mon Oct 18 08:39:40 2021 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC

# Line 122 | Line 122 | type
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;
125       function GetDateFormatStr(IncludeTime: boolean): AnsiString;
126       function GetTimeFormatStr: AnsiString;
127       function GetTimestampFormatStr: AnsiString;
# Line 132 | Line 129 | type
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;
136       function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
137       function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
138       procedure CheckActive; virtual;
# Line 205 | 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;
# Line 288 | Line 289 | type
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;
# Line 318 | Line 320 | type
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;
# Line 326 | Line 328 | type
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 767 | Line 770 | 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 797 | Line 805 | end;
805  
806   procedure TSQLVarData.RowChange;
807   begin
808 +  FArrayIntf := nil;
809    FModified := false;
810    FVarString := '';
811   end;
# Line 906 | 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 1570 | Line 1613 | end;
1613   function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1614   var i: integer;
1615      cplen: integer;
1573 –    s: AnsiString;
1616   begin
1617    Result := 0;
1576 –  s := strpas(p);
1618    for i := 1 to FieldWidth do
1619    begin
1620      cplen := UTF8CodepointSizeFull(p);
# Line 2130 | Line 2171 | begin
2171   end;
2172  
2173   procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2133 – var C: Currency;
2174   begin
2175    CheckActive;
2176    Changing;
# Line 2380 | 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 2425 | Line 2465 | end;
2465   var b: IBlob;
2466      dt: TDateTime;
2467      timezone: AnsiString;
2428 –    FloatValue: Double;
2468      Int64Value: Int64;
2469      BCDValue: TBCD;
2470      aScale: integer;
# Line 2463 | Line 2502 | begin
2502    SQL_SHORT,
2503    SQL_LONG,
2504    SQL_INT64:
2505 <    {If the string contains an integer then convert and set directly}
2506 <    if TryStrToInt64(Value,Int64Value) then
2468 <      SetAsInt64(Int64Value)
2469 <    else
2470 <    if getColMetaData.getScale = 0 then {integer expected but non-integer string}
2471 <    begin
2472 <      if TryStrToFloat(Value,FloatValue) then
2473 <        {truncate it if the column is limited to an integer}
2474 <        SetAsInt64(Trunc(FloatValue))
2475 <      else
2476 <        DoSetString;
2477 <    end
2478 <    else
2479 <    if TryStrToFloat(Value,FloatValue) then
2480 <    begin
2481 <      aScale := getColMetaData.getScale;
2482 <      {Set as int64 with adjusted scale}
2483 <      SetAsNumeric(AdjustScaleFromDouble(FloatValue,aScale),aScale)
2484 <    end
2505 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2506 >      SetAsNumeric(Int64Value,aScale)
2507      else
2508        DoSetString;
2509  
# Line 2497 | Line 2519 | begin
2519    SQL_D_FLOAT,
2520    SQL_DOUBLE,
2521    SQL_FLOAT:
2522 <    if TryStrToFloat(Value,FloatValue) then
2523 <      SetAsDouble(FloatValue)
2522 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2523 >      SetAsDouble(NumericToDouble(Int64Value,aScale))
2524      else
2525        DoSetString;
2526  
# Line 2652 | 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  

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines