Apologies in advance for a rather large reduced program to show the problem... Full code at the end of my question.
I've got a program using TClientDataSet extensively, sometimes leading to error messages for what as far as I can tell is correct code. I've reduced this to a sample program that runs on a .\SQLEXPRESS MSSQL instance, on the tempdb database, and uses TClientDataSet to access three tables with master-detail links. The database structure looks like this:
╔═══════════╗ ╔═══════════╗ ╔═══════════╗
║ Test1 ║ ║ Test2 ║ ║ Test3 ║
╟───────────╢ ╟───────────╢ ╟───────────╢
║ id ║─┐ ║ id ║─┐ ║ id ║
║ datafield ║ └──║ Test1 ║ └──║ Test2 ║
╚═══════════╝ ║ datafield ║ ║ datafield ║
╚═══════════╝ ╚═══════════╝
In this simplified version, the three id fields are simple integer fields, but in my real code, they are identity columns. This is not directly relevant, except for the invariable "why are you doing this?" question.
When pushing a record into Test3, in the provider's BeforeUpdateRecord event, I set its Test2 value to the corresponding record's id field. This is necessary, as it does not happen automatically when a real identity column is used and the Test2 record is newly inserted. I also use NewValue for other server-calculated values.
After I've called ApplyUpdates, which succeeds, I attempt to fetch the detail records for the next master record. This succeeds, the details get loaded, but: the detail record is marked as usModified, even though the data set's ChangeCount is zero. In other words, the last assert fails.
Delphi 2010 behaves the same, and comes with MIDAS sources, allowing me to trace to figure out what's going wrong. In short, OverWriteRecord is used when pushing the NewValue back into the database. OverWriteRecord uses record iRecNoNext as a temporary buffer, and leaves its attr field trashed. FetchDetails later ends up calling InsertRecord, which assumes the new record buffer's attr is still 0. It isn't 0, and everything goes wrong after that.
Knowing that, I could solve it by changing the MIDAS sources to always reset attr. Except Delphi XE Pro doesn't include them. So, my questions:
- Is this problem fixed in Delphi XE3?
- If so, is its
midas.dllfreely redistributable?- If so, where can I get it?
- If so, is its
- If not, is there any way to avoid the problem without changing the MIDAS sources?
Note that having the problem occur less frequently (by avoiding setting NewValue except when strictly necessary) is insufficient.
Both the use of poPropagateChanges to move the NewValues back into the original ClientDataSet, and the use of poFetchDetailsOnDemand to not load all detail records in one go, are essential to the application.
New observation: the code in InsertRecord (in dsupd.cpp):
if (!bDisableLog) // Nov. -97
{
piAttr[iRecNoNext-1] = dsRecNew;
}
intentionally does not clear the attribute. When it is called from ReadRows (in dsinmem2.cpp), the attribute gets set before InsertRecord gets called, so resetting the attribute in that case would be wrong. Whatever would need to be changed shouldn't be changed at that point anyway.
Full code:
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.