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 345 by tony, Mon Aug 23 14:22:29 2021 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (file contents), Revision 372 by tony, Wed Jan 5 16:20:22 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
135     function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
136     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 154 | Line 150 | type
150       property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
151    public
152       constructor Create(api: TFBClientAPI);
153 <     function GetSQLType: cardinal; virtual; abstract;
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: short): 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;
160 >     function GetScale: integer; virtual; abstract; {Current Field Data scale}
161       function GetAsBoolean: boolean;
162       function GetAsCurrency: Currency;
163       function GetAsInt64: Int64;
# Line 178 | 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 205 | 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);
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 247 | 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 267 | 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 284 | Line 287 | type
287      FModified: boolean;
288      FUniqueName: boolean;
289      FVarString: RawByteString;
290 +    FColMetaData: IParamMetaData;
291      function GetStatement: IStatement;
292      procedure SetName(AValue: AnsiString);
293    protected
294 <    function GetAttachment: IAttachment; virtual; abstract;
294 >    FArrayIntf: IArray;
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 296 | 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;
330 <    function GetAsArray(Array_ID: TISC_QUAD): IArray; virtual; abstract;
330 >    function GetAsArray: IArray; virtual; abstract;
331      function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; virtual; abstract;
332      function CreateBlob: IBlob; virtual; abstract;
333      function GetArrayMetaData: IArrayMetaData; virtual; abstract;
334      function GetBlobMetaData: IBlobMetaData; virtual; abstract;
335 +    function getColMetadata: IParamMetaData;
336      procedure Initialize; virtual;
337 +    procedure SaveMetaData;
338 +    procedure SetArray(AValue: IArray);
339  
340    public
341      property AliasName: AnsiString read GetAliasName;
# Line 333 | 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 348 | 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 356 | Line 370 | type
370      FChangeSeqNo: integer;
371    protected
372      procedure CheckActive; override;
359    function GetAttachment: IAttachment; override;
373      function SQLData: PByte; override;
374      function GetDataLength: cardinal; override;
375      function GetCodePage: TSystemCodePage; override;
# Line 365 | 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 384 | 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 397 | Line 412 | type
412    { TIBSQLData }
413  
414    TIBSQLData = class(TColumnMetaData,ISQLData)
400  private
401    FTransaction: ITransaction;
415    protected
416      procedure CheckActive; override;
417    public
405    function GetTransaction: ITransaction; override;
418      function GetIsNull: Boolean; override;
419      function GetAsArray: IArray;
420      function GetAsBlob: IBlob; overload;
# Line 411 | Line 423 | type
423      property AsBlob: IBlob read GetAsBlob;
424   end;
425  
426 +  { TSQLParamMetaData }
427 +
428 +  TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
429 +  private
430 +    FSQLType: cardinal;
431 +    FSQLSubType: integer;
432 +    FScale: integer;
433 +    FCharSetID: cardinal;
434 +    FNullable: boolean;
435 +    FSize: cardinal;
436 +    FCodePage: TSystemCodePage;
437 +  public
438 +    constructor Create(src: TSQLVarData);
439 +    {IParamMetaData}
440 +    function GetSQLType: cardinal;
441 +    function GetSQLTypeName: AnsiString;
442 +    function getSubtype: integer;
443 +    function getScale: integer;
444 +    function getCharSetID: cardinal;
445 +    function getCodePage: TSystemCodePage;
446 +    function getIsNullable: boolean;
447 +    function GetSize: cardinal;
448 +    property SQLType: cardinal read GetSQLType;
449 +  end;
450 +
451    { TSQLParam }
452  
453    TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
# Line 423 | Line 460 | type
460      procedure SetSQLType(aValue: cardinal); override;
461    public
462      procedure Clear;
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 455 | 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 498 | Line 538 | type
538      function ByName(Idx: AnsiString): ISQLParam ;
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 520 | Line 564 | type
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 >
578 > constructor TSQLParamMetaData.Create(src: TSQLVarData);
579 > begin
580 >  inherited Create;
581 >  FSQLType := src.GetSQLType;
582 >  FSQLSubType := src.getSubtype;
583 >  FScale := src.GetScale;
584 >  FCharSetID := src.getCharSetID;
585 >  FNullable := src.GetIsNullable;
586 >  FSize := src.GetSize;
587 >  FCodePage := src.GetCodePage;
588 > end;
589 >
590 > function TSQLParamMetaData.GetSQLType: cardinal;
591 > begin
592 >  Result := FSQLType;
593 > end;
594 >
595 > function TSQLParamMetaData.GetSQLTypeName: AnsiString;
596 > begin
597 >  Result := TSQLDataItem.GetSQLTypeName(FSQLType);
598 > end;
599 >
600 > function TSQLParamMetaData.getSubtype: integer;
601 > begin
602 >  Result := FSQLSubType;
603 > end;
604 >
605 > function TSQLParamMetaData.getScale: integer;
606 > begin
607 >  Result := FScale;
608 > end;
609 >
610 > function TSQLParamMetaData.getCharSetID: cardinal;
611 > begin
612 >  Result := FCharSetID;
613 > end;
614 >
615 > function TSQLParamMetaData.getCodePage: TSystemCodePage;
616 > begin
617 >  Result :=  FCodePage;
618 > end;
619 >
620 > function TSQLParamMetaData.getIsNullable: boolean;
621 > begin
622 >  Result :=  FNullable;
623 > end;
624 >
625 > function TSQLParamMetaData.GetSize: cardinal;
626 > begin
627 >  Result := FSize;
628 > end;
629  
630   { TSQLDataArea }
631  
# Line 542 | 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 674 | 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
837   end;
838  
839 + procedure TSQLVarData.SaveMetaData;
840 + begin
841 +  FColMetaData := TSQLParamMetaData.Create(self);
842 + end;
843 +
844 + procedure TSQLVarData.SetArray(AValue: IArray);
845 + begin
846 +  FArrayIntf := AValue;
847 + end;
848 +
849   constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
850   begin
851    inherited Create;
# Line 687 | 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 697 | 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 >  else
875 >  if Length(aValue) > DataLength then
876 >    IBError(ibxeStringOverflow,[Length(aValue),DataLength]);
877    Scale := 0;
878 +  if  (SQLType <> SQL_VARYING) and (SQLType <> SQL_TEXT) then
879 +    IBError(ibxeUnableTosetaTextType,[Index,Name,TSQLDataItem.GetSQLTypeName(SQLType)]);
880    SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
881   end;
882  
# Line 709 | Line 887 | end;
887  
888   procedure TSQLVarData.RowChange;
889   begin
890 +  FArrayIntf := nil;
891    FModified := false;
892    FVarString := '';
893   end;
894  
895 + function TSQLVarData.getColMetadata: IParamMetaData;
896 + begin
897 +  Result := FColMetaData;
898 + end;
899 +
900   procedure TSQLVarData.Initialize;
901  
902    function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
# Line 772 | Line 956 | end;
956  
957   {TSQLDataItem}
958  
775 function TSQLDataItem.AdjustScale(Value: Int64; aScale: Integer): Double;
776 var
777  Scaling : Int64;
778  i: Integer;
779  Val: Double;
780 begin
781  Scaling := 1; Val := Value;
782  if aScale > 0 then
783  begin
784    for i := 1 to aScale do
785      Scaling := Scaling * 10;
786    result := Val * Scaling;
787  end
788  else
789    if aScale < 0 then
790    begin
791      for i := -1 downto aScale do
792        Scaling := Scaling * 10;
793      result := Val / Scaling;
794    end
795    else
796      result := Val;
797 end;
798
799 function TSQLDataItem.AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
800 var
801  Scaling : Int64;
802  i: Integer;
803  Val: Int64;
804 begin
805  Scaling := 1; Val := Value;
806  if aScale > 0 then begin
807    for i := 1 to aScale do Scaling := Scaling * 10;
808    result := Val * Scaling;
809  end else if aScale < 0 then begin
810    for i := -1 downto aScale do Scaling := Scaling * 10;
811    result := Val div Scaling;
812  end else
813    result := Val;
814 end;
815
816 function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
817  ): Currency;
818 var
819  Scaling : Int64;
820  i : Integer;
821  FractionText, PadText, CurrText: AnsiString;
822 begin
823  Result := 0;
824  Scaling := 1;
825  PadText := '';
826  if aScale > 0 then
827  begin
828    for i := 1 to aScale do
829      Scaling := Scaling * 10;
830    result := Value * Scaling;
831  end
832  else
833    if aScale < 0 then
834    begin
835      for i := -1 downto aScale do
836        Scaling := Scaling * 10;
837      FractionText := IntToStr(abs(Value mod Scaling));
838      for i := Length(FractionText) to -aScale -1 do
839        PadText := '0' + PadText;
840      {$IF declared(DefaultFormatSettings)}
841      with DefaultFormatSettings do
842      {$ELSE}
843      {$IF declared(FormatSettings)}
844      with FormatSettings do
845      {$IFEND}
846      {$IFEND}
847      if Value < 0 then
848        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
849      else
850        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
851      try
852        result := StrToCurr(CurrText);
853      except
854        on E: Exception do
855          IBError(ibxeInvalidDataConversion, [nil]);
856      end;
857    end
858    else
859      result := Value;
860 end;
861
959   function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
960   begin
961    {$IF declared(DefaultFormatSettings)}
# Line 956 | Line 1053 | begin
1053      end;
1054   end;
1055  
959 function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
960  ): Int64;
961 var
962  Scaling : Int64;
963  i : Integer;
964 begin
965  Result := 0;
966  Scaling := 1;
967  if aScale < 0 then
968  begin
969    for i := -1 downto aScale do
970      Scaling := Scaling * 10;
971    result := trunc(Value * Scaling);
972  end
973  else
974  if aScale > 0 then
975  begin
976    for i := 1 to aScale do
977       Scaling := Scaling * 10;
978    result := trunc(Value / Scaling);
979  end
980  else
981    result := trunc(Value);
982 end;
983
984 function TSQLDataItem.AdjustScaleFromDouble(Value: Double; aScale: Integer
985  ): Int64;
986 var
987  Scaling : Int64;
988  i : Integer;
989 begin
990  Result := 0;
991  Scaling := 1;
992  if aScale < 0 then
993  begin
994    for i := -1 downto aScale do
995      Scaling := Scaling * 10;
996    result := trunc(Value * Scaling);
997  end
998  else
999  if aScale > 0 then
1000  begin
1001    for i := 1 to aScale do
1002       Scaling := Scaling * 10;
1003    result := trunc(Value / Scaling);
1004  end
1005  else
1006    result := trunc(Value);
1007 end;
1008
1056   procedure TSQLDataItem.CheckActive;
1057   begin
1058    //Do nothing by default
# Line 1072 | Line 1119 | begin
1119    FFirebirdClientAPI := api;
1120   end;
1121  
1122 + function TSQLDataItem.CanChangeMetaData: boolean;
1123 + begin
1124 +  Result := false;
1125 + end;
1126 +
1127   function TSQLDataItem.GetSQLTypeName: AnsiString;
1128   begin
1129    Result := GetSQLTypeName(GetSQLType);
1130   end;
1131  
1132 < class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1132 > class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1133   begin
1134    Result := 'Unknown';
1135    case SQLType of
# Line 1147 | Line 1199 | begin
1199            end;
1200          end;
1201          SQL_SHORT:
1202 <          result := AdjustScaleToCurrency(Int64(PShort(SQLData)^),
1203 <                                      Scale);
1202 >          result := NumericFromRawValues(Int64(PShort(SQLData)^),
1203 >                                      Scale).getAsCurrency;
1204          SQL_LONG:
1205 <          result := AdjustScaleToCurrency(Int64(PLong(SQLData)^),
1206 <                                      Scale);
1205 >          result := NumericFromRawValues(Int64(PLong(SQLData)^),
1206 >                                      Scale).getAsCurrency;
1207          SQL_INT64:
1208 <          result := AdjustScaleToCurrency(PInt64(SQLData)^,
1209 <                                      Scale);
1208 >          result := NumericFromRawValues(PInt64(SQLData)^,
1209 >                                      Scale).getAsCurrency;
1210          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1211            result := Round(AsDouble);
1212  
# Line 1185 | Line 1237 | begin
1237          end;
1238        end;
1239        SQL_SHORT:
1240 <        result := AdjustScaleToInt64(Int64(PShort(SQLData)^),
1241 <                                    Scale);
1240 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1241 >                                    Scale).getAsInt64;
1242        SQL_LONG:
1243 <        result := AdjustScaleToInt64(Int64(PLong(SQLData)^),
1244 <                                    Scale);
1243 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1244 >                                    Scale).getAsInt64;
1245        SQL_INT64:
1246 <        result := AdjustScaleToInt64(PInt64(SQLData)^,
1247 <                                    Scale);
1246 >        result := NumericFromRawValues(PInt64(SQLData)^,
1247 >                                    Scale).getAsInt64;
1248        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1249          result := Round(AsDouble);
1250        else
# Line 1321 | Line 1373 | begin
1373          end;
1374        end;
1375        SQL_SHORT:
1376 <        result := AdjustScale(Int64(PShort(SQLData)^),
1377 <                              Scale);
1376 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1377 >                              Scale).getAsDouble;
1378        SQL_LONG:
1379 <        result := AdjustScale(Int64(PLong(SQLData)^),
1380 <                              Scale);
1379 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1380 >                              Scale).getAsDouble;
1381        SQL_INT64:
1382 <        result := AdjustScale(PInt64(SQLData)^, Scale);
1382 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsDouble;
1383        SQL_FLOAT:
1384          result := PFloat(SQLData)^;
1385        SQL_DOUBLE, SQL_D_FLOAT:
# Line 1373 | Line 1425 | begin
1425          end;
1426        end;
1427        SQL_SHORT:
1428 <        result := Round(AdjustScale(Int64(PShort(SQLData)^),
1429 <                                    Scale));
1428 >        result := NumericFromRawValues(Int64(PShort(SQLData)^),
1429 >                                    Scale).getAsInteger;
1430        SQL_LONG:
1431 <        result := Round(AdjustScale(Int64(PLong(SQLData)^),
1432 <                                    Scale));
1431 >        result := NumericFromRawValues(Int64(PLong(SQLData)^),
1432 >                                    Scale).getAsInteger;
1433        SQL_INT64:
1434 <        result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1434 >        result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsInteger;
1435 >
1436        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1437          result := Round(AsDouble);
1438        SQL_DEC_FIXED,
# Line 1476 | Line 1529 | end;
1529   function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1530   var i: integer;
1531      cplen: integer;
1479    s: AnsiString;
1532   begin
1533    Result := 0;
1482  s := strpas(p);
1534    for i := 1 to FieldWidth do
1535    begin
1536      cplen := UTF8CodepointSizeFull(p);
# Line 1596 | Line 1647 | begin
1647          result := Int128ToStr(SQLData,scale);
1648  
1649        else
1650 <        IBError(ibxeInvalidDataConversion, [nil]);
1650 >        IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1651      end;
1652   end;
1653  
1654 + function TSQLDataItem.GetAsNumeric: IFBNumeric;
1655 + var aValue: Int64;
1656 + begin
1657 +  case SQLType of
1658 +   SQL_TEXT, SQL_VARYING:
1659 +     Result := NewNumeric(GetAsString);
1660 +
1661 +   SQL_SHORT:
1662 +     Result := NumericFromRawValues(PShort(SQLData)^, Scale);
1663 +
1664 +   SQL_LONG:
1665 +     Result := NumericFromRawValues(PLong(SQLData)^, Scale);
1666 +
1667 +   SQL_INT64:
1668 +     Result := NumericFromRawValues(PInt64(SQLData)^, Scale);
1669 +
1670 +   SQL_DEC16,
1671 +   SQL_DEC34,
1672 +   SQL_DEC_FIXED,
1673 +   SQL_INT128:
1674 +     Result := NewNumeric(GetAsBCD);
1675 +
1676 +   else
1677 +     IBError(ibxeInvalidDataConversion, [nil]);
1678 +  end;
1679 + end;
1680 +
1681   function TSQLDataItem.GetIsNull: Boolean;
1682   begin
1683    CheckActive;
# Line 1738 | Line 1816 | begin
1816    if GetSQLDialect < 3 then
1817      AsDouble := Value
1818    else
1819 +  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> -4)) then
1820 +    SetAsNumeric(NewNumeric(Value))
1821 +  else
1822    begin
1823      Changing;
1824      if IsNullable then
# Line 1753 | Line 1834 | end;
1834   procedure TSQLDataItem.SetAsInt64(Value: Int64);
1835   begin
1836    CheckActive;
1837 <  Changing;
1838 <  if IsNullable then
1839 <    IsNull := False;
1837 >  if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> 0)) then
1838 >    SetAsNumeric(NewNumeric(Value))
1839 >  else
1840 >  begin
1841 >    Changing;
1842 >    if IsNullable then
1843 >      IsNull := False;
1844  
1845 <  SQLType := SQL_INT64;
1846 <  Scale := 0;
1847 <  DataLength := SizeOf(Int64);
1848 <  PInt64(SQLData)^ := Value;
1849 <  Changed;
1845 >    SQLType := SQL_INT64;
1846 >    Scale := 0;
1847 >    DataLength := SizeOf(Int64);
1848 >    PInt64(SQLData)^ := Value;
1849 >    Changed;
1850 >  end;
1851   end;
1852  
1853   procedure TSQLDataItem.SetAsDate(Value: TDateTime);
# Line 1924 | Line 2010 | end;
2010   procedure TSQLDataItem.SetAsLong(Value: Long);
2011   begin
2012    CheckActive;
2013 <  if IsNullable then
2014 <    IsNull := False;
2013 >  if not CanChangeMetaData and ((SQLType <> SQL_LONG) or (Scale <> 0)) then
2014 >    SetAsNumeric(NewNumeric(Value))
2015 >  else
2016 >  begin
2017 >    if IsNullable then
2018 >      IsNull := False;
2019  
2020 <  Changing;
2021 <  SQLType := SQL_LONG;
2022 <  DataLength := SizeOf(Long);
2023 <  Scale := 0;
2024 <  PLong(SQLData)^ := Value;
2025 <  Changed;
2020 >    Changing;
2021 >    SQLType := SQL_LONG;
2022 >    DataLength := SizeOf(Long);
2023 >    Scale := 0;
2024 >    PLong(SQLData)^ := Value;
2025 >    Changed;
2026 >  end;
2027   end;
2028  
2029   procedure TSQLDataItem.SetAsPointer(Value: Pointer);
# Line 1967 | Line 2058 | end;
2058   procedure TSQLDataItem.SetAsShort(Value: short);
2059   begin
2060    CheckActive;
2061 <  Changing;
2062 <  if IsNullable then
2063 <    IsNull := False;
2061 >  if not CanChangeMetaData and ((SQLType <> SQL_SHORT) or (Scale <> 0)) then
2062 >    SetAsNumeric(NewNumeric(Value))
2063 >  else
2064 >  begin
2065 >    Changing;
2066 >    if IsNullable then
2067 >      IsNull := False;
2068  
2069 <  SQLType := SQL_SHORT;
2070 <  DataLength := SizeOf(Short);
2071 <  Scale := 0;
2072 <  PShort(SQLData)^ := Value;
2073 <  Changed;
2069 >    SQLType := SQL_SHORT;
2070 >    DataLength := SizeOf(Short);
2071 >    Scale := 0;
2072 >    PShort(SQLData)^ := Value;
2073 >    Changed;
2074 >  end;
2075   end;
2076  
2077   procedure TSQLDataItem.SetAsString(Value: AnsiString);
# Line 1995 | Line 2091 | begin
2091      varEmpty, varNull:
2092        IsNull := True;
2093      varSmallint, varInteger, varByte,
2094 <      varWord, varShortInt:
2095 <      AsLong := Value;
2000 <    varInt64:
2001 <      AsInt64 := Value;
2094 >      varWord, varShortInt, varInt64:
2095 >        SetAsNumeric(NewNumeric(Int64(Value)));
2096      varSingle, varDouble:
2097        AsDouble := Value;
2098      varCurrency:
2099 <      AsCurrency := Value;
2099 >      SetAsNumeric(NewNumeric(Currency(Value)));
2100      varBoolean:
2101        AsBoolean := Value;
2102      varDate:
# Line 2021 | Line 2115 | begin
2115    end;
2116   end;
2117  
2118 < procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
2118 > procedure TSQLDataItem.SetAsNumeric(Value: IFBNumeric);
2119   begin
2120    CheckActive;
2121    Changing;
2122    if IsNullable then
2123      IsNull := False;
2124  
2125 <  SQLType := SQL_INT64;
2126 <  Scale := aScale;
2127 <  DataLength := SizeOf(Int64);
2128 <  PInt64(SQLData)^ := Value;
2125 >  if CanChangeMetadata then
2126 >  begin
2127 >    {Restore original values}
2128 >    SQLType := getColMetadata.GetSQLType;
2129 >    Scale := getColMetadata.getScale;
2130 >    SetDataLength(getColMetadata.GetSize);
2131 >  end;
2132 >
2133 >  with FFirebirdClientAPI do
2134 >  case GetSQLType of
2135 >  SQL_LONG:
2136 >      PLong(SQLData)^ := SafeInteger(Value.clone(Scale).getRawValue);
2137 >  SQL_SHORT:
2138 >    PShort(SQLData)^ := SafeSmallInt(Value.clone(Scale).getRawValue);
2139 >  SQL_INT64:
2140 >    PInt64(SQLData)^ := Value.clone(Scale).getRawValue;
2141 >  SQL_TEXT, SQL_VARYING:
2142 >   SetAsString(Value.getAsString);
2143 >  SQL_D_FLOAT,
2144 >  SQL_DOUBLE:
2145 >    PDouble(SQLData)^ := Value.getAsDouble;
2146 >  SQL_FLOAT:
2147 >    PSingle(SQLData)^ := Value.getAsDouble;
2148 >  SQL_DEC_FIXED,
2149 >  SQL_DEC16,
2150 >  SQL_DEC34:
2151 >     SQLDecFloatEncode(Value.getAsBCD,SQLType,SQLData);
2152 >  SQL_INT128:
2153 >    StrToInt128(Scale,Value.getAsString,SQLData);
2154 >  else
2155 >    IBError(ibxeInvalidDataConversion, [nil]);
2156 >  end;
2157    Changed;
2158   end;
2159  
2160   procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2039 var C: Currency;
2161   begin
2162    CheckActive;
2163    Changing;
2164    if IsNullable then
2165      IsNull := False;
2166  
2167 +  if not CanChangeMetaData then
2168 +  begin
2169 +    SetAsNumeric(NewNumeric(aValue));
2170 +    Exit;
2171 +  end;
2172  
2173    with FFirebirdClientAPI do
2174    if aValue.Precision <= 16 then
# Line 2112 | Line 2238 | end;
2238  
2239   function TColumnMetaData.GetAttachment: IAttachment;
2240   begin
2241 <  Result := GetStatement.GetAttachment;
2241 >  Result := FIBXSQLVAR.GetAttachment;
2242   end;
2243  
2244   function TColumnMetaData.SQLData: PByte;
# Line 2132 | Line 2258 | end;
2258  
2259   constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2260   begin
2261 <  inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
2261 >  inherited Create(aIBXSQLVAR.GetAttachment.getFirebirdAPI as TFBClientAPI);
2262    FIBXSQLVAR := aIBXSQLVAR;
2263    FOwner := aOwner;
2264    FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
# Line 2148 | Line 2274 | end;
2274  
2275   function TColumnMetaData.GetSQLDialect: integer;
2276   begin
2277 <  Result := FIBXSQLVAR.Statement.GetSQLDialect;
2277 >  Result := FIBXSQLVAR.GetAttachment.GetSQLDialect;
2278 > end;
2279 >
2280 > function TColumnMetaData.getColMetadata: IParamMetaData;
2281 > begin
2282 >  Result := self;
2283   end;
2284  
2285   function TColumnMetaData.GetIndex: integer;
# Line 2247 | Line 2378 | end;
2378  
2379   function TColumnMetaData.GetTransaction: ITransaction;
2380   begin
2381 <  Result := GetStatement.GetTransaction;
2381 >  Result := FIBXSQLVAR.GetTransaction;
2382   end;
2383  
2384   { TIBSQLData }
# Line 2269 | Line 2400 | begin
2400      IBError(ibxeBOF,[nil]);
2401   end;
2402  
2272 function TIBSQLData.GetTransaction: ITransaction;
2273 begin
2274  if FTransaction = nil then
2275    Result := inherited GetTransaction
2276  else
2277    Result := FTransaction;
2278 end;
2279
2403   function TIBSQLData.GetIsNull: Boolean;
2404   begin
2405    CheckActive;
# Line 2286 | Line 2409 | end;
2409   function TIBSQLData.GetAsArray: IArray;
2410   begin
2411    CheckActive;
2412 <  result := FIBXSQLVAR.GetAsArray(AsQuad);
2412 >  result := FIBXSQLVAR.GetAsArray;
2413   end;
2414  
2415   function TIBSQLData.GetAsBlob: IBlob;
# Line 2330 | Line 2453 | end;
2453  
2454   var b: IBlob;
2455      dt: TDateTime;
2333    CurrValue: Currency;
2334    FloatValue: single;
2456      timezone: AnsiString;
2457 +    Int64Value: Int64;
2458 +    BCDValue: TBCD;
2459 +    aScale: integer;
2460   begin
2461    CheckActive;
2462    if IsNullable then
# Line 2364 | Line 2488 | begin
2488    SQL_TEXT:
2489      DoSetString;
2490  
2491 <    SQL_SHORT,
2492 <    SQL_LONG,
2493 <    SQL_INT64:
2494 <      if TryStrToCurr(Value,CurrValue) then
2495 <        SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2496 <      else
2497 <        DoSetString;
2491 >  SQL_SHORT,
2492 >  SQL_LONG,
2493 >  SQL_INT64:
2494 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2495 >      SetAsNumeric(NumericFromRawValues(Int64Value,aScale))
2496 >    else
2497 >      DoSetString;
2498  
2499 <    SQL_D_FLOAT,
2500 <    SQL_DOUBLE,
2501 <    SQL_FLOAT:
2502 <      if TryStrToFloat(Value,FloatValue) then
2503 <        SetAsDouble(FloatValue)
2504 <      else
2505 <        DoSetString;
2499 >  SQL_DEC_FIXED,
2500 >  SQL_DEC16,
2501 >  SQL_DEC34,
2502 >  SQL_INT128:
2503 >    if TryStrToBCD(Value,BCDValue) then
2504 >      SetAsNumeric(NewNumeric(BCDValue))
2505 >    else
2506 >      DoSetString;
2507  
2508 <    SQL_TIMESTAMP:
2508 >  SQL_D_FLOAT,
2509 >  SQL_DOUBLE,
2510 >  SQL_FLOAT:
2511 >    if TryStrToNumeric(Value,Int64Value,aScale) then
2512 >      SetAsNumeric(NumericFromRawValues(Int64Value,AScale))
2513 >    else
2514 >      DoSetString;
2515 >
2516 >  SQL_TIMESTAMP:
2517        if TryStrToDateTime(Value,dt) then
2518          SetAsDateTime(dt)
2519        else
2520          DoSetString;
2521  
2522 <    SQL_TYPE_DATE:
2522 >  SQL_TYPE_DATE:
2523        if TryStrToDateTime(Value,dt) then
2524          SetAsDate(dt)
2525        else
2526          DoSetString;
2527  
2528 <    SQL_TYPE_TIME:
2528 >  SQL_TYPE_TIME:
2529        if TryStrToDateTime(Value,dt) then
2530          SetAsTime(dt)
2531        else
2532          DoSetString;
2533  
2534 <    SQL_TIMESTAMP_TZ:
2534 >  SQL_TIMESTAMP_TZ,
2535 >  SQL_TIMESTAMP_TZ_EX:
2536        if ParseDateTimeTZString(value,dt,timezone) then
2537          SetAsDateTime(dt,timezone)
2538        else
2539          DoSetString;
2540  
2541 <    SQL_TIME_TZ:
2541 >  SQL_TIME_TZ,
2542 >  SQL_TIME_TZ_EX:
2543        if ParseDateTimeTZString(value,dt,timezone,true) then
2544          SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2545        else
2546          DoSetString;
2547  
2548 <    SQL_DEC_FIXED,
2549 <    SQL_DEC16,
2415 <    SQL_DEC34,
2416 <    SQL_INT128:
2417 <      SetAsBCD(StrToBCD(Value));
2418 <
2419 <    else
2420 <      IBError(ibxeInvalidDataConversion,[GetSQLTypeName(SQLType)]);
2548 >  else
2549 >    IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2550    end;
2551   end;
2552  
# Line 2455 | Line 2584 | begin
2584    IsNull := true;
2585   end;
2586  
2587 + function TSQLParam.CanChangeMetaData: boolean;
2588 + begin
2589 +  Result := FIBXSQLVAR.CanChangeMetaData;
2590 + end;
2591 +
2592 + function TSQLParam.getColMetadata: IParamMetaData;
2593 + begin
2594 +  Result := FIBXSQLVAR.getColMetadata;
2595 + end;
2596 +
2597   function TSQLParam.GetModified: boolean;
2598   begin
2599    CheckActive;
# Line 2529 | Line 2668 | begin
2668    if not FIBXSQLVAR.UniqueName then
2669      IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
2670  
2671 +  FIBXSQLVAR.SetArray(anArray); {save array interface}
2672    SetAsQuad(AnArray.GetArrayID);
2673   end;
2674  
# Line 3004 | Line 3144 | begin
3144    end;
3145   end;
3146  
3147 + procedure TSQLParam.SetAsNumeric(aValue: IFBNumeric);
3148 + var i: integer;
3149 +    OldSQLVar: TSQLVarData;
3150 + begin
3151 +  if FIBXSQLVAR.UniqueName then
3152 +    inherited SetAsNumeric(AValue)
3153 +  else
3154 +  with FIBXSQLVAR.Parent do
3155 +  begin
3156 +    for i := 0 to Count - 1 do
3157 +      if Column[i].Name = Name then
3158 +      begin
3159 +        OldSQLVar := FIBXSQLVAR;
3160 +        FIBXSQLVAR := Column[i];
3161 +        try
3162 +          inherited SetAsNumeric(AValue);
3163 +        finally
3164 +          FIBXSQLVAR := OldSQLVar;
3165 +        end;
3166 +      end;
3167 +  end;
3168 + end;
3169 +
3170   { TMetaData }
3171  
3172   procedure TMetaData.CheckActive;
# Line 3025 | Line 3188 | end;
3188  
3189   destructor TMetaData.Destroy;
3190   begin
3191 <  (FStatement as TInterfaceOwner).Remove(self);
3191 >  if FStatement <> nil then
3192 >    (FStatement as TInterfaceOwner).Remove(self);
3193    inherited Destroy;
3194   end;
3195  
# Line 3091 | Line 3255 | end;
3255  
3256   destructor TSQLParams.Destroy;
3257   begin
3258 <  (FStatement as TInterfaceOwner).Remove(self);
3258 >  if FStatement <> nil then
3259 >    (FStatement as TInterfaceOwner).Remove(self);
3260    inherited Destroy;
3261   end;
3262  
# Line 3147 | Line 3312 | begin
3312    Result := FSQLParams.CaseSensitiveParams;
3313   end;
3314  
3315 + function TSQLParams.GetStatement: IStatement;
3316 + begin
3317 +  Result := FSQLParams.GetStatement;
3318 + end;
3319 +
3320 + function TSQLParams.GetTransaction: ITransaction;
3321 + begin
3322 +  Result := FSQLParams.GetTransaction;
3323 + end;
3324 +
3325 + function TSQLParams.GetAttachment: IAttachment;
3326 + begin
3327 +  Result := FSQLParams.GetAttachment;
3328 + end;
3329 +
3330 + procedure TSQLParams.Clear;
3331 + var i: integer;
3332 + begin
3333 +  for i := 0 to getCount - 1 do
3334 +    getSQLParam(i).Clear;
3335 + end;
3336 +
3337   { TResults }
3338  
3339   procedure TResults.CheckActive;
# Line 3171 | Line 3358 | begin
3358      IBError(ibxeInvalidColumnIndex,[nil]);
3359  
3360    if not HasInterface(aIBXSQLVAR.Index) then
3361 <    AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3362 <  col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3363 <  col.FTransaction := GetTransaction;
3361 >  begin
3362 >    col := TIBSQLData.Create(self,aIBXSQLVAR);
3363 >    AddInterface(aIBXSQLVAR.Index, col);
3364 >  end
3365 >  else
3366 >    col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3367    Result := col;
3368   end;
3369  
# Line 3238 | Line 3428 | end;
3428  
3429   function TResults.GetTransaction: ITransaction;
3430   begin
3431 <  Result := FStatement.GetTransaction;
3431 >  Result := FResults.GetTransaction;
3432 > end;
3433 >
3434 > function TResults.GetAttachment: IAttachment;
3435 > begin
3436 >  Result := FResults.GetAttachment;
3437   end;
3438  
3439   procedure TResults.SetRetainInterfaces(aValue: boolean);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines