最新賀歲大片——機靈鼠（MC1傾情獻演）【轉】修改window.extern－我有兩把槍

在JavaScript中，有一個比較特殊的對象，即window.external，用它可以調用瀏覽器提供的外部方法
一個很簡單的例子就是將噹前頁添加到收藏夾
window.external.addFavorite("http://hi.baidu.com/rarnu","橙子的百度博客');
這樣寫腳本就可以了。

那麼如果我想自己定義external，以便在自己的軟件內使用IE核心的瀏覽器作為UI容器，該如何做呢？
本文即是解決此問題。

一、制作TLB
在File | New | Other 菜單下，選擇新建一個Type Library，這個向導在ActiveX頁內。
然後按下圖所示，新建一個接口，在接口下新建一個DoSearchData方法，這個方法即是將來需要添加到external中的。

友情客串：〆.◇餖槳】&〆.◇油鞗〗

完成添加後，點擊保存為TLB按鈕，將生成一個TLB文件，此處我將它命名為GetData.tlb

二、實現IDocHostUIHandler接口
這部分相對比較簡單，從MSDN上找到相關的C++代碼，把它轉換成Delphi的即可。代碼如下：

01 unit DocHostUIHandler;
02
03 interface
04
05 uses
06 Windows, ActiveX;
07 const
08 DOCHOSTUIFLAG_DIALOG                      = $00000001;
09 DOCHOSTUIFLAG_DISABLE_HELP_MENU           = $00000002;
10 DOCHOSTUIFLAG_NO3DBORDER                  = $00000004;
11 DOCHOSTUIFLAG_SCROLL_NO                   = $00000008;
12 DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE     = $00000010;
13 DOCHOSTUIFLAG_OPENNEWWIN                  = $00000020;
14 DOCHOSTUIFLAG_DISABLE_OFFSCREEN           = $00000040;
15 DOCHOSTUIFLAG_FLAT_SCROLLBAR              = $00000080;
16 DOCHOSTUIFLAG_DIV_BLOCKDEFAULT            = $00000100;
17 DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY     = $00000200;
18 DOCHOSTUIFLAG_OVERRIDEBEHAVIORFACTORY     = $00000400;
19 DOCHOSTUIFLAG_CODEPAGELINKEDFONTS         = $00000800;
20 DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8   = $00001000;
21 DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8    = $00002000;
22 DOCHOSTUIFLAG_ENABLE_FORMS_AUTOCOMPLETE   = $00004000;
23 DOCHOSTUIFLAG_ENABLE_INPLACE_NAVIGATION   = $00010000;
24 DOCHOSTUIFLAG_IME_ENABLE_RECONVERSION     = $00020000;
25 DOCHOSTUIFLAG_THEME                       = $00040000;
26 DOCHOSTUIFLAG_NOTHEME                     = $00080000;
27 DOCHOSTUIFLAG_NOPICS                      = $00100000;
28 DOCHOSTUIFLAG_NO3DOUTERBORDER             = $00200000;
29 DOCHOSTUIFLAG_DISABLE_EDIT_NS_FIXUP       = $1;
30 DOCHOSTUIFLAG_LOCAL_MACHINE_ACCESS_CHECK = $1;
31 DOCHOSTUIFLAG_DISABLE_UNTRUSTEDPROTOCOL   = $1;
32 DOCHOSTUIDBLCLK_DEFAULT         = 0;
33 DOCHOSTUIDBLCLK_SHOWPROPERTIES = 1;
34 DOCHOSTUIDBLCLK_SHOWCODE        = 2;
35 DOCHOSTUITYPE_BROWSE = 0;
36 DOCHOSTUITYPE_AUTHOR = 1;
37
38 type
39 TDocHostUIInfo = record
40     cbSize: ULONG;
41     dwFlags: DWORD;
42     dwDoubleClick: DWORD;
43     pchHostCss: PWChar;
44     pchHostNS: PWChar;
45 end;
46
47 PDocHostUIInfo = ^TDocHostUIInfo;
48 IDocHostUIHandler = interface(IUnknown)
49     ['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}']
50     function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
51       const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HResult;
52       stdcall;
53     function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall;
54     function ShowUI(const dwID: DWORD;
55       const pActiveObject: IOleInPlaceActiveObject;
56       const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
57       const pDoc: IOleInPlaceUIWindow): HResult; stdcall;
58     function HideUI: HResult; stdcall;
59     function UpdateUI: HResult; stdcall;
60     function EnableModeless(const fEnable: BOOL): HResult; stdcall;
61     function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall;
62     function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall;
63     function ResizeBorder(const prcBorder: PRECT;
64       const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;
65       stdcall;
66     function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
67       const nCmdID: DWORD): HResult; stdcall;
68     function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD ): HResult;
69       stdcall;
70     function GetDropTarget(const pDropTarget: IDropTarget;
71       out ppDropTarget: IDropTarget): HResult; stdcall;
72     function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
73     function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
74       var ppchURLOut: POLESTR): HResult; stdcall;
75     function FilterDataObject(const pDO: IDataObject;
76       out ppDORet: IDataObject): HResult; stdcall;
77     end;
78
79 implementation
80
81 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;
    procedure SetBrowserOleClientSite(const Site: IOleClientSite);
protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function SaveObject: HResult; stdcall;
    function GetMoniker(dwAssign: Longint;
      dwWhichMoniker: Longint;
      out mk: IMoniker): HResult; stdcall;
    function GetContainer(
      out container: IOleContainer): HResult; stdcall;
    function ShowObject: HResult; stdcall;
    function OnShowWindow(fShow: BOOL): HResult; stdcall;
    function RequestNewObjectLayout: HResult; stdcall;
    function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
      const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HResult;
      stdcall;
    function GetHostInfo(var pInfo: TDocHostUIInfo): HResult; stdcall;
    function ShowUI(const dwID: DWORD;
      const pActiveObject: IOleInPlaceActiveObject;
      const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
      const pDoc: IOleInPlaceUIWindow): HResult,LV M40156 Neverfull 中號手袋單肩包老花系列 LV包包價格、目錄、型錄、新款官方網站旗艦店; stdcall;
    function HideUI: HResult; stdcall;
    function UpdateUI: HResult; stdcall;
    function EnableModeless(const fEnable: BOOL): HResult; stdcall;
    function OnDocWindowActivate(const fActivate: BOOL): HResult; stdcall;
    function OnFrameWindowActivate(const fActivate: BOOL): HResult; stdcall;
    function ResizeBorder(const prcBorder: PRECT;
      const pUIWindow: IOleInPlaceUIWindow; const fFrameWindow: BOOL): HResult;
      stdcall;
    function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
      const nCmdID: DWORD): HResult; stdcall;
    function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD ): HResult;
      stdcall;
    function GetDropTarget(const pDropTarget: IDropTarget;
      out ppDropTarget: IDropTarget): HResult; stdcall;
    function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
    function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
      var ppchURLOut: POLESTR): HResult; stdcall;
    function FilterDataObject(const pDO: IDataObject;
      out ppDORet: IDataObject): HResult; stdcall;
public
    constructor Create(const HostedBrowser: TWebBrowser);
    destructor Destroy; override;
    property HostedBrowser: 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; out Obj): 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
    raise Exception.Create('Browser''s Default interface does not support IOleObject');
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.