道歉事先为一个相当大的简化程序来显示问题...完整的代码在我的问题结束。使用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
推回到数据库中时使用OverWriteRecord
。 OverWriteRecord
使用记录iRecNoNext
作为临时缓冲区,并将其attr
字段废弃。 FetchDetails后来结束呼叫InsertRecord
,它假定新的记录缓冲区的attr
仍然是0.它不是0,并且之后一切都出错了。
知道了,我可以通过更改MIDAS来源来始终将attr
重置。除了Delphi XE Pro不包括它们。所以,我的问题:
- 在Delphi XE3中修复了这个问题吗?
- 如果是这样,它的
midas.dll
是否可以自由重新分配?- 如果是这样,我在哪里可以得到它?
- 如果是这样,它的
- 如果没有,有没有办法避免这个问题不改变MIDAS来源是什么?
请注意,出现问题的频率较低(避免设置NewValue
,除非严格需要时)不足。
使用poPropagateChanges
将NewValue
s移回到原始的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.
检查此答案[SO问题](http://stackoverflow.com/questions/2210025/how-to-mark-all-tclientdataset-records-as-inserted)。我认为它可以帮助你解决它,而无需修改midas源代码。 –
谢谢,看起来很有趣。我对此有所怀疑,因为midas图层会在不同的地方直接检查属性而不读取CDS的缓冲区,但我一定会试一试。 – hvd
@GuillemVicens不幸的是,正如我担心的那样,这是行不通的。尝试将属性伪装为未修改的属性会给UpdateStatus usUnmodified,但是然后修改记录会导致意外的异常“操作不适用”。 – hvd