FireDAC Bug (Embarcadero® RAD Studio 11 Version 28.0.46141.0937)

[Tuğrul HELVACI]

Arkadaşlar merhaba; FireDAC'da başlıkta belirttiğim Delphi sürümünde bir bug mevcut. Belki de Delphinin yeni sürümlerinde de vardır emin değilim. Kontrol etme imkanı olanlar kontrol edip, bu konuda paylaşabilirse faydalı olacaktır.

Sql Server'da aşağıdaki gibi bir kısım tanımlamalarımız olduğunu düşünelim:

Kod: (Select All)

CREATE TYPE [dbo].[IDTable2] AS TABLE(
    [ID] [INT] NOT NULL,
    INDEX [IX_IDTable] NONCLUSTERED
(
    [ID] ASC
)
WITH (IGNORE_DUP_KEY = OFF)
)

Kod: (Select All)

CREATE PROCEDURE sp_Dummy_Sil_Sil
    @Tbl1    dbo.IDTable2 READONLY,
    @Param1    INT = 100,
    @Tbl2    dbo.IDTable2 READONLY,
    @Param2 VARCHAR(10) = 'TEST'
AS
    SELECT
        'From TBL 1' AS TableSource,
        @Param1 AS Param1,
        @Param2 AS Param2,
        T1.*
    FROM @Tbl1 T1
    UNION ALL
    SELECT
        'From TBL 2' AS TableSource,
        @Param1 AS Param1,
        @Param2 AS Param2,
        T2.*
    FROM @Tbl2 T2

Gördüğünüz gibi; sp_Dummy_Sil_Sil isimli stored procedure'de IDTable2 türünde 2 adet parametre mevcut. FireDAC'ın düzeltilmemiş varsayılan halinde; siz bu parametreleri Delphi tarafında doldursanız dahi hep birinci parametrenin içi doluyor idi.

Test kodu aşağıdaki gibidir:

