IE,Twebbrowser,如何能得到当前光标处的超链地址？(100分)

[blue]
// --------------------------------------------------------------- 
// 在WebBrowser中得到当前鼠标下图片和对象的链接                    
// Get the element's url under the mouse pointer in WebBrowser     
// Copyright (c) 2002 Powered by Manfeel                           
// Manfeel保留版权，转载请保留作者信息！                           
//                                            [red]Mingtao@sina.com[/red]
// --------------------------------------------------------------- 
[/blue]
unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, SHDocVw_TLB, MSHTML_TLB, ActiveX, ComObj, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
    PanelTop: TPanel;
    Edit1: TEdit;
    procedure FormActivate(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TEventSink = class(TObject, IUnknown, IDispatch)
  private
    FRefCount:Longint;
    FControl:TControl;
  protected
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IDispatch }
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
    property Control:TControl read FControl;      
  public
    constructor Create(Control: TControl);
  end;

const
  IID_IConnectionPointContainer: TGUID = '{B196B284-BAB4-101A-B69C-00AA00341D07}';
  DISPID_HTMLElement_ONMouseOver  = -2147418104 ;  
var
  Form1: TForm1;
  CPC:IConnectionPointContainer;
  CP:IConnectionPoint;
  Cookie:Integer;
  EventSink:TEventSink;
implementation

{$R *.DFM}
constructor TEventSink.Create(Control: TControl);
begin
  FControl := Control;
end;

function TEventSink.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

function TEventSink._AddRef: Integer;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TEventSink._Release: Integer;
begin
  Dec(FRefCount);
  Result := FRefCount;
end;

{ TEventSink.IDispatch }

function TEventSink.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Count := 0;
  Result := S_OK;
end;

function TEventSink.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Pointer(TypeInfo) := nil;
  Result := E_NOTIMPL;
end;

function TEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;


function TEventSink.Invoke(DispID: integer; const IID: TGUID; LocaleID: Integer;
    Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
  WB:IHTMLDocument2;
  Anchor:IHTMLElement;
begin
  if (DispID = DISPID_HTMLElement_ONMouseOver) then
  begin
    WB:=(FControl as TForm1).WebBrowser1.Document as IHTMLDocument2;
    Anchor:=WB.parentWindow.event.srcElement;
    if (Anchor.tagName='A') then
    begin
      (Fcontrol as TForm1).Memo1.lines.Add((Anchor as IHTMLAnchorElement).href);
    end;
    if (Anchor.parentElement.tagName='A') then
    begin
      (Fcontrol as TForm1).Memo1.lines.Add((Anchor.parentElement as IHTMLAnchorElement).href);
    end;
  end;
  Result := S_OK;
end;


procedure TForm1.FormActivate(Sender: TObject);
begin
  WebBrowser1.Navigate('about:blank');
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  Doc:IHTMLDocument2;
begin
  Doc:=WebBrowser1.Document as IHTMLDocument2;
  OleCheck(Doc.QueryInterface(IID_IConnectionPointContainer, CPC));
  OleCheck(CPC.FindConnectionPoint(DIID_HTMLDocumentEvents2,CP));
  EventSink:= TEventSink.Create(Self);
  OleCheck(CP.Advise(IUnKnown(EventSink),Cookie));
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then WeBbrowser1.Navigate(Edit1.text);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Align := alClient;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CP.Unadvise(Cookie);
end;

end.