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

最新推荐文章于 2025-02-06 09:53:20 发布

weixin_33881041

最新推荐文章于 2025-02-06 09:53:20 发布

阅读量890

点赞数

本文介绍了一个使用Delphi中WebBrowser控件的示例程序，演示了如何通过该控件加载网页并进行基本操作，包括导航到指定网址、获取当前页面URL及检查页面内容等。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

相关资料：

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

程序下载：

http://download.youkuaiyun.com/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.