相关资料：
占时想不起来了，有时间我补上吧。
程序下载：
http://download.csdn.net/detail/zhujianqiangqq/9666390
实例代码：
1 unit Unit1;
2
3 interface
4
5 uses
6 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.OleCtrls, SHDocVw,
8 Vcl.StdCtrls, MSHTML;
9
10 type
11 TForm1 = class(TForm)
12 Panel1: TPanel;
13 WebBrowser1: TWebBrowser;
14 Splitter1: TSplitter;
15 Button1: TButton;
16 Button2: TButton;
17 Button3: TButton;
18 Button4: TButton;
19 Button5: TButton;
20 Edit1: TEdit;
21 Memo1: TMemo;
22 Edit2: TEdit;
23 WebBrowser2: TWebBrowser;
24 Splitter2: TSplitter;
25 Label1: TLabel;
26 ABV: TPanel;
27 procedure Button1Click(Sender: TObject);
28 procedure WebBrowser1DocumentComplete(ASender: TObject;
29 const pDisp: IDispatch; const URL: OleVariant);
30 procedure Button2Click(Sender: TObject);
31 procedure Button3Click(Sender: TObject);
32 procedure Button4Click(Sender: TObject);
33 procedure Button5Click(Sender: TObject);
34 procedure WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
35 var Cancel: WordBool);
36 procedure WebBrowser2BeforeNavigate2(ASender: TObject;
37 const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
38 Headers: OleVariant; var Cancel: WordBool);
39 private
40 { Private declarations }
41 public
42 { Public declarations }
43 end;
44
45 var
46 Form1: TForm1;
47
48 implementation
49
50 {$R *.dfm}
51
52 procedure TForm1.Button1Click(Sender: TObject);
53 begin
54 WebBrowser1.Navigate(Edit1.Text);
55 end;
56
57 procedure TForm1.Button2Click(Sender: TObject);
58 var
59 aintf: IWebBrowser;
60 begin
61 aintf := WebBrowser1.Application as IWebBrowser;
62 ShowMessage(aintf.LocationURL);
63 end;
64
65 procedure TForm1.Button3Click(Sender: TObject);
66 var
67 aintf: IHTMLDocument2; //MSHTML
68 begin
69 aintf := WebBrowser1.Document as IHTMLDocument2;
70 ShowMessage(aintf.url);
71 end;
72
73 procedure TForm1.Button4Click(Sender: TObject);
74 begin
75 ShowMessage(WebBrowser1.LocationURL);
76 end;
77
78 procedure TForm1.Button5Click(Sender: TObject);
79 begin
80 if Pos(Edit2.Text, WebBrowser1.OleObject.document.body.innerHTML) > 0 then
81 begin
82 ShowMessage('包含');
83 end;
84 end;
85
86 procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
87 const pDisp: IDispatch; const URL: OleVariant);
88 begin
89 Memo1.Lines.Add('OK');
90 if webbrowser1.Application = pDisp then
91 Memo1.Lines.Add(URL);
92 end;
93
94 procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
95 var Cancel: WordBool);
96 var
97 str: string;
98 begin
99 //禁止弹页面
100 Cancel:= true;
101 try
102 str:= WebBrowser1.oleObject.document.ActiveElement.GetAttribute('href');
103 if str <> '' then
104 begin
105 try
106 WebBrowser1.Navigate(str);
107 except
108 showmessage('暂时无法打开此站点!');
109 end;
110 end;
111 except
112 end;
113 // PpDisp := WebBrowser2.Application; // 新的窗口先指向WebBrowser2
114 end;
115
116 procedure TForm1.WebBrowser2BeforeNavigate2(ASender: TObject;
117 const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
118 Headers: OleVariant; var Cancel: WordBool);
119 var
120 Str: string;
121 begin
122 Str := string(URL);
123 WebBrowser1.Navigate(Str); // 再指回WebBrowser1
124 Cancel := True;
125 end;
126
127
128 end.