急急急!!!如何让TWebBrower直接读取HTML源码?(100分)

  • 主题发起人 主题发起人 yeah
  • 开始时间 开始时间
Y

yeah

Unregistered / Unconfirmed
GUEST, unregistred user!
实际上,我有两个问题,但只要解决其中之一便可(最好是在D4中解决)
我看过Cakk在http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=159175中的回答
,但只能在D5上使用,如何在D4中使用?
如只能在D5中使用,那么,如何解决RxLib2.75(for D5)中的
RxRichEdit经D5编译后没有Popmenu的问题(在D4中正常)?
 
两段代码一段是直接从WebBorwser中读出HTML源码,是一个是不通过文件装入HTML页面。
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;

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;
 
d4使用THIML
 
procedure GetCurrentDoc(var theList: TStringList);
var
all:IHTMLElementcollection;
doc:IHTMLDocument2;
item:OleVariant;
begin
doc := Browser.document as ihtmldocument2;
all:=doc.all;
item:=all.item(0,varEmpty);

//item.innerhtml是源文件的<title>到</body>
//item.outerhtml是全文

theList.Add( item.innerhtml );
end;
</font>
 
终于进来了,各位老哥可能没看清楚问题吧
我的意思是让Twebbrowser从Stream或Buffer中读取源文件并显示.
 
如果这个问题在D4下没有办法解决,那么谁知道Rxlib(2.75)中的RxRichedit,已设置
Popupmenu,但在D5中编译后无论如何也弹不出菜单来,我用Rxlib自带的示范程序编译后,
也是同样的问题,请问是如何造成的,如何修改?
 
没有人知道吗?
 
请在D5下用Rxlib的朋友帮助试一下,谢谢!
 
---- 为了实现在自己的程序中显示HTML文档,我们一般采用IE(Internet Explorer本文中简称为IE)发行时附带的一个ActiveX控件TWebBrowser。这个控件使用和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
stdcall;
// 从流中载入
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函数引发一个异常,提示用户;然后用CreateStreamOnHGlobal函数建立一个基于全局堆内存块的流,第二个参数如果为True则流在释放时自动释放所占全局堆内存。如果建立成功则此流和刚刚建立的内存块共用同一块内存区域。接着用WebBrowser.Document.QueryInterface函数建立一个IPersistStreamInit接口。然后就可以直接使用此接口,psi.InitNew初始化状态;psi.Load(Stream)从流中载入HTML源码。
---- 至此,以Html参数指定的HTML源码就在WebBrowser参数指定的控件中显示出来。

---- 值得注意的是,每个关于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.Document对象是否有效,无效则退出;然后取得IPersistStreamInit接口;接着取得HTML源码的大小:本来应该使用IPersistStreamInit接口的GetSizeMax函数,但在我的机器上测试,这个函数范围值衡为0,无效。因此只能先定义一个足够大的缓冲区,如BufSize = $10000字节(注意此缓冲区应该足够大);然后同样地分配全局堆内存块,建立流,然后将HTML文本写到流中。因为此HTML文本在流中是以#0结尾的字符串,因此可以用Size := StrLen(PChar(hHTMLText))取得实际长度,用SetLength(Result, Size);设置返回字符串长度为HTML源码实际长度,最后复制字符串到返回字符串中。
---- 至此,直接访问WebBrowser控件中的HTML源码所需的两个函数全部解析完毕。

---- 不过需要注意的时,在使用这两个函数前,最好对WebBrowser.Document对象进行初始化。下面提供一个函数,通过显示一个空白页面实现WebBrowser.Document对象初始化。

procedure ShowBlankPage(WebBrowser:
TWebBrowser);
var
URL: OleVariant;
begin
URL := 'about:blank';
WebBrowser.Navigate2(URL);
end;

 
to Chenlili:
您抄的这张贴子我早就看过了,在D4+IE4中不行。
 
太简单了,这样怎么样?我的是D5+IE5.5。
var
DoC: IHTMLDocument2;
begin
Doc := WebBrowser1.Document as IHTMLDocument2;
Memo1.Lines.Add(Doc.body.outerhtml)
//读源码
Memo1.Lines.Add(Doc.body.outerText)
//Html To Text
end;
 
》》谁知道Rxlib(2.75)中的RxRichedit,已设置
Popupmenu,但在D5中编译后无论如何也弹不出菜单来,我用Rxlib自带的示范程序编译后,
也是同样的问题,请问是如何造成的,如何修改?
可变通如下:
procedure TForm1.RxRichEdit1DblClick(Sender: TObject);
var
x,y:integer;
lppoint:Tpoint;

begin

Getcursorpos(lppoint);
x:=lppoint.x;
y:=lppoint.y;
RxPopupMenu1.Popup (x,y);
end;
 
》》谁知道Rxlib(2.75)中的RxRichedit,已设置
Popupmenu,但在D5中编译后无论如何也弹不出菜单来,我用Rxlib自带的示范程序编译后,
也是同样的问题,请问是如何造成的,如何修改?
哪位大虾知道,请赐教!


 
》》谁知道Rxlib(2.75)中的RxRichedit,已设置
Popupmenu,但在D5中编译后无论如何也弹不出菜单来,我用Rxlib自带的示范程序编译后,
也是同样的问题,请问是如何造成的,如何修改?
哪位大虾知道,请赐教!


 
我找到了:
在//BORLAND/DELPHI5/RX/UNIT/RXRICHED.PAS中:
{$IFDEF RX_D5}
procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
begin
{ RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
{ so we get no WM_CONTEXTMENU message. Simulate message here. }
if Win32MajorVersion <5 then
Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
inherited;
end;
{$ENDIF}
修改为:
{$IFDEF RX_D5}
procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
begin
{ RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
{ so we get no WM_CONTEXTMENU message. Simulate message here. }
if Win32MajorVersion <= 5 then
Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
inherited;
end;
{$ENDIF}
因为DELPHI5用WM_CONTEXTMENU响应弹出菜单.
 
我找到了:
在//BORLAND/DELPHI5/RX/UNIT/RXRICHED.PAS中:
{$IFDEF RX_D5}
procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
begin
{ RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
{ so we get no WM_CONTEXTMENU message. Simulate message here. }
if Win32MajorVersion <5 then
Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
inherited;
end;
{$ENDIF}
修改为:
{$IFDEF RX_D5}
procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
begin
{ RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
{ so we get no WM_CONTEXTMENU message. Simulate message here. }
if Win32MajorVersion <= 5 then
Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
inherited;
end;
{$ENDIF}
因为DELPHI5用WM_CONTEXTMENU响应弹出菜单.
 
电脑报上有文章好象不受版本控制。
 
感谢swanheart,我去试试再说。
 
感谢其它各位的回答,分只能给SWANHERT了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部