WebBrowser的各种使用方法(未完待续)(XE8+WIN7)

相关资料：

占时想不起来了，有时间我补上吧。

程序下载：

http://download.csdn.net/detail/zhujianqiangqq/9666390

实例代码：

 unit Unit1;

 interface

 uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.OleCtrls, SHDocVw,
   Vcl.StdCtrls, MSHTML;

 type
   TForm1 = class(TForm)
     Panel1: TPanel;
     WebBrowser1: TWebBrowser;
     Splitter1: TSplitter;
     Button1: TButton;
     Button2: TButton;
     Button3: TButton;
     Button4: TButton;
     Button5: TButton;
     Edit1: TEdit;
     Memo1: TMemo;
     Edit2: TEdit;
     WebBrowser2: TWebBrowser;
     Splitter2: TSplitter;
     Label1: TLabel;
     ABV: TPanel;
     procedure Button1Click(Sender: TObject);
     procedure WebBrowser1DocumentComplete(ASender: TObject;
       const pDisp: IDispatch; const URL: OleVariant);
     procedure Button2Click(Sender: TObject);
     procedure Button3Click(Sender: TObject);
     procedure Button4Click(Sender: TObject);
     procedure Button5Click(Sender: TObject);
     procedure WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
       var Cancel: WordBool);
     procedure WebBrowser2BeforeNavigate2(ASender: TObject;
       const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
       Headers: OleVariant; var Cancel: WordBool);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

 var
   Form1: TForm1;

 implementation

 {$R *.dfm}

 procedure TForm1.Button1Click(Sender: TObject);
 begin
   WebBrowser1.Navigate(Edit1.Text);
 end;

 procedure TForm1.Button2Click(Sender: TObject);
 var
   aintf: IWebBrowser;
 begin
   aintf := WebBrowser1.Application as IWebBrowser;
   ShowMessage(aintf.LocationURL);
 end;

 procedure TForm1.Button3Click(Sender: TObject);
 var
   aintf: IHTMLDocument2; //MSHTML
 begin
   aintf := WebBrowser1.Document as IHTMLDocument2;
   ShowMessage(aintf.url);
 end;

 procedure TForm1.Button4Click(Sender: TObject);
 begin
   ShowMessage(WebBrowser1.LocationURL);
 end;

 procedure TForm1.Button5Click(Sender: TObject);
 begin
   if Pos(Edit2.Text, WebBrowser1.OleObject.document.body.innerHTML) >  then
   begin
     ShowMessage('包含');
   end;
 end;

 procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
   const pDisp: IDispatch; const URL: OleVariant);
 begin
   Memo1.Lines.Add('OK');
   if webbrowser1.Application = pDisp then
     Memo1.Lines.Add(URL);
 end;

 procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
   var Cancel: WordBool);
 var
   str: string;
 begin
   //禁止弹页面
   Cancel:= true;
   try
     str:= WebBrowser1.oleObject.document.ActiveElement.GetAttribute('href');
     if str <> '' then
     begin
       try
         WebBrowser1.Navigate(str);
       except
         showmessage('暂时无法打开此站点!');
       end;
     end;
   except
   end;
 //  PpDisp := WebBrowser2.Application; // 新的窗口先指向WebBrowser2
 end;

 procedure TForm1.WebBrowser2BeforeNavigate2(ASender: TObject;
   const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
   Headers: OleVariant; var Cancel: WordBool);
 var
   Str: string;
 begin
   Str := string(URL);
   WebBrowser1.Navigate(Str); // 再指回WebBrowser1
   Cancel := True;
 end;

 end.