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 350 by tony, Wed Oct 20 14:58:56 2021 UTC vs.
ibx/branches/journaling/fbintf/client/FBSQLData.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 2021 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 2422 | Line 2462 | begin
2462    Changed;
2463   end;
2464  
2425 function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
2426 var i: integer;
2427    ds: integer;
2428 begin
2429  Result := false;
2430  ds := 0;
2431  S := Trim(S);
2432  {$IF declared(DefaultFormatSettings)}
2433  with DefaultFormatSettings do
2434  {$ELSE}
2435  {$IF declared(FormatSettings)}
2436  with FormatSettings do
2437  {$IFEND}
2438  {$IFEND}
2439  begin
2440    {ThousandSeparator not allowed as by Delphi specs}
2441    if (ThousandSeparator <> DecimalSeparator) and
2442       (Pos(ThousandSeparator, S) <> 0) then
2443        Exit;
2444
2445    for i := length(S) downto 1 do
2446    begin
2447      if S[i] = AnsiChar(DecimalSeparator) then
2448      begin
2449          if ds <> 0 then Exit; {only one allowed}
2450          ds := i-1;
2451          system.Delete(S,i,1);
2452      end
2453      else
2454      if (i > 1) and (S[i] in ['+','-']) then
2455        Exit
2456      else
2457      if not (S[i] in ['0'..'9']) then
2458          Exit; {bad character}
2459
2460    end;
2461    if ds = 0 then
2462      scale := 0
2463    else
2464      scale := ds - Length(S);
2465    Result := TryStrToInt64(S,Value);
2466  end;
2467 end;
2468
2465   var b: IBlob;
2466      dt: TDateTime;
2467      timezone: AnsiString;
2472    {$ifdef FPC_HAS_TYPE_EXTENDED}
2473    FloatValue: Extended;
2474    {$else}
2475    FloatValue: Double;
2476    {$endif}
2468      Int64Value: Int64;
2469      BCDValue: TBCD;
2470      aScale: integer;
# Line 2512 | Line 2503 | begin
2503    SQL_LONG,
2504    SQL_INT64:
2505      if TryStrToNumeric(Value,Int64Value,aScale) then
2506 <    begin
2516 <      if aScale = 0 then
2517 <        SetAsInt64(Int64Value)
2518 <      else
2519 <        SetAsNumeric(Int64Value,aScale);
2520 <    end
2521 <    else
2522 <    if TryStrToFloat(Value,FloatValue) then
2523 <      SetAsDouble(FloatValue)
2506 >      SetAsNumeric(Int64Value,aScale)
2507      else
2508        DoSetString;
2509  
# Line 2536 | 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 2691 | 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