Question

提前为一个相当大的简化程序道歉以显示问题...在我的问题结尾处的完整代码。

我有一个广泛使用TClientDataSet的程序，有时导致错误消息，据我所知，这是正确的代码。我已将此缩减为在.\SQLEXPRESS数据库上的tempdb MSSQL实例上运行的示例程序，并使用TClientDataSet访问具有主 - 详细信息链接的三个表。数据库结构如下所示：

╔═══════════╗    ╔═══════════╗    ╔═══════════╗
║ Test1     ║    ║ Test2     ║    ║ Test3     ║
╟───────────╢    ╟───────────╢    ╟───────────╢
║ id        ║─┐  ║ id        ║─┐  ║ id        ║
║ datafield ║ └──║ Test1     ║ └──║ Test2     ║
╚═══════════╝    ║ datafield ║    ║ datafield ║
                 ╚═══════════╝    ╚═══════════╝

在这个简化版本中，三个id字段是简单的整数字段，但在我的实际代码中，它们是标识列。除了不变的“你为什么要这样做？”之外，这并不直接相关。问题

将记录推送到Test3时，在提供商的BeforeUpdateRecord事件中，我将其Test2值设置为相应记录的id字段。这是必要的，因为当使用真实标识列并且新插入Test2记录时，它不会自动发生。我还将NewValue用于其他服务器计算的值。

在我成功调用ApplyUpdates之后，我尝试获取下一个主记录的详细记录。这样成功，细节被加载，但是：详细记录被标记为usModified，即使数据集的ChangeCount为零。换句话说，最后一个断言失败。

Delphi 2010的行为相同，并附带MIDAS源代码，允许我追踪以找出问题所在。简而言之，在将OverWriteRecord推回数据库时使用NewValue。 OverWriteRecord使用记录iRecNoNext作为临时缓冲区，并使其attr字段被删除。 FetchDetails后来最终调用InsertRecord，假设新记录缓冲区的attr仍为0.它不是0，之后一切都出错了。

知道了，我可以通过将MIDAS源更改为始终重置attr来解决此问题。除Delphi外，XE Pro不包含它们。所以，我的问题：

Delphi XE3中是否修复了此问题？
- 如果是，那么midas.dll是否可以自由再分发？
  - 如果是这样，我在哪里可以得到它？
如果没有，有没有办法避免没有更改MIDAS来源？

请注意，问题发生频率较低（避免设置NewValue除非严格必要）是不够的。

使用poPropagateChanges将NewValue移回原始ClientDataSet，并使用poFetchDetailsOnDemand一次性不加载所有详细记录，对于应用

新观察：InsertRecord中的代码（dsupd.cpp中）：

if (!bDisableLog) // Nov. -97
{
    piAttr[iRecNoNext-1] = dsRecNew;
}

故意不清除属性。当从ReadRows（在dsinmem2.cpp中）调用它时，在调用InsertRecord之前设置属性，因此在这种情况下重置属性将是错误的。无论如何都不应该改变需要改变的东西。

完整代码：

DBClientTest.dpr ：

program DBClientTest;

uses
  Forms,
  MainForm in 'MainForm.pas' {frmMain};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.

MainForm.dfm ：

