Freeing Multiply-referenced Objects - delphi

This is another post about me inheriting an Intraweb app that had a 2MB text file of memory leaks as reported by FastMM4, where I've got it down to 115 instances of one class leaking 52 bytes each.
The leaks are from a rather convoluted instantiation and handling of the class. Each instantiation of the class is needed to get the app to work right now. So I'm looking for some ways to either clone the class with some straight-forward cleanup of the clone, or referencing in a different way, or..?
The first instantiation of the class (TCwcBasicAdapter) is as a local variable that gets added to a TObjectList (not Owning) and destroyed with the TObjectList (FCDSAdapters):
procedure TCwcDeclaration.AttachAdapter(DS: TDataSource; const FormName, KeyFN, TitleFN: string; const Multiple: boolean = False;
const AllowAttachment: boolean = False; const AllowComment: boolean = False);
var
Forms : TCwcSessionForms;
Adapter: TCwcCDSAdapter;
KeyField, TitleField: TField;
begin
Forms := GetForms(FormName);
KeyField := DS.DataSet.FindField(KeyFN);
TitleField := DS.DataSet.FindField(TitleFN);
Adapter := TCwcBasicAdapter.Create(DS, KeyField, TitleField, Multiple);
Adapter.AttachDBPersist(Self.DBPersist);
Forms.AttachDataAdapter(Adapter);
Forms.SetAllowAttachments(AllowAttachment);
Forms.SetAllowComments(AllowComment);
end;
procedure TCwcSessionForms.AttachDataAdapter(aCDSAdapter: TCwcCDSAdapter);
var
Index: integer;
begin
if (FCDSAdapters.IndexOf(aCDSAdapter) -1)
then raise Exception.CreateFmt('Duplicate Adapter attempting to be attached on %0:s', [FFormClassName]);
Index := FCDSAdapters.Add(aCDSAdapter);
if (FDefaultAdapterIndex = -1)
then FDefaultAdapterIndex := Index;
end;
The second instantiation of the class is also as a local variable that gets added to a TObjectList (not Owning) and destroyed with the TObjectList (FAdapters):
procedure TCwcCDSMulticastList.InitializeAdapters(const aSessionForms: TCwcSessionForms);
var
i, Count: integer;
Adapter: TCwcCDSAdapter;
TempMulticast: TCwcCDSEventMulticast;
begin
Count := aSessionForms.GetDataAdapterCount;
for i := 0 to Pred(Count) do begin
Adapter := aSessionForms.GetDataAdapter(i);
TempMulticast := FindDataSource(Adapter.DataSource);
if (TempMulticast = nil) then begin
TempMulticast := TCwcCDSEventMulticast.Create(Adapter.DataSource);
try
FMulticastList.Add(TempMulticast);
except
FreeAndNil(TempMulticast);
raise;
end;
end;
TempMulticast.AddObserver(Adapter);
FAdapters.Add(Adapter);
end;
end;
The third instantiation of the class is as part of an observer pattern from the TempMulticast.AddObserver(Adapter) line above. The observer is added to TObjectList FObservers (Owning):
procedure TCwcCDSEventMulticast.AddObserver(const aCDSAdapter: TCwcCDSAdapter);
begin
FObservers.Add(TCwcCDSAdapterObserver.Create(aCDSAdapter));
end;
constructor TCwcCDSAdapterObserver.Create(const aCDSAdapter: TCwcCDSAdapter);
begin
inherited Create;
FOnStateChange := aCDSAdapter.OnStateChangeIntercept;
FOnAfterDelete := aCDSAdapter.AfterDeleteIntercept;
FInvalidateCursors := aCDSAdapter.InvalidateCursors;
end;
The TCwcBasicAdapter is leaked here, not cleaned up when FObservers is destroyed.
The latest thing I've tried is changing FObservers to not Owning, creating a private field for the Adapter, freeing the private field in TCwcCDSAdapterObserver.Destroy, but that causes errors.
Thanks,
Paul Rice

If the lists aren't owners, then they will not free the objects when the list is freed. Just calling Remove on each item won't do it either. You would have to iterate through the list and call Free on each item in the list, and then free the list itself.
If you make the lists owners, then they will do this for you when you free the list.
for i := 0 to FAdapters.Count do Free(FAdapters[i]);
FreeAndNil(FAdapters);