object Form1: TForm1
  Left = 0
 Top = 0
 Caption = 'Form1'
 ClientHeight = 442
 ClientWidth = 628
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -12
 Font.Name = 'Segoe UI'
 Font.Style = []
 TextHeight = 15
 object Button1: TButton
   Left = 8
   Top = 32
   Width = 75
   Height = 25
   Caption = 'Button1'
   TabOrder = 0
   OnClick = Button1Click
 end
 object DBGrid1: TDBGrid
   Left = 89
   Top = 32
   Width = 500
   Height = 385
   DataSource = DataSource1
   TabOrder = 1
   TitleFont.Charset = DEFAULT_CHARSET
   TitleFont.Color = clWindowText
   TitleFont.Height = -12
   TitleFont.Name = 'Segoe UI'
   TitleFont.Style = []
   Columns = <
     item
       Expanded = False
       FieldName = 'TableSource'
       Visible = True
     end
     item
       Expanded = False
       FieldName = 'Param1'
       Visible = True
     end
     item
       Expanded = False
       FieldName = 'Param2'
       Visible = True
     end
     item
       Expanded = False
       FieldName = 'ID'
       Visible = True
     end>
 end
 object conn: TFDConnection
   Params.Strings = (
     'MonitorBy=Remote'
     'Pooled=False'
     'ConnectionDef=MargeXSqlConnection')
   Connected = True
   LoginPrompt = False
   Left = 336
   Top = 88
 end
 object sp: TFDStoredProc
   Connection = conn
   FetchOptions.AssignedValues = [evMode]
   FetchOptions.Mode = fmAll
   StoredProcName = 'sp_Dummy_Sil_Sil'
   Left = 176
   Top = 88
   ParamData = <
     item
       Position = 1
       Name = '@RETURN_VALUE'
       DataType = ftInteger
       ParamType = ptResult
       Value = 0
     end
     item
       Position = 2
       Name = '@Tbl1'
       DataType = ftDataSet
       ParamType = ptInput
       DataTypeName = 'MARGEX.dbo.IDTable2'
     end
     item
       Position = 3
       Name = '@Tbl2'
       DataType = ftDataSet
       ParamType = ptInput
       DataTypeName = 'MARGEX.dbo.IDTable2'
     end
     item
       Position = 4
       Name = '@Param1'
       DataType = ftInteger
       ParamType = ptInput
     end
     item
       Position = 5
       Name = '@Param2'
       DataType = ftString
       ParamType = ptInput
       Size = 10
     end>
   object spTableSource: TStringField
     FieldName = 'TableSource'
     Origin = 'TableSource'
     ReadOnly = True
     Required = True
     Size = 10
   end
   object spParam1: TIntegerField
     FieldName = 'Param1'
     Origin = 'Param1'
     ReadOnly = True
   end
   object spParam2: TStringField
     FieldName = 'Param2'
     Origin = 'Param2'
     ReadOnly = True
     Size = 10
   end
   object spID: TIntegerField
     FieldName = 'ID'
     Origin = 'ID'
     ReadOnly = True
     Required = True
   end
 end
 object mem1: TFDMemTable
   Active = True
   FetchOptions.AssignedValues = [evMode]
   FetchOptions.Mode = fmAll
   ResourceOptions.AssignedValues = [rvPersistent, rvSilentMode]
   ResourceOptions.Persistent = True
   ResourceOptions.SilentMode = True
   UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
   UpdateOptions.CheckRequired = False
   UpdateOptions.AutoCommitUpdates = True
   Left = 176
   Top = 192
   Content = {
     4144425310000000D0000000FF00010001FF02FF030400060000006D0065006D
     000500060000006D0065006D00060000000000070000080032000000090000FF
     0AFF0B04000400000049004400050004000000490044000C00010000000E000D
     000F000110000111000112000113000114000115000400000049004400FEFEFF
     16FEFF17FEFF18FF191A0000000000FF1B00000A000000FEFEFF191A00010000
     00FF1B00000B000000FEFEFF191A0002000000FF1B00000C000000FEFEFEFEFE
     FF1CFEFF1D1E0003000000FF1FFEFEFE0E004D0061006E006100670065007200
     1E00550070006400610074006500730052006500670069007300740072007900
     12005400610062006C0065004C006900730074000A005400610062006C006500
     08004E0061006D006500140053006F0075007200630065004E0061006D006500
     0A0054006100620049004400240045006E0066006F0072006300650043006F00
     6E00730074007200610069006E00740073001E004D0069006E0069006D007500
     6D0043006100700061006300690074007900180043006800650063006B004E00
     6F0074004E0075006C006C00140043006F006C0075006D006E004C0069007300
     74000C0043006F006C0075006D006E00100053006F0075007200630065004900
     44000E006400740049006E007400330032001000440061007400610054007900
     700065001400530065006100720063006800610062006C006500120041006C00
     6C006F0077004E0075006C006C000800420061007300650014004F0041006C00
     6C006F0077004E0075006C006C0012004F0049006E0055007000640061007400
     650010004F0049006E00570068006500720065001A004F007200690067006900
     6E0043006F006C004E0061006D0065001C0043006F006E007300740072006100
     69006E0074004C00690073007400100056006900650077004C00690073007400
     0E0052006F0077004C00690073007400060052006F0077000A0052006F007700
     4900440010004F0072006900670069006E0061006C001800520065006C006100
     740069006F006E004C006900730074001C005500700064006100740065007300
     4A006F00750072006E0061006C001200530061007600650050006F0069006E00
     74000E004300680061006E00670065007300}
   object mem1ID: TIntegerField
     FieldName = 'ID'
   end
 end
 object DataSource1: TDataSource
   DataSet = sp
   Left = 232
   Top = 89
 end
 object mem2: TFDMemTable
   Active = True
   FetchOptions.AssignedValues = [evMode]
   FetchOptions.Mode = fmAll
   ResourceOptions.AssignedValues = [rvPersistent, rvSilentMode]
   ResourceOptions.Persistent = True
   ResourceOptions.SilentMode = True
   UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
   UpdateOptions.CheckRequired = False
   UpdateOptions.AutoCommitUpdates = True
   Left = 248
   Top = 192
   Content = {
     4144425310000000D4000000FF00010001FF02FF030400080000006D0065006D
     0032000500080000006D0065006D003200060000000000070000080032000000
     090000FF0AFF0B04000400000049004400050004000000490044000C00010000
     000E000D000F0001100001110001120001130001140001150004000000490044
     00FEFEFF16FEFF17FEFF18FF191A0000000000FF1B0000E8030000FEFEFF191A
     0001000000FF1B0000E9030000FEFEFF191A0002000000FF1B0000EA030000FE
     FEFEFEFEFF1CFEFF1D1E0003000000FF1FFEFEFE0E004D0061006E0061006700
     650072001E005500700064006100740065007300520065006700690073007400
     7200790012005400610062006C0065004C006900730074000A00540061006200
     6C00650008004E0061006D006500140053006F0075007200630065004E006100
     6D0065000A0054006100620049004400240045006E0066006F00720063006500
     43006F006E00730074007200610069006E00740073001E004D0069006E006900
     6D0075006D004300610070006100630069007400790018004300680065006300
     6B004E006F0074004E0075006C006C00140043006F006C0075006D006E004C00
     6900730074000C0043006F006C0075006D006E00100053006F00750072006300
     6500490044000E006400740049006E0074003300320010004400610074006100
     54007900700065001400530065006100720063006800610062006C0065001200
     41006C006C006F0077004E0075006C006C000800420061007300650014004F00
     41006C006C006F0077004E0075006C006C0012004F0049006E00550070006400
     61007400650010004F0049006E00570068006500720065001A004F0072006900
     670069006E0043006F006C004E0061006D0065001C0043006F006E0073007400
     7200610069006E0074004C00690073007400100056006900650077004C006900
     730074000E0052006F0077004C00690073007400060052006F0077000A005200
     6F0077004900440010004F0072006900670069006E0061006C00180052006500
     6C006100740069006F006E004C006900730074001C0055007000640061007400
     650073004A006F00750072006E0061006C001200530061007600650050006F00
     69006E0074000E004300680061006E00670065007300}
   object mem2ID: TIntegerField
     FieldName = 'ID'
   end
 end
