修改window.external使JS可调用Delphi方法

原文地址：http://hi.baidu.com/rarnu/blog/item/4ec80608022766d663d986ea.html

在js中，有一个比较特殊的对象，即window.external，用它可以调用浏览器提供的外部方法
一个很简单的例子就是将当前页添加到收藏夹
window.external.addFavorite("http://blog.csdn.NET/youthon","弘石的博客');
这样写脚本就可以了。
那么如果我想自己定义external，以便在自己的软件内使用IE核心的浏览器作为UI容器，该如何做呢？
本文即是解决此问题。
一、制作TLB
在File | New | Other 菜单下，选择新建一个Type Library，这个向导在ActiveX页内。
然后按下图所示，新建一个接口，在接口下新建一个DoSearchData方法，这个方法即是将来需要添加到external中的。



完成添加后，点击保存为TLB按钮，将生成一个TLB文件，此处我将它命名为GetData.tlb
二、实现IDocHostUIHandler接口
这部分相对比较简单，从MSDN上找到相关的C++代码，把它转换成Delphi的即可。代码如下：
unitDocHostUIHandler;

interface
uses
Windows, ActiveX;
const
DOCHOSTUIFLAG_DIALOG =$00000001;
DOCHOSTUIFLAG_DISABLE_HELP_MENU =$00000002;
DOCHOSTUIFLAG_NO3DBORDER =$00000004;
DOCHOSTUIFLAG_SCROLL_NO =$00000008;
DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = $00000010;
DOCHOSTUIFLAG_OPENNEWWIN =$00000020;
DOCHOSTUIFLAG_DISABLE_OFFSCREEN =$00000040;
DOCHOSTUIFLAG_FLAT_SCROLLBAR =$00000080;
DOCHOSTUIFLAG_DIV_BLOCKDEFAULT =$00000100;
DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = $00000200;
DOCHOSTUIFLAG_OVERRIDEBEHAVIORFACTORY = $00000400;
DOCHOSTUIFLAG_CODEPAGELINKEDFONTS =$00000800;
DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8 = $00001000;
DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8 = $00002000;
DOCHOSTUIFLAG_ENABLE_FORMS_AUTOCOMPLETE = $00004000;
DOCHOSTUIFLAG_ENABLE_INPLACE_NAVIGATION = $00010000;
DOCHOSTUIFLAG_IME_ENABLE_RECONVERSION = $00020000;
DOCHOSTUIFLAG_THEME =$00040000;
DOCHOSTUIFLAG_NOTHEME =$00080000;
DOCHOSTUIFLAG_NOPICS =$00100000;
DOCHOSTUIFLAG_NO3DOUTERBORDER =$00200000;
DOCHOSTUIFLAG_DISABLE_EDIT_NS_FIXUP = $1;
DOCHOSTUIFLAG_LOCAL_MACHINE_ACCESS_CHECK =$1;
DOCHOSTUIFLAG_DISABLE_UNTRUSTEDPROTOCOL = $1;
DOCHOSTUIDBLCLK_DEFAULT = 0;
DOCHOSTUIDBLCLK_SHOWPROPERTIES = 1;
DOCHOSTUIDBLCLK_SHOWCODE = 2;
DOCHOSTUITYPE_BROWSE = 0;
DOCHOSTUITYPE_AUTHOR = 1;

type
TDocHostUIInfo = record
cbSize: ULONG;
dwFlags: DWORD;
dwDoubleClick: DWORD;
pchHostCss: PWChar;
pchHostNS: PWChar;
end;
PDocHostUIInfo = ^TDocHostUIInfo;
IDocHostUIHandler = interface(IUnknown)
['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}']
functionShowContextMenu(const dwID:DWORD;constppt: PPOINT;
constpcmdtReserved:IUnknown;constpdispReserved: IDispatch): HResult;
stdcall;
functionGetHostInfo(var pInfo:TDocHostUIInfo): HResult;stdcall;
functionShowUI(const dwID:DWORD;
constpActiveObject: IOleInPlaceActiveObject;
constpCommandTarget: IOleCommandTarget;const pFrame:IOleInPlaceFrame;
constpDoc: IOleInPlaceUIWindow): HResult;stdcall;
function HideUI:HResult;stdcall;
function UpdateUI:HResult;stdcall;
functionEnableModeless(const fEnable:BOOL):HResult;stdcall;
functionOnDocWindowActivate(const fActivate:BOOL):HResult;stdcall;
functionOnFrameWindowActivate(const fActivate:BOOL):HResult;stdcall;
functionResizeBorder(const prcBorder:PRECT;
constpUIWindow: IOleInPlaceUIWindow;const fFrameWindow:BOOL):HResult;
stdcall;
functionTranslateAccelerator(const lpMsg: PMSG;constpguidCmdGroup: PGUID;
constnCmdID:DWORD): HResult;stdcall;
functionGetOptionKeyPath(var pchKey:POLESTR;const dw:DWORD): HResult;
stdcall;
functionGetDropTarget(const pDropTarget:IDropTarget;
out ppDropTarget: IDropTarget): HResult; stdcall;
functionGetExternal(out ppDispatch: IDispatch): HResult;stdcall;
functionTranslateUrl(const dwTranslate:DWORD;constpchURLIn: POLESTR;
varppchURLOut: POLESTR): HResult;stdcall;
functionFilterDataObject(const pDO:IDataObject;
out ppDORet: IDataObject): HResult; stdcall;
end;

implementation

end.
三、实现一个带有IE组件的容器
由于Delphi自带的WebBrowser控件不支持external的直接扩展，因此我们需要另外写一个容器，使它实现IDocHostUIHandler接口，并且通过ActiveX单元的IOleObject.SetClientSite方法，将我们自己的容器填充进去。
这部分的代码直接参考了EmbeddedWB组件的相关实现，具体代码如下：
unit NulContainer;

interface

uses
Windows, ActiveX, SHDocVw, DocHostUIHandler;

type
TNulWBContainer = class(TObject,
IUnknown,IOleClientSite, IDocHostUIHandler)
private
fHostedBrowser: TWebBrowser;
procedureSetBrowserOleClientSite(const Site: IOleClientSite);
protected
functionQueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function_AddRef: Integer; stdcall;
function_Release: Integer; stdcall;
functionSaveObject: HResult; stdcall;
functionGetMoniker(dwAssign: Longint;
dwWhichMoniker: Longint;
out mk: IMoniker): HResult; stdcall;
functionGetContainer(
out Container: IOleContainer): HResult; stdcall;
functionShowObject: HResult; stdcall;
functionOnShowWindow(fShow: BOOL): HResult; stdcall;
functionRequestNewObjectLayout: HResult; stdcall;
functionShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
const pcmdtReserved: IUnknown; const pdispReserved: IDispatch):HResult;
stdcall;
functionGetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall;
functionShowUI(const dwID: DWORD;
const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame:IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HResult; stdcall;
functionHideUI: HResult; stdcall;
functionUpdateUI: HResult; stdcall;
functionEnableModeless(const fEnable: BOOL): HResult; stdcall;
functionOnDocWindowActivate(const fActivate: BOOL): HResult; stdcall;
functionOnFrameWindowActivate(const fActivate: BOOL): HResult;stdcall;
functionResizeBorder(const prcBorder: PRECT;
const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL):HResult;
stdcall;
functionTranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup:PGUID;
const nCmdID: DWORD): HResult; stdcall;
functionGetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD ):HResult;
stdcall;
functionGetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget): HResult; stdcall;
functionGetExternal(out ppDispatch: IDispatch): HResult; stdcall;
functionTranslateUrl(const dwTranslate: DWORD; const pchURLIn:POLESTR;
var ppchURLOut: POLESTR): HResult; stdcall;
functionFilterDataObject(const pDO: IDataObject;
out ppDORet: IDataObject): HResult; stdcall;
public
constructorCreate(const HostedBrowser: TWebBrowser);
destructorDestroy; override;
propertyHostedBrowser: TWebBrowser read fHostedBrowser;
end;

