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推回到數據庫中時使用OverWriteRecord。 OverWriteRecord使用記錄iRecNoNext作爲臨時緩衝區，並將其attr字段廢棄。 FetchDetails後來結束呼叫InsertRecord，它假定新的記錄緩衝區的attr仍然是0.它不是0，並且之後一切都出錯了。
知道了，我可以通過更改MIDAS來源來始終將attr重置。除了Delphi XE Pro不包括它們。所以，我的問題：
- 在Delphi XE3中修復了這個問題嗎？
- 如果是這樣，它的
midas.dll是否可以自由重新分配？- 如果是這樣，我在哪裏可以得到它？
- 如果是這樣，它的
- 如果沒有，有沒有辦法避免這個問題不改變MIDAS來源是什麼？
請注意，出現問題的頻率較低（避免設置NewValue，除非嚴格需要時）不足。
使用poPropagateChanges將NewValues移回到原始的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