delphi 获取网页所有链接并访问赚取金币

    上学期看到宿舍一孩子天天上 时光网 不停点击某个图片链接然后又返回点击下一个图片链接，他说每天要点200个链接去访问别人的空间来赚取金币。天啊，看着手都酸了。

    需求：访问http://my.mtime.com/app/card/top10_tools/index.html总共有4页，每页有50个用户的链接，总共有200个链接要求全部访问。

    思路：获取页面的所有链接，提取有效的链接并访问。首先注册个账号，使用delphi 写个程序提取第一页的所有链接，发现链接有规律，对于有效的链接是夹在 http://my.mtime.com/app/card/qa/ 和 http://my.mtime.com/app/card/top10_tools/index-2.html 之间的， 同理其他3个页面也一样的，只不过末尾那个链接的index-2.html 中的2是其他值3,4,1. 这样我们获取的有效连接还是有重复的，有4个重复：

去掉重复的链接，并一个个访问。

实现代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,MSHTML, StdCtrls, OleCtrls, SHDocVw, ExtCtrls;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Memo3: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    Timer1: TTimer;
    ComboBox1: TComboBox;
    Label4: TLabel;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  n:integer=1;
  num:integer=0;
  sum:integer=0;
  m:integer=1;
  g:integer=0;
  urlstr1:string='http://my.mtime.com/app/card/top10_tools/index-1.html';
  urlstr2:string='http://my.mtime.com/app/card/top10_tools/index-2.html';
  urlstr3:string='http://my.mtime.com/app/card/top10_tools/index-3.html';
  urlstr4:string='http://my.mtime.com/app/card/top10_tools/index-4.html';

implementation

{$R *.dfm}

//抽取当前页面的所有链接到meno1，并提取有效链接到meno2
procedure TForm1.Button1Click(Sender: TObject);
var
  doc:IHTMLDocument2;
  all:IHTMLElementCollection;
  len,i,r,j,k:integer;
  item:OleVariant;
begin
  button1.Caption:='正在抽取第'+inttostr(n)+'页链接';
  button1.Enabled:=false;
  memo1.Clear;
  doc:=WebBrowser1.Document as IHTMLDocument2;
  all:=doc.Get_links;
  len:=all.length;
  sum:=sum+len;
  for i:=0 to len-1 do
  begin
    item:=all.item(i,varempty);
    memo1.lines.add(item.href);
  end;

  //找到这样的链接则停止
  for r:=1 to 100 do
  if(memo1.lines[r]='http://my.mtime.com/app/card/qa/') then
  break;

  //找到那4个链接中的一个就停止
  for j:=r to 250 do
  if(memo1.lines[j]=urlstr1) or (memo1.lines[j]=urlstr2) or (memo1.lines[j]=urlstr3) or (memo1.lines[j]=urlstr4) then
  break;

  //获取类似：http://my.mtime.com/app/card/friend/1118521/ 这样的链接 并加到meno1
  for k:=r+3 to j-1 do
  begin
    memo2.Lines.Add(memo1.Lines[k]);
    num:=num+1;
  end;

  n:=n+1;
  edit1.Clear;
  edit1.text:=inttostr(sum);
  edit2.Clear;
  edit2.text:=inttostr(num);

  if(n=5) then
  begin
    button1.Caption:='抽取完成!';
    button1.Enabled:=false;
    button2.Enabled:=true;
  end
  else
  begin
    button1.Enabled:=true;
    button1.Caption:='点击抽取第'+inttostr(n)+'页链接';
    webbrowser1.Navigate('http://my.mtime.com/app/card/top10_tools/index-'+inttostr(n)+'.html');
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //设置为true 防止出现“脚本错误”提示
  webbrowser1.Silent:=true;
  //开始时，打开第一页面
  webbrowser1.Navigate('http://my.mtime.com/app/card/top10_tools/index-1.html');
end;

//设置访问时间间隔
procedure TForm1.Button2Click(Sender: TObject);
begin
  timer1.Interval:=strtoint(combobox1.text);
  timer1.Enabled:=true;
  button2.Enabled:=false;
  button3.Enabled:=true;
end;

//
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if m>num then
  begin
    webbrowser1.Stop;
    button3.Enabled:=false;
    button3.Caption:='完成!';
  end
  else
  begin
    //过滤重复链接，并对有效链接进行访问
    webbrowser1.Navigate(memo2.Lines[m]);
    memo3.Lines.Add(memo2.Lines[m]);
    m:=m+4; //过滤重复链接
    g:=g+1;
    edit3.Text:=inttostr(g);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  timer1.Enabled:=false;
  webbrowser1.Stop;
  button3.Enabled:=false;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  form1.Close ;
end;

end.

界面:

ok，金币到手，收工。