我正在尝试解决此问题。这很奇怪，因为它不会引发堆栈溢出错误，但是会引发访问冲突错误。（请参见下面的代码。）
每当CallDestructor调用函数时，都会DestroyChildren被调用。因此，这是一个递归函数。
当我只处理几个对象时，它可以正常工作。我的麻烦是当我有很多实例要销毁时。
unit AggregationObject;
interface
uses
System.Classes, System.Generics.Collections, System.Contnrs;
type
IParentObject = Interface;
IChildObject = Interface
['{061A8518-0B3A-4A1C-AA3A-4F42B81FB4B5}']
procedure CallDestructor();
procedure ChangeParent(Parent: IParentObject);
End;
IParentObject = Interface
['{86162E3B-6A82-4198-AD5B-77C4623481CB}']
procedure AddChild(ChildObject: IChildObject);
function RemoveChild(ChildObject: IChildObject): Integer;
function ChildrenCount(): Integer;
procedure DestroyChildren();
End;
TName = type String;
TChildObject = class(TInterfacedPersistent, IChildObject)
protected
FParentObject: IParentObject;
public
constructor Create( AParent: IParentObject ); virtual;
{IChildObject}
procedure CallDestructor();
procedure ChangeParent(Parent: IParentObject);
end;
TParentObject = class(TInterfacedPersistent, IParentObject)
strict private
FChildren: TInterfaceList;
private
FName: TName;
public
constructor Create();
{Polimórficos}
procedure BeforeDestruction; override;
{IParentObject}
procedure AddChild(AChildObject: IChildObject);
function RemoveChild(AChildObject: IChildObject): Integer;
function ChildrenCount(): Integer;
procedure DestroyChildren();
property Name: TName read FName write FName;
end;
TAggregationObject = class(TChildObject, IParentObject)
private
FController: IParentObject;
function GetController: IParentObject;
public
constructor Create( AParent: IParentObject ); override;
destructor Destroy(); override;
{Controller implementation}
public
property Controller: IParentObject read GetController implements IParentObject;
end;
implementation
uses
System.SysUtils, Exceptions;
{ TChildObject }
procedure TChildObject.CallDestructor;
begin
Self.Free;
end;
procedure TChildObject.ChangeParent(Parent: IParentObject);
begin
if Self.FParentObject <> nil then
IParentObject( Self.FParentObject ).RemoveChild( Self );
Self.FParentObject := Parent;
if Parent <> nil then
Parent.AddChild( Self );
end;
constructor TChildObject.Create(AParent: IParentObject);
begin
if not (AParent = nil) then
begin
FParentObject := AParent;
FParentObject.AddChild( Self );
end;
end;
{ TParentObject }
procedure TParentObject.AddChild(AChildObject: IChildObject);
begin
if (FChildren = nil) then FChildren := TInterfaceList.Create();
FChildren.Add( AChildObject );
end;
procedure TParentObject.BeforeDestruction;
begin
inherited;
DestroyChildren();
end;
function TParentObject.ChildrenCount: Integer;
begin
Result := -1;
if Assigned(FChildren) then
Result := FChildren.Count;
end;
constructor TParentObject.Create;
begin
FName := 'NoName';
end;
procedure TParentObject.DestroyChildren;
var
Instance: IChildObject;
begin
while FChildren <> nil do
begin
Instance := FChildren.Last as IChildObject;
if Instance <> nil then
begin
if RemoveChild( Instance ) > -1 then
begin
try
Instance.CallDestructor();
except on E: Exception do
raise EChildAlReadyDestroyed.Create('Parent: ' + Self.FName + #13#10 + E.Message);
end;
end;
end;
end;
end;
function TParentObject.RemoveChild(AChildObject: IChildObject): Integer;
begin
Result := -1;{if has no children}
if (FChildren <> nil) then
begin
Result := 0;{ Index 0}
if ( ( FChildren.Items[0] as IChildObject) = AChildObject) then
FChildren.Delete(0)
else
Result := FChildren.RemoveItem( AChildObject, TList.TDirection.FromEnd );
if (FChildren.Count = 0) then
begin
FreeAndNil( FChildren );
end;
end;
end;
{ TAggregationObject }
constructor TAggregationObject.Create(AParent: IParentObject);
begin
inherited Create(AParent);
FController := TParentObject.Create();
( FController as TParentObject ).Name := Self.ClassName + '_Parent';
end;
destructor TAggregationObject.Destroy;
begin
( FController as TParentObject ).Free;
inherited;
end;
function TAggregationObject.GetController: IParentObject;
begin
Result := FController;
end;
end.
细节在于区别。
TValueObject是TAggregationObject的特化，它实现IMasterValue，如下所示：
IMasterValue = interface
//GUID Here
function MasterValue: variant;
end;
TValueObject = class(TAggregationObject , IMasterValue)
public
function MasterValue: variant;
end;
所以我有：TSomeService =类公共函数Find（AMasterValue：IMasterValue）：TValueObject; 结尾;
procedure DoSome(AValueObject: TValueObject);
begin
with TSomeService.Create() do
begin
try
Find(AValueObject); //This will get cleared when method exits
finally
AValueObject.Free(); //But the object is destroyed before that
end;
end;
end;
//由于内存将被重用，因此发生高并发性，否则内存仍然隐藏该问题。运行销毁循环的线程将显示该问题。
解决方法是：
procedure DoSome(AValueObject: TValueObject);
var
LMasterValue: IMasterValue;
begin
with TSomeService.Create() do
begin
try
LMasterValue := AValueObject;
try
Find(LMasterValue);
finally
LMasterValue := nil;
end;
finally
AValueObject.Free();
end;
end;
end;
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句