You realize you can dispose of objects by yourself without making their owners auto-dispose of them? I ask this because it feels like you're trying to make the automatics do the job in all cases.

Related

Delphi tstringlist.free erases result [duplicate]

This question already has answers here:
How do i return an object from a function in Delphi without causing Access Violation?
(10 answers)
Closed last month.
Ok, this I don't understand.
path:=tstringlist.create;
//load up the path with stuff
Result := path;
path.free;
exit;
I would have thought that result would actually equal the path but it apparently doesn't. If I remove path.free from the code above, the result works as it should and it = the path tstringlist but I get a memory leak. When I put path.free in there, the result becomes empty. I understand the memory leak but how is result getting erased if I free the path AFTER I make it := ????
And yes, the above code is inside multiple for loops which is why I'm using exit. I've tried break and try finally and had no luck making those work either.
Let me rephrase your variable and class names and add a few comments:
function MyNewHouse(): TStringList;
var
NewAddress: TStringList;
begin
// Construct a house with walls, windows, doors and a roof. Those
// are the properties and methods that we're able to use later.
NewAddress := House.Create();
// ...fill the house with content, using our walls, windows, doors...
// Only copy the new house's address, not the house in its entirety.
// And certainly not its content.
Result := NewAddress;
// Demolish/Tear down the house, which can only be made once. When
// the house is demolished, you can neither access it, nor tear it
// down anew. However, the address is still somewhat "valid". While
// everything but the spot where it once existed is gone.
NewAddress.Free();
Exit;
end;
Whenever you assign variables of a class type (such as TObject or TStringList or TForm) you're merely copying its address, not its entire content. For copying (believe it or not) the method .Assign() exists:
// Instead of only "Result := NewAddress;"
Result.Assign( NewAddress );
That copies its whole content. This method exists for many classes, and for each different class "copying its content" can mean different things, just like you may want to copy a TStringList's items, but not necessarily its other settings. But if you wanted it that way you would have used Result.Items := NewAddress.Items already in your example...
The reason why Result becomes empty when you include path.free is because Result is just a reference to path. When you call path.free, you are freeing the memory that path occupies, which makes the reference to that memory invalid. When you try to access Result after freeing path, you are trying to access invalid memory, which can result in undefined behavior.
You need to free the returned TStringList outside of the function, you should modify the function as follows:
function getPath: TStringList;
begin
Result := tstringlist.create;
//load up the path with stuff
end;
// usage:
var
path: TStringList;
begin
path := getPath;
try
// use path here
finally
path.Free;
end;
end;
This way, the returned TStringList is created inside the function and is passed as a reference to the caller. The caller is responsible for freeing the TStringList when it is no longer needed by calling Free on it. This is called "resource acquisition is initialization" (RAII) and is a common pattern in Delphi for managing resources such as dynamically allocated objects.
By using this pattern, you can ensure that the TStringList is always properly freed and avoid potential memory leaks.
More advanced trick (XE2+):
type
IScope<T: class> = interface
private
function GetIt: T;
public
property It: T read GetIt;
end;
TScope<T: class> = class(TInterfacedObject, IScope<T>)
private
FValue: T;
public
constructor Create(const AValue: T);
destructor Destroy; override;
function GetIt: T;
end;
constructor TScope<T>.Create(const AValue: T);
begin
inherited Create;
FValue := AValue;
end;
destructor TScope<T>.Destroy;
begin
FValue.Free;
inherited;
end;
function TScope<T>.GetIt: T;
begin
Result := FValue;
end;
function getPath: IScope<TStringList>;
var
path: TStringList;
begin
path := tstringlist.create;
//load up the path with stuff
Result := TScope<TStringList>.Create(path);
end;
// usage:
var
path: TStringList;
begin
path := getPath.It;
// use path here
end; // auto-free here

Why TForm's _release does not call destructor?

