3

对于一个相当大的简化程序来显示问题，提前道歉......我的问题结束时的完整代码。

我有一个TClientDataSet广泛使用的程序，有时会导致错误消息，据我所知是正确的代码。我已将其简化为一个示例程序，该程序在.\SQLEXPRESSMSSQL 实例上运行，在tempdb数据库上，并用于TClientDataSet访问具有主从链接的三个表。数据库结构如下所示：

╔═══════════╗╔═══════════╗╔═══════════╗
║ 测试1 ║ ║ 测试2 ║ ║ 测试3 ║
╟────────────╢ ╟────────────╢ ╟────────────╢
║身份证        ║─┐║身份证        ║─┐║身份证        ║
║ 数据域 ║ └──║ Test1 ║ └──║ Test2 ║
╚═══════════╝║数据域║║数据域║
                 ╚═══════════╝╚═══════════╝

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

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

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

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

知道了这一点，我可以通过将 MIDAS 源更改为 always reset 来解决它attr。除了 Delphi XE Pro 不包括它们。所以，我的问题：

  • 这个问题在 Delphi XE3 中修复了吗？
    • 如果是这样，它是否midas.dll可以自由再分配？
      • 如果是这样，我在哪里可以得到它？
  • 如果没有，有没有办法在不改变 MIDAS 来源的情况下避免这个问题？

请注意，减少问题发生的频率（通过避免设置，NewValue除非非常必要）是不够的。

使用poPropagateChanges将NewValues 移回原始 ClientDataSet 和使用poFetchDetailsOnDemand不一次性加载所有详细记录对于应用程序都是必不可少的。

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

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

故意不清除属性。当从ReadRows(in 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.
4

1 回答 1

2

在广泛搜索 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再次调用恢复内存保护
  • 最后，我传递 to 的地址DllGetClassObject，RegisterMidasLib以防止DBClient尝试再次加载 MIDAS.DLL，甚至可能是不同的 MIDAS.DLL

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

于 2013-01-05T14:05:38.797 回答