object frmMain: TfrmMain
  Left = 0
  Top = 0
  Caption = 'frmMain'
  ClientHeight = 297
  ClientWidth = 297
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ADOConnection: TADOConnection
    Connected = True
    ConnectionString =
      'Provider=SQLNCLI10.1;Integrated Security=SSPI;Persist Security I' +
      'nfo=False;User ID="";Initial Catalog=tempdb;Data Source=.\SQLEXP' +
      'RESS;Initial File Name="";Server SPN=SSPI'
    LoginPrompt = False
    Provider = 'SQLNCLI10.1'
    Left = 32
    Top = 8
  end
  object DropTablesCommand: TADOCommand
    CommandText =
      'if object_id('#39'Test3'#39') is not null'#13#10#9'drop table Test3;'#13#10#13#10'if obje' +
      'ct_id('#39'Test2'#39') is not null'#13#10#9'drop table Test2;'#13#10#13#10'if object_id('#39 +
      'Test1'#39') is not null'#13#10#9'drop table Test1;'
    Connection = ADOConnection
    ExecuteOptions = [eoExecuteNoRecords]
    Parameters = <>
    Left = 32
    Top = 56
  end
  object CreateTablesCommand: TADOCommand
    CommandText =
      'create table Test1 ('#13#10#9'id int not null identity(1, 1) primary ke' +
      'y,'#13#10#9'datafield int not null );'#13#10#13#10'create table Test2 ('#13#10#9'id int ' +
      'not null identity(1, 1) primary key,'#13#10#9'Test1 int not null'#13#10#9#9'con' +
      'straint FK_Test2_Test1 foreign key references Test1 ( id ),'#13#10#9'da' +
      'tafield int not null );'#13#10#13#10'create table Test3 ('#13#10#9'id int not nul' +
      'l identity(1, 1) primary key,'#13#10#9'Test2 int not null'#13#10#9#9'constraint' +
      ' FK_Test3_Test2 foreign key references Test2 ( id ),'#13#10#9'datafield' +
      ' int not null );'
    Connection = ADOConnection
    ExecuteOptions = [eoExecuteNoRecords]
    Parameters = <>
    Left = 32
    Top = 104
  end
  object Test1ADO: TADODataSet
    Connection = ADOConnection
    CursorType = ctStatic
    CommandText = 'select id, datafield from Test1;'
    IndexFieldNames = 'id'
    Parameters = <>
    Left = 32
    Top = 152
    object Test1ADOid: TIntegerField
      FieldName = 'id'
      ProviderFlags = [pfInUpdate, pfInWhere, pfInKey]
    end
    object Test1ADOdatafield: TIntegerField
      FieldName = 'datafield'
    end
  end
  object Test2ADO: TADODataSet
    Connection = ADOConnection
    CursorType = ctStatic
    CommandText = 'select id, Test1, datafield from Test2 where Test1 = :id;'
    DataSource = Test1ADODS
    IndexFieldNames = 'Test1;id'
    MasterFields = 'id'
    Parameters = <
      item
        Name = 'id'
        Attributes = [paSigned]
        DataType = ftInteger
        Precision = 10
        Value = 1
      end>
    Left = 32
    Top = 200
    object Test2ADOid: TIntegerField
      FieldName = 'id'
      ProviderFlags = [pfInUpdate, pfInWhere, pfInKey]
    end
    object Test2ADOTest1: TIntegerField
      FieldName = 'Test1'
    end
    object Test2ADOdatafield: TIntegerField
      FieldName = 'datafield'
    end
  end
  object Test3ADO: TADODataSet
    Connection = ADOConnection
    CursorType = ctStatic
    CommandText = 'select id, Test2, datafield from Test3 where Test2 = :id;'
    DataSource = Test2ADODS
    IndexFieldNames = 'Test2;id'
    MasterFields = 'id'
    Parameters = <
      item
        Name = 'id'
        Attributes = [paSigned]
        DataType = ftInteger
        Precision = 10
        Value = 1
      end>
    Left = 32
    Top = 248
    object Test3ADOid: TIntegerField
      FieldName = 'id'
      ProviderFlags = [pfInUpdate, pfInWhere, pfInKey]
    end
    object Test3ADOTest2: TIntegerField
      FieldName = 'Test2'
    end
    object Test3ADOdatafield: TIntegerField
      FieldName = 'datafield'
    end
  end
  object Test1ADODS: TDataSource
    DataSet = Test1ADO
    Left = 104
    Top = 152
  end
  object Test2ADODS: TDataSource
    DataSet = Test2ADO
    Left = 104
    Top = 200
  end
  object DataSetProvider: TDataSetProvider
    DataSet = Test1ADO
    Options = [poFetchDetailsOnDemand, poPropogateChanges, poUseQuoteChar]
    BeforeUpdateRecord = DataSetProviderBeforeUpdateRecord
    Left = 184
    Top = 152
  end
  object Test1CDS: TClientDataSet
    Aggregates = <>
    FetchOnDemand = False
    Params = <>
    ProviderName = 'DataSetProvider'
    Left = 256
    Top = 152
    object Test1CDSid: TIntegerField
      FieldName = 'id'
      ProviderFlags = [pfInUpdate, pfInWhere, pfInKey]
    end
    object Test1CDSdatafield: TIntegerField
      FieldName = 'datafield'
    end
    object Test1CDSTest2ADO: TDataSetField
      FieldName = 'Test2ADO'
    end
  end
  object Test2CDS: TClientDataSet
    Aggregates = <>
    DataSetField = Test1CDSTest2ADO
    FetchOnDemand = False
    Params = <>
    Left = 256
    Top = 200
    object Test2CDSid: TIntegerField
      FieldName = 'id'
      ProviderFlags = [pfInUpdate, pfInWhere, pfInKey]
    end
    object Test2CDSTest1: TIntegerField
      FieldName = 'Test1'
    end
    object Test2CDSdatafield: TIntegerField
      FieldName = 'datafield'
    end
    object Test2CDSTest3ADO: TDataSetField
      FieldName = 'Test3ADO'
    end
  end
  object Test3CDS: TClientDataSet
    Aggregates = <>
    DataSetField = Test2CDSTest3ADO
    FetchOnDemand = False
    Params = <>
    Left = 256
    Top = 248
    object Test3CDSid: TIntegerField
      FieldName = 'id'
      ProviderFlags = [pfInUpdate, pfInWhere, pfInKey]
    end
    object Test3CDSTest2: TIntegerField
      FieldName = 'Test2'
    end
    object Test3CDSdatafield: TIntegerField
      FieldName = 'datafield'
    end
  end
