提取网页中的所有链接、点击第 n 个链接 - 回复 "刘丽" 的问题

问题来源: http://www.cnblogs.com/del/archive/2009/01/08/1370907.html#1425544

---

本例效果图:

---

代码文件:

---

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, OleCtrls, SHDocVw;



type

  TForm1 = class(TForm)

    WebBrowser1: TWebBrowser;

    ListBox1: TListBox;

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    procedure FormCreate(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



{控件初始化}

procedure TForm1.FormCreate(Sender: TObject);

begin

  WebBrowser1.Align := alTop;

  WebBrowser1.Navigate('http://del.cnblogs.com');

  ListBox1.Align := alClient;



  Button1.Caption := '提取网页所有链接地址';

  Button2.Caption := '提取网页所有链接文本';

  Button3.Caption := '模拟点击指定的链接';

end;



{提取网页所有链接地址}

procedure TForm1.Button1Click(Sender: TObject);

var

  i: Integer;

begin

  ListBox1.Clear;

  for i := 0 to WebBrowser1.OleObject.document.anchors.Length - 1 do

    ListBox1.Items.Add(WebBrowser1.OleObject.document.anchors.item(i).href);

end;



{提取网页所有链接文本}

procedure TForm1.Button2Click(Sender: TObject);

var

  i: Integer;

begin

  ListBox1.Clear;

  for i := 0 to WebBrowser1.OleObject.document.anchors.Length - 1 do

    ListBox1.Items.Add(WebBrowser1.OleObject.document.anchors.item(i).innerText);

end;



{模拟点击指定的链接}

procedure TForm1.Button3Click(Sender: TObject);

begin

//  WebBrowser1.OleObject.document.anchors.item(0).click; {假如是第一个链接}

  if ListBox1.ItemIndex <> -1 then

    WebBrowser1.OleObject.document.anchors.item(ListBox1.ItemIndex).click;



  ListBox1.Clear;

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 229

  ClientWidth = 626

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object ListBox1: TListBox

    Left = 8

    Top = 127

    Width = 185

    Height = 130

    ItemHeight = 13

    TabOrder = 4

  end

  object WebBrowser1: TWebBrowser

    Left = 8

    Top = 8

    Width = 300

    Height = 113

    TabOrder = 0

    ControlData = {

      4C000000021F0000AE0B00000000000000000000000000000000000000000000

      000000004C000000000000000000000001000000E0D057007335CF11AE690800

      2B2E126208000000000000004C0000000114020000000000C000000000000046

      8000000000000000000000000000000000000000000000000000000000000000

      00000000000000000100000000000000000000000000000000000000}

  end

  object Button1: TButton

    Left = 451

    Top = 127

    Width = 151

    Height = 25

    Caption = 'Button1'

    TabOrder = 1

    OnClick = Button1Click

  end

  object Button2: TButton

    Left = 451

    Top = 158

    Width = 151

    Height = 25

    Caption = 'Button2'

    TabOrder = 2

    OnClick = Button2Click

  end

  object Button3: TButton

    Left = 451

    Top = 189

    Width = 151

    Height = 25

    Caption = 'Button3'

    TabOrder = 3

    OnClick = Button3Click

  end

end