如何在得到ie中当前鼠标下图片和对象的src url? (300分)

  • 主题发起人 主题发起人 g622
  • 开始时间 开始时间
G

g622

Unregistered / Unconfirmed
GUEST, unregistred user!
ie是当前窗口的情况下
很急,另有1000分酬谢
 
不好办!在Delphi中还没有想到办法!
MSDN中有VB的例子,用WithEvents声明一个对象就行了
简单得让人难以想象,可我和大家一样,都不喜欢用vb,微软真是TMD坏透了!
 
黑干两天两夜,终于被我编出来了!
代码:
[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, MSHTML, 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.
 
在2000下代码没有反映
 
我在Window98和Windows XP下都试过了,全部都可以运行。
你把问题说清楚一点
 
我是在win2000下,没有看到结果,webbrowser里移动鼠标到一个图片没有效果。
 
不好意思,是有问题,我把你的问题理解错了[:(],不过还好,知错能改,善莫大焉[:)]
马上对invoke程序作如下修改:
代码:
function TMyEventSink.Invoke(DispID: integer; const IID: TGUID; LocaleID: Integer;
    Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
  obj:Variant;
begin
  if (DispID = DISPID_HTMLElement_ONMouseOver) then
  begin
    obj:=(Control as TForm1).WebBrowser1.Document;
    obj:=obj.parentWindow.event.srcElement;
[red]//加入自己需要的tagName吧[/red]
    if  (obj.tagName='IMG') or
        (obj.tagName='APPLET') or
        (obj.tagName='EMBED') then
      (Control as TForm1).UrlList.lines.Add(obj.src);
  end;
  Result := S_OK;
end;
[blue]
// --------------------------------------------------------------- //
// Copyright (c) 2002 Powered by Manfeel //
// Manfeel保留版权,转载请保留作者信息! //
// Mingtao@sina.com //
// --------------------------------------------------------------- //[/blue]
 
manfeel: 还有1000分稍候就到
谢谢。
 
manfeel:请看一下这个问题,也是这个方面的
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1145030
 
后退
顶部