beta 的第四篇心得：一个释放后自动清空实例指针的类 (20分)

你不是989里的那个人吧。那里也有个叫BETA的。

to 816: 那个 beta 就是我，我还喜欢和 363264 斗嘴呢：）
您也是？在那里的 id 是什么？：）

BETA兄显然已非常理解面向对象的概念，能把这些理论娓娓道来，功底深厚！可以写书。
不知BETA是否受了类工厂模式的影响。
自己做自己的工厂，很有创意。
就是有一个小小BUG，存放指针的“仓库”FPtrList没有释放

to Arming: 呵呵，果然没有释放，一时手快，漏掉了[] 多谢老兄提醒！ ：）
“······可以写书。”
此话差亦，豆腐块文章难登大雅之堂，一时兴起，写出来大家共同分享而已：）
不过要是有机会，我会继续的：）

准备结帖。

不用着急结贴的吧。其实你已经开始聊到了垃圾清除和类似引用记数的内容了。说起原理
似乎很简单，实现起来原来还有这么多的限制，难怪要使用统一的类工厂来实现 COM 了。
再等等吧，起码过正月十五吧，看看还有没有讨论的了。

小雨哥: 多些关注。正月初五快到了：）

[][]

先UP，再订个mail，结帖时收藏。

我看到 darkiss 也有一篇 < 安全的指针 > 的代码在这里:
http://www.delphibbs.com/delphibbs/dispq.asp?lid=677278
这边是 aimingoo 对 darkiss 的具体代码的评论说明:
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1024427
再次 up

多谢小雨哥让我发现了那么好的帖子。
粗看了一下，darkiss 的 < 安全的指针 > ，以及 aimingoo 的评论，
觉得 aimingoo 的评论没有说到点子上，darkiss 对于异常的理解的确
是有问题，不过那不是主要问题。
强调一下，我只是粗略看了一看。darkiss 的“安全指针”并不安全，
他的 TSafePtr 不仅没有解决悬空指针的问题，而且还有几个 bug ：）
darkiss 的源代码摘录如下：(添加了一行以修正一个 bug)
{**********************************************************************
SaftPtr
Automatically allocate memories and free them
Author arkiss
Create Date :2001/10/17
**********************************************************************}
unit SafePtr;
interface
uses
classes, SysUtils ;
type
TObjRecord = class
private
FClass :TClass ;
FObject :TObject ;
public
constructor Create(SomeClass:TClass) ;
destructor Destroy ;override ;
published
property ptrClass :TClass read FClass ;
property ptrObject:TObject read FObject;
end ;
TSafePtr = class
private
FList:TList ;
public
constructor Create ;
overload ;
destructor Destroy ;override ;
function Create(SomeClass:TClass):TObject ;
overload ;
end ;

implementation
{ TObjRecord }
constructor TObjRecord.Create(SomeClass:TClass);
begin
if not Assigned(SomeClass) then
raise Exception.Create('TObjRecord.Create: Invalid Class!') ;
FClass := SomeClass ;
try
FObject := FClass.Create ;
except
on Exceptiondo
raise Exception.Create('TObjRecord.Create: Can not Create Object!');
end ;
end;

destructor TObjRecord.Destroy;
begin
if Assigned(FObject) then
with FObject as FClassdo
free ;
inherited;
end;

{ TSafePtr }
constructor TSafePtr.Create ;
begin
FList := FList.Create ;
end;

function TSafePtr.Create(SomeClass: TClass): TObject;
var temp :TObjRecord ;
begin
try
temp := TObjRecord.Create(SomeClass) ;
except
raise Exception.Create('TSaftPtr.Create: Error Create Ptr') ;
exit ;
// 这行不会被执行到，应略去，aimingoo 已经指出了
end ;
FList.Add(temp) ;
// 以下由 beta 添加一行：
Result := temp;
// 要不然这个函数怎么用？：）
end;

destructor TSafePtr.Destroy;
var temp :TObjRecord ;
begin
while Boolean(FList.Count)do
// 这一行的用法倒是挺有意思：）
begin
temp := FList.Last ;
with temp.FObject as temp.FClassdo
free ;
FList.Delete(FList.Count-1) ;
end ;
FList.Clear ;
inherited;
end;

end.

问题：
在 TSafePtr 创建的时候创建了一个 TObjRecord 对象，并加入了 FList，
但是在 TSafePtr 释放的时候却没有释放 FList 中的 TObjRecord 对象，
而是释放了 TObjRecord 对象中的 FObject，而这应该是 TObjRecord 释放
的时候干的事情。因此，按照 darkiss 的思路，TSafePtr 的析构函数应该
改写如下：
destructor TSafePtr.Destroy;
var temp :TObjRecord ;
begin
while Boolean(FList.Count)do
begin
temp := FList.Last ;
temp.free ;
// 修改成这个样子
FList.Delete(FList.Count-1) ;
end ;
FList.Clear ;
FList.Free;
// 还要记得释放他，犯了和我一样的错误：）
inherited;
end;