end

unit uFireDAC_TVP_Bug_Deneme;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FireDAC.Stan.Intf, FireDAC.Stan.Option,
 FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
 FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MSSQL,
 FireDAC.Phys.MSSQLDef, FireDAC.VCLUI.Wait, FireDAC.Stan.Param, FireDAC.DatS,
 FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Comp.Client, Data.DB,
 FireDAC.Comp.DataSet, Vcl.StdCtrls, FireDAC.Stan.StorageBin, Vcl.Grids,
 Vcl.DBGrids, FireDAC.Moni.Base, FireDAC.Moni.RemoteClient;

type
 TForm1 = class(TForm)
   Button1: TButton;
   conn: TFDConnection;
   sp: TFDStoredProc;
   mem1: TFDMemTable;
   mem1ID: TIntegerField;
   DataSource1: TDataSource;
   DBGrid1: TDBGrid;
   mem2: TFDMemTable;
   mem2ID: TIntegerField;
   spTableSource: TStringField;
   spParam1: TIntegerField;
   spParam2: TStringField;
   spID: TIntegerField;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 iMultiply : Integer = 0;

implementation
uses
 FireDAC.Phys.ODBCWrapper;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 AParam1,
 AParam2 : TFDParam;
begin
 conn.Open();
 sp.Close;

 AParam1 := sp.FindParam('@Tbl1');
 AParam2 := sp.FindParam('@Tbl2');

 Inc(iMultiply);

 mem1.First;
 while not mem1.Eof do
 begin
   mem1.Edit;
   mem1.FieldByName('ID').Value := mem1.FieldByName('ID').Value * iMultiply;
   mem1.Post;

   mem1.Next;
 end;
 mem1.First;

 mem2.First;
 while not mem2.Eof do
 begin
   mem2.Edit;
   mem2.FieldByName('ID').Value := mem2.FieldByName('ID').Value * iMultiply;
   mem2.Post;

   mem2.Next;
 end;
 mem2.First;

 if Assigned(AParam1) then
   if AParam1.DataType = ftDataSet then
     AParam1.AsDataSet := mem1;

 if Assigned(AParam2) then
   if AParam2.DataType = ftDataSet then
     AParam2.AsDataSet := mem2;

 AParam1 := sp.FindParam('@Param1');
 AParam2 := sp.FindParam('@Param2');

 if Assigned(AParam1) then
   AParam1.Value := 1453;

 if Assigned(AParam2) then
   AParam2.Value := 'FETİH';

 sp.Open();