implementation

uses
SysUtils;

{ TNulWBContainer }

constructor TNulWBContainer.Create(const HostedBrowser:TWebBrowser);
begin
Assert(Assigned(HostedBrowser));
inherited Create;
fHostedBrowser := HostedBrowser;
SetBrowserOleClientSite(Self as IOleClientSite);
end;

destructor TNulWBContainer.Destroy;
begin
SetBrowserOleClientSite(nil);
inherited;
end;

function TNulWBContainer.EnableModeless(const fEnable: BOOL):HResult;
begin
Result := S_OK;
end;

function TNulWBContainer.FilterDataObject(const pDO:IDataObject;
out ppDORet: IDataObject): HResult;
begin
ppDORet := nil;
Result := S_FALSE;
end;

function TNulWBContainer.GetContainer(
out container: IOleContainer): HResult;
begin
container := nil;
Result := E_NOINTERFACE;
end;

function TNulWBContainer.GetDropTarget(const pDropTarget:IDropTarget;
out ppDropTarget: IDropTarget): HResult;
begin
ppDropTarget := nil;
Result := E_FAIL;
end;

function TNulWBContainer.GetExternal(out ppDispatch: IDispatch):HResult;
begin
ppDispatch := nil;
Result := E_FAIL;
end;

function TNulWBContainer.GetHostInfo(var pInfo: TDocHostUIInfo):HResult;
begin
Result := S_OK;
end;

