获取一个页面上的所有链接代码执行问题

Question

在网上找到一段代码用来获取一个页面上的所有链接,代码如下,问题是WebBrowser1DocumentComplete这个事件会不停的执行,你可以把edit1的TEXT属性设为www.hexun.com后,这个事件就会不停,执行,应该如何解决?
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, MSHTML_TLB;type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    WebBrowser1: TWebBrowser;
    ListBox1: TListBox;
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,i:integer;
item:OleVariant;
begin
  if not webbrowser1.busy then
  begin
     doc:=webbrowser1.Document as IHTMLDocument2;
     all:=doc.Get_Links;
     len:=all.length;
     ListBox1.Clear;
    for i:=0 to len-1 do
      begin
        item:=all.item(i,varempty);
        listbox1.Items.Add(item);
        button1.Caption:='获取所有链接'+'('+IntToStr(listbox1.Items.Count-1)+')';
      end;
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Navigate(Edit1.Text);
end;end.

Answer 1

这是里面有Frame，所以有多次的DocumentComplete可以加个判断procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; 
  const pDisp: IDispatch; var URL: OleVariant); 
var 
doc:IHTMLDocument2; 
all:IHTMLElementCollection; 
len,i:integer; 
item:OleVariant; 
sUrl: WideString;
begin 
  sUrl:=URL;
  if Lowercase(sUrl)<>'http://www.hexun.com' then Exit; //自己调整一下后面的那个值
  if not webbrowser1.busy then 
  begin 
    doc:=webbrowser1.Document as IHTMLDocument2; 
    all:=doc.Get_Links; 
    len:=all.length; 
    ListBox1.Clear; 
    for i:=0 to len-1 do 
      begin 
        item:=all.item(i,varempty); 
        listbox1.Items.Add(item); 
        button1.Caption:='获取所有链接'+'('+IntToStr(listbox1.Items.Count-1)+')'; 
      end; 
  end; 
end; 

Answer 2

谢谢这位仁兄，照你的方法，是可以让它不出现不停的获取情况。
我想在加个进度条，来显示WebBrowser1DocumentComplete的进度，不知道应该怎么写代码？但是我想不通，页面里有iframe总的有数吧，为什么不加那句代码，它就一直不停的获取呢？可是我等待的时间不够吧，这个无所谓，反正已经解决我的问题。

Answer 3

---- OnProgressChange = procedure(Sender: TObject; Progress, ProgressMax: Integer) of object; ---- 在打开页面的进度变化时发生，参数Progress为当前进度，ProgressMax为总进度，我们可以根据这两个参数来更新我们自己的状态栏提示信息或处理其它的事务． 

Answer 4

楼主可以考试使用idhttp，这样可以获得页面的html代码，保存到文本文件中，通过正则表达式来分析页面中的url