我按照《程序员大本营2001 Borland版》第68页做的《使用Internet Explor在Web 页面中查找所有的链接》程序无法运行！(Win98+IE5.5+Delphi

Question

我按照《程序员大本营2001 Borland版》第68页做的《使用Internet Explor在Web 页面中查找所有的链接》程序无法运行！(Win98+IE5.5+Delphi5)
出现以下错误提示：
Project FindingLinks.exe raised exception class EvariantError with message ‘Invalid variant operation’. Process stopped. Use Step or Run to continue.
FINDINGLINKS 在 0167:bff95a6c 的模块
 KERNEL32.DLL 中导致无效页错误。
Registers:
EAX=9249f00c CS=0167 EIP=bff95a6c EFLGS=00010206
EBX=819c0248 SS=016f ESP=00540000 EBP=00540034
ECX=819b6f44 DS=016f ESI=81955384 FS=6d4f
EDX=0000000d ES=016f EDI=819b6f38 GS=0000
Bytes at CS:EIP:
e8 d0 e8 fd ff e8 31 48 fe ff 8b 44 24 14 8b 4c 
Stack dump:
819b6f44 81955384 00000000 bff88aa5 81955384 819c0248 00000001 005400dc 819c0248 0063ea30 00000000 00000000 00000000 005400c4 bff8820c 00000001
FINDINGLINKS 在 0167:bff881e0 的模块
 KERNEL32.DLL 中导致无效页错误。
Registers:
EAX=c00301d8 CS=0167 EIP=bff881e0 EFLGS=00010206
EBX=0063e9d8 SS=016f ESP=00540000 EBP=0054006c
ECX=00540190 DS=016f ESI=00540190 FS=73ff
EDX=00000000 ES=016f EDI=0063e198 GS=0000
Bytes at CS:EIP:
53 56 57 8b 30 83 7d 10 01 8b 4e 38 89 4d f8 75 
Stack dump:
00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000源代码：
unit MainFrm;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, SHDocVw, OleServer ;type
  TForm1 = class(TForm)
    lblURL: TLabel;
    edtURL: TEdit;
    btnFindLinks: TButton;
    lstbxLinks: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure btnFindLinksClick(Sender: TObject);
  private
    { Private declarations }
    FInternetExplorer:TInternetExplorer;
    procedure WebBrowserDocumentComplete(Sender:Tobject; var pDisp : OleVariant ;var Url :OleVariant);
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses MSHTML_TLB, ComObj;
{$R *.DFM}{ TForm1 }procedure TForm1.WebBrowserDocumentComplete(Sender: Tobject;
  var pDisp: OleVariant; var Url: OleVariant);
var
  Doc:IHTMLDocument2;
  ElementCollection:IHTMLElementCollection;
  HTMLElement:IHTMLElement;
  I:Integer;
  AnchorString:string;
begin
  lstbxLinks.Clear;
  Doc:=FInternetExplorer.Document as  IHTMLDocument2;
  If Doc = nil then
    raise  Exception.Create('Couldn''t convert the'+'FInternetExplorer.Document to an IHTMLDocument2');
    ElementCollection:=doc.all;
    for I:=0 to   ElementCollection.length-1 do
    begin
        HTMLElement:=ElementCollection.item(I,'') as IHTMLElement;
        if HTMLElement.tagName ='A' then
          begin
             AnchorString:= HTMLElement.innerText;
             if   AnchorString='' then
               AnchorString:='(Empty Name)';
             AnchorString:=AnchorString+'-'+(HTMLElement as IHTMLAnchorElement).href;
             lstbxLinks.Items.Add(AnchorString);
          end;
    end; 
end;procedure TForm1.FormCreate(Sender: TObject);
begin
        FInternetExplorer:=TInternetExplorer.Create(self);
        FInternetExplorer.OnDocumentComplete:=WebBrowserDocumentComplete;
end;procedure TForm1.btnFindLinksClick(Sender: TObject);
begin
        FInternetExplorer.Navigate(edtURL.Text , EmptyParam , EmptyParam, EmptyParam);
end;end.

Answer 1

unit MainFrm;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, SHDocVw, OleServer ;type
  TForm1 = class(TForm)
    lblURL: TLabel;
    edtURL: TEdit;
    btnFindLinks: TButton;
    lstbxLinks: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure btnFindLinksClick(Sender: TObject);
  private
    { Private declarations }
    FInternetExplorer:TInternetExplorer;
    procedure WebBrowserDocumentComplete(Sender:TObject; var pDisp : OleVariant; var URL :OleVariant);
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses MSHTML_TLB, ComObj;
{$R *.DFM}{ TForm1 }procedure TForm1.WebBrowserDocumentComplete(Sender: TObject;
  var pDisp: OleVariant; var URL: OleVariant);
var
  Doc:IHTMLDocument2;
  ElementCollection:IHTMLElementCollection;
  HtmlElement:IHTMLElement;
  I:Integer;
  AnchorString:string;
begin
  lstbxLinks.Clear;
  //在这里处理文档。太早的话工作会不正常，因为还没有完全调入
  Doc:=FInternetExplorer.Document as  IHTMLDocument2;
  If Doc = nil then
    raise  Exception.Create('Couldn''t convert the'+'FInternetExplorer.Document to an IHTMLDocument2');
    //首先，获取Web页面中的所有新元素
    ElementCollection:=Doc.all ;
    for I:=0 to ElementCollection.length -1 do
    begin
        //获得当前元素
        HtmlElement:=ElementCollection.item(I,'') as IHTMLElement;
        //接着检查是不是链接(tagName为A)。
        //你可以很容易的找到其它标签（例如TABLE，FONT等）
        if HTMLElement.tagName ='A' then
          begin
             //现在获取链接的innerText。InnerText包含标签的全部文字。
             //例如：从"Go TO Borland"中将获得"<a href=http://www.borland.com">
             //<b>Go To Borland</b></a>"。要想获得“<b>Go To Borland</b>”，可以使用innerHTML
             AnchorString:= HtmlElement.innerText ;
             if   AnchorString='' then
               AnchorString:='(Empty Name)';
               //因为tagName是'A'，所以该元素是IHTMLAnchorElement
             AnchorString:=AnchorString+'-'+(HtmlElement as IHTMLAnchorElement).href;
             lstbxLinks.Items.Add(AnchorString);
          end;
    end; 
end;procedure TForm1.FormCreate(Sender: TObject);
begin
        FInternetExplorer:=TInternetExplorer.Create(self);
        FInternetExplorer.OnDocumentComplete:=WebBrowserDocumentComplete;
end;procedure TForm1.btnFindLinksClick(Sender: TObject);
begin
        FInternetExplorer.Navigate(edtURL.Text , EmptyParam , EmptyParam, EmptyParam, EmptyParam);
end;end.

Answer 2

Win2000 + IE5.0 + Delphi5
也关注我类似的问题：
http://www.csdn.net/Expert/TopicView1.asp?id=1031372

Answer 3

//原来用TWebBrowser,IHTMLDocument2接口。Delphi5 企业版编译通过！
//发布正确答案了：
//----------------------------
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, OleCtrls, SHDocVw;type
  TForm1 = class(TForm)
    wb1: TWebBrowser;
    Panel1: TPanel;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure wb1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
implementationuses MSHTML;{$R *.DFM}procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if (Edit1.Text <> '') and (Key = #13) then
    wb1.Navigate(Edit1.Text);
end;procedure TForm1.wb1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  Doc:IHTMLDocument2;
  ElementCollection:IHTMLElementCollection;
  HTMLElement:IHTMLElement;
  I:Integer;
  AnchorString:string;
begin
  Memo1.Clear;
  Doc:=wb1.Document as  IHTMLDocument2;
  If Doc = nil then
    raise  Exception.Create('不能转化为 IHTMLDocument2');
    ElementCollection:=doc.all;
    for I:=0 to  ElementCollection.length-1 do
    begin
        HTMLElement:=ElementCollection.item(I,'') as IHTMLElement;
        if HTMLElement.tagName ='A' then
          begin
             {AnchorString:= HTMLElement.innerText;
             if   AnchorString='' then
               AnchorString:='(Empty Name)';
             AnchorString:=AnchorString+'-'+(HTMLElement as IHTMLAnchorElement).href;
             Memo1.Lines.Add(AnchorString);}
             Memo1.Lines.Add((HTMLElement as IHTMLAnchorElement).href);
          end;
    end; 
end;end.