G
g622
Unregistered / Unconfirmed
GUEST, unregistred user!
ie是当前窗口的情况下
很急,另有1000分酬谢
很急,另有1000分酬谢
[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.
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;