Why TForm's _release method does not call destructor?
var
F, U : IUnknown;
procedure TForm1.btn1Click(Sender: TObject);
begin
U := IUnknown(TMyObject.Create); // MyIterfacedObject (inherits TInterfacedObject)
F := IUnknown(TMyForm.Create(nil));
end;
procedure TForm1.btn2Click(Sender: TObject);
begin
U := nil; // Calls destructor
F._Release; // Does not call destructor
F := nil; // Does not call destructor
end;
I took a look at _release methods of TInterfaceObject and TComponent classes:
function TInterfacedObject._Release: Integer;
begin
Result := InterlockedDecrement(FRefCount);
if Result = 0 then
Destroy;
end;
function TComponent._Release: Integer;
begin
if FVCLComObject = nil then
Result := -1 // -1 indicates no reference counting is taking place
else
Result := IVCLComObject(FVCLComObject)._Release;
end;
TInterfacedObject's _release seems quite intelligible, but what TComponent's _release do? Seems weird to me...
The reason is that TComponent adopts the policy that lifetime management is the responsibility of the user of the class, and is not to be managed automatically by any interface references taken. That policy is expressed clearly in TComponent._Release.
function TComponent._Release: Integer;
begin
if FVCLComObject = nil then
Result := -1 // -1 indicates no reference counting is taking place
else
Result := IVCLComObject(FVCLComObject)._Release;
end;
The common scenario, the one which you describe, has FVCLComObject equal to nil. And so the code explicitly says that there is no reference counting by returning -1. It's even commented that way.
Lifetime management needs to be done one way or another. The two commonly used patterns with Delphi code are:
Lifetime managed by caller
var
obj: TMyObject;
....
obj := TMyObject.Create;
try
DoSomething(obj);
finally
obj.Free; // the object is explicitly destroyed here
end;
Although, TComponent is often used a little differently from this in that its constructor is passed an owner component. And this owner is then charged with the responsibility of destroying the owned component. So that pattern looks like this:
component := TMyComponent.Create(OwnerComponent);
... // now component will be destroyed when OwnerComponent is destroyed
Lifetime managed by interface references
var
intf: IMyInterface;
....
intf := TMyObject.Create;
DoSomething(intf);
// the implementing object behind intf is destroyed when the last
// interface reference leaves scope
You cannot mix the two patterns. The design choice was made that TComponent would follow the first pattern. And so the interface reference counting must be disabled. By way of contrast, TInterfacedObject adopts the other policy.

Is there memory leak here?

