I have a COM class, which looks something like this:
TRadioTracer = class(TAutoObject, IRadioTracer)
Now, I can do
var
obj: TRadioTracer;
begin
obj := TRadioTracer.Create;
// some other code
obj.Free;
obj.CleanupInstance;
obj.FreeInstance;
end;
These are from System.pas
procedure TObject.FreeInstance;
begin
CleanupInstance;
_FreeMem(Pointer(Self));
end;
procedure TObject.CleanupInstance;
{$IFDEF PUREPASCAL}
var
ClassPtr: TClass;
InitTable: Pointer;
begin
{$IFDEF WEAKREF}
_CleanupInstance(Self);
{$ENDIF}
ClassPtr := ClassType;
repeat
InitTable := PPointer(PByte(ClassPtr) + vmtInitTable)^;
if InitTable <> nil then
_FinalizeRecord(Self, InitTable);
ClassPtr := ClassPtr.ClassParent;
until ClassPtr = nil;
TMonitor.Destroy(Self);
end;
{$ELSE !PUREPASCAL}
// some other code
procedure TObject.Free;
begin
// under ARC, this method isn't actually called since the compiler translates
// the call to be a mere nil assignment to the instance variable, which then calls _InstClear
{$IFNDEF AUTOREFCOUNT}
if Self <> nil then
Destroy;
{$ENDIF}
end;
Which one should I use to free the COM object?
Use the interface type to store a reference to the object. It will be destroyed as soon as there is no reference to it left:
var
obj: IRadioTracer;
begin
obj := TRadioTracer.Create;
obj.DoThings;
end; // obj will be freed here automatically
When you use the COM-Object in a different application or via a TAutoObjectFactory then you will only know the interface type. You have no access then to the concrete class type. That's an additional reason why to prefer the interface type here over the class type.
In case you are using the class type to reference the object you need to call Free to destroy it.
Related
I am adding components to a form at run time and I am also adding events that change properties of these components in a dictionary to call them later.
TEventBeforeInsert = function(var AComponent: TComponent; AForm: TForm): Boolean of Object;
TFieldBase = class
private
FEvent:TEventBeforeInsert;
....
function TFieldBase.EventBeforeInsert: TEventBeforeInsert;
begin
Result:=FEvent;
end;
function TFieldBase.EventBeforeInsert(AEvent: TEventBeforeInsert): TFieldBase ;
begin
FEvent:=AEvent;
Result:=Self;
end;
....
The Form Call
TFormBase.New
.addStringField
(
TFieldBase.New
.Enabled(True)
.Description('User')
.EventBeforeInsert(TEvents.New.EditFillUser), TTabsNames.Tab1
).Show();
The Form Class
TFormBase = class(TForm)
private
FDictionary: TDictionary<String, TEventBeforeInsert>;
...
function TFormBase.addStringField(AField: TFieldBase; ATab: TTabsNames): TFormBase;
var
FLink: TLinkControlToField;
FEdit: TEdit;
begin
Result := Self;
FEdit := TEdit.Create(Self);
FEdit.Visible := True;
FEdit.Parent := TPanel(PanelParent.FindComponent('PanelTab' + Ord(ATab).ToString));
FEdit.Enabled:=AField.Enabled;
if Assigned(AField.EventBeforeInsert) then
begin
FDictionary.Add(FEdit.Name,AField.EventBeforeInsert);
end;
end;
...
procedure TFormBase.rectInsertClick(Sender: TObject);
var
Item:String;
begin
for Item in FDictionary.Keys do
begin
if Not FDictionary.Items[Item](Self.FindComponent(Item),Self) then
Exit;
end;
end;
I'm having a problem here, when debugging I see the text property being changed correctly, but no changes are made to the form being displayed.
TEvents = class
...
function TEvents.EditFillUser(AComponent: TComponent;AForm: TForm): Boolean;
begin
TEdit(AComponent).Text:=IntToStr(0);
Result:=True;
end
I'm thinking it may be a problem that the variable is being passed by value ... Can someone help me?
Edit 1:
I've tried with the dictionary declared like this:
FDictionary: TDictionary<TComponent, TEventBeforeInsert>;
...
if Not FDictionary.Items[Item](Item,Self) then //call
And I also tried use TForm reference like this:
function TEvents.EditFillUser(AComponent: String;AForm: TForm): Boolean;
begin
TEdit(AForm.FindComponent(AComponent)).Text:=IntToStr(0);
Result:=True;
end
In TFormBase.addStringField(), you are not assigning a Name value to the newly create TEdit object before inserting it into FDictionary.. Only components created at design-time have auto-generated Names. Components created at run-time do not. So, you are tracking your objects using blank Names. If you want to track the objects by Name, you need to actually assign your own value to FEdit.Name, eg:
function TFormBase.addStringField(AField: TFieldBase; ATab: TTabsNames): TFormBase;
var
...
FEdit: TEdit;
FEvent: TEventBeforeInsert;
begin
...
FEdit := TEdit.Create(Self);
FEdit.Name := 'SomeUniqueNameHere'; // <-- for you to decide on...
...
FEvent := AField.EventBeforeInsert;
if Assigned(FEvent) then
FDictionary.Add(FEdit.Name, FEvent);
end;
However, in this particular case, I see no reason to use a TDictionary at all. Consider using a TList instead, then you don't need the Names at all. This will also boost the performance of the iteration in TFormBase.rectInsertClick() since it won't have to hunt for every TComponent object using FindComponent() anymore:
TFormBase = class(TForm)
private
type TEventBeforeInsertPair = TPair<TComponent, TEventBeforeInsert>;
FBeforeInsertEvents: TList<TEventBeforeInsertPair>;
...
public
constructor Create;
destructor Destroy; override;
...
end;
...
constructor TFormBase.Create;
begin
inherited;
FBeforeInsertEvents := TList<TEventBeforeInsertPair>.Create;
end;
destructor TFormBase.Destroy;
begin
FBeforeInsertEvents.Free;
inherited;
end;
function TFormBase.addStringField(AField: TFieldBase; ATab: TTabsNames): TFormBase;
var
...
FEdit: TEdit;
FEvent: TEventBeforeInsert;
begin
...
FEdit := TEdit.Create(Self);
...
FEvent := AField.EventBeforeInsert;
if Assigned(FEvent) then
FBeforeInsertEvents.Add(TEventBeforeInsertPair.Create(FEdit, FEvent));
end;
procedure TFormBase.rectInsertClick(Sender: TObject);
var
Item: TEventBeforeInsertPair;
begin
for Item in FBeforeInsertEvents do
begin
if not Item.Value(Item.Key, Self) then
Exit;
end;
end;
...
Also, your TEvents.EditFillUser() method does not match the definition of TEventBeforeInsert. The 1st parameter of TEventBeforeInsert is declared as passing the TComponent pointer by var reference (why?), but the 1st parameter of EditFillUser() is not doing that. Unless you want your event handlers to alter what the TComponent pointers are pointing at (which won't work the way you are currently using TEventBeforeInsert with TDictionary), then there is no reason to pass around the TComponent pointers by var reference at all:
TEventBeforeInsert = function(AComponent: TComponent; AForm: TForm): Boolean of Object;
Also, your use of TEvents.New appears to be a memory leak, as nobody is taking ownership of the newly created TEvents object (unless its constructor is adding the object to some internal list that we can't see). Same with TFieldBase.New. And even TFormBase.New (assuming there is no OnClose event that sets Action=caFree when the Form is closed). At some point, you need to call Free() any class object that you Create().
This may be an extension of my previous question.
I have understood that an interface-based variable can not be defined as its original type, otherwise the reference count does not work properly for automatic release.
But if a class implements two interfaces, then what type should be defined when make an instance of it?
Consider following code:
program Project2;
{$APPTYPE CONSOLE}
{$R *.res}
uses
SysUtils, Classes;
type
ITestInterface = interface(IInvokable)
['{A7BDD122-7DC6-4F23-93A2-B686571AB2C8}']
procedure TestMethod;
end;
IAnotherInterface = interface(IInvokable)
['{15FEC4A7-E361-41D0-9D52-170AFAD1794B}']
procedure AnotherMethod;
end;
TTestObj = class(TInterfacedObject, ITestInterface, IAnotherInterface)
constructor Create;
destructor Destroy; override;
private
FData: TStrings;
public
procedure TestMethod;
procedure AnotherMethod;
end;
{ TTestObj }
constructor TTestObj.Create;
begin
FData := TStringList.Create;
end;
destructor TTestObj.Destroy;
begin
Writeln('Destroy');
FData.Free;
inherited;
end;
procedure TTestObj.TestMethod;
begin
FData.Text := 'TestMethod';
Writeln(FData.Strings[0]);
end;
procedure TTestObj.AnotherMethod;
begin
FData.Text := 'AnotherMethod';
Writeln(FData.Strings[0]);
end;
{ Main }
function CreateObj: TTestObj;
begin
Result := TTestObj.Create;
end;
function CreateObj_i1: ITestInterface;
begin
Result := TTestObj.Create;
end;
function CreateObj_i2: IAnotherInterface;
begin
Result := TTestObj.Create;
end;
procedure Main;
var
TestObj: ITestInterface; // It must be declared as an interface type, or it won't be freed correctly.
AnotherObj: IAnotherInterface;
NaturalObj: TTestObj;
begin
{ 1st way: The syntax is a bit natural, but easily lead to memory leaks. }
CreateObj; // memory leak !
TestObj := CreateObj;
TestObj.TestMethod;
AnotherObj := CreateObj;
AnotherObj.AnotherMethod;
TestObj := nil;
AnotherObj := nil;
Writeln('----------');
{ 2nd way: The syntax is a bit messy, you should do type conversion carefully. }
CreateObj_i1; // object freed correctly.
TestObj := TTestObj(CreateObj_i2); // Using ITestInterface(CreateObj_i2) is wrong.
TestObj.TestMethod;
AnotherObj := TTestObj(CreateObj_i1); // Using IAnotherInterface(CreateObj_i1) is wrong.
AnotherObj.AnotherMethod;
TestObj := nil; // useless, it won't be be freed until the procedure returns.
AnotherObj := nil; // as above.
Writeln('----------');
{ 3rd way: The syntax is a bit natural, but it's easily lead to access violation if pass the `NaturalObj` out of the procedure. }
NaturalObj := TTestObj(CreateObj_i1); // Using TTestObj(CreateObj_i2) is okay too.
NaturalObj.TestMethod;
NaturalObj.AnotherMethod;
end;
begin
Writeln('Program start!');
Main;
Writeln('Program end.');
Readln;
end.
So which way is your preferred? Or any other advice? Thanks in advance.
There is a lot of confusion and complexity here. Rather than trying to dissect what you have, I'll show you how I would do it.
First of all remove all variables of type TTestObj. You should be using interface references only. You'll want a variable for each one.
var
TestIntf: ITestInterface;
AnotherIntf: IAnotherInterface;
Note that I have changed the name of these variables, replacing the Obj suffix with Intf. This reflects that they are interface references rather than object references.
Then you can simply do this:
TestIntf := TTestObj.Create;
AnotherIntf := TestIntf as IAnotherInterface;
Now you have two interface variables, one for each of your interfaces. It so happens that the implementing object behind both of these references is the same object, which is presumably what you want.
You could equally have reversed the logic:
AnotherIntf := TTestObj.Create;
TestIntf := AnotherIntf as ITestInterface;
This achieves exactly the same effect, you can do it either way.
If you want a different instance behind the variables then that is easy enough:
TestIntf := TTestObj.Create;
AnotherIntf := TTestObj.Create;
The key points here are:
Don't mix interfaces and objects. Once you start using an interface don't access the implementing object behind it.
When an object implements multiple interfaces, use the as operator to obtain the other interfaces.
I want to assign an event handler in constructor, if it does not have one assigned. Consequentially I want to remove the eventually assigned event handler in destructor. I wrote the code as follows, but cannot be compiled.
constructor TSomeControl.Create(Panel: TPanel);
begin
inherited Create;
FPanel := Panel;
if not Assigned(FPanel.OnResize) then
FPanel.OnResize := HandlePanelResize;
end;
destructor TSomeControl.Destroy;
begin
if #FPanel.OnResize = #HandlePanelResize then // [dcc32 Error] E2036 Variable required
FPanel.OnResize := nil;
FPanel := nil;
inherited;
end;
How to test it properly? I know a solution is to use a variable to record, whether I have assigned OnResize. But I do not want this as solution.
No need to write any custom code here as you can use the already existing comparers from Generics.Defaults:
destructor TSomeControl.Destroy;
begin
if Assigned(FPanel) and TEqualityComparer<TNotifyEvent>.Default.Equals(
FPanel.OnResize, HandlePanelResize) then
FPanel.OnResize := nil;
FPanel := nil;
inherited;
end;
This is complicated by the fact that OnResize is a property rather than a variable. And it's quite hard to refer to a method directly without the compiler thinking you want to call the method. This is the big drawback of Pascal's convenience of allowing you to call a procedure without using parens.
All this makes it rather hard to do it in a one-liner. As far as I can see you will need to do something like this:
destructor TSomeControl.Destroy;
var
Method1, Method2: TNotifyEvent;
begin
if Assigned(FPanel) then
begin
Method1 := FPanel.OnResize;
Method2 := HandlePanelResize;
if TMethod(Method1) = TMethod(Method2) then
FPanel.OnResize := nil;
end;
FPanel := nil;
inherited;
end;
This relies on modern Delphi's TMethod record which includes an overloaded equality operator to make the = test work.
I would wrap this all up in a generic method if I was doing it more than once. It might look like this:
type
TEventComparer = class
class function Equal<T>(const lhs, rhs: T): Boolean; static;
end;
class function TEventComparer.Equal<T>(const lhs, rhs: T): Boolean;
begin
Assert(SizeOf(T)=SizeOf(TMethod));
Result := TMethod((#lhs)^)=TMethod((#rhs)^);
end;
You'd call it like this:
destructor TSomeControl.Destroy;
begin
if Assigned(FPanel) and TEventComparer.Equal<TNotifyEvent>(FPanel.OnResize,
HandlePanelResize) then
FPanel.OnResize := nil;
FPanel := nil;
inherited;
end;
One thing that this highlights is that the generic constraints available to you do not allow you to constraint a type to being a method pointer. Hence the basic sanity check that the size of T is the same as the size of a method. This doesn't offer much safety though. You can call this method passing Int64, or Double. I'd be interested to see if anyone can come up with a cleaner variant.
There is no need to use Generics.Defaults or any generics at all. There is TMethod record declared in System unit, so this is probably the simplest one:
destructor TSomeControl.Destroy;
var
Event: TNotifyEvent;
begin
Event := HandlePanelResize;
if TMethod(FPanel.OnResize).Code = Addr(Event) then
FPanel.OnResize := nil;
FPanel := nil;
inherited;
end;
I'm passing created object to a constructor of another object which need an Interface which that object implements.
ISomeInterface = interface
['{840D46BA-B9FB-4273-BF56-AD0BE40AA3F9}']
end;
TSomeObject = class(TInterfacedObject, ISomeinterface)
end;
TSomeObject2 = class
private
FSomeInterface: ISomeinterface;
public
constructor Create(SomeObject: ISomeInterface);
end;
var
Form1: TForm1; // main form
SomeObject: TSomeObject;
constructor TSomeObject2.Create(SomeObject: ISomeInterface);
begin
FSomeInterface := SomeObject;
end;
// main form creating
procedure TForm1.FormCreate(Sender: TObject);
var SomeObject2: TSomeObject2;
begin
SomeObject := TSomeObject.Create;
// SomeObject2 := TSomeObject2.Create(nil); // ok
SomeObject2 := TSomeObject2.Create(SomeObject); // not ok
try
// do some things
finally
SomeObject2.Free;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SomeObject.Free; // if passed to a SomeObject2 Constructor - freeing it causing av
end;
After I close main form it gives me an AV and a memory leak - whole main form has leaked.
If I'm passing nil to a TSomeObject constructor everything is well. Is compilator freeing FSomeInterface by reference counting and I'm shouldn't try to free SomeObject in mainForm destructor? How can I avoid it?
TSomeObject inherited from TInterfacedObject and thus is reference counted. Your instance of TSomeObject is not reference counted and should be removed or replaced by an interface variable.
If you need the instance of TSomeObject created in FormCreate, you should assign it to a variable of type ISomeInterface, so that the reference counting will work for that, too.
Another approach is to inherit from TInterfacedPersistant instead of TInterfacedObject to avoid the reference counting.
To explain what is happening in your code:
procedure TForm1.FormCreate(Sender: TObject);
var SomeObject2: TSomeObject2;
begin
{ Here you create the instance and assign it to a variable holding the instance.
After this line the reference count of the instance is 0 }
SomeObject := TSomeObject.Create;
// SomeObject2 := TSomeObject2.Create(nil); // ok
{ Using the instance as a parameter will increase the reference count to 1 }
SomeObject2 := TSomeObject2.Create(SomeObject); // not ok
try
// do some things
finally
{ Freeing SomeObject2 also destroys the interface reference FSomeInterface is
pointing to (which is SomeObject), decreasing the reference count to 0, which
in turn frees the instance of TSomeObject. }
SomeObject2.Free;
end;
{ Now, after SomeObject is freed, the variable points to invalid memory causing the
AV in FormDestroy. }
end;
When using Interfaces in Delphi and overriding reference counting, it is possible to bypass the_Release calls Delphi makes when an interface reaches a reference count of zero.
But - when mixing classes and interfaces (which is very useful) the _Release method is ALWAYS called no matter what. The problem is that in the sample code below, the local object is nill-ed, but _Release is still called - except on invalid memory. Depending on memory operations in the application, an exception can result when _Release is called on the nilled localObject's old location or no exception if the memory was not re-used.
So, can the compiler generated call to _Release be "removed/blocked/avoided/killed/redirected/vmt hijacked/terminated/smacked/etc etc etc"? If this can be achieved you have proper pure interfaces in Delphi.
unit TestInterfaces;
interface
uses
Classes,
SysUtils;
type
ITestInterface = interface
['{92D4D6E4-A67F-4DB4-96A9-9E1C40825F9C}']
procedure Run;
end;
TTestClass = class(TInterfacedObject, ITestInterface)
protected
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
public
procedure Run;
end;
TRunTestClass = class(TObject)
protected
FlocalInterface : ITestInterface;
FlocalObject : TTestClass;
public
constructor Create;
destructor Destroy; override;
procedure Test;
end;
procedure RunTest;
procedure RunTestOnClass;
var
globalInterface : ITestInterface;
implementation
procedure RunTest;
var
localInterface : ITestInterface;
localObject : TTestClass;
begin
try
//create an object
localObject := TTestClass.Create;
//local scope
// causes _Release call when object is nilled
localInterface := localObject;
localInterface.Run;
//or global scope
// causes _Release call when exe shuts down - possibly on invalid memory location
globalInterface := localObject;
globalInterface.Run;
finally
//localInterface := nil; //--> forces _Release to be called
FreeAndNil( localObject );
end;
end;
procedure RunTestOnClass;
var
FRunTestClass : TRunTestClass;
begin
FRunTestClass := TRunTestClass.Create;
FRunTestClass.Test;
FRunTestClass.Free;
end;
{ TTheClass }
procedure TTestClass.Run;
begin
beep;
end;
function TTestClass._AddRef: Integer;
begin
result := -1;
end;
function TTestClass._Release: integer;
begin
result := -1;
end;
{ TRunTestClass }
constructor TRunTestClass.Create;
begin
FlocalObject := TTestClass.Create;
FlocalInterface := FlocalObject;
end;
destructor TRunTestClass.Destroy;
begin
//..
FlocalObject.Free;
//FlocalObject := nil;
inherited;
end;
procedure TRunTestClass.Test;
begin
FlocalInterface.Run;
end;
end.
There's no practical way to achieve what you are looking for. The compiler is going to emit the calls to _Release and in order to whack them you would need to find all the call sites. That's not practical.
I'm afraid the only viable approach when reference counted lifetime management is disabled is to ensure that you finalize (i.e. set to nil) all your interface references before calling Free.
When you use Interfaces you do not need to free your objects any more. interfaced objects will released automatically when there is no any references to same object.
In your sample you must delete _Release and _Addref functions in TTestClass they are defined in TInterfacedObject class.
In RunTest procedure you not need to Free the localObject only in finally section set globalInterface to nil. after end of procedure localInterface will destroy the local object automatically.
try
... use your code
...
finnaly
globalInnterface := nil;
end;
And about TTestRun.Destroy just left this destructor blank. you must not Free the FlocalObject.
TTestRun.Destroy;
begin
inherited;
end;