Delphi 中WebBrowser控件详解实例

Delphi 中WebBrowser控件详解实例 转

2008-05-07 12:07

        很久都没有原创了，前几天帮朋友做了个网址发布程序，主要应用到了WebBrowser控件。

今天主要给大家演示一下过程，让大家学习一下Delphi工具。

WebBrowser功能：

1。自动加载网页

2。去除WebBrowser滚动条

3。WebBrowser自身打开页面

4。禁止右键

 

1。首先，新建一个FROM窗体：

 

 

2。加入一个WEBBROWSER控件

 

 

 

3。调整后如下：

 

4.这样一个webbrowser就完成了，下一步我们来让程序打开后自动加载一个网页。

核心代码：WebBrowser1.Navigate('http://v.28.la');

双击窗体灰色处，对窗体进行初始化，在代码窗口中输入（Begin 与 End间输入核心代码）：

procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://v.28.la');   //窗体初始化完成WEBBROWSER加载一个网页
end;

5。下面我们来实现禁止WEBBROWSER控件的滚动条功能：

核心代码：WebBrowser1.oleobject.Document.body.Scroll:= ‘no’;

    利用这个代码去掉滚动条的前提是webbrowser中必须有打开的网页，也就是在网页加载完

完毕后再去掉滚动条。所以首先要判断页面是否加载完毕，如果加载完毕，就执行上面的语句

去掉滚动条。这时就要引入一个按扭控件来触发程序

加入SPEEDBUTTEN

 

 

 

调整形后：

 

 

好了，现在可以实现禁止滚动条的功能了：

第一步：在WebBrowser1DocumentComplete事件中置一个标志tag:=1(代表加载完毕)

单击WEBBROWSER控件，在WebBrowser属性

的EVENS事件中找到WebBrowser1DocumentComplete    （双击）

 

 

然后在代码窗口中输入：

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
tag:=1; //去掉Webbrowser1滚动条的标志
end;

对SpeedButten控件操作：（双击onClick)

 

 

加入如下代码：

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
Doc: IHTMLDocument2;
begin
tag := 0; //去掉Webbrowser1滚动条的标志
WebBrowser1.Navigate2(’http://www.baidu.com’);
while(tag=0) do Application.ProcessMessages;
WebBrowser1.oleobject.Document.body.Scroll := ‘no’;
end;

注意：使用前必须在uses中加入mshtml;

这样WebBrowser就禁止了滚动条。主要应用到了IHTMLDocument2。

6。

让Webbrowser中的链接点击时在自身窗口打开：（单击WebBrowser控件，属性中的

EVENS事件，双击NewWindow2）

 

 

 

 

 

代码窗口中输入：

procedure TForm1.WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
begin
   // 將新視窗在自身開啟
        ppdisp := webBrowser1.Application;
end;

7。最后是禁用WebBrowser中的右键功能，放一个ApplicationEvents控件：

 

ApplicationEvents控件属性Evens事件中双击Onmessage：

 

在代码窗口中输入：

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if (Msg.message = wm_rbuttondown) or (Msg.message = wm_rbuttonup) or
    (msg.message = WM_RBUTTONDBLCLK)   then
begin
    if IsChild(Webbrowser1.Handle, Msg.hwnd) then
      Handled := true;
end;
end;

到此完成对程序的制作，调试

去滚动条后：

 

 

 

 

 

 

 

 

 

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

===================================

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw,mshtml, AppEvnts;

type
TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    ApplicationEvents1: TApplicationEvents;
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Button1Click(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
tag:=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
a: IHTMLDocument2;

begin
tag := 0;
WebBrowser1.Navigate('http://www.baidu.com');
while(tag=0) do Application.ProcessMessages;
WebBrowser1.oleobject.Document.body.Scroll := 'no';
a :=WebBrowser1.Document as IHTMLDocument2;
a.Get_ParentWindow.ScrollBy(0,20);
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if (Msg.message = wm_rbuttondown) or (Msg.message = wm_rbuttonup) or
    (msg.message = WM_RBUTTONDBLCLK)   then
begin
    if IsChild(Webbrowser1.Handle, Msg.hwnd) then
      Handled := true;
end;
end;

end.

=================================================================================

delphi 对网页自动操作

uses mshtml,IdHTTP;

procedure TFrmmain.Act_BeginWrite;
var
myitem:Olevariant;
i:integer;
tmp:string;
TemName:String;
TemIniFile:TIniFile;
begin

Try
myitem := WebBrowser1.Document;

for i := 0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
begin
if Uppercase(myitem.all.item(i).type)='TEXT' then //文本框
begin

TemName:=Act_GetName+RANDOMStr(1);

if Uppercase(myitem.all.item(i).name)='USERNAME' then
begin
myitem.all.item(i).focus;
myitem.all.item(i).value:=TemName;
TemIniFile:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'name.ini');
TemIniFile.WriteString(FormatDateTime('YYYY-MM-DD HH:mm:ss',now),'Name',TemName);
TemIniFile.Free;
end;
end;
end;
end;


keybd_event(VK_SPACE,MapVirtualKey(VK_SPACE,0),0,0);

keybd_event(VK_SPACE,MapVirtualKey(VK_SPACE,0),KEYEVENTF_KEYUP,0);

keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);

keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);


for i := 0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
begin
IF Uppercase(myitem.all.item(i).type)='RADIO' then //选择一个
begin
If Uppercase(myitem.all.item(i).name)='RADIOBUTTON' then
begin
myitem.all.item(i).checked :=true;

if FYX_GetRanDom(1)= 1 then
break;
end;
end;
end;
end;


for i := 0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'SELECT' then
begin
if Uppercase(myitem.all.item(i).id)='DRPPID' then //文本框
begin
if Uppercase(myitem.all.item(i).name)='DRPPID' then
begin
if myitem.all.item(i).tagName = 'OPTION' then
myitem.all.item(i).selected:='SELECTED';
end;
end;
end;
end;

sleep(1000);

for i:= 0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
begin
if Uppercase(myitem.all.item(i).type)='TEXT' then //文本框
begin

If Uppercase(myitem.all.item(i).name)='USERNICK' then
begin

myitem.all.item(i).value:=Act_GetName;

end;
end;
end;
end;


for i:=0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
begin
if Uppercase(myitem.all.item(i).type)='TEXT' then //文本框
begin
If Uppercase(myitem.all.item(i).name)='TXTCHECKNUM' then
myitem.all.item(i).value:=FYX_GetCodeID;
end;
end;
end;

for i:=0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
begin
IF Uppercase(myitem.all.item(i).type)='PASSWORD' then //文本框
begin
If Uppercase(myitem.all.item(i).name)='PASSWORD1' then
myitem.all.item(i).value:=1234567;

end;
end;
end;


for i := 0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
begin
IF Uppercase(myitem.all.item(i).type)='PASSWORD' then //文本框
begin

If Uppercase(myitem.all.item(i).name)='PASSWORD_CNF' then
myitem.all.item(i).value:=1234567;
end;
end;
end;


((WebBrowser1.Document as IHTMLDocument2).all.item('selYear', 0) as
IHTMLSelectElement).selectedIndex := FYX_GetRanDomYear(35);

((WebBrowser1.Document as IHTMLDocument2).all.item('selMonth', 0) as
IHTMLSelectElement).selectedIndex := FYX_GetRanDom(13);

((WebBrowser1.Document as IHTMLDocument2).all.item('selDay', 0) as
IHTMLSelectElement).selectedIndex := FYX_GetRanDom(30);

((WebBrowser1.Document as IHTMLDocument2).all.item('drpPid', 0) as
IHTMLSelectElement).selectedIndex := FYX_GetRanDom(30);


tmp := 'GetCity(''drpPid'',''drpCity'')';
WebBrowser1.OleObject.Document.parentWindow.execScript(tmp,'JavaScript');

((WebBrowser1.Document as IHTMLDocument2).all.item('drpCity', 0) as
IHTMLSelectElement).selectedIndex := FYX_GetRanDom(5)-1;


for i := 0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
begin
if Uppercase(myitem.all.item(i).type)='CHECKBOX' then //Checkbox
begin
If Uppercase(myitem.all.item(i).name)='CHKAGREEMENT' then
myitem.all.item(i).checked :=true;
end;
end;
end;

//showmessage('OK');

for i := 0 to myitem.all.length - 1 do
begin
if myitem.all.item(i).tagName = 'INPUT' then
begin
if Uppercase(myitem.all.item(i).type)='SUBMIT' then //找按钮点击
begin
myitem.all.item(i).click;
end;
end;
end; //Tagname = Input

Except
end;


TemNum:=TemNum-1;
EdNum.Text:=IntToStr(TemNum);

SumNum:=SumNum+1;



if TemNum <= 0 then
Close;

Timer4.Enabled:=True;
end;

 

 

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

//获取源码

function   WB_GetHTMLCode(WebBrowser:   TWebBrowser;   ACode:   TStrings):   Boolean;  
var  
      ps:   IPersistStreamInit;
      ss:   TStringStream;  
      sa:   IStream;
      s:   string;  
begin
      ps   :=   WebBrowser.Document   as   IPersistStreamInit;  
      s   :=   '';
      ss   :=   TStringStream.Create(s);  
      try
          sa   :=   TStreamAdapter.Create(ss,   soReference)   as   IStream;  
          Result   :=   Succeeded(ps.Save(sa,   True));
          if   Result   then   ACode.Add(ss.Datastring);  
      finally
          ss.Free;
      end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines.Clear;
   WB_GetHTMLCode(Webbrowser1,   Memo1.Lines);
end;