用TWebBrower不断打开多个网页,多某些版本的操作系统上运行一段时间后,发现占用系统内存达几百M,直到关闭程序后,占用的内存才能释放。
这个问题在网有很多讨论,比较多人的建议办法是用SetProcessWorkingSetSize(GetCurrentProcess(),-1,-1)处理一下,这个变通的办法貌似可行。
然后在http://www.winu.cn/space-14160-do-blog-id-270.html出现别一个解决办法,当中提到OLE中存在内存泄露,通过重写OLE函数得以解决问题。
弃而不舍的zhongs终于找到问题的所在,未经验证,抄袭如下:
把TWebBrowser= class(TOleControl)修改为TWebBrowser= class(TrsOleControl)
unit rsOleCtrls;
interface
uses
OleCtrls;
type
TrsOleControl = class (TOleControl)
protected
function GetIDispatchProp(Index: Integer): IDispatch;
function GetIUnknownProp(Index: Integer): IUnknown;
end;
implementation
{ TOleControlFix }
function TrsOleControl.GetIDispatchProp(Index: Integer): IDispatch;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
// Result := IDispatch(Temp.VDispatch); ***** Change to:
Pointer(Result) := Temp.VDispatch; //this avoids the extra AddRef
end;
function TrsOleControl.GetIUnknownProp(Index: Integer): IUnknown;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
// Result := IDispatch(Temp.VUnknown); ***** Change to:
Pointer(Result) := Temp.VUnknown; //this avoids the extra AddRef
end;
end.
把TWebBrowser= class(TOleControl)修改为TWebBrowser= class(TrsOleControl)
unit rsOleCtrls;
interface
uses
OleCtrls;
type
TrsOleControl = class (TOleControl)
protected
function GetIDispatchProp(Index: Integer): IDispatch;
function GetIUnknownProp(Index: Integer): IUnknown;
end;
implementation
{ TOleControlFix }
function TrsOleControl.GetIDispatchProp(Index: Integer): IDispatch;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
// Result := IDispatch(Temp.VDispatch); ***** Change to:
Pointer(Result) := Temp.VDispatch; //this avoids the extra AddRef
end;
function TrsOleControl.GetIUnknownProp(Index: Integer): IUnknown;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
// Result := IDispatch(Temp.VUnknown); ***** Change to:
Pointer(Result) := Temp.VUnknown; //this avoids the extra AddRef
end;
end.
另一种修改源文件的方法如下:
zhongs建议在TWebBrowser和TOleControl的继承关系中间加入一个修正此问题的中间类...
但是经我观察, 我认为TOleControl存在的缺陷会广泛波及其它既有的和将来可能有的自动化控件, 所以我的建议是对OleCtrls.pas进行如下修改:
function TOleControl.GetIDispatchProp(Index: Integer): IDispatch;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
//Result := IDispatch(Temp.VDispatch);
Pointer(Result) := Temp.VDispatch;
end;
function TOleControl.GetIUnknownProp(Index: Integer): IUnknown;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
//Result := IUnknown(Temp.VUnknown);
Pointer(Result) := Temp.VUnknown;
end;
并且要记住重新编译OleCtrls.pas
zhongs建议在TWebBrowser和TOleControl的继承关系中间加入一个修正此问题的中间类...
但是经我观察, 我认为TOleControl存在的缺陷会广泛波及其它既有的和将来可能有的自动化控件, 所以我的建议是对OleCtrls.pas进行如下修改:
function TOleControl.GetIDispatchProp(Index: Integer): IDispatch;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
//Result := IDispatch(Temp.VDispatch);
Pointer(Result) := Temp.VDispatch;
end;
function TOleControl.GetIUnknownProp(Index: Integer): IUnknown;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
//Result := IUnknown(Temp.VUnknown);
Pointer(Result) := Temp.VUnknown;
end;
并且要记住重新编译OleCtrls.pas
相关链接:
http://blog.csdn.net/ScriptBaby/archive/2007/05/20/1618486.aspx
http://blog.csdn.net/ScriptBaby/article/details/1618486
http://blog.csdn.net/ScriptBaby/archive/2007/05/20/1618486.aspx
http://blog.csdn.net/ScriptBaby/article/details/1618486