WebBrowser

获取Html源码
uses mshtml;
var
    iall : IHTMLElement;
begin
   if Assigned(WebBrowser1.Document) then
   begin
     iall := (WebBrowser1.Document AS IHTMLDocument2).body;
     while iall.parentElement <> nil do
     begin
       iall := iall.parentElement;
     end;
     memo1.Text := iall.outerHTML;
   end;
end;
模拟登录网站
procedure TForm1.Button2Click(Sender: TObject);
Var
  input: OleVariant;
  Doc: IHTMLDocument2;
  UserEdt, UserPwd: IHTMLElement;
  i: Integer;
begin
  Doc := WebBrowser1.Document as IHTMLDocument2;
  input := Doc.all.item('switch_login', 0);     //模拟点击按钮
  input.click;
  UserEdt := Doc.all.item('u', 0) as IHTMLElement;
  UserPwd := Doc.all.item('p', 0) as IHTMLElement;
  UserEdt.setAttribute('Value', Edit1.Text, 0);
  UserPwd.setAttribute('Value', Edit2.Text, 0);
  input := Doc.all.item('login_button', 0);
  input.click;
end;

((WebBrowser1.Document as IHTMLDocument2).body as HTMLBody).scroll := 'no';  
(WebBrowser1.Document as IHTMLDocument2).body.style.border := '0';  
(WebBrowser1.Document as IHTMLDocument2).body.style.borderStyle := 'none';  
(WebBrowser1.Document as IHTMLDocument2).body.style.margin := '0';  
(WebBrowser1.Document as IHTMLDocument2).body.style.padding := '0';  
(WebBrowser1.Document as IHTMLDocument2).body.style.overflow := 'hidden';  
//DocumentComplete事件中加入下列代码即可
//去掉滚动条只对某些网页起作用,比如百度的页面就不知道为什么去不掉。
//下面是用Webbrowser显示图片时去掉边框和滚动条的方法,也适用于部分网页,实际上就是设置网页CSS。
WebBrowser1.Navigate('javascript:document.getElementById("Test").click();');
//Delphi调用WebBrowser中JavaScript代码的方法
procedure TForm1.Button1Click(Sender: TObject);
Var
  I, Cnt: integer;
begin
  Cnt := WebBrowser1.OleObject.Document.GetElementsByTagName('A').Length;
  for I := 0 to Cnt - 1 do
  Begin
    If WebBrowser1.OleObject.Document.GetElementsByTagName('A').Item(I)
      .InnerHtml = '活跃度' Then
    Begin
      WebBrowser1.OleObject.Document.GetElementsByTagName('A').item(5).Click;
   // memo1.Lines.Add(WebBrowser1.OleObject.document.getElementsByTagName('A').item(i).innerHTML);
    End;
  End;
End;
//遍历A元素,通过得到文字后进行模拟点击
WebBrowser1.GoHome;  //到浏览器默认主页
WebBrowser1.Refresh;  //刷新
WebBrowser1.GoBack;  //后退
WebBrowser1.GoForward;  //前进
WebBrowser1.Navigate('...');  //打开指定页面
WebBrowser1.Navigate('about:blank');  //打开空页面
procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Navigate(
    'about:<head><title>标题</title><body bgcolor=#ff0000>' +
    '<form method="POST" action="http://del.cnblogs.com">' +
    '<input type="submit" value="提交" id="btnID" name="btnName">' +
    '</form></body>');
  Button2.Enabled := True;
  Button3.Enabled := True;
  Button4.Enabled := True;
end;

{假如知道按钮名称, 譬如是: btnName}
procedure TForm1.Button2Click(Sender: TObject);
begin
  WebBrowser1.OleObject.document.all.item('btnName').click;
  //WebBrowser1.OleObject.document.all.item('btnName', 0).click;
  FormCreate(nil);
end;

{假如知道按钮的 ID, 譬如是: btnID}
procedure TForm1.Button3Click(Sender: TObject);
begin
  WebBrowser1.OleObject.document.getElementByID('btnID').click;
  FormCreate(nil);
end;

{假如只知道是第几个按钮, 譬如是第一个}
procedure TForm1.Button4Click(Sender: TObject);
begin
  WebBrowser1.OleObject.document.getElementsByTagName('input').item(0).click;
  FormCreate(nil);
end;

end.
//获取网页源代码
var
  s: string;
begin
  s := WebBrowser1.OleObject.document.body.innerHTML; //body内的所有代码
  s := WebBrowser1.OleObject.document.body.outerHTML; //body内的所有代码, 包含body标签
  s := WebBrowser1.OleObject.document.documentElement.innerHTML; //html内的所有代码
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  WebBrowser1.Navigate('www.baidu.com');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Key: string;
  doc, sr: OleVariant;
begin
  if WebBrowser1.Busy = True then
  Begin
    Exit;
  End;
  Key := 'gfuchao'; // 待查找的字符串,你自己定义吧
  doc := WebBrowser1.Document;
  if VarIsEmpty(doc) then
    Exit;
  if VarIsEmpty(doc.selection) then
    sr := doc.body.createTextRange
  else
  begin
    sr := doc.selection.createRange;
    sr.collapse(True);
    sr.moveStart('character', 1);
  end;
  if sr.findText(Key, 1, 0) then
    sr.select // findText为True就表示含有关键字,你自己处理吧
  else
    ShowMessage('已收缩到文档末尾!');
  sr := Unassigned;
end;







 


 

