发信人: catmail()
整理人: catmail(2000-12-05 19:24:03), 站内信件
|
直接访问WebBrowser控件中的HTML源码
华中师范大学
卢小海
---- 为了实现在自己的程序中显示HTML文档，我们一般
采用IE(Internet Explorer本
文中简称为IE)发行时附带的一个ActiveX控件TWebBrow
ser。这个控件使用和IE相同的
内核，功能强大，并从Delphi5开始，正式得到Inprise
公司的支持，取代了原来的那
个THTML控件，成为Delphi中显示HTML文档的首选控件。
---- 但是在实际编程过程中，我发现这个控件提供的功
能有很多限制，比如对HTML文
档的浏览，只能通过指定URL或文件名来实现，不能像以
往使用THTML控件那样直接读
写HTML源码。因此如果程序动态生成了一段HTML文本，
就必须把文本内容先写到一个
临时文件，然后再将此文件的文件名传递给WebBrowser
控件，实现显示。走这一个弯
路使程序响应速度受到很大影响，而且容易遗留下一些
"垃圾"(临时文件)。
---- 在考察了一些使用了WebBrowser控件的程序后，我
发现大部分程序，如著名国产
软件FoxMail，都是使用的通过临时文件传递HTML文档的
方法；但一些国外的软件，如
MS自己的OutLook Express则不存在这个问题，而因为其
无需产生临时文件，因此对
HTML文档的显示速度明显超过Foxmail。
---- 为此，我查阅了一些相关资料，最后在网友的帮助
下找到了实现直接访问
WebBrowser控件中的HTML源码的方法。在此要特别感谢
白云黄鹤
BBS(bbs.whnet.edu.cn)上的网友AngleFalls提供线索。
---- 其实，WebBrowser控件中的Document对象，这个对
象提供了一个
IPersistStreamInit接口，通过此接口，我们可以方便
地实现对HTML源码的读写。
---- 以下是IPersistStreamInit接口的相关定义及说明
：
{ IPersistStream interface }
{$EXTERNALSYM IPersistStream}
IPersistStream = interface(IPersist)
['{00000109-0000-0000-C000-000000000046}']
function IsDirty: HResult; stdcall;
// 最后一次存盘后是否被修改
function Load(const stm: IStream): HResult; stdc
all;
// 从流中载入
function Save(const stm: IStream;
fClearDirty: BOOL): HResult; stdcall;
// 保存到流
function GetSizeMax(out cbSize: Largeint):
HResult; stdcall; // 取得保存所需空间大小
end;
{ IPersistStreamInit interface }
{$EXTERNALSYM IPersistStreamInit}
IPersistStreamInit = interface(IPersistStream)
['{7FD52380-4E07-101B-AE2D-08002B2EC713}']
function InitNew: HResult; stdcall; // 初始化
end;
首先来实现写，因为这是最迫切的要求：
procedure SetHtml(const WebBrowser:
TWebBrowser; const Html: string);
var
Stream: IStream;
hHTMLText: HGLOBAL;
psi: IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then Exit;
hHTMLText := GlobalAlloc(GPTR, Length(Html) + 1)
;
if 0 = hHTMLText then RaiseLastWin32Error;
CopyMemory(Pointer(hHTMLText),
PChar(Html), Length(Html));
OleCheck(CreateStreamOnHGlobal
(hHTMLText, True, Stream));
try
OleCheck(WebBrowser.Document.
QueryInterface(IPersistStreamInit, psi));
try
OleCheck(psi.InitNew);
OleCheck(psi.Load(Stream));
finally
psi := nil;
end;
finally
Stream := nil;
end;
end;
---- 首先，此过程需要的两个参数，WebBrowser是显示
目的控件，Html是需要显示的
HTML源码；然后，先检查WebBrowser.Document对象是否
有效，无效则退出；接着在系
统全局堆里分配一块内存，将需要显示的HTML源码复制
进去。这是因为下一步需要建
立一个WebBrowser控件可以读取的流。GlobalAlloc函数
的参数GPTR表示需要分配一块
固定的以0初始化过的内存区域，如果分配失败则返回0
，则通过RaiseLastWin32Error
函数引发一个异常，提示用户；然后用CreateStreamOn
HGlobal函数建立一个基于全局
堆内存块的流，第二个参数如果为True则流在释放时自
动释放所占全局堆内存。如果
建立成功则此流和刚刚建立的内存块共用同一块内存区
域。接着用
WebBrowser.Document.QueryInterface函数建立一个IP
ersistStreamInit接口。然后
就可以直接使用此接口，psi.InitNew初始化状态；psi
.Load(Stream)从流中载入HTML
源码。
---- 至此，以Html参数指定的HTML源码就在WebBrowse
r参数指定的控件中显示出来。
---- 值得注意的是，每个关于COM接口的函数调用，也
就是那些返回类型为HResult的
函数，都必须以OleCheck包装，因为一个不检查返回状
态的COM接口操作实在太危险
了；此外接口的释放，虽然Delphi可以在后台自动完成
，但作为一个好的编程习惯，
还是应该显式地手工释放，释放只需将接口设为nil即可
。
---- 接着来实现HTML源码的读：
function GetHtml(const WebBrowser:
TWebBrowser): string;
const
BufSize = $10000;
var
Size: Int64;
Stream: IStream;
hHTMLText: HGLOBAL;
psi: IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then Exit;
OleCheck(WebBrowser.Document.QueryInterface
(IPersistStreamInit, psi));
try
//OleCheck(psi.GetSizeMax(Size));
hHTMLText := GlobalAlloc(GPTR, BufSize);
if 0 = hHTMLText then RaiseLastWin32Error;
OleCheck(CreateStreamOnHGlobal(hHTMLText,
True, Stream));
try
OleCheck(psi.Save(Stream, False));
Size := StrLen(PChar(hHTMLText));
SetLength(Result, Size);
CopyMemory(PChar(Result), Pointer(hHTMLText),
Size);
finally
Stream := nil;
end;
finally
psi := nil;
end;
end;
---- 此函数有一个参数WebBrowser指定从那个控件读取
HTML源码，返回一个字符串为
此控件中的HTML源码。首先还是要先检查WebBrowser.D
ocument对象是否有效，无效则
退出；然后取得IPersistStreamInit接口；接着取得HT
ML源码的大小：本来应该使用
IPersistStreamInit接口的GetSizeMax函数，但在我的
机器上测试，这个函数范围值
衡为0，无效。因此只能先定义一个足够大的缓冲区，如
BufSize = $10000字节(注意
此缓冲区应该足够大)；然后同样地分配全局堆内存块，
建立流，然后将HTML文本写到
流中。因为此HTML文本在流中是以#0结尾的字符串，因
此可以用Size :=
StrLen(PChar(hHTMLText))取得实际长度，用SetLengt
h(Result, Size);设置返回字
符串长度为HTML源码实际长度，最后复制字符串到返回
字符串中。
---- 至此，直接访问WebBrowser控件中的HTML源码所需
的两个函数全部解析完毕。
---- 不过需要注意的时，在使用这两个函数前，最好对
WebBrowser.Document对象进
行初始化。下面提供一个函数，通过显示一个空白页面
实现WebBrowser.Document对象
初始化。
procedure ShowBlankPage(WebBrowser:
TWebBrowser);
var
URL: OleVariant;
begin
URL := 'about:blank';
WebBrowser.Navigate2(URL);
end;
---- 建议在你有WebBrowser控件的Form的FormCreate事
件里调用此函数，初始化
WebBrowser.Document对象。
---- 本文程序在Win NT + Delphi 5 环境下调试通过
---- 参考资料：MSDN
---- 特别感谢：白云黄鹤BBS(bbs.whnet.edu.cn)网友
AngleFalls
--
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.104.184.249]
|
|