TWebBrowser问题(100分)

请问如何查出WebBrowser所加载的HTML文件中的某个字符串。并且把
找到的所有字符串都HighLight出来？
谢谢。

Delphi 3开始有了TWebBrowser 构件，不过那时是以ActiveX 控件的形式出
现的，而且需要自己引入，在其后的4.0 和5.0 中，它就在封装好shdocvw.dll
之后作为 Internet 构件组之一出现在构件面板上了。常常听到有人骂Delphi的
帮助做得极差，这次的TWebBrowser 又是Microsoft 的东东，自然不会好到哪里
去，虽说MSDN上什么都有，可是内容太过庞杂，如果没有入口点更是件烦人的事，
查找起来给人的感觉大概可以用一句话来形容：非常复杂、复杂非常。　　这里
有平时我自己用TWebBrowser 做程序的一些心得和上网收集到的部分例子和资料，
整理了一下，希望能给有兴趣用TWebBrowser 编程的朋友带来些帮助。

１、初始化和终止化（Initialization & Finalization ）

大家在执行TWebBrowser 的某个方法以进行期望的操作，如ExecWB等的时候
可能都碰到过“试图激活未注册的丢失目标”或“OLE 对象未注册”等错误，或
者并没有出错但是得不到希望的结果，比如不能将选中的网页内容复制到剪贴板
等。以前用它编程的时候，我发现ExecWB有时侯起作用但有时侯又不行，在 Delphi
生成的缺省工程主窗口上加入TWebBrowser ，运行时并不会出现“OLE 对象未注
册”的错误。同样是一个偶然的机会，我才知道OLE 对象需要初始化和终止化
（懂得的东东实在太少了）。
我用我的前一篇文章《Delphi程序窗口动画&正常排列平铺的解决》所说的
方法编程，运行时出了上面所说的错误，我便猜想应该有OleInitialize 之类的
语句，于是，找到并加上了下面几句话，终于搞定！究其原因，我想大概是由于
TWebBrowser是一个嵌入的OLE 对象而不算是用Delphi编写的VCL 吧。

initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;

这几句话放在主窗口所有语句之后，“end.”之前。

--------------------------------------------------------------------------------------------------------

２、EmptyParam在Delphi 5中TWebBrowser 的Navigate方法被多次重载：

procedure Navigate(const URL: WideString); overload;
procedure Navigate(const URL: WideString; var Flags: OleVariant); overload;
procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName:OleVariant); overload;
procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName:OleVariant; var PostData: OleVariant); overload;
procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName:OleVariant; var PostData: OleVariant; var Headers: OleVariant); overload;

而在实际应用中，使用后几种方法调用时，由于我们很少用到后面几个参数，
但函数声明又要求是变量参数，一般的做法如下：

var
t:OleVariant;
begin
webbrowser1.Navigate(edit1.text,t,t,t,t);
end;

需要定义变量t （还有很多地方要用到它），很麻烦。其实我们可以用 EmptyParam
来代替（EmptyParam是一个公用的Variant 空变量，不要对它赋值），只需一句
话就可以了：webbrowser1.Navigate（edit1.text，EmptyParam，EmptyParam，
EmptyParam，EmptyParam）；虽然长一点，但比每次都定义变量方便得多。当然，
也可以使用第一种方式。

webbrowser1.Navigate（edit1.text）

--------------------------------------------------------------------------------------------------------

３、命令操作常用的命令操作用ExecWB方法即可完成，ExecWB同样多次被重
载：

procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT); overload;
procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn:OleVariant); overload;
procedure ExecWB(cmdID: rOLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn:OleVariant; var pvaOut: OleVariant); overload;

打开：弹出“打开Internet地址”对话框，CommandID 为OLECMDID_OPEN
（若浏览器版本为IE5.0 ，则此命令不可用）。

另存为：调用“另存为”对话框。

ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_DODEFAULT, EmptyParam,EmptyParam);

