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.