WebbrowserEx模仿IE实例源码 Private WithEvents mobjWebDoc As MSHTML.HTMLDocument Private WithEvents MouseEvent As CMouseHook Private WithEvents KeyboardEvent As CKeyboardHook Private WithEvents frmTopParent As VB.Form Private m_Documents As Collection 'HTML Documents collection Private m_Frames As Collection 'HTML Frames collection '------------------------------------------------------------------------------- ' Webbrowser naviagtion events '------------------------------------------------------------------------------- ' Event IntializeBeforeGoHome(Cancel As Boolean) Event StatusTextChange(ByVal Text As String) Event TitleChange(ByVal Text As String) Event NewDocumentStart(ByVal WebDoc As HTMLDocument, ByVal URL As String, ByVal IsTargetedToFrame As Boolean, ByVal TargetFrameName As String, Cancel As Boolean) Event NewDocumentComplete(ByVal WebDoc As HTMLDocument, ByVal URL As String, ByVal IsTargetedToFrame As Boolean, ByVal TargetFrameName As String) Event BeforeNavigate2(ByVal WebDoc As HTMLDocument, ByVal URL As String, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean) Event NavigateComplete2(ByVal WebDoc As HTMLDocument, ByVal URL As String) Event DocumentComplete(ByVal WebDoc As HTMLDocument, ByVal URL As String) Event BeforeNewWindow2(ByVal URL As String, NewBrowser As Object, Cancel As Boolean) '------------------------------------------------------------------------------- ' User control-wide mouse events '------------------------------------------------------------------------------- ' Event UserControlMouseUp(ByVal Control As Object, ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event UserControlMouseMove(ByVal Control As Object, ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event UserControlMouseDown(ByVal Control As Object, ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) '------------------------------------------------------------------------------- ' WebBrowser mouse events '------------------------------------------------------------------------------- ' Event WebBrowserDblClick(Cancel As Boolean) Event WebBrowserMouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event WebBrowserMouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event WebBrowserMouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event WebBrowserMouseDownContextMenu(ByVal IsMouseOnLink As Boolean, ByVal URL As String, ByVal SelText As String, Cancel As Boolean) Event WebBrowserMouseUpContextMenu(ByVal IsMouseOnLink As Boolean, ByVal URL As String, ByVal SelText As String, Cancel As Boolean) '------------------------------------------------------------------------------- ' WebBrowser keyboard events '------------------------------------------------------------------------------- ' Event WebBrowserKeyDown(KeyCode As Integer, Shift As Integer) Event WebBrowserKeyUp(KeyCode As Integer, Shift As Integer) '------------------------------------------------------------------------------- ' Go button keyboard events '------------------------------------------------------------------------------- ' Event GoButtonKeyDown(KeyCode As Integer, Shift As Integer) Event GoButtonKeyUp(KeyCode As Integer, Shift As Integer) '------------------------------------------------------------------------------- ' Address bar keyboard events (combo box) '------------------------------------------------------------------------------- ' Event AddressBarContextMenu(Cancel As Boolean) Event AddressBarKeyDown(KeyCode As Integer, Shift As Integer) Event AddressBarKeyUp(KeyCode As Integer, Shift As Integer) '------------------------------------------------------------------------------- ' Statusbar keyboard events '------------------------------------------------------------------------------- ' Event StatusBarKeyDown(KeyCode As Integer, Shift As Integer) Event StatusBarKeyUp(KeyCode As Integer, Shift As Integer) '------------------------------------------------------------------------------- ' Statusbar mouse events '------------------------------------------------------------------------------- ' Event StatusBarPanelClick(Panel As MSComctlLib.Panel) Event StatusBarPanelDblClick(Panel As MSComctlLib.Panel) Event StatusBarMouseMove(Panel As MSComctlLib.Panel, Button As Integer, Shift As Integer, X As Single, Y As Single) Event StatusBarMouseDown(Panel As MSComctlLib.Panel, Button As Integer, Shift As Integer, X As Single, Y As Single) Event StatusBarMouseUp(Panel As MSComctlLib.Panel, Button As Integer, Shift As Integer, X As Single, Y As Single) Private mstrStatusText As String 'Webrrowser status text Private mlngWBHwnd As Long 'Webbrowser handle Private mHwndComboEdit As Long 'Combo edit box handle Private mobjTopParent As VB.Form 'Reference to Top parent form Private mbRunMode As Boolean 'Run/Develope mode detection variable Private newX As Single 'Variables that contained the converted x, y coordinates Private newY As Single Private mhwndTopParent As Long 'Top parent form handle Private mstrClickedLinkURL As String 'Click-on url Private mstrNavigate2URL As String 'Navigation start url Private mstrNavigatedURL As String 'Navigated url Private mstrTargetFrameName As String 'Naviation target frame Const m_def_PopupWindowAllowed = True Const m_def_OpenHomePageAtStart = True Const m_def_AddressBarVisible = True Const m_def_StatusBarVisible = True Const m_def_MouseEventEnabled = True Const m_def_KeyboardEventEnabled = True Private m_AddressBarVisible As Boolean Private m_PopupWindowAllowed As Boolean Private m_OpenHomePageAtStart As Boolean Private m_StatusBarVisible As Boolean Private m_MouseEventEnabled As Boolean Private m_KeyboardEventEnabled As Boolean '------------------------------------------------------------------------------- ' TopParent '------------------------------------------------------------------------------- ' Get the top parent form of the user control Public Property Get TopParent() As Object On Error Resume Next If mobjTopParent Is Nothing Then Dim objParent As Object Set objParent = UserControl.Parent Do While Not TypeOf objParent Is VB.Form Set objParent = objParent.Parent Loop Set mobjTopParent = objParent Set objParent = Nothing End If Set TopParent = mobjTopParent End Property
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值