end;

end.

Şimdi gelelim çözüm için ne yapabileceğimize:

1. FireDAC.Phys.ODBCWrapper.pas
   
2. FireDAC.inc
   
3. FireDAC.Phys.ODBCBase.pas
   
4. FireDAC.Phys.MSSQL.pas
   

dosyalarını Embarcadero kurulum klasöründen uygulamanızın olduğu klasöre kopyalayacaksınız.

Ardından; FireDAC.Phys.ODBCWrapper.pas dosyasında aşağıdaki değişiklikleri yapacaksınız:

  TODBCVariable = class(TObject)
  private
   FCDataType: SQLSmallint;
   FColumnSize: SQLULen;
   FDataSize: SQLLen;
   FLastDataSize: SQLLen;
   FLocalBuffer: SQLPointer;
   FLocalBufIndicator: PSQLLen;
   FParamType: SQLSmallint;
   FPosition: SQLSmallint;
   FName: String;
   FScale: SQLInteger;
   FSQLDataType: SQLSmallint;
   FCVariantSbType: SQLSmallint;
   [weak] FList: TODBCVariableList;
   FForceLongData: Boolean;
   FLongData: Boolean;
   FBinded: Boolean;
   FStreamed: Boolean;
   FFlagsUpdated: Boolean;
   FForceLateBinding: Boolean;
   FLateBinding: Boolean;
   FIsParameter: Boolean;
   FIsCurrency: Boolean;
   FMSAccBoolean: Boolean;
   FMSSQLVariantBinary: Boolean;
   FLimitedToMaxLen: Boolean;
   FDataReader: IUnknown;
{$IFDEF FireDAC_MONITOR}
   FDumpLabel: String;
{$ENDIF}
   fTag : Integer; // Tuğrul

   function GetConnection: TODBCConnection; inline;
   function GetStatement: TODBCStatementBase; inline;
   function GetDumpLabel: String;
   function CalcDataSize(AColumnSize: SQLULen): SQLLen;
   procedure VarTypeUnsup(ACType: SQLSmallint);
   procedure SetCDataType(const AValue: SQLSmallint);
   procedure SetDataSize(const AValue: SQLLen);
   procedure SetSQLDataType(const AValue: SQLSmallint);
   procedure SetForceLongData(const AValue: Boolean);
   procedure SetForceLateBinding(const AValue: Boolean);
   function AllocLongData(AIndex: SQLULen; ASize: SQLLen): PSQLPointer;
   procedure FreeLongData(AIndex: SQLULen);
   function GetAsStrings(AIndex: SQLULen): String;
   procedure SetColumnSize(const AValue: SQLULen);
   procedure SetBindAttributes(ADescKind: SQLInteger);
 protected
   function GetDataInd(AIndex: SQLULen; out ApData: SQLPointer;
     out ApInd: PSQLLen): PSQLPointer;
   function GetDataPtr(AIndex: SQLULen; out ApData: SQLPointer;
     out ASize: SQLLen; out ApInd: PSQLLen): PSQLPointer;
   procedure InternalBind; virtual; abstract;
   function GetDecimalSeparator: Char; virtual; abstract;
   class function GetDescriptorType: SQLSmallint; virtual; abstract;
   property LocalBuffer: SQLPointer read FLocalBuffer write FLocalBuffer;
   property LocalBufIndicator: PSQLLen read FLocalBufIndicator
     write FLocalBufIndicator;
 public
   constructor Create;
   destructor Destroy; override;
   procedure UpdateFlags;
   procedure ResetFlagsUpdated;
   procedure Bind;
   function GetData(AIndex: SQLULen; var ApData: SQLPointer;
     var ASize: SQLLen; AByRef: Boolean = False): Boolean;
   procedure SetData(AIndex: SQLULen; ApData: SQLPointer;
     ASize: SQLLen);
   procedure SetDataReader(AIndex: SQLULen; ApData: SQLPointer);
{$IFDEF FireDAC_MONITOR}
   function DumpValue(AIndex: SQLULen; var ASize: SQLLen): String; overload;
   function DumpValue(AIndex: SQLULen): String; overload;
   function DumpCDataType: String;
   function DumpParamType: String;
{$ENDIF}
   // properties
   // RO
   property Connection: TODBCConnection read GetConnection;
   property Statement: TODBCStatementBase read GetStatement;
   property Binded: Boolean read FBinded;
   property IsParameter: Boolean read FIsParameter;
   property ParamType: SQLSmallint read FParamType;
   property LongData: Boolean read FLongData;
   property LateBinding: Boolean read FLateBinding;
   property DecimalSeparator: Char read GetDecimalSeparator;
   property DescriptorType: SQLSmallint read GetDescriptorType;
   property IsCurrency: Boolean read FIsCurrency;
   property AsStrings[AIndex: SQLULen]: String read GetAsStrings;
   property DataReader: IUnknown read FDataReader;
   // RW
   property SQLDataType: SQLSmallint read FSQLDataType write SetSQLDataType;
   property CDataType: SQLSmallint read FCDataType write SetCDataType;
   property DataSize: SQLLen read FDataSize write SetDataSize;
   property ColumnSize: SQLULen read FColumnSize write SetColumnSize;
   property Scale: SQLInteger read FScale write FScale;
   property CVariantSbType: SQLSmallint read FCVariantSbType write FCVariantSbType;
   property Position: SQLSmallint read FPosition write FPosition;
   property ForceLongData: Boolean read FForceLongData write SetForceLongData;
   property ForceLateBinding: Boolean read FForceLateBinding write SetForceLateBinding;
   property Streamed: Boolean read FStreamed write FStreamed;
   property MSAccBoolean: Boolean read FMSAccBoolean write FMSAccBoolean;
   property MSSQLVariantBinary: Boolean read FMSSQLVariantBinary write FMSSQLVariantBinary;
   property LimitedToMaxLen: Boolean read FLimitedToMaxLen write FLimitedToMaxLen;
   property Name: String read FName write FName;
{$IFDEF FireDAC_MONITOR}
   property DumpLabel: String read GetDumpLabel write FDumpLabel;
{$ENDIF}

   property Tag : Integer read fTag write fTag; // Tuğrul
 end;