打印、打印预览和页面设置：调用“打印”、“打印预览”和“页面设置”
对话框（IE5.5 及以上版本才支持打印预览，故实现应该检查此命令是否可用）。

ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, EmptyParam,EmptyParam);
if QueryStatusWB(OLECMDID_PRINTPREVIEW)=3 then
ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT,EmptyParam,EmptyParam);
ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT, EmptyParam,EmptyParam);

剪切、复制、粘贴、全选：功能无须多说，需要注意的是：剪切和粘贴不仅
对编辑框文字，而且对网页上的非编辑框文字同样有效，用得好的话，也许可以
做出功能特殊的东东。获得其命令使能状态和执行命令的方法有两种（以复制为
例，剪切、粘贴和全选分别将各自的关键字替换即可，分别为CUT ，PASTE 和SELECTALL）
：A 、用TWebBrowser 的QueryStatusWB 方法。

if(QueryStatusWB(OLECMDID_COPY)=OLECMDF_ENABLED) or OLECMDF_SUPPORTED) then
ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, EmptyParam,EmptyParam);

B 、用IHTMLDocument2的QueryCommandEnabled 方法。

var
Doc: IHTMLDocument2;
begin
Doc :=WebBrowser1.Document as IHTMLDocument2;
if Doc.QueryCommandEnabled(''Copy'') then
Doc.ExecCommand(''Copy'',false,EmptyParam);
end;

查找：　参考第九条“查找”功能。

--------------------------------------------------------------------------------------------------------

４、字体大小类似“字体”菜单上的从“最大”到“最小”五项（对应整数
0 ～4 ， Largest等假设为五个菜单项的名字，Tag 属性分别设为0 ～4 ）。

A 、读取当前页面字体大小。

var
t: OleVariant;
Begin
WebBrowser1.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,EmptyParam,t);
case t of
4: Largest.Checked :=true;
3: Larger.Checked :=true;
2: Middle.Checked :=true;
1: Small.Checked :=true;
0: Smallest.Checked :=true;
end;
end;

B 、设置页面字体大小。

Largest.Checked :=false;
Larger.Checked :=false;
Middle.Checked :=false;
Small.Checked :=false;
Smallest.Checked :=false;
TMenuItem(Sender).Checked :=true;
t :=TMenuItem(Sender).Tag;
WebBrowser1.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,t,t);
-------------------------------------------------------------------------------------------------------

５、添加到收藏夹和整理收藏夹

const
CLSID_ShellUIHelper: TGUID = ''{64AB4BB7-111E-11D1-8F79- 00C04FC2FBE1}'';
var
procedure(Handle: THandle; Path: PChar); stdcall;

procedure TForm1.OrganizeFavorite(Sender: Tobject);
var
H: HWnd;
begin
H := LoadLibrary(PChar(''shdocvw.dll''));
if H <> 0 then
begin
　p := GetProcAddress(H, PChar(''DoOrganizeFavDlg''));
　if Assigned(p) then p(Application.Handle, PChar (FavFolder));
end;
FreeLibrary(h);
end;