这仅仅是修正了 bug，但是并不能解决问题，因为这个方案本身就存在着缺
陷。看看 TObjRecord 的析构函数：
destructor TObjRecord.Destroy;
begin
if Assigned(FObject) then
with FObject as FClassdo
free ;
inherited;
end;

关键就出在 if Assigned(FObject) then
这一行上，试想要是用户已经该
对象释放，那么此时调用 FObject.Free 就会出现问题。
从根本上说，他这个方案就是没有考虑悬空指针的问题。
我认为，darkiss 该方法的提出本意可能是想实现对象的自动释放，即所谓的
“垃圾回收”（应该就是这么回事吧？[]），却没有考虑到在你回收垃圾
之前，某垃圾就已经被“处理”了。
这时，我的自动清空实例指针的办法就派上用场了。就是说，对于某个类，先
用我的办法将其改装为可以自动清空实例指针的类，然后用 darkiss 的办法进
行“包装”使用。这样就可以从一定程度上实现较可靠的“垃圾回收”。不过
这个办法有一个很大的局限，就是只能可靠的回收经过“改装”的类的对象，
无法通用，而且它这个外壳负责回收，却没人来回收它，还是得手动释放：）
欢迎继续讨论。

to beta:
您现在好像主要关心将指针清除的办法，这需要从新定义类，很不方便。
我的想法是能不能从修改Assigned函数入手，看看Free后类地址指向的内容有没有变化，
从而一劳永逸（当然，这不一定行）。 另外，也可以考虑用异常来判断类指针是否
指向实例。从写一个XXXXAsigned函数。
//另外，其实用Free后直接用赋空值的办法就差不多可以了。
//线程对象的重复使用情况我到现在为止还没有碰到，故而对此兴趣不大。
--------谨对您的探索精神表示敬意。

多谢 DarwinZhang，您的建议是个不错的方向，不过恐怕实现起来很难。
我想，或许可以通过 VirtualQuery 查询某指针指向的地址在 Free 前
和 Free 后的属性之间的区别来实现 XXXAssigned，不过 VirtualQuery
要求的参数 lpAddress 和页面文件有关，似乎和我们的指针变量没有什
么直接的联系：（

我随手写了一个，经过验证在我的机器上还可以。
------ K6-2-450/128MSD+Win2K/Delphi7.0(4.453)
function DarwinZhangAssigned(P:TObject):Boolean;
begin
if Assigned(P)
then
Result:=FindHInstance(Pointer(PDWord( PDWord(P)^ -4 )^ ))<>0;
else
Result:=False;
end;

其实FindHInstance就是调用了VirtualQuery,
其实是在同一个进程当中，应该没问题的。^_*
如果有错误，请指教！^_^

up

多谢 DarwinZhang 关注，不过在我这里测试不通过：（
var
a: TButton;
function DarwinZhangAssigned(P: TObject): Boolean;
begin
if Assigned(P) then
Result := FindHInstance(Pointer(PDWord(PDWord(P)^ - 4)^)) <> 0
else
Result := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
a := TButton.Create(nil);
if DarwinZhangAssigned(a) then
Memo1.Lines.Add('a Assigned')
else
Memo1.Lines.Add('a not Assigned');
a.Free;
if DarwinZhangAssigned(a) then
Memo1.Lines.Add('a Assigned')
else
Memo1.Lines.Add('a not Assigned');
a := nil;
if DarwinZhangAssigned(a) then
Memo1.Lines.Add('a Assigned')
else
Memo1.Lines.Add('a not Assigned');
end;

Memo1 的输出结果是：
a Assigned
a Assigned
a not Assigned
我的环境：CII-600/192M SDRAM + Win2K/Delphi6.0

to beta:
先修改一下.也许是offset随版本变化.[]
我今天回杭州,到达后再看看能不能写出 for delphi 6.0 的.
function DarwinZhangAssigned(P:TObject):Boolean;
const
{$IFDEF VER150} //7.0版本
offset=4;
{$else
}
//加入其他版本情况
{$ENDIF}
begin
Result:=False;
if FindHInstance(P)=0 then
exit;
if FindHInstance(PDWord( PDWord(P)^ -offset ))=0 then
exit;
if FindHInstance(Pointer(PDWord( PDWord(P)^ -offset )^))=0 then
exit;
Result:=True;
end;

改成这样还是不行：
function XAssigned(P: TObject): Boolean;
const
{$IFDEF VER150} //7.0版本
offset = 4;
{$else
}
//加入其他版本情况
offset = 4;
// or 0
{$ENDIF}
begin
Result := False;
if FindHInstance(P) = 0 then
exit;
if FindHInstance(PDWord(PDWord(P)^ - offset)) = 0 then
exit;
if FindHInstance(Pointer(PDWord(PDWord(P)^ - offset )^)) = 0 then
exit;
Result := True;
end;

到达后就生病了......[]
我看了一下Delphi6的Free，惨不忍睹......
正想办法中......

up