function TODBCVariableList.FindByToken(ApToken: SQLPointer): TODBCVariable;
var
 i: Integer;
 oVar: TODBCVariable;
 oPar: TODBCParameter;
begin
 if NativeUInt(ApToken) < $FFFF then
   Result := Items[NativeUInt(ApToken) - 1]
 else begin
   Result := nil;
   for i := 0 to Count - 1 do begin
     oVar := Items[i];
     if oVar = ApToken then
       Result := oVar
     else if oVar.IsParameter then begin
       oPar := TODBCParameter(oVar);
       if (oPar.DataTypeName <> '') and
          (StrLIComp(PChar(ApToken), PChar(oPar.DataTypeName), Length(oPar.DataTypeName)) = 0) then
       begin
         if oPar.Tag = 0 then // Tuğrul
         begin
           Result := oVar;
           Result.Tag := 1;
         end;
       end
       else if oPar.FColumnList <> nil then
         Result := oPar.FColumnList.FindByToken(ApToken)
     end;
     if Result <> nil then
       Break;
   end;
 end;
end;

function TODBCCommandStatement.PutLongParams: SQLReturn;
var
 pParamNum: SQLPointer;
 oPar, oTVPPar: TODBCParameter;
 iCurNum: SQLSmallint;
 iIndex: Integer;

 iCounter  : Integer; // Tuğrul
 AVariable : TODBCVariable; // Tuğrul