is this piece of code safe from memory leaks?
s := TStringList.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object to live somewhere in memory
end;
function GetSomeSettings : TStringList;
var
rawString : string;
settings : TStringList;
begin
// Singleton pattern implementation
// Trying to find already existing settings in class variable
settings := TSettingsClass.fSettings;
// If there is no already defined settings then get them
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TSettingsClass.fSettings := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
end;
Result := settings;
end;
I'm wondering s := GetSomeSettings; potentially harmful and ignoring first object, keeps it in the memory?
Yes, the StringList created on line 1 is leaked.
Essentialy, you are doing:
s := TStringList.Create;
s := AnotherStringList;
AnotherStringList.Free;
As for the GetSomeSettings routine:
Normally it is not wise or encouraged to return newly created instances as function results, because you transfer the responsibility for ownership and destruction to the calling code. Unless you have a mechanism/framework in place that takes care of it, which seems to be the case with your TSettingsClass, but there is not enough evidence for that in this little piece of code.
Nevertheless, the combination of both pieces of code display another problem: After s.Free, TSettingsClass.fSettings is destroyed but not nil. Thus the second time GetSomeSettings is called, it returns a dangling pointer.
1) you should not ask when you can check in two minutes!
program {$AppType Console};
uses Classes, SysUtils;
type TCheckedSL = class(TStringList)
public
procedure BeforeDestruction; override;
procedure AfterConstruction; override;
end;
procedure TCheckedSL.BeforeDestruction;
begin
inherited;
WriteLn('List ',IntToHex(Self,8), ' going to be safely destroyed.');
end;
procedure TCheckedSL.AfterConstruction;
begin
WriteLn('List ',IntToHex(Self,8), ' was created - check whether it is has matched destruction.');
inherited;
end;
procedure DoTest; var s: TStrings;
function GetSomeSettings: TStrings;
begin Result := TCheckedSL.Create end;
begin
Writeln('Entered DoTest procedure');
s := TCheckedSL.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object
end;
Writeln('Leaving DoTest procedure');
end;
BEGIN
DoTest;
Writeln;
Writeln('Check output and press Enter when done');
ReadLn;
END.
2) Still that could be safe in few niche cases.
in FPC (http://FreePascal.org) S could be a "global property" of some unit, having a setter which would free old list.
in Delphi Classic S could be of some interface type, supported by the created object. Granted, standard TStringList lacks any interface, but some libraries ( for example http://jcl.sf.net ) do offer interface-based string lists, with richer API (iJclStringList type and related).
in Delphi/LLVM all objects were made reference-counted, like interfaces without GUID's. So that code would be safe there.
You can declare S as a record - a so-called Extended Record having re-defined class operator Implicit so that the typecast s{record} := TStringList.Create would free the previous instance before assigning a new one. That is dangerous though, as it is VERY fragile and easy to misuse, and destroy the list in some other place leaving a dangling pointer inside the S record.
Your object may be not that vanilla TStringList, but some subclass, overriding constructors or AfterConstruction to register itself in some list, that would be all-at-once in some place. Kind of Mark/Sweep heap management around large chunk of workload. VCL TComponent may be seen as following this pattern: form is owning its component and frees them when needed. And this is what you - in reduced form - are trying to do with TSettingsClass.fSettings containter (any reference is 1-sized container). However those frameworks do require a loopback: when the object is freed it should also remove itself from all the containers, referencing it.
.
procedure TCheckedSL.BeforeDestruction;
begin
if Self = TSettingsClass.fSettings then TSettingsClass.fSettings := nil;
inherited;
end;
class procedure TSettingsClass.SetFSettings(Value);
var fSet2: TObject;
begin
if fSettings <> nil then begin
fSet2 := fSettings;
f_fSettings := nil; // breaking the loop-chain
fSet2.Destroy;
end;
f_fSettings := Value;
end;
class destructor TSettingsClass.Destroy;
begin
fSettings := nil;
end;
However then - by the obvious need to keep design symmetric - the registration should also be done as a part of the class. Who is responsible for de-registration is usually the one responsible for registration as well, unless there are reasons to skew the design.
procedure TCheckedSL.AfterConstruction;
begin
inherited;
TSettingsClass.fSettings := Self;
end;
...
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TCheckedSL.Create.Text := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
Assert( Assigned(settings), 'wrong class used for DB settings' );
end;
Result := settings;

Cannot add objects to GlobalInterfaceTable during ADO async callback

i am using the follow test code to add an object to the GlobalInterfaceTable:
function TForm1.AddSomethingToGit(): DWORD;
var
unk: IUnknown;
cookie: DWORD;
git: IGlobalInterfaceTable;
begin
unk := TCounter.Create;
if FGit = nil then
begin
git := CoGlobalInterfaceTable.Create;
Fgit := git; //yes, i didn't use InterlockedCompareExchange. Can you imagine trying to explain that syntax to people?
end;
OleCheck(Fgit.RegisterInterfaceInGlobal(unk, IUnknown, {out}cookie));
Result := cookie;
end;
And i call the test code from a button handler:
procedure TForm1.Button1Click(Sender: TObject);
begin
AddSomethingToGit();
end;
And everything is good. The object it sitting in the global interface table, waiting to be extracted. i know it is still in there because the the destructor in TInterfacedObject has not been run e.g. breakpoint never hit:
Note: if i close the test app right now, then i will see the GlobalInterfaceTable call Release on my object, freeing it. But that's during shutdown, for now i'm still in memory.
But if i call the same test function from an ADO callback:
conn := CreateTrustedSqlServerConnection(serverName, defaultDatabaseName);
dataSet := TADODataSet.Create(nil);
dataSet.Connection := conn;
dataSet.OnFetchComplete := FetchComplete;
dataSet.CursorLocation := clUseClient;
dataSet.CommandText := 'WAITFOR DELAY ''00:00:03''; SELECT GETDATE() AS foo';
dataSet.CommandType := cmdText;
dataSet.ExecuteOptions := [eoAsyncFetch];
dataSet.Open();
with the callback:
procedure TForm1.FetchComplete(DataSet: TCustomADODataSet;
const Error: Error; var EventStatus: TEventStatus);
begin
AddSomethingToGit();
end;
the object i placed into the Global Interface Table is destroyed as soon as the callback returns, hitting the breakpoint in TInterfacedObject.
In reality i wouldn't be adding a dummy test object to the GIT during the ADO async callback, i would be adding an actual ADO interface. But when that didn't work we trim the failing code down to the bare-bones.
tl;dr: i try to add an object to the Global Interface Table, but it gets destroyed as soon as i put it in there.
Bonus Chatter
i thought maybe i had to manually call AddRef before placing the object into the GIT, but the GIT register method calls AddRef itself.
How to construct an IGlobalInterfaceTable:
class function CoGlobalInterfaceTable.Create: IGlobalInterfaceTable;
begin
// There is a single instance of the global interface table per process, so all calls to this function in a process return the same instance.
OleCheck(CoCreateInstance(CLSID_StdGlobalInterfaceTable, nil, CLSCTX_INPROC_SERVER, IGlobalInterfaceTable, Result));
end;
with the (not my) Delphi translation of the interface:
IGlobalInterfaceTable = interface(IUnknown)
['{00000146-0000-0000-C000-000000000046}']
function RegisterInterfaceInGlobal(pUnk: IUnknown; const riid: TIID; out dwCookie: DWORD): HRESULT; stdcall;
function RevokeInterfaceFromGlobal(dwCookie: DWORD): HRESULT; stdcall;
function GetInterfaceFromGlobal(dwCookie: DWORD; const riid: TIID; out ppv): HRESULT; stdcall;
end;
And for completeness:
const
CLSID_StdGlobalInterfaceTable : TGUID = '{00000323-0000-0000-C000-000000000046}';
Update One
i desperately wanted to avoid adding my own object, for fear someone would think my object was screwed up. That's why originally i demonstrated with Delphi's in-built TInterfacedObject. In order to confirm that it really is "my" object that's being destroyed, i changed references in the question from TInterfacedObject to TCounter:
TCounter = class(TInterfacedObject, IUnknown)
private
FFingerprint: string;
public
constructor Create;
destructor Destroy; override;
end;
{ TCounter }
constructor TCounter.Create;
begin
inherited Create;
FFingerprint := 'Rob Kennedy';
end;
destructor TCounter.Destroy;
begin
if FFingerprint = 'Rob Kennedy' then
Beep;
inherited;
end;
And my TCounter.Destroy is hit.
I know it's old, but you can simply schedule an anonymous method in another thread (that will go down at the exit of the application) where you create the object and store it into the GIT. Like that the apartment of this special thread will be managed by you and the object will live in that apartment.
Moroever, it seems from my tests that in git you can register objects created in other apartments too from an apartment. But part of the documentations states differently. I'm still working on this.
i figured out the problem; it's likely an (undocumented) fundamental limitation of IGlobalInterfaceTable that makes it essentially unusable:
Any object added to the GlobalInterfaceTable must be retrieved before the adding apartment is torn down.
Running the following from a separate thread:
procedure TAddToGitThread.Execute;
var
unk: IUnknown;
cookie: DWORD;
git: IGlobalInterfaceTable;
begin
CoInitialize(nil);
try
unk := TCounter.Create;
git := CoGlobalInterfaceTable.Create;
OleCheck(git.RegisterInterfaceInGlobal(unk, IUnknown, {out}cookie));
unk := nil;
finally
CoUninitialize; <--objects added from this apartment Released
end;
end;
As soon as the apartment associated with the separate thread is uninitialized: any objects still in the GlobalInterfaceTable are flushed.
This makes it impossible the post messages containing GIT cookie values between threads.
Even artificially inflating the reference count, to prevent object destruction won't help you:
procedure TAddToGitThread.Execute;
var
unk: IUnknown;
cookie: DWORD;
git: IGlobalInterfaceTable;
begin
CoInitialize(nil);
try
unk := TCounter.Create;
unk._AddRef; //inflate reference count to prevent destruction on apartment teardown
git := CoGlobalInterfaceTable.Create;
OleCheck(git.RegisterInterfaceInGlobal(unk, IUnknown, {out}cookie));
unk := nil;
finally
CoUninitialize; <--object added from this apartment is Released, but not freed
end;
end;
Even though the object was not destroyed (because we inflated the reference count), it will no longer be in the global interface table. Asking for it will just fail:
hr := _git.GetInterfaceFromGlobal(_cookie, IUnknown, {out}unk);
returns
0x80070057 The parameter is incorrect
You wanted to use that object added to the GIT? You had should have grabbed it while you didn't have the chance!
i hate bugs where i do nothing wrong, but it still fails.

Delphi & shared datasources

In my app I have different forms that use the same datasource (so the queries are the same too), defined in a common datamodule. Question is, is there a way to know how many times did I open a specific query? By being able to do this, I could avoid close that query without closing it "every where else".
Edit: It's important to mention that I'm using Delphi3 and it is not a single query but several.
The idea is to use the DataLinks property of the TDataSource.
But, as it is protected, you have to gain access to it. One common trick is to create a fake descendant just for the purpose of casting:
type
TDataSourceHack = class(TDataSource);
Then you use it like:
IsUsed := TDataSourceHack(DataSource1).DataLinks.Count > 0;
You can get creative using a addref/release like approach. Just create a few functions and an integer variable in your shared datamodule to do the magic, and be sure to call them..partial code follows:
TDMShared = class(tDataModule)
private
fQueryCount : integer; // set to 0 in constructor
public
function GetQuery : tDataset;
procedure CloseQuery;
end;
function TDMShared.GetQuery : tDataset;
begin
inc(fQueryCount);
if fQueryCount = 1 then
SharedDatsetQry.open;
Result := shareddatasetqry; // your shared dataset here
end;
procedure TDMShared.CloseQuery;
begin
dec(fQueryCount);
if fQueryCount <= 0 then
shareddatasetqry.close; // close only when no refs left.
end;
EDIT: To do this with multiple queries, you need a container to hold the query references, and a way to manipulate them. a tList works well for this. You will need to make appropriate changes for your TDataset descendant, as well as create a FreeAndNil function if you are using an older version of Delphi. The concept I used for this was to maintain a list of all queries you request and manipulate them by the handle which is in effect the index of the query in the list. The method FreeUnusedQueries is there to free any objects which no longer have a reference...this can also be done as part of the close query method, but I separated it to handle the cases where a specific query would need to be reopened by another module.
Procedure TDMShared.DataModuleCreate(Sender:tObject);
begin
dsList := tList.create;
end;
Function TDMShared.CreateQuery(aSql:String):integer;
var
ds : tAdoDataset;
begin
// create your dataset here, for this example using TADODataset
ds := tAdoDataset.create(nil); // self managed
ds.connection := database;
ds.commandtext := aSql;
ds.tag := 0;
Result := dsList.add(ds);
end;
function TDMShared.GetQuery( handle : integer ) : tDataset;
begin
result := nil;
if handle > dsList.count-1 then exit;
if dsList.Items[ handle ] = nil then exit; // handle already closed
result := tAdoDataset( dsList.items[ handle ]);
Inc(Result.tag);
if Result.Tag = 1 then
Result.Open;
end;
procedure TDMShared.CloseQuery( handle : integer );
var
ds : tAdoDataset;
begin
if handle > dsLIst.count-1 then exit;
ds := tAdoDataset( dsList.items[ handle ]);
dec(ds.Tag);
if ds.Tag <= 0 then
ds.close;
end;
procedure TDMShared.FreeUnusedQueries;
var
ds : tAdoDataset;
ix : integer;
begin
for ix := 0 to dsList.Count - 1 do
begin
ds := tAdoDataset(dsLIst.Items[ ix ]);
if ds.tag <= 0 then
FreeAndNil(dsList.Items[ix]);
end;
end;
procedure TDMShared.DataModuleDestroy(Sender: TObject);
var
ix : integer;
begin
for ix := 0 to dsList.count-1 do
begin
if dsLIst.Items[ix] <> nil then
FreeAndNil(dsLIst.Items[ix]);
end;
dsList.free;
end;
Ok, a completely different solution...one that should work for Delphi 3.
Create a new "Descendant Object" from your existing dataset into a new unit, and add some behavior in the new object. Unfortunately I do not have Delphi 3 available for testing, but it should work if you can find the proper access points. For example:
TMySharedDataset = class(tOriginalDataset)
private
fOpenCount : integer;
protected
procedure Internal_Open; override;
procedure Internal_Close; override;
end;
TMySharedDataset.Internal_Open;
begin
inherited Internal_Open;
inc(fOpenCount);
end;
TMySharedDataset.Internal_Close;
begin
dec(fOpenCount);
if fOpenCount <= 0 then
Inherited Internal_Close;
end;
Then just include the unit in your data module, and change the reference to your shared dataset (you will also have to register this one and add it to the palette if your using components). Once this is done, you won't have to make changes to the other units as the dataset is still a descendant of your original one. What makes this all work is the creation of YOUR overridden object.
You could have a generic TDataSet on the shared datamodule and set it on the OnDataChange, using the DataSet property of the Field parameter
dstDataSet := Field.DataSet;
This way, when you want to close the dataset, close the dataset on the datamodule, which is a pointer to the correct DataSet on some form you don't even have to know

Resources