Menu
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:
midas.dll freely redistributable?
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.
After extensive searching through the D2010 MIDAS code, I have determined that for the uses in my application, there are three possibilities for InsertRecord:
dsRecNewThe fourth possibility, the attribute having already been set to a value other than 0, is not one that can occur in my application. Because of that, always setting the attribute at that point is not a problem for me. I am taking a slight gamble and saying that this is still true with XE's MIDAS DLL.
I opted for manually loading MIDAS.DLL, and patching it in-memory. Based on the D2010 code:
if (!bDisableLog) // Nov. -97
{
piAttr[iRecNoNext-1] = dsRecNew;
}
compiles to
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:
Knowing that bDisableLog is either 0 or 1, I've changed the code to the effect of
piAttr[iRecNoNext-1] = (bDisableLog - 1) & dsRecNew;
which can be compiled to
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
which is the exact same number of bytes. esi did not hold a value that needed to be preserved.
So in my code:
LoadLibrary('midas.dll')GetProcAddress(handle, 'DllGetClassObject')$24094 bytes after DllGetClassObjectVirtualProtect to ensure the memory is writable (copy on write, to be exact)VirtualProtect again to restore the memory protectionDllGetClassObject to RegisterMidasLib, to prevent DBClient from attempting to load MIDAS.DLL again, or perhaps even a different MIDAS.DLLYes, this is fragile and will break with newer versions of MIDAS.DLL. If that turns out to be a problem, I can ensure that XE's MIDAS.DLL gets loaded from the application directory, bypassing any MIDAS that happens to be installed system-wide. If/when I upgrade to a newer version of Delphi, regardless of whether this bug will have been fixed, I will make sure it is a version that includes the MIDAS sources, so that I can avoid getting stuck on problems like this.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With