function TNulWBContainer.GetMoniker(dwAssign, dwWhichMoniker:Integer;
out mk: IMoniker): HResult;
begin
mk := nil;
Result := E_NOTIMPL;
end;

function TNulWBContainer.GetOptionKeyPath(var pchKey:POLESTR;
const dw: DWORD): HResult;
begin
Result := E_FAIL;
end;

function TNulWBContainer.HideUI: HResult;
begin
Result := S_OK;
end;

function TNulWBContainer.OnDocWindowActivate(
const fActivate: BOOL): HResult;
begin
Result := S_OK;
end;

function TNulWBContainer.OnFrameWindowActivate(
const fActivate: BOOL): HResult;
begin
Result := S_OK;
end;

function TNulWBContainer.OnShowWindow(fShow: BOOL):HResult;
begin
Result := S_OK;
end;

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

function TNulWBContainer.RequestNewObjectLayout: HResult;
begin
Result := E_NOTIMPL;
end;

function TNulWBContainer.ResizeBorder(const prcBorder:PRECT;
const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL):HResult;
begin
Result := S_FALSE;
end;

function TNulWBContainer.SaveObject: HResult;
begin
Result := S_OK;
end;

procedure TNulWBContainer.SetBrowserOleClientSite(
const Site: IOleClientSite);
var
OleObj: IOleObject;
begin
Assert((Site = Self as IOleClientSite) or (Site = nil));
if not Supports(fHostedBrowser.DefaultInterface, IOleObject,OleObj) then
raiseException.Create('Browser''s Default interface does not supportIOleObject');
OleObj.SetClientSite(Site);
end;

function TNulWBContainer.ShowContextMenu(const dwID:DWORD;
const ppt: PPOINT; const pcmdtReserved: IInterface;
const pdispReserved: IDispatch): HResult;
begin
Result := S_FALSE
end;

function TNulWBContainer.ShowObject: HResult;
begin
Result := S_OK;
end;

function TNulWBContainer.ShowUI(const dwID: DWORD;
const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame:IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HResult;
begin
Result := S_OK;
end;

function TNulWBContainer.TranslateAccelerator(const lpMsg:PMSG;
const pguidCmdGroup: PGUID; const nCmdID: DWORD): HResult;
begin
Result := S_FALSE;
end;

function TNulWBContainer.TranslateUrl(const dwTranslate:DWORD;
const pchURLIn: POLESTR; var ppchURLOut: POLESTR): HResult;
begin
Result := E_FAIL;
end;

function TNulWBContainer.UpdateUI: HResult;
begin
Result := S_OK;
end;

function TNulWBContainer._AddRef: Integer;
begin
Result := -1;
end;

function TNulWBContainer._Release: Integer;
begin
Result := -1;
end;

end.
http://blog.csdn.net/youthon/article/details/8446135