begin
 iCurNum := -1;
 oPar := nil;
 FFocusedParam := nil;
 iIndex := 0;
 oTVPPar := nil;
 repeat
   pParamNum := nil;
   Result := Lib.SQLParamData(FHandle, pParamNum);
   // Teradata: SQLParamData after last BLOB parameter returns "invalid cursor state"
   if (TODBCConnection(Owner).DriverKind = dkTeradata) and
      (Result = SQL_ERROR) and (DIAG_SQLSTATE[1] = '24000') then
     Result := SQL_SUCCESS
   else if Result = SQL_NEED_DATA then begin
     // MSSQL: subsequent SQLParamData calls for TVP return pParamNum=nil
     if pParamNum <> nil then
       oPar := ParamList.FindByToken(pParamNum) as TODBCParameter;
     ASSERT(oPar <> nil);
     if (oPar.SQLDataType <> SQL_SS_TABLE) and not oPar.FList.ChildList then begin
       if iCurNum >= oPar.Position then
         Inc(iIndex);
       iCurNum := oPar.Position;
     end;
     if oPar.SQLDataType = SQL_SS_TABLE then begin
       PutTableParam(oPar, iIndex, oTVPPar <> oPar);
       oTVPPar := oPar;
     end
     else if oPar.Streamed then begin
       FFocusedParam := oPar;
       FFocusedResult := Result;
     end
     else if oPar.DataReader <> nil then
       PutStreamParam(oPar, iIndex)
     else
       PutBlobParam(oPar, iIndex);
   end;
 until (Result <> SQL_NEED_DATA) or (FocusedParam <> nil);

 (*
   Tuğrul
   Parametre listesinde dönüp, her bir ODBCVariable'ın Tag'ını tekrar
   sıfıra eşitleyeceğiz.
 *)

 for iCounter := 0 to ParamList.Count - 1 do
 begin
   AVariable := ParamList.Items[iCounter];

   AVariable.Tag := 0;
 end; // for iCounter := 0 to ParamList.Count - 1 do
end;

Yukarıdaki kod bloklarında ekstradan eklediğim kodların yanında Tuğrul metni var, değişiklikleri bu şekilde gözlemleyebilirsiniz.

Bir sonraki bug fix'e kadar şimdilik çözümümüz bu şekilde.

İşinize yaraması dileğim ile herkese hayırlı akşamlar dilerim.

[mcuyan]

Hocam FireDAC da parametre kullanımı hep problem li. bazen clear yapmıyor eski paramı arıyor, bazen yani parametreyi bulamıyor vs.s.vs.

[Tuğrul HELVACI]

Buradaki sorun, stored procedure içinde birden fazla Table Valued Parameters(TVP) var ise gerçekleşiyor. Aslında bug TODBCVariableList.FindByToken metodunda. Bu metod veri türüne göre parametre bulmaya çalışıyor, ancak aynı türde birden fazla parametre olduğu için; ilk parametreyi bulup geri dönüyordu.

[finn9328]

I have faced the same issue

[Tuğrul HELVACI]

(18-07-2024, Saat: 11:12)finn9328 Adlı Kullanıcıdan Alıntı: I have faced the same issue

I hope this solution works for you.