2012-12-27 35 views
3

道歉事先为一个相当大的简化程序来显示问题...完整的代码在我的问题结束。使用poPropagateChanges和poFetchDetailsOnDemand避免ClientDataSets中的内存损坏?

我有一个程序广泛使用TClientDataSet,有时会导致错误消息,据我所知可以是正确的代码。我已将这个简化为示例程序,该程序在.\SQLEXPRESS MSSQL实例上的tempdb数据库上运行,并使用TClientDataSet访问具有主 - 细节链接的三个表。数据库结构如下所示:

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

在这种简化的版本,这三个id字段是简单的整型字段,但在我真正的代码,他们是标识列。这不是直接相关的,除了不变的“你为什么这样做?”题。

当按下记录到Test3,在供应商的BeforeUpdateRecord事件,我设置其Test2值到相应的记录的id场。这是必要的,因为它不会在使用真实身份列时自动发生,并且新插入的记录是Test2。我还使用NewValue作为其他服务器计算的值。

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

德尔福2010年表现相同,并与MIDAS来源,让我跟踪找出出了什么问题。简而言之,在将NewValue推回到数据库中时使用OverWriteRecordOverWriteRecord使用记录iRecNoNext作为临时缓冲区,并将其attr字段废弃。 FetchDetails后来结束呼叫InsertRecord,它假定新的记录缓冲区的attr仍然是0.它不是0,并且之后一切都出错了。

知道了,我可以通过更改MIDAS来源来始终将attr重置。除了Delphi XE Pro不包括它们。所以,我的问题:

  • 在Delphi XE3中修复了这个问题吗?
    • 如果是这样,它的midas.dll是否可以自由重新分配?
      • 如果是这样,我在哪里可以得到它?
  • 如果没有,有没有办法避免这个问题改变MIDAS来源是什么?

请注意,出现问题的频率较低(避免设置NewValue,除非严格需要时)不足。

使用poPropagateChangesNewValues移回到原始的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. 
+0

检查此答案[SO问题](http://stackoverflow.com/questions/2210025/how-to-mark-all-tclientdataset-records-as-inserted)。我认为它可以帮助你解决它,而无需修改midas源代码。 –

+0

谢谢,看起来很有趣。我对此有所怀疑,因为midas图层会在不同的地方直接检查属性而不读取CDS的缓冲区,但我一定会试一试。 – hvd

+0

@GuillemVicens不幸的是,正如我担心的那样,这是行不通的。尝试将属性伪装为未修改的属性会给UpdateStatus usUnmodified,但是然后修改记录会导致意外的异常“操作不适用”。 – hvd

回答

2

经过大量的通过D2010 MIDAS代码搜索,我已经确定,在我的应用程序的使用,有三种可能性InsertRecord

  • 属性已被设置为0
  • 的属性未设置并且将不会被设置
  • 属性需要被设置到dsRecNew

第四可能性中,具有属性alread y被设置为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,以确保内存是可写的(复制写入,将exa CT)
  • 我重写内存
  • 我打电话VirtualProtect再次恢复记忆保护
  • 最后,我的DllGetClassObject地址传递给RegisterMidasLib,防止DBClient从尝试再次加载MIDAS.DLL,甚或一个不同的MIDAS.DLL

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