procedure TForm1.AddFavorite(Sender: TObject);
var
ShellUIHelper: ISHellUIHelper;
url, title: Olevariant;
begin
Title := Webbrowser1.LocationName;
Url := Webbrowser1.LocationUrl;
if Url <> '''' then
begin
　ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;
　ShellUIHelper.AddFavorite(url, title);
end;
end;

--------------------------------------------------------------------------------------------------------

６、使WebBrowser获得焦点TWebBrowser 非常特殊，它从TWinControl 继承
来的SetFocus方法并不能使得它所包含的文档获得焦点，从而不能立即使用Internet
Explorer本身具有得快捷键，解决方法如下：<

procedure TForm1.SetFocusToDoc;
begin
if WebBrowser1.Document <> nil then
　with WebBrowser1.Application as IOleobject do
　　DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect);
end;

除此之外，我还找到一种更简单的方法，这里一并列出：

if WebBrowser1.Document <> nil then
IHTMLWindow2(IHTMLDocument2 (WebBrowser1.Document).ParentWindow).focus

刚找到了更简单的方法，也许是最简单的：

if WebBrowser1.Document <> nil then
IHTMLWindow4(WebBrowser1.Document).focus

还有，需要判断文档是否获得焦点这样来做：

if IHTMLWindow4(WebBrowser1.Document).hasfocus then
--------------------------------------------------------------------------------------------------------

７、点击“提交”按钮如同程序里每个窗体上有一个“缺省”按钮一样，Web
页面上的每个Form也有一个“缺省”按钮——即属性为“Submit”的按钮，当用
户按下回车键时就相当于鼠标单击了“Submit”。但是TWebBrowser 似乎并不响
应回车键，并且，即使把包含TWebBrowser 的窗体的KeyPreview设为True，在窗
体的KeyPress事件里还是不能截获用户向TWebBrowser 发出的按键。

我的解决办法是用ApplicatinEvents构件或者自己编写TApplication对象的
OnMessage 事件，在其中判断消息类型，对键盘消息做出响应。至于点击“提交”
按钮，可以通过分析网页源代码的方法来实现，不过我找到了更为简单快捷的方
法，有两种，第一种是我自己想出来的，另一种是别人写的代码，这里都提供给
大家，以做参考。

A 、用SendKeys函数向WebBrowser发送回车键
在Delphi 5光盘上的Info/Extras/SendKeys目录下有一个SndKey32.pas文件，
其中包含了两个函数SendKeys和AppActivate ，我们可以用SendKeys函数来向
WebBrowser发送回车键，我现在用的就是这个方法，使用很简单，在WebBrowser
获得焦点的情况下（不要求WebBrowser所包含的文档获得焦点），用一条语句即
可：

Sendkeys(''~'',true);// press RETURN key

SendKeys函数的详细参数说明等，均包含在SndKey32.pas文件中。

B 、在OnMessage 事件中将接受到的键盘消息传递给WebBrowser.

procedure TForm1.ApplicationEvents1Message(var Msg: TMsg; var Handled: Boolean);
{fixes the malfunction of some keys within webbrowser control}
const
StdKeys = [VK_TAB, VK_RETURN]; { standard keys }
ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT]; { extended keys }
fExtended = $01000000; { extended key flag }
begin
Handled := False;
with Msg do
if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
((wParam in StdKeys) or {$IFDEF VER120}(GetKeyState(VK_CONTROL) < 0)
or {$ENDIF}(wParam in ExtKeys) and ((lParam and fExtended) = fExtended)) then
　　try
　　　if IsChild(Handle, hWnd) then { handles all browser related messages }
　　　begin
　　　　with {$IFDEF VER120}Application_{$ELSE}Application {$ENDIF} as IOleInPlaceActiveObject do
　　　　　Handled := TranslateAccelerator(Msg) = S_OK;
　　　　　if not Handled then
　　　　　begin
　　　　　　Handled := True;
　　　　　　TranslateMessage(Msg);
　　　　　　DispatchMessage(Msg);
　　　　　end;
　　　end;
　　except
　　end;
end; // MessageHandler （此方法来自EmbeddedWB.pas）
--------------------------------------------------------------------------------------------------------

８、直接从TWebBrowser 得到网页源码及Html下面先介绍一种极其简单的得
到TWebBrowser 正在访问的网页源码的方法。一般方法是利用TWebBrowser 控件
中的Document对象提供的IPersistStreamInit接口来实现，具体就是：先检查WebBrowser.Document
对象是否有效，无效则退出；然后取得IPersistStreamInit接口，接着取得HTML
源码的大小，分配全局堆内存块，建立流，再将HTML文本写到流中。程序虽然不
算复杂，但是有更简单的方法，所以实现代码不再给出。其实基本上所有IE的功
能TWebBrowser 都应该有较为简单的方法来实现，获取网页源码也是一样。下面
的代码将网页源码显示在 Memo1中。

Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);

同时，在用TWebBrowser 浏览HTML文件的时候要将其保存为文本文件就很简
单了，不需要任何的语法解析工具，因为TWebBrowser 也完成了，如下：

Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterText);
--------------------------------------------------------------------------------------------------------

９、“查找”功能查找对话框可以在文档获得焦点的时候通过按键Ctrl-F来
调出，程序中则调用IOleCommandTarget 对象的成员函数Exec执行OLECMDID_FIND
操作来调用，下面给出的方法是如何在程序中用代码来做出文字选择，即你可以
自己设计查找对话框。

var
Doc: IHtmlDocument2;
TxtRange: IHtmlTxtRange;
begin
Doc :=WebBrowser1.Document as IHtmlDocument2;
Doc.SelectAll; 　　//此处为简写，选择全部文档的方法请参见第三条命令操作
　　　　　　　　　　　　　//这句话尤为重要，因为IHtmlTxtRange对象的方法能够操作的前提是
　　　　　　　　　　　　　//Document已经有一个文字选择区域。由于接着执行下面的语句，所以不会
　　　　　　　　　　　　　//看到文档全选的过程。
TxtRange :=Doc.Selection.CreateRange as IHtmlTxtRange;
TxtRange.FindText(''Text to be searched'',0.0);
TxtRange.Select;
end;

还有，从Txt.Get_text可以得到当前选中的文字内容，某些时候是有用的。

--------------------------------------------------------------------------------------------------------

１０、提取网页中所有链接这个方法来自大富翁论坛hopfield朋友的对一个
问题的回答，我本想自己试验，但总是没成功。

var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,i:integer;
item:OleVariant;
begin
doc:=WebBrowser1 .Document as IHTMLDocument2;
all:=doc.Get_links;　　　　　　　　　　　　　//doc.Links亦可
len:=all.length;
for i:=0 to len-1 do
begin
item:=all.item(i,varempty);　　　　　　　　//EmpryParam亦可
memo1.lines.add(item.href);
end;
end;
--------------------------------------------------------------------------------------------------------

１１、设置TWebBrowser 的编码为什么我总是错过很多机会？其实早就该想
到的，但是一念之差，便即天壤之别。当时我要是肯再多考虑一下，多试验一下，
这就不会排到第１１条了。下面给出一个函数，搞定，难以想象的简单。

procedure SetCharSet(AWebBrowser: TWebBrowser; ACharSet: String);
var
RefreshLevel: OleVariant;
Begin
IHTMLDocument2(AWebBrowser.Document).Set_CharSet(ACharSet);
RefreshLevel :=7;　　　　　　　　　　　　　　//这个7应该从注册表来，帮助有Bug。
AWebBrowser.Refresh2(RefreshLevel);
End;

I saw this document before. But I cannot find the answer of my question.
In the document I can only find the first text I want to find. Cannot find
others. And highlight all found texts is much more impossible.

Does anybody know how to find the secnd and others text with the method
in the document?

I am really appreciate if somebody can answer me.

I can find one by one now. the key sourcecode is as below:
//
TxtRange: IHtmlTxtRange;
TextToFind: string;
//
TextToFind := 'cat';
while TxtRange.FindText(TextToFind,1,0) do
begin
TxtRange.select;
TxtRange.moveStart('Character',1);
TxtRange.moveEnd('Textedit',1);
end;

用TEmbededWB试试
http://www.8421.org/article.php?id=178

{....}

private
procedure SearchAndHighlightText(aText: string);

{....}

procedure TForm1.SearchAndHighlightText(aText: string);
var
i: Integer;
begin
for i := 0 to WebBrowser1.OleObject.Document.All.Length - 1 do
begin
if Pos(aText, WebBrowser1.OleObject.Document.All.Item(i).InnerText) <> 0 then
begin
WebBrowser1.OleObject.Document.All.Item(i).Style.Color := '#FFFF00';
WebBrowser1.OleObject.Document.All.Item(i).ScrollIntoView(True);
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SearchAndHighlightText('some text...');
end;

initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;
编译不通过

>>

收藏

to chrisfan:
add unit-activex;

to:sephy

向TWebBrowser发送字符串的方法行不通，我试过了，没有反应。
我想通过TWebBrowser调用大富翁的登陆界面，然后通过buttonclick来自动登陆，
总达不到预想的效果。