end

MainForm.pas ：

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, DBClient, Provider;

type
  TfrmMain = class(TForm)
    ADOConnection: TADOConnection;
    DropTablesCommand: TADOCommand;
    CreateTablesCommand: TADOCommand;
    Test1ADO: TADODataSet;
    Test1ADOid: TIntegerField;
    Test1ADOdatafield: TIntegerField;
    Test2ADO: TADODataSet;
    Test2ADOid: TIntegerField;
    Test2ADOTest1: TIntegerField;
    Test2ADOdatafield: TIntegerField;
    Test3ADO: TADODataSet;
    Test3ADOid: TIntegerField;
    Test3ADOTest2: TIntegerField;
    Test3ADOdatafield: TIntegerField;
    Test1ADODS: TDataSource;
    Test2ADODS: TDataSource;
    DataSetProvider: TDataSetProvider;
    Test1CDS: TClientDataSet;
    Test1CDSid: TIntegerField;
    Test1CDSdatafield: TIntegerField;
    Test1CDSTest2ADO: TDataSetField;
    Test2CDS: TClientDataSet;
    Test2CDSid: TIntegerField;
    Test2CDSTest1: TIntegerField;
    Test2CDSdatafield: TIntegerField;
    Test2CDSTest3ADO: TDataSetField;
    Test3CDS: TClientDataSet;
    Test3CDSid: TIntegerField;
    Test3CDSTest2: TIntegerField;
    Test3CDSdatafield: TIntegerField;
    procedure DataSetProviderBeforeUpdateRecord(Sender: TObject;
      SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
      UpdateKind: TUpdateKind; var Applied: Boolean);
    procedure FormCreate(Sender: TObject);
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

{ TfrmMain }

procedure TfrmMain.DataSetProviderBeforeUpdateRecord(Sender: TObject;
  SourceDS: TDataSet; DeltaDS: TCustomClientDataSet; UpdateKind: TUpdateKind;
  var Applied: Boolean);
