hoho 我笨了， 下面是代码
{*************************************************
Copyright (C), 2004, 风车工作室.
作者: 追风逐月
版本: 1.0
日期: 2005年04月11日
描述: 实现browser Helper Object 接口单元
修改历史:
追风逐月 2005/04/11 1.0 创建该文件
...
*************************************************}
//***********************************************************
// Browser Helper Object Demo 1.01 *
// (Jan. 14, 2000) *
// *
// For Delphi 4/5 *
// by *
// Per Linds?Larsen *
// per.lindsoe@larsen.dk *
// *
// Documentation and updated versions: *
// *
// http://www.euromind.com/iedelphi *
//***********************************************************
//procedure BuildPositionalDispIds and function Invoke
//is created using EventSinkImp, written by Binh Ly (bly@castle.net)
//You can download EventSinkImp from: http://www.techvanguard.com/
unit _IEBrowserHelper;
interface
uses
dialogs, sysutils, shdocvw, registry, Windows, ActiveX, Classes, ComObj,
mshtml;
const
DISPID_BEFORENAVIGATE = 100;
// this is sent before navigation to give a chance to abort
DISPID_NAVIGATECOMPLETE = 101;
// in async, this is sent when we have enough to show
DISPID_STATUSTEXTCHANGE = 102;
DISPID_QUIT = 103;
DISPID_DOWNLOADCOMPLETE = 104;
DISPID_COMMANDSTATECHANGE = 105;
DISPID_DOWNLOADBEGIN = 106;
DISPID_NEWWINDOW = 107; // sent when a new window should be created
DISPID_PROGRESSCHANGE = 108; // sent when download progress is updated
DISPID_WINDOWMOVE = 109; // sent when main window has been moved
DISPID_WINDOWRESIZE = 110; // sent when main window has been sized
DISPID_WINDOWACTIVATE = 111; // sent when main window has been activated
DISPID_PROPERTYCHANGE = 112; // sent when the PutProperty method is called
DISPID_TITLECHANGE = 113; // sent when the document title changes
DISPID_TITLEICONCHANGE = 114;
// sent when the top level window icon may have changed.
DISPID_FRAMEBEFORENAVIGATE = 200;
DISPID_FRAMENAVIGATECOMPLETE = 201;
DISPID_FRAMENEWWINDOW = 204;
DISPID_BEFORENAVIGATE2 = 250; // hyperlink clicked on
DISPID_NEWWINDOW2 = 251;
DISPID_NAVIGATECOMPLETE2 = 252; // UIActivate new document
DISPID_ONQUIT = 253;
DISPID_ONVISIBLE = 254; // sent when the window goes visible/hidden
DISPID_ONTOOLBAR = 255; // sent when the toolbar should be shown/hidden
DISPID_ONMENUBAR = 256; // sent when the menubar should be shown/hidden
DISPID_ONSTATUSBAR = 257; // sent when the statusbar should be shown/hidden
DISPID_ONFULLSCREEN = 258; // sent when kiosk mode should be on/off
DISPID_DOCUMENTCOMPLETE = 259; // new document goes ReadyState_Complete
DISPID_ONTHEATERMODE = 260; // sent when theater mode should be on/off
DISPID_ONADDRESSBAR = 261; // sent when the address bar should be shown/hidden
DISPID_WINDOWSETRESIZABLE = 262;
// sent to set the style of the host window frame
DISPID_WINDOWCLOSING = 263;
// sent before script window.close closes the window
DISPID_WINDOWSETLEFT = 264;
// sent when the put_left method is called on the WebOC
DISPID_WINDOWSETTOP = 265;
// sent when the put_top method is called on the WebOC
DISPID_WINDOWSETWIDTH = 266;
// sent when the put_width method is called on the WebOC
DISPID_WINDOWSETHEIGHT = 267;
// sent when the put_height method is called on the WebOC
DISPID_CLIENTTOHOSTWINDOW = 268;
// sent during window.open to request conversion of dimensions
DISPID_SETSECURELOCKICON = 269;
// sent to suggest the appropriate security icon to show
DISPID_FILEDOWNLOAD = 270;
// Fired to indicate the File Download dialog is opening
type
//鼠标移出事件处理
TMouseOutSink = class(TInterfacedObject, iDispatch)
private
Fie: IWebbrowser2;
public
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;
end;
//鼠标移入事件处理
TMouseOverSink = class(TInterfacedObject, iDispatch)
private
Fie: IWebbrowser2;
public
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;
end;
TIEBrowserHelperFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register: Boolean); override;
end;
TIEBrowserHelper = class(TComObject, IDispatch, IObjectWithSite)
public
MouseOutSink: TMouseOutSink;
MouseOverSink: TMouseOverSink;
protected
function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
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;
virtual; stdcall;
end;
const
Class_IEBrowserHelper: TGUID = '{492B8F66-B8CF-4F7A-B0EE-B7383B92F5BA}';
implementation
uses IEHelperForm, ComServ, Controls;
{ TIEBrowserHelper }
var
Cookie: Integer;
CP: IConnectionPoint;
HelperForm: THelperForm;
procedure DoStatusTextChange(const Text: WideString);
begin
//HelperForm.Memo1.Lines.Add('Statustext: ' + TEXT);
end;
procedure DoProgressChange(Progress: Integer; ProgressMax: Integer);
begin
//HelperForm.Memo1.Lines.Add('ProgressChange: ' + InttoStr(Progress) + '/' + InttoStr(ProgressMax));
end;
procedure DoCommandStateChange(Command: Integer; Enable: WordBool);
begin
//HelperForm.Memo1.Lines.Add('CommandStateChange: COMMAND:' + InttoStr(Command));
end;
procedure DoDownloadBegin;
begin
//HelperForm.Memo1.Lines.Add('Download Begin');
end;
procedure DoDownloadComplete;
begin
//HelperForm.Memo1.Lines.Add('Download Complete');
end;
procedure DoTitleChange(const Text: WideString);
begin
//HelperForm.Memo1.Lines.Add('TitleChange: ' + TEXT);
end;
procedure DoPropertyChange(const szProperty: WideString);
begin
//HelperForm.Memo1.Lines.Add('PropertyChange: ' + szProperty);
end;
procedure DoBeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var
Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant; var
Headers: OleVariant; var Cancel: WordBool);
begin
end;
procedure DoNewWindow2(var ppDisp: IDispatch; var Cancel: WordBool);
begin
end;
procedure DoNavigateComplete2(const pDisp: IDispatch; var URL: OleVariant);
begin
end
