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

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents):
Revision 345 by tony, Mon Aug 23 14:22:29 2021 UTC vs.
Revision 349 by tony, Mon Oct 18 08:39:40 2021 UTC

# Line 154 | Line 154 | type
154       property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
155    public
156       constructor Create(api: TFBClientAPI);
157 <     function GetSQLType: cardinal; virtual; abstract;
157 >     function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
158       function GetSQLTypeName: AnsiString; overload;
159 <     class function GetSQLTypeName(SQLType: short): AnsiString; overload;
159 >     class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
160       function GetStrDataLength: short;
161       function GetName: AnsiString; virtual; abstract;
162 <     function GetScale: integer; virtual; abstract;
162 >     function GetScale: integer; virtual; abstract; {Current Field Data scale}
163       function GetAsBoolean: boolean;
164       function GetAsCurrency: Currency;
165       function GetAsInt64: Int64;
# Line 284 | Line 284 | type
284      FModified: boolean;
285      FUniqueName: boolean;
286      FVarString: RawByteString;
287 +    FColMetaData: IParamMetaData;
288      function GetStatement: IStatement;
289      procedure SetName(AValue: AnsiString);
290    protected
# Line 322 | Line 323 | type
323      function CreateBlob: IBlob; virtual; abstract;
324      function GetArrayMetaData: IArrayMetaData; virtual; abstract;
325      function GetBlobMetaData: IBlobMetaData; virtual; abstract;
326 +    function getColMetadata: IParamMetaData;
327      procedure Initialize; virtual;
328 +    procedure SaveMetaData;
329  
330    public
331      property AliasName: AnsiString read GetAliasName;
# Line 411 | Line 414 | type
414      property AsBlob: IBlob read GetAsBlob;
415   end;
416  
417 +  { TSQLParamMetaData }
418 +
419 +  TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
420 +  private
421 +    FSQLType: cardinal;
422 +    FSQLSubType: integer;
423 +    FScale: integer;
424 +    FCharSetID: cardinal;
425 +    FNullable: boolean;
426 +    FSize: cardinal;
427 +    FCodePage: TSystemCodePage;
428 +  public
429 +    constructor Create(src: TSQLVarData);
430 +    {IParamMetaData}
431 +    function GetSQLType: cardinal;
432 +    function GetSQLTypeName: AnsiString;
433 +    function getSubtype: integer;
434 +    function getScale: integer;
435 +    function getCharSetID: cardinal;
436 +    function getCodePage: TSystemCodePage;
437 +    function getIsNullable: boolean;
438 +    function GetSize: cardinal;
439 +    property SQLType: cardinal read GetSQLType;
440 +  end;
441 +
442    { TSQLParam }
443  
444    TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
# Line 423 | Line 451 | type
451      procedure SetSQLType(aValue: cardinal); override;
452    public
453      procedure Clear;
454 +    function getColMetadata: IParamMetaData;
455      function GetModified: boolean; override;
456      function GetAsPointer: Pointer;
457      function GetAsString: AnsiString; override;
# Line 528 | Line 557 | implementation
557  
558   uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
559  
560 + { TSQLParamMetaData }
561 +
562 + constructor TSQLParamMetaData.Create(src: TSQLVarData);
563 + begin
564 +  inherited Create;
565 +  FSQLType := src.GetSQLType;
566 +  FSQLSubType := src.getSubtype;
567 +  FScale := src.GetScale;
568 +  FCharSetID := src.getCharSetID;
569 +  FNullable := src.GetIsNullable;
570 +  FSize := src.GetSize;
571 +  FCodePage := src.GetCodePage;
572 + end;
573 +
574 + function TSQLParamMetaData.GetSQLType: cardinal;
575 + begin
576 +  Result := FSQLType;
577 + end;
578 +
579 + function TSQLParamMetaData.GetSQLTypeName: AnsiString;
580 + begin
581 +  Result := TSQLDataItem.GetSQLTypeName(FSQLType);
582 + end;
583 +
584 + function TSQLParamMetaData.getSubtype: integer;
585 + begin
586 +  Result := FSQLSubType;
587 + end;
588 +
589 + function TSQLParamMetaData.getScale: integer;
590 + begin
591 +  Result := FScale;
592 + end;
593 +
594 + function TSQLParamMetaData.getCharSetID: cardinal;
595 + begin
596 +  Result := FCharSetID;
597 + end;
598 +
599 + function TSQLParamMetaData.getCodePage: TSystemCodePage;
600 + begin
601 +  Result :=  FCodePage;
602 + end;
603 +
604 + function TSQLParamMetaData.getIsNullable: boolean;
605 + begin
606 +  Result :=  FNullable;
607 + end;
608 +
609 + function TSQLParamMetaData.GetSize: cardinal;
610 + begin
611 +  Result := FSize;
612 + end;
613 +
614   { TSQLDataArea }
615  
616   function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
# Line 679 | Line 762 | begin
762    //Ignore
763   end;
764  
765 + procedure TSQLVarData.SaveMetaData;
766 + begin
767 +  FColMetaData := TSQLParamMetaData.Create(self);
768 + end;
769 +
770   constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
771   begin
772    inherited Create;
# Line 713 | Line 801 | begin
801    FVarString := '';
802   end;
803  
804 + function TSQLVarData.getColMetadata: IParamMetaData;
805 + begin
806 +  Result := FColMetaData;
807 + end;
808 +
809   procedure TSQLVarData.Initialize;
810  
811    function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
# Line 1004 | Line 1097 | begin
1097    end
1098    else
1099      result := trunc(Value);
1100 + //  writeln('Adjusted ',Value,' to ',Result);
1101   end;
1102  
1103   procedure TSQLDataItem.CheckActive;
# Line 1077 | Line 1171 | begin
1171    Result := GetSQLTypeName(GetSQLType);
1172   end;
1173  
1174 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1174 > class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1175   begin
1176    Result := 'Unknown';
1177    case SQLType of
# Line 2330 | Line 2424 | end;
2424  
2425   var b: IBlob;
2426      dt: TDateTime;
2333 –    CurrValue: Currency;
2334 –    FloatValue: single;
2427      timezone: AnsiString;
2428 +    FloatValue: Double;
2429 +    Int64Value: Int64;
2430 +    BCDValue: TBCD;
2431 +    aScale: integer;
2432   begin
2433    CheckActive;
2434    if IsNullable then
2435      IsNull := False;
2436    with FFirebirdClientAPI do
2437 <  case SQLTYPE of
2437 >  case getColMetaData.SQLTYPE of
2438    SQL_BOOLEAN:
2439      if AnsiCompareText(Value,STrue) = 0 then
2440        AsBoolean := true
# Line 2364 | Line 2460 | begin
2460    SQL_TEXT:
2461      DoSetString;
2462  
2463 <    SQL_SHORT,
2464 <    SQL_LONG,
2465 <    SQL_INT64:
2466 <      if TryStrToCurr(Value,CurrValue) then
2467 <        SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2468 <      else
2469 <        DoSetString;
2470 <
2471 <    SQL_D_FLOAT,
2376 <    SQL_DOUBLE,
2377 <    SQL_FLOAT:
2463 >  SQL_SHORT,
2464 >  SQL_LONG,
2465 >  SQL_INT64:
2466 >    {If the string contains an integer then convert and set directly}
2467 >    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 <        SetAsDouble(FloatValue)
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
2485 +    else
2486 +      DoSetString;
2487 +
2488 +  SQL_DEC_FIXED,
2489 +  SQL_DEC16,
2490 +  SQL_DEC34,
2491 +  SQL_INT128:
2492 +    if TryStrToBCD(Value,BCDValue) then
2493 +      SetAsBCD(BCDValue)
2494 +    else
2495 +      DoSetString;
2496  
2497 <    SQL_TIMESTAMP:
2497 >  SQL_D_FLOAT,
2498 >  SQL_DOUBLE,
2499 >  SQL_FLOAT:
2500 >    if TryStrToFloat(Value,FloatValue) then
2501 >      SetAsDouble(FloatValue)
2502 >    else
2503 >      DoSetString;
2504 >
2505 >  SQL_TIMESTAMP:
2506        if TryStrToDateTime(Value,dt) then
2507          SetAsDateTime(dt)
2508        else
2509          DoSetString;
2510  
2511 <    SQL_TYPE_DATE:
2511 >  SQL_TYPE_DATE:
2512        if TryStrToDateTime(Value,dt) then
2513          SetAsDate(dt)
2514        else
2515          DoSetString;
2516  
2517 <    SQL_TYPE_TIME:
2517 >  SQL_TYPE_TIME:
2518        if TryStrToDateTime(Value,dt) then
2519          SetAsTime(dt)
2520        else
2521          DoSetString;
2522  
2523 <    SQL_TIMESTAMP_TZ:
2523 >  SQL_TIMESTAMP_TZ,
2524 >  SQL_TIMESTAMP_TZ_EX:
2525        if ParseDateTimeTZString(value,dt,timezone) then
2526          SetAsDateTime(dt,timezone)
2527        else
2528          DoSetString;
2529  
2530 <    SQL_TIME_TZ:
2530 >  SQL_TIME_TZ,
2531 >  SQL_TIME_TZ_EX:
2532        if ParseDateTimeTZString(value,dt,timezone,true) then
2533          SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2534        else
2535          DoSetString;
2536  
2537 <    SQL_DEC_FIXED,
2538 <    SQL_DEC16,
2415 <    SQL_DEC34,
2416 <    SQL_INT128:
2417 <      SetAsBCD(StrToBCD(Value));
2418 <
2419 <    else
2420 <      IBError(ibxeInvalidDataConversion,[GetSQLTypeName(SQLType)]);
2537 >  else
2538 >    IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2539    end;
2540   end;
2541  
# Line 2455 | Line 2573 | begin
2573    IsNull := true;
2574   end;
2575  
2576 + function TSQLParam.getColMetadata: IParamMetaData;
2577 + begin
2578 +  Result := FIBXSQLVAR.getColMetadata;
2579 + end;
2580 +
2581   function TSQLParam.GetModified: boolean;
2582   begin
2583    CheckActive;

Diff Legend

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