begin
  if SourceDS = Test3ADO then
  begin
    with DeltaDS.FieldByName(Test3CDSTest2.FieldName) do
      NewValue := DeltaDS.DataSetField.DataSet.FieldByName(Test2CDSid.FieldName).Value;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  DropTablesCommand.Execute;
  try
    CreateTablesCommand.Execute;

    Test1ADO.Open;
    Test2ADO.Open;
    Test3ADO.Open;

    Assert(Test1ADO.IsEmpty);
    Test1ADO.AppendRecord([ nil, 1 ]);

      Assert(Test2ADO.IsEmpty);
      Test2ADO.AppendRecord([ nil, Test1ADOid.Value, 2 ]);

        Assert(Test3ADO.IsEmpty);
        Test3ADO.AppendRecord([ nil, Test2ADOid.Value, 3 ]);

    Test1ADO.AppendRecord([ nil, 4 ]);

      Assert(Test2ADO.IsEmpty);
      Test2ADO.AppendRecord([ nil, Test1ADOid.Value, 5 ]);

        Assert(Test3ADO.IsEmpty);
        Test3ADO.AppendRecord([ nil, Test2ADOid.Value, 6 ]);

    Test3ADO.Close;
    Test2ADO.Close;
    Test1ADO.Close;

    Test1CDS.Open;

    Test1CDS.First;
    Assert(Test1CDSdatafield.Value = 1);

    Assert(Test2CDS.IsEmpty);
    Test1CDS.FetchDetails;
    Assert(Test2CDS.RecordCount = 1);

    Assert(Test3CDS.IsEmpty);
    Test2CDS.FetchDetails;
    Assert(Test3CDS.RecordCount = 1);

    Test3CDS.First;
    Assert(Test3CDSdatafield.Value = 3);
    Test3CDS.Edit;
    Test3CDSdatafield.Value := -3;
    Test3CDS.Post;

    Test1CDS.ApplyUpdates(0);

    Assert(Test3CDSdatafield.Value = -3);

    Test1CDS.Last;
    Assert(Test1CDSdatafield.Value = 4);

    Assert(Test2CDS.IsEmpty);
    Test1CDS.FetchDetails;
    Assert(Test2CDS.RecordCount = 1);
    Assert(Test2CDS.UpdateStatus = usUnmodified);

    Assert(Test3CDS.IsEmpty);
    Test2CDS.FetchDetails;
    Assert(Test3CDS.RecordCount = 1);
    Assert(Test3CDS.UpdateStatus = usUnmodified);
  finally
    DropTablesCommand.Execute;
  end;
end;

end.

Answer 1

经过对D2010 MIDAS代码的广泛搜索后，我确定在我的应用程序中使用InsertRecord有三种可能性：

该属性已设为0
该属性未设置且不会设置
该属性需要设置为dsRecNew

第四种可能性，即已经设置为0以外的值的属性，不是我的应用程序中可能出现的属性。因此，始终在该点设置属性对我来说不是问题。我正在采取轻微的赌博，并说XE的MIDAS DLL仍然如此。

我选择手动加载MIDAS.DLL，并在内存中修补它。基于D2010代码：

if (!bDisableLog) // Nov. -97
{
    piAttr[iRecNoNext-1] = dsRecNew;
}

编译到

837B2400   cmp dword ptr [ebx+$24],$00
750B       jnz skip
8B4338     mov eax,[ebx+$38]
8B537C     mov edx,[ebx+$7c]
C64410FF04 mov byte ptr [edx+eax-$01],$04
           skip:

知道bDisableLog为0或1，我已将代码更改为

的效果

piAttr[iRecNoNext-1] = (bDisableLog - 1) & dsRecNew;

可编译为

8B4324     mov eax,[ebx+$24]
48         dec eax
83E004     and eax,$04
8B5338     mov edx,[ebx+$38]
8B737C     mov esi,[ebx+$7c]
884432FF   mov [edx+esi-$01],al

这是完全相同的字节数。 esi没有保留需要保留的值。

所以在我的代码中：

我致电LoadLibrary('midas.dll')
我致电GetProcAddress(handle, 'DllGetClassObject')
我发现上面的代码在$24094

DllGetClassObject

我验证读取17个字节会产生17个预期字节
我调用VirtualProtect以确保内存可写（确切地说是写入时复制）
我覆盖了内存
我再次致电VirtualProtect以恢复内存保护
最后，我将DllGetClassObject的地址传递给RegisterMidasLib，以防止DBClient再次尝试加载MIDAS.DLL，或者甚至是不同的MIDAS.DLL

是的，这很脆弱，会破坏更新版本的MIDAS.DLL。如果这是一个问题，我可以确保从应用程序目录加载XE的MIDAS.DLL，绕过恰好在系统范围内安装的任何MIDAS。如果/当我升级到更新版本的Delphi时，无论这个bug是否已修复，我都会确保它是一个包含MIDAS源的版本，这样我就可以避免陷入这样的问题。

使用poPropagateChanges和poFetchDetailsOnDemand避免ClientDataSets中的内存损坏？

1 个答案: