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/branches/journaling/fbintf/client/FBSQLData.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (file contents), Revision 373 by tony, Thu Jan 6 14:14:57 2022 UTC

# Line 129 | 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;
132       procedure CheckActive; virtual;
133       procedure CheckTZSupport;
134       function GetAttachment: IAttachment; virtual; abstract;
135 +     function GetTransaction: ITransaction; virtual; abstract;
136       function GetSQLDialect: integer; virtual; abstract;
137       function GetTimeZoneServices: IExTimeZoneServices; virtual;
138       procedure Changed; virtual;
# Line 155 | Line 150 | type
150       property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
151    public
152       constructor Create(api: TFBClientAPI);
153 +     function CanChangeMetaData: boolean; virtual;
154       function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
155       function GetSQLTypeName: AnsiString; overload;
156       class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
157       function GetStrDataLength: short;
158 +     function getColMetadata: IParamMetaData; virtual; abstract;
159       function GetName: AnsiString; virtual; abstract;
160       function GetScale: integer; virtual; abstract; {Current Field Data scale}
161       function GetAsBoolean: boolean;
# Line 179 | Line 176 | type
176       function GetAsQuad: TISC_QUAD;
177       function GetAsShort: short;
178       function GetAsString: AnsiString; virtual;
179 +     function GetAsNumeric: IFBNumeric;
180       function GetIsNull: Boolean; virtual;
181       function GetIsNullable: boolean; virtual;
182       function GetAsVariant: Variant;
# Line 206 | Line 204 | type
204       procedure SetAsShort(Value: short); virtual;
205       procedure SetAsString(Value: AnsiString); virtual;
206       procedure SetAsVariant(Value: Variant);
207 <     procedure SetAsNumeric(Value: Int64; aScale: integer); virtual;
207 >     procedure SetAsNumeric(Value: IFBNumeric); virtual;
208       procedure SetAsBcd(aValue: tBCD); virtual;
209       procedure SetIsNull(Value: Boolean); virtual;
210       procedure SetIsNullable(Value: Boolean); virtual;
# Line 248 | Line 246 | type
246      FUniqueRelationName: AnsiString;
247      FColumnList: array of TSQLVarData;
248      function GetStatement: IStatement; virtual; abstract;
249 +    function GetAttachment: IAttachment; virtual;
250 +    function GetTransaction: ITransaction; virtual;
251      function GetPrepareSeqNo: integer; virtual; abstract;
252      function GetTransactionSeqNo: integer; virtual; abstract;
253      procedure SetCount(aValue: integer); virtual; abstract;
# Line 268 | Line 268 | type
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;
271 >    property Column[index: integer]: TSQLVarData read GetColumn; default;
272      property UniqueRelationName: AnsiString read FUniqueRelationName;
273      property Statement: IStatement read GetStatement;
274 +    property Attachment: IAttachment read GetAttachment;
275      property PrepareSeqNo: integer read GetPrepareSeqNo;
276 +    property Transaction: ITransaction read GetTransaction;
277      property TransactionSeqNo: integer read GetTransactionSeqNo;
278    end;
279  
# Line 290 | Line 292 | type
292      procedure SetName(AValue: AnsiString);
293    protected
294      FArrayIntf: IArray;
295 <    function GetAttachment: IAttachment; virtual; abstract;
295 >    function GetAttachment: IAttachment;
296 >    function GetTransaction: ITransaction;
297      function GetSQLType: cardinal; virtual; abstract;
298      function GetSubtype: integer; virtual; abstract;
299      function GetAliasName: AnsiString;  virtual; abstract;
# Line 299 | Line 302 | type
302      function GetRelationName: AnsiString;  virtual; abstract;
303      function GetScale: integer; virtual; abstract;
304      function GetCharSetID: cardinal; virtual; abstract;
305 <    function GetCharSetWidth: integer; virtual; abstract;
306 <    function GetCodePage: TSystemCodePage; virtual; abstract;
305 >    function GetCharSetWidth: integer;
306 >    function GetCodePage: TSystemCodePage;
307      function GetIsNull: Boolean;   virtual; abstract;
308      function GetIsNullable: boolean; virtual; abstract;
309      function GetSQLData: PByte;  virtual; abstract;
310      function GetDataLength: cardinal; virtual; abstract; {current field length}
311      function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
312      function GetDefaultTextSQLType: cardinal; virtual; abstract;
313 +    procedure InternalSetSQLType(aValue: cardinal); virtual; abstract;
314 +    procedure InternalSetScale(aValue: integer); virtual; abstract;
315 +    procedure InternalSetDataLength(len: cardinal); virtual; abstract;
316      procedure SetIsNull(Value: Boolean); virtual; abstract;
317      procedure SetIsNullable(Value: Boolean);  virtual; abstract;
318      procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
319 <    procedure SetScale(aValue: integer); virtual; abstract;
320 <    procedure SetDataLength(len: cardinal); virtual; abstract;
321 <    procedure SetSQLType(aValue: cardinal); virtual; abstract;
319 >    procedure SetScale(aValue: integer);
320 >    procedure SetDataLength(len: cardinal);
321 >    procedure SetSQLType(aValue: cardinal);
322      procedure SetCharSetID(aValue: cardinal); virtual; abstract;
323      procedure SetMetaSize(aValue: cardinal); virtual;
324    public
325      constructor Create(aParent: TSQLDataArea; aIndex: integer);
326 +    function CanChangeMetaData: boolean;
327      procedure SetString(aValue: AnsiString);
328      procedure Changed; virtual;
329      procedure RowChange; virtual;
# Line 339 | Line 346 | type
346      property Index: integer read FIndex;
347      property Name: AnsiString read FName write SetName;
348      property CharSetID: cardinal read GetCharSetID write SetCharSetID;
349 +    property CodePage: TSystemCodePage read GetCodePage;
350      property SQLType: cardinal read GetSQLType write SetSQLType;
351      property SQLSubtype: integer read GetSubtype;
352      property SQLData: PByte read GetSQLData;
# Line 354 | Line 362 | type
362  
363    { TColumnMetaData }
364  
365 <  TColumnMetaData = class(TSQLDataItem,IColumnMetaData)
365 >  TColumnMetaData = class(TSQLDataItem,IColumnMetaData,IParamMetaData)
366    private
367      FIBXSQLVAR: TSQLVarData;
368      FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
# Line 362 | Line 370 | type
370      FChangeSeqNo: integer;
371    protected
372      procedure CheckActive; override;
365    function GetAttachment: IAttachment; override;
373      function SQLData: PByte; override;
374      function GetDataLength: cardinal; override;
375      function GetCodePage: TSystemCodePage; override;
# Line 371 | Line 378 | type
378      constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
379      destructor Destroy; override;
380      function GetSQLDialect: integer; override;
381 +    function getColMetadata: IParamMetaData; override;
382  
383    public
384      {IColumnMetaData}
# Line 390 | Line 398 | type
398      function GetArrayMetaData: IArrayMetaData;
399      function GetBlobMetaData: IBlobMetaData;
400      function GetStatement: IStatement;
401 <    function GetTransaction: ITransaction; virtual;
401 >    function GetTransaction: ITransaction; override;
402 >    function GetAttachment: IAttachment; override;
403      property Name: AnsiString read GetName;
404      property Size: cardinal read GetSize;
405      property CharSetID: cardinal read getCharSetID;
# Line 403 | Line 412 | type
412    { TIBSQLData }
413  
414    TIBSQLData = class(TColumnMetaData,ISQLData)
406  private
407    FTransaction: ITransaction;
415    protected
416      procedure CheckActive; override;
417    public
411    function GetTransaction: ITransaction; override;
418      function GetIsNull: Boolean; override;
419      function GetAsArray: IArray;
420      function GetAsBlob: IBlob; overload;
# Line 454 | Line 460 | type
460      procedure SetSQLType(aValue: cardinal); override;
461    public
462      procedure Clear;
463 <    function getColMetadata: IParamMetaData;
463 >    function CanChangeMetaData: boolean; override;
464 >    function getColMetadata: IParamMetaData; override;
465      function GetModified: boolean; override;
466      function GetAsPointer: Pointer;
467      function GetAsString: AnsiString; override;
# Line 487 | Line 494 | type
494      procedure SetAsQuad(AValue: TISC_QUAD);
495      procedure SetCharSetID(aValue: cardinal);
496      procedure SetAsBcd(aValue: tBCD);
497 +    procedure SetAsNumeric(aValue: IFBNumeric);
498  
499      property AsBlob: IBlob read GetAsBlob write SetAsBlob;
500      property IsNullable: Boolean read GetIsNullable write SetIsNullable;
# Line 527 | Line 535 | type
535      {ISQLParams}
536      function getCount: integer;
537      function getSQLParam(index: integer): ISQLParam;
538 <    function ByName(Idx: AnsiString): ISQLParam ;
538 >    function ByName(Idx: AnsiString): ISQLParam ; virtual;
539      function GetModified: Boolean;
540      function GetHasCaseSensitiveParams: Boolean;
541 +    function GetStatement: IStatement;
542 +    function GetTransaction: ITransaction;
543 +    function GetAttachment: IAttachment;
544 +    procedure Clear;
545    end;
546  
547    { TResults }
# Line 548 | Line 560 | type
560       constructor Create(aResults: TSQLDataArea);
561        {IResults}
562       function getCount: integer;
563 <     function ByName(Idx: AnsiString): ISQLData;
563 >     function ByName(Idx: AnsiString): ISQLData; virtual;
564       function getSQLData(index: integer): ISQLData;
565       procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
566       function GetStatement: IStatement;
567 <     function GetTransaction: ITransaction; virtual;
567 >     function GetTransaction: ITransaction;
568 >     function GetAttachment: IAttachment;
569       procedure SetRetainInterfaces(aValue: boolean);
570   end;
571  
572   implementation
573  
574 < uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
574 > uses FBMessages, variants, IBUtils, FBTransaction, FBNumeric, DateUtils;
575  
576   { TSQLParamMetaData }
577  
# Line 628 | Line 641 | begin
641    Result := Length(FColumnList);
642   end;
643  
644 + function TSQLDataArea.GetTransaction: ITransaction;
645 + begin
646 +  Result := GetStatement.GetTransaction;
647 + end;
648 +
649 + function TSQLDataArea.GetAttachment: IAttachment;
650 + begin
651 +  Result := GetStatement.GetAttachment;
652 + end;
653 +
654   procedure TSQLDataArea.SetUniqueRelationName;
655   var
656    i: Integer;
# Line 760 | Line 783 | begin
783      FName := AValue;
784   end;
785  
786 + function TSQLVarData.GetAttachment: IAttachment;
787 + begin
788 +  Result := Parent.Attachment;
789 + end;
790 +
791 + function TSQLVarData.GetTransaction: ITransaction;
792 + begin
793 +  Result := Parent.Transaction;
794 + end;
795 +
796 + function TSQLVarData.GetCharSetWidth: integer;
797 + begin
798 +  result := 1;
799 +  GetAttachment.CharSetWidth(GetCharSetID,result);
800 + end;
801 +
802 + function TSQLVarData.GetCodePage: TSystemCodePage;
803 + begin
804 +  result := CP_NONE;
805 +  GetAttachment.CharSetID2CodePage(GetCharSetID,result);
806 + end;
807 +
808 + procedure TSQLVarData.SetScale(aValue: integer);
809 + begin
810 +  if aValue = Scale then
811 +    Exit;
812 +  if not CanChangeMetaData  then
813 +    IBError(ibxeScaleCannotBeChanged,[]);
814 +  InternalSetScale(aValue);
815 + end;
816 +
817 + procedure TSQLVarData.SetDataLength(len: cardinal);
818 + begin
819 +  if len = DataLength then
820 +    Exit;
821 +  InternalSetDataLength(len);
822 + end;
823 +
824 + procedure TSQLVarData.SetSQLType(aValue: cardinal);
825 + begin
826 +  if aValue = SQLType then
827 +    Exit;
828 +  if not CanChangeMetaData then
829 +    IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(SQLType),
830 +                                          TSQLDataItem.GetSQLTypeName(aValue)]);
831 +  InternalSetSQLType(aValue);
832 + end;
833 +
834   procedure TSQLVarData.SetMetaSize(aValue: cardinal);
835   begin
836    //Ignore
# Line 783 | Line 854 | begin
854    FUniqueName := true;
855   end;
856  
857 + function TSQLVarData.CanChangeMetaData: boolean;
858 + begin
859 +  Result := Parent.CanChangeMetaData;
860 + end;
861 +
862   procedure TSQLVarData.SetString(aValue: AnsiString);
863   begin
864    {we take full advantage here of reference counted strings. When setting a string
# Line 793 | Line 869 | begin
869    FVarString := aValue;
870    if SQLType = SQL_BLOB then
871      SetMetaSize(GetAttachment.GetInlineBlobLimit);
872 <  SQLType := GetDefaultTextSQLType;
872 >  if CanChangeMetaData then
873 >    SQLType := GetDefaultTextSQLType;
874    Scale := 0;
875 +  if  (SQLType <> SQL_VARYING) and (SQLType <> SQL_TEXT) then
876 +    IBError(ibxeUnableTosetaTextType,[Index,Name,TSQLDataItem.GetSQLTypeName(SQLType)]);
877 +  if not CanChangeMetaData and (Length(aValue) > GetSize) then
878 +    IBError(ibxeStringOverflow,[Length(aValue),DataLength]);
879    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
880   end;
881  
# Line 874 | Line 955 | end;
955  
956   {TSQLDataItem}
957  
877 function TSQLDataItem.AdjustScale(Value: Int64; aScale: Integer): Double;
878 var
879  Scaling : Int64;
880  i: Integer;
881  Val: Double;
882 begin
883  Scaling := 1; Val := Value;
884  if aScale > 0 then
885  begin
886    for i := 1 to aScale do
887      Scaling := Scaling * 10;
888    result := Val * Scaling;
889  end
890  else
891    if aScale < 0 then
892    begin
893      for i := -1 downto aScale do
894        Scaling := Scaling * 10;
895      result := Val / Scaling;
896    end
897    else
898      result := Val;
899 end;
900
901 function TSQLDataItem.AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
902 var
903  Scaling : Int64;
904  i: Integer;
905  Val: Int64;
906 begin
907  Scaling := 1; Val := Value;
908  if aScale > 0 then begin
909    for i := 1 to aScale do Scaling := Scaling * 10;
910    result := Val * Scaling;
911  end else if aScale < 0 then begin
912    for i := -1 downto aScale do Scaling := Scaling * 10;
913    result := Val div Scaling;
914  end else
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
955  Scaling : Int64;
956  i : Integer;
957  FractionText, PadText, CurrText: AnsiString;
958 begin
959  Result := 0;
960  Scaling := 1;
961  PadText := '';
962  if aScale > 0 then
963  begin
964    for i := 1 to aScale do
965      Scaling := Scaling * 10;
966    result := Value * Scaling;
967  end
968  else
969    if aScale < 0 then
970    begin
971      for i := -1 downto aScale do
972        Scaling := Scaling * 10;
973      FractionText := IntToStr(abs(Value mod Scaling));
974      for i := Length(FractionText) to -aScale -1 do
975        PadText := '0' + PadText;
976      {$IF declared(DefaultFormatSettings)}
977      with DefaultFormatSettings do
978      {$ELSE}
979      {$IF declared(FormatSettings)}
980      with FormatSettings do
981      {$IFEND}
982      {$IFEND}
983      if Value < 0 then
984        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
985      else
986        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
987      try
988        result := StrToCurr(CurrText);
989      except
990        on E: Exception do
991          IBError(ibxeInvalidDataConversion, [nil]);
992      end;
993    end
994    else
995      result := Value;
996 end;
997
958   function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
959   begin
960    {$IF declared(DefaultFormatSettings)}
# Line 1092 | Line 1052 | begin
1052      end;
1053   end;
1054  
1095 function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1096  ): Int64;
1097 var
1098  Scaling : Int64;
1099  i : Integer;
1100 begin
1101  Result := 0;
1102  Scaling := 1;
1103  if aScale < 0 then
1104  begin
1105    for i := -1 downto aScale do
1106      Scaling := Scaling * 10;
1107    result := trunc(Value * Scaling);
1108  end
1109  else
1110  if aScale > 0 then
1111  begin
1112    for i := 1 to aScale do
1113       Scaling := Scaling * 10;
1114    result := trunc(Value / Scaling);
1115  end
1116  else
1117    result := trunc(Value);
1118 end;
1119
1120 function TSQLDataItem.AdjustScaleFromDouble(Value: Double; aScale: Integer
1121  ): Int64;
1122 var
1123  Scaling : Int64;
1124  i : Integer;
1125 begin
1126  Result := 0;
1127  Scaling := 1;
1128  if aScale < 0 then
1129  begin
1130    for i := -1 downto aScale do
1131      Scaling := Scaling * 10;
1132    result := trunc(Value * Scaling);
1133  end
1134  else
1135  if aScale > 0 then
1136  begin
1137    for i := 1 to aScale do
1138       Scaling := Scaling * 10;
1139    result := trunc(Value / Scaling);
1140  end
1141  else
1142    result := trunc(Value);
1143 //  writeln('Adjusted ',Value,' to ',Result);
1144 end;
1145
1055   procedure TSQLDataItem.CheckActive;
1056   begin
1057    //Do nothing by default
# Line 1209 | Line 1118 | begin
1118    FFirebirdClientAPI := api;
1119   end;
1120  
1121 + function TSQLDataItem.CanChangeMetaData: boolean;
1122 + begin
1123 +  Result := false;
1124 + end;
1125 +
1126   function TSQLDataItem.GetSQLTypeName: AnsiString;
1127   begin
1128    Result := GetSQLTypeName(GetSQLType);
# Line 1284 | Line 1198 | begin
1198            end;
1199          end;
1200          SQL_SHORT:
1201 <          result := AdjustScaleToCurrency(Int64(PShort(SQLData)^),
1202 <                                      Scale);
1201 >          result := NumericFromRawValues(Int64(PShort(SQLData)^),
1202 >                                      Scale).getAsCurrency;
1203          SQL_LONG:
1204 <          result := AdjustScaleToCurrency(Int64(PLong(SQLData)^),
1205 <                                      Scale);
1204 >          result := NumericFromRawValues(Int64(PLong(SQLData)^),
1205 >                                      Scale).getAsCurrency;
1206          SQL_INT64:
1207 <          result := AdjustScaleToCurrency(PInt64(SQLData)^,
1208 <                                      Scale);
1207 >          result := NumericFromRawValues(PInt64(SQLData)^,
1208 >                                      Scale).getAsCurrency;
1209          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1210            result := Round(AsDouble);
1211  
# Line 1322 | Line 1236 | begin
1236          end;
1237        end;
1238        SQL_SHORT:
1239 <        result := AdjustScaleToInt64(Int64(PShort(SQLData)^),
1240 <                                    Scale);
1239 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1240 >                                    Scale).getAsInt64;
1241        SQL_LONG:
1242 <        result := AdjustScaleToInt64(Int64(PLong(SQLData)^),
1243 <                                    Scale);
1242 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1243 >                                    Scale).getAsInt64;
1244        SQL_INT64:
1245 <        result := AdjustScaleToInt64(PInt64(SQLData)^,
1246 <                                    Scale);
1245 >        result := NumericFromRawValues(PInt64(SQLData)^,
1246 >                                    Scale).getAsInt64;
1247        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1248          result := Round(AsDouble);
1249        else
# Line 1458 | Line 1372 | begin
1372          end;
1373        end;
1374        SQL_SHORT:
1375 <        result := AdjustScale(Int64(PShort(SQLData)^),
1376 <                              Scale);
1375 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1376 >                              Scale).getAsDouble;
1377        SQL_LONG:
1378 <        result := AdjustScale(Int64(PLong(SQLData)^),
1379 <                              Scale);
1378 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1379 >                              Scale).getAsDouble;
1380        SQL_INT64:
1381 <        result := AdjustScale(PInt64(SQLData)^, Scale);
1381 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsDouble;
1382        SQL_FLOAT:
1383          result := PFloat(SQLData)^;
1384        SQL_DOUBLE, SQL_D_FLOAT:
# Line 1510 | Line 1424 | begin
1424          end;
1425        end;
1426        SQL_SHORT:
1427 <        result := Round(AdjustScale(Int64(PShort(SQLData)^),
1428 <                                    Scale));
1427 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1428 >                                    Scale).getAsInteger;
1429        SQL_LONG:
1430 <        result := Round(AdjustScale(Int64(PLong(SQLData)^),
1431 <                                    Scale));
1430 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1431 >                                    Scale).getAsInteger;
1432        SQL_INT64:
1433 <        result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1433 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsInteger;
1434 >
1435        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1436          result := Round(AsDouble);
1437        SQL_DEC_FIXED,
# Line 1731 | Line 1646 | begin
1646          result := Int128ToStr(SQLData,scale);
1647  
1648        else
1649 <        IBError(ibxeInvalidDataConversion, [nil]);
1649 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1650      end;
1651   end;
1652  
1653 + function TSQLDataItem.GetAsNumeric: IFBNumeric;
1654 + var aValue: Int64;
1655 + begin
1656 +  case SQLType of
1657 +   SQL_TEXT, SQL_VARYING:
1658 +     Result := NewNumeric(GetAsString);
1659 +
1660 +   SQL_SHORT:
1661 +     Result := NumericFromRawValues(PShort(SQLData)^, Scale);
1662 +
1663 +   SQL_LONG:
1664 +     Result := NumericFromRawValues(PLong(SQLData)^, Scale);
1665 +
1666 +   SQL_INT64:
1667 +     Result := NumericFromRawValues(PInt64(SQLData)^, Scale);
1668 +
1669 +   SQL_DEC16,
1670 +   SQL_DEC34,
1671 +   SQL_DEC_FIXED,
1672 +   SQL_INT128:
1673 +     Result := NewNumeric(GetAsBCD);
1674 +
1675 +   else
1676 +     IBError(ibxeInvalidDataConversion, [nil]);
1677 +  end;
1678 + end;
1679 +
1680   function TSQLDataItem.GetIsNull: Boolean;
1681   begin
1682    CheckActive;
# Line 1873 | Line 1815 | begin
1815    if GetSQLDialect < 3 then
1816      AsDouble := Value
1817    else
1818 +  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> -4)) then
1819 +    SetAsNumeric(NewNumeric(Value))
1820 +  else
1821    begin
1822      Changing;
1823      if IsNullable then
# Line 1888 | Line 1833 | end;
1833   procedure TSQLDataItem.SetAsInt64(Value: Int64);
1834   begin
1835    CheckActive;
1836 <  Changing;
1837 <  if IsNullable then
1838 <    IsNull := False;
1836 >  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> 0)) then
1837 >    SetAsNumeric(NewNumeric(Value))
1838 >  else
1839 >  begin
1840 >    Changing;
1841 >    if IsNullable then
1842 >      IsNull := False;
1843  
1844 <  SQLType := SQL_INT64;
1845 <  Scale := 0;
1846 <  DataLength := SizeOf(Int64);
1847 <  PInt64(SQLData)^ := Value;
1848 <  Changed;
1844 >    SQLType := SQL_INT64;
1845 >    Scale := 0;
1846 >    DataLength := SizeOf(Int64);
1847 >    PInt64(SQLData)^ := Value;
1848 >    Changed;
1849 >  end;
1850   end;
1851  
1852   procedure TSQLDataItem.SetAsDate(Value: TDateTime);
# Line 2059 | Line 2009 | end;
2009   procedure TSQLDataItem.SetAsLong(Value: Long);
2010   begin
2011    CheckActive;
2012 <  if IsNullable then
2013 <    IsNull := False;
2012 >  if not CanChangeMetaData and ((SQLType <> SQL_LONG) or (Scale <> 0)) then
2013 >    SetAsNumeric(NewNumeric(Value))
2014 >  else
2015 >  begin
2016 >    if IsNullable then
2017 >      IsNull := False;
2018  
2019 <  Changing;
2020 <  SQLType := SQL_LONG;
2021 <  DataLength := SizeOf(Long);
2022 <  Scale := 0;
2023 <  PLong(SQLData)^ := Value;
2024 <  Changed;
2019 >    Changing;
2020 >    SQLType := SQL_LONG;
2021 >    DataLength := SizeOf(Long);
2022 >    Scale := 0;
2023 >    PLong(SQLData)^ := Value;
2024 >    Changed;
2025 >  end;
2026   end;
2027  
2028   procedure TSQLDataItem.SetAsPointer(Value: Pointer);
# Line 2102 | Line 2057 | end;
2057   procedure TSQLDataItem.SetAsShort(Value: short);
2058   begin
2059    CheckActive;
2060 <  Changing;
2061 <  if IsNullable then
2062 <    IsNull := False;
2060 >  if not CanChangeMetaData and ((SQLType <> SQL_SHORT) or (Scale <> 0)) then
2061 >    SetAsNumeric(NewNumeric(Value))
2062 >  else
2063 >  begin
2064 >    Changing;
2065 >    if IsNullable then
2066 >      IsNull := False;
2067  
2068 <  SQLType := SQL_SHORT;
2069 <  DataLength := SizeOf(Short);
2070 <  Scale := 0;
2071 <  PShort(SQLData)^ := Value;
2072 <  Changed;
2068 >    SQLType := SQL_SHORT;
2069 >    DataLength := SizeOf(Short);
2070 >    Scale := 0;
2071 >    PShort(SQLData)^ := Value;
2072 >    Changed;
2073 >  end;
2074   end;
2075  
2076   procedure TSQLDataItem.SetAsString(Value: AnsiString);
# Line 2130 | Line 2090 | begin
2090      varEmpty, varNull:
2091        IsNull := True;
2092      varSmallint, varInteger, varByte,
2093 <      varWord, varShortInt:
2094 <      AsLong := Value;
2135 <    varInt64:
2136 <      AsInt64 := Value;
2093 >      varWord, varShortInt, varInt64:
2094 >        SetAsNumeric(NewNumeric(Int64(Value)));
2095      varSingle, varDouble:
2096        AsDouble := Value;
2097      varCurrency:
2098 <      AsCurrency := Value;
2098 >      SetAsNumeric(NewNumeric(Currency(Value)));
2099      varBoolean:
2100        AsBoolean := Value;
2101      varDate:
# Line 2156 | Line 2114 | begin
2114    end;
2115   end;
2116  
2117 < procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
2117 > procedure TSQLDataItem.SetAsNumeric(Value: IFBNumeric);
2118   begin
2119    CheckActive;
2120    Changing;
2121    if IsNullable then
2122      IsNull := False;
2123  
2124 <  SQLType := SQL_INT64;
2125 <  Scale := aScale;
2126 <  DataLength := SizeOf(Int64);
2127 <  PInt64(SQLData)^ := Value;
2124 >  if CanChangeMetadata then
2125 >  begin
2126 >    {Restore original values}
2127 >    SQLType := getColMetadata.GetSQLType;
2128 >    Scale := getColMetadata.getScale;
2129 >    SetDataLength(getColMetadata.GetSize);
2130 >  end;
2131 >
2132 >  with FFirebirdClientAPI do
2133 >  case GetSQLType of
2134 >  SQL_LONG:
2135 >      PLong(SQLData)^ := SafeInteger(Value.clone(Scale).getRawValue);
2136 >  SQL_SHORT:
2137 >    PShort(SQLData)^ := SafeSmallInt(Value.clone(Scale).getRawValue);
2138 >  SQL_INT64:
2139 >    PInt64(SQLData)^ := Value.clone(Scale).getRawValue;
2140 >  SQL_TEXT, SQL_VARYING:
2141 >   SetAsString(Value.getAsString);
2142 >  SQL_D_FLOAT,
2143 >  SQL_DOUBLE:
2144 >    PDouble(SQLData)^ := Value.getAsDouble;
2145 >  SQL_FLOAT:
2146 >    PSingle(SQLData)^ := Value.getAsDouble;
2147 >  SQL_DEC_FIXED,
2148 >  SQL_DEC16,
2149 >  SQL_DEC34:
2150 >     SQLDecFloatEncode(Value.getAsBCD,SQLType,SQLData);
2151 >  SQL_INT128:
2152 >    StrToInt128(Scale,Value.getAsString,SQLData);
2153 >  else
2154 >    IBError(ibxeInvalidDataConversion, [nil]);
2155 >  end;
2156    Changed;
2157   end;
2158  
# Line 2177 | Line 2163 | begin
2163    if IsNullable then
2164      IsNull := False;
2165  
2166 +  if not CanChangeMetaData then
2167 +  begin
2168 +    SetAsNumeric(NewNumeric(aValue));
2169 +    Exit;
2170 +  end;
2171  
2172    with FFirebirdClientAPI do
2173    if aValue.Precision <= 16 then
# Line 2246 | Line 2237 | end;
2237  
2238   function TColumnMetaData.GetAttachment: IAttachment;
2239   begin
2240 <  Result := GetStatement.GetAttachment;
2240 >  Result := FIBXSQLVAR.GetAttachment;
2241   end;
2242  
2243   function TColumnMetaData.SQLData: PByte;
# Line 2266 | Line 2257 | end;
2257  
2258   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2259   begin
2260 <  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
2260 >  inherited Create(aIBXSQLVAR.GetAttachment.getFirebirdAPI as TFBClientAPI);
2261    FIBXSQLVAR := aIBXSQLVAR;
2262    FOwner := aOwner;
2263    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 2282 | Line 2273 | end;
2273  
2274   function TColumnMetaData.GetSQLDialect: integer;
2275   begin
2276 <  Result := FIBXSQLVAR.Statement.GetSQLDialect;
2276 >  Result := FIBXSQLVAR.GetAttachment.GetSQLDialect;
2277 > end;
2278 >
2279 > function TColumnMetaData.getColMetadata: IParamMetaData;
2280 > begin
2281 >  Result := self;
2282   end;
2283  
2284   function TColumnMetaData.GetIndex: integer;
# Line 2381 | Line 2377 | end;
2377  
2378   function TColumnMetaData.GetTransaction: ITransaction;
2379   begin
2380 <  Result := GetStatement.GetTransaction;
2380 >  Result := FIBXSQLVAR.GetTransaction;
2381   end;
2382  
2383   { TIBSQLData }
# Line 2403 | Line 2399 | begin
2399      IBError(ibxeBOF,[nil]);
2400   end;
2401  
2406 function TIBSQLData.GetTransaction: ITransaction;
2407 begin
2408  if FTransaction = nil then
2409    Result := inherited GetTransaction
2410  else
2411    Result := FTransaction;
2412 end;
2413
2402   function TIBSQLData.GetIsNull: Boolean;
2403   begin
2404    CheckActive;
# Line 2473 | Line 2461 | begin
2461    if IsNullable then
2462      IsNull := False;
2463    with FFirebirdClientAPI do
2464 <  case getColMetaData.SQLTYPE of
2464 >  case SQLTYPE of
2465    SQL_BOOLEAN:
2466      if AnsiCompareText(Value,STrue) = 0 then
2467        AsBoolean := true
# Line 2503 | Line 2491 | begin
2491    SQL_LONG,
2492    SQL_INT64:
2493      if TryStrToNumeric(Value,Int64Value,aScale) then
2494 <      SetAsNumeric(Int64Value,aScale)
2494 >      SetAsNumeric(NumericFromRawValues(Int64Value,aScale))
2495      else
2496        DoSetString;
2497  
# Line 2512 | Line 2500 | begin
2500    SQL_DEC34,
2501    SQL_INT128:
2502      if TryStrToBCD(Value,BCDValue) then
2503 <      SetAsBCD(BCDValue)
2503 >      SetAsNumeric(NewNumeric(BCDValue))
2504      else
2505        DoSetString;
2506  
# Line 2520 | Line 2508 | begin
2508    SQL_DOUBLE,
2509    SQL_FLOAT:
2510      if TryStrToNumeric(Value,Int64Value,aScale) then
2511 <      SetAsDouble(NumericToDouble(Int64Value,aScale))
2511 >      SetAsNumeric(NumericFromRawValues(Int64Value,AScale))
2512      else
2513        DoSetString;
2514  
# Line 2595 | Line 2583 | begin
2583    IsNull := true;
2584   end;
2585  
2586 + function TSQLParam.CanChangeMetaData: boolean;
2587 + begin
2588 +  Result := FIBXSQLVAR.CanChangeMetaData;
2589 + end;
2590 +
2591   function TSQLParam.getColMetadata: IParamMetaData;
2592   begin
2593    Result := FIBXSQLVAR.getColMetadata;
# Line 3150 | Line 3143 | begin
3143    end;
3144   end;
3145  
3146 + procedure TSQLParam.SetAsNumeric(aValue: IFBNumeric);
3147 + var i: integer;
3148 +    OldSQLVar: TSQLVarData;
3149 + begin
3150 +  if FIBXSQLVAR.UniqueName then
3151 +    inherited SetAsNumeric(AValue)
3152 +  else
3153 +  with FIBXSQLVAR.Parent do
3154 +  begin
3155 +    for i := 0 to Count - 1 do
3156 +      if Column[i].Name = Name then
3157 +      begin
3158 +        OldSQLVar := FIBXSQLVAR;
3159 +        FIBXSQLVAR := Column[i];
3160 +        try
3161 +          inherited SetAsNumeric(AValue);
3162 +        finally
3163 +          FIBXSQLVAR := OldSQLVar;
3164 +        end;
3165 +      end;
3166 +  end;
3167 + end;
3168 +
3169   { TMetaData }
3170  
3171   procedure TMetaData.CheckActive;
# Line 3171 | Line 3187 | end;
3187  
3188   destructor TMetaData.Destroy;
3189   begin
3190 <  (FStatement as TInterfaceOwner).Remove(self);
3190 >  if FStatement <> nil then
3191 >    (FStatement as TInterfaceOwner).Remove(self);
3192    inherited Destroy;
3193   end;
3194  
# Line 3237 | Line 3254 | end;
3254  
3255   destructor TSQLParams.Destroy;
3256   begin
3257 <  (FStatement as TInterfaceOwner).Remove(self);
3257 >  if FStatement <> nil then
3258 >    (FStatement as TInterfaceOwner).Remove(self);
3259    inherited Destroy;
3260   end;
3261  
# Line 3293 | Line 3311 | begin
3311    Result := FSQLParams.CaseSensitiveParams;
3312   end;
3313  
3314 + function TSQLParams.GetStatement: IStatement;
3315 + begin
3316 +  Result := FSQLParams.GetStatement;
3317 + end;
3318 +
3319 + function TSQLParams.GetTransaction: ITransaction;
3320 + begin
3321 +  Result := FSQLParams.GetTransaction;
3322 + end;
3323 +
3324 + function TSQLParams.GetAttachment: IAttachment;
3325 + begin
3326 +  Result := FSQLParams.GetAttachment;
3327 + end;
3328 +
3329 + procedure TSQLParams.Clear;
3330 + var i: integer;
3331 + begin
3332 +  for i := 0 to getCount - 1 do
3333 +    getSQLParam(i).Clear;
3334 + end;
3335 +
3336   { TResults }
3337  
3338   procedure TResults.CheckActive;
# Line 3317 | Line 3357 | begin
3357      IBError(ibxeInvalidColumnIndex,[nil]);
3358  
3359    if not HasInterface(aIBXSQLVAR.Index) then
3360 <    AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3361 <  col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3362 <  col.FTransaction := GetTransaction;
3360 >  begin
3361 >    col := TIBSQLData.Create(self,aIBXSQLVAR);
3362 >    AddInterface(aIBXSQLVAR.Index, col);
3363 >  end
3364 >  else
3365 >    col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3366    Result := col;
3367   end;
3368  
# Line 3384 | Line 3427 | end;
3427  
3428   function TResults.GetTransaction: ITransaction;
3429   begin
3430 <  Result := FStatement.GetTransaction;
3430 >  Result := FResults.GetTransaction;
3431 > end;
3432 >
3433 > function TResults.GetAttachment: IAttachment;
3434 > begin
3435 >  Result := FResults.GetAttachment;
3436   end;
3437  
3438   procedure TResults.SetRetainInterfaces(aValue: boolean);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines