利用 Delphi 编写 IE 扩展
TechnoFantasy 原作
就是如何使 ie 扩展组件可以响应事件。
在自己的程序中使用过 webbrowser 控件的朋友都知道 ,webbrowser 控件定义了诸如 beforenavigate 、 downloadcomplete 等事件 ,我们可以通过编写事件处理代码实现对 webbrowser 控件的操作。那么如何实现对 ie 的事件响应和处理呢？同建立 ie 面板一样。我们需要建立一个实现 iobjectwithsite 接口的 com 组件 ,不同的是 ,我们还需要实现 idispatch 接口 ,在 iobjectwithsite 接口的 setsite 方法中获得 ie 的 webbrowser 接口并建立自身与 webbrowser 的连接 ,然后如果在 ie 的 webbrowser 对象中发生什么事件的话 ,那么 ie 就会回调连接的 idispatch 接口的 invoke 方法。我们通过在 invoke 方法中编写代码就可以获得 ie 事件了。这个利用的是 com 编程的回调接口原理。
下面我们首先来实现代码。点击 delphi 菜单 file | new 。在 activex 页面中选择 active library ,然后点击 ok 按钮。然后用同样的方法建立一个 com object 。在 com object wizard 窗口中 ,将复选框 included type library 去掉。然后在 class name 中输入 iehelper,在 implemented interface 中输入 :idispatch;iobjectwithsite 。然后点击 ok 按钮建立一个 com 组件。
保存工程 ,将工程保存为 iehelper.dpr,将 unit1 保存为 iehelperunit.pas 。下面是 iehelperunit.pas 的具体代码 :
unit iehelperunit;
interface
uses
windows, comobj, activex, shdocvw, mshtml,dialogs;
type
tiehelperfactory = class(tcomobjectfactory)
private
procedure addkeys;
procedure removekeys;
public
procedure updateregistry(register: boolean); override;
end;
tiehelper = class(tcomobject, idispatch, iobjectwithsite)
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;
function setsite(const punksite: iunknown): hresult; stdcall;
function getsite(const riid: tiid; out site: iunknown): hresult; stdcall;
private
ie: iwebbrowser2;
cookie: integer;
end;
const
class_iehelper: tguid = '{3d898c55-74cc-4b7c-b5f1-45913f368388}';
implementation
uses comserv, registry, sysutils;
procedure dostatustextchange(const text: widestring);
begin
end;
procedure doprogresschange(progress: integer; progressmax: integer);
begin
end;
procedure docommandstatechange(command: integer; enable: wordbool);
begin
end;
procedure dodownloadbegin;
begin
end;
procedure dodownloadcomplete;
begin
end;
procedure dotitlechange(const text: widestring);
begin
end;
procedure dopropertychange(const szproperty: widestring);
begin
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
if url<>'http://www.applevb.com/'then begin
showmessage(' 你不可以浏览其它站点 ');
cancel:=true;
url:='http://www.applevb.com';
(pdisp as iwebbrowser2).navigate2(url,flags,targetframename,postdata,headers);
end;
end;
procedure donewwindow2(var ppdisp: idispatch; var cancel: wordbool);
begin
end;
procedure donavigatecomplete2(const pdisp: idispatch; var url: olevariant);
begin
end;
procedure dodocumentcomplete(const pdisp: idispatch; var url: olevariant);
begin
end;
procedure doonquit;
begin
end;
procedure doonvisible(visible: wordbool);
begin
end;
procedure doontoolbar(toolbar: wordbool);
begin
end;
procedure doonmenubar(menubar: wordbool);
begin
end;
procedure doonstatusbar(statusbar: wordbool);
begin
end;
procedure doonfullscreen(fullscreen: wordbool);
begin
end;
procedure doontheatermode(theatermode: wordbool);
begin
end;
procedure buildpositionaldispids(pdispids: pdispidlist; const dps: tdispparams);
var
i: integer;
begin
assert(pdispids <> nil);
for i := 0 to dps.cargs - 1 do
pdispids^ := dps.cargs - 1 - i;
if (dps.cnamedargs <= 0) then exit;
for i := 0 to dps.cnamedargs - 1 do
pdispids^[dps.rgdispidnamedargs^] := i;
end;
function tiehelper.invoke(dispid: integer; const iid: tguid; localeid: integer;
flags: word; var params; varresult, excepinfo, argerr: pointer): hresult;
type
polevariant = ^olevariant;
var
dps: tdispparams absolute params;
bhasparams: boolean;
pdispids: pdispidlist;
idispidssize: integer;
begin
result := disp_e_membernotfound;
pdispids := nil;
idispidssize := 0;
bhasparams := (dps.cargs > 0);
if (bhasparams) then
begin
idispidssize := dps.cargs * sizeof(tdispid);
getmem(pdispids, idispidssize);
end;
try
if (bhasparams) then buildpositionaldispids(pdispids, dps);
case dispid of
102:
begin
dostatustextchange(dps.rgvarg^[pdispids^[0]].bstrval);
result := s_ok;
end;
108:
begin
doprogresschange(dps.rgvarg^[pdispids^[0]].lval, dps.rgvarg^[pdispids^[1]].lval);
result := s_ok;
end;
105:
begin
docommandstatechange(dps.rgvarg^[pdispids^[0]].lval, dps.rgvarg^[pdispids^[1]].vbool);
result := s_ok;
end;
106:
begin
dodownloadbegin();
result := s_ok;
end;
104:
begin
dodownloadcomplete();
result := s_ok;
end;
113:
begin
dotitlechange(dps.rgvarg^[pdispids^[0]].bstrval);
result := s_ok;
end;
112:
begin
dopropertychange(dps.rgvarg^[pdispids^[0]].bstrval);
result := s_ok;
end;
250:
begin
dobeforenavigate2(idispatch(dps.rgvarg^[pdispids^[0]].dispval), polevariant(dps.rgvarg^[pdispids^[1]].pvarval)^, polevariant(dps.rgvarg^[pdispids^[2]].pvarval)^, polevariant(dps.rgvarg^[pdispids^[3]].pvarval)^, polevariant(dps.rgvarg^[pdispids^[4]].pvarval)^, polevariant(dps.rgvarg^[pdispids^[5]].pvarval)^, dps.rgvarg^[pdispids^[6]].pbool^);
result := s_ok;
end;
251:
begin
donewwindow2(idispatch(dps.rgvarg^[pdispids^[0]].pdispval^), dps.rgvarg^[pdispids^[1]].pbool^);
result := s_ok;
end;
252:
begin
donavigatecomplete2(idispatch(dps.rgvarg^[pdispids^[0]].dispval), polevariant(dps.rgvarg^[pdispids^[1]].pvarval)^);
result := s_ok;
end;
259:
begin
dodocumentcomplete(idispatch(dps.rgvarg^[pdispids^[0]].dispval), polevariant(dps.rgvarg^[pdispids^[1]].pvarval)^);
result := s_ok;
end;
253:
begin
doonquit();
result := s_ok;
end;
254:
begin
doonvisible(dps.rgvarg^[pdispids^[0]].vbool);
result := s_ok;
end;
255:
begin
doontoolbar(dps.rgvarg^[pdispids^[0]].vbool);
result := s_ok;
end;
256:
begin
doonmenubar(dps.rgvarg^[pdispids^[0]].vbool);
result := s_ok;
end;
257:
begin
doonstatusbar(dps.rgvarg^[pdispids^[0]].vbool);
result := s_ok;
end;
258:
begin
doonfullscreen(dps.rgvarg^[pdispids^[0]].vbool);
result := s_ok;
end;
260:
begin
doontheatermode(dps.rgvarg^[pdispids^[0]].vbool);
result := s_ok;
end;
end;
finally
if (bhasparams) then freemem(pdispids, idispidssize);
end;
end;
function tiehelper.getidsofnames(const iid: tguid; names: pointer;
namecount, localeid: integer; dispids: pointer): hresult;
begin
result := e_notimpl;
end;
function tiehelper.gettypeinfo(index, localeid: integer;
out typeinfo): hresult;
begin
result := e_notimpl;
pointer(typeinfo) := nil;
end;
function tiehelper.gettypeinfocount(out count: integer): hresult;
begin
result := e_notimpl;
count := 0;
end;
function tiehelper.getsite(const riid: tiid; out site: iunknown): hresult;
begin
// result := s_ok;
if assigned(ie) then result:=ie.queryinterface(riid, site)
else
result:= e_fail;
end;
function tiehelper.setsite(const punksite: iunknown): hresult;
var
cmdtarget: iolecommandtarget;
sp: iserviceprovider;
cpc: iconnectionpointcontainer;
cp: iconnectionpoint;
begin
if assigned(punksite) then begin
cmdtarget := punksite as iolecommandtarget;
sp := cmdtarget as iserviceprovider;
if assigned(sp)then
sp.queryservice(iwebbrowserapp, iwebbrowser2, ie);
if assigned(ie) then begin
ie.queryinterface(iconnectionpointcontainer, cpc);
cpc.findconnectionpoint(dwebbrowserevents2, cp);
cp.advise(self, cookie)
end;
end;
result := s_ok;
end;
procedure tiehelperfactory.addkeys;
var s: string;
begin
s := guidtostring(class_iehelper);
with tregistry.create do
try
rootkey := hkey_local_machine;
if openkey('software/microsoft/windows/currentversion/explorer/browser helper objects/' + s, true)
then closekey;
finally
free;
end;
end;
procedure tiehelperfactory.removekeys;
var s: string;
begin
s := guidtostring(class_iehelper);
with tregistry.create do
try
rootkey := hkey_local_machine;
deletekey('software/microsoft/windows/currentversion/explorer/browser helper objects/' + s);
finally
free;
end;
end;
procedure tiehelperfactory.updateregistry(register: boolean);
begin
inherited updateregistry(register);
if register then addkeys else removekeys;
end;
initialization
tiehelperfactory.create(comserver, tiehelper, class_iehelper,
'iehelper', '', cimultiinstance, tmapartment);
end.
代码很长 ,但是关键的是 tiehelper.setsite 方法以及 tiehelper.invoke 方法。在 tiehelper.setsite 方法中注意以下语句 :
if assigned(sp)then
sp.queryservice(iwebbrowserapp, iwebbrowser2, ie);
if assigned(ie) then begin
ie.queryinterface(iconnectionpointcontainer, cpc);
cpc.findconnectionpoint(dwebbrowserevents2, cp);
cp.advise(self, cookie)
上面的语句作用是 ,首先获得 ie 的 webbrowser 接口 ,然后寻找到连接点。并通过 advise 方法建立 com 自身与连接点的连接。
当连接建立成功后 ,ie 在有事件引发后 ,会调用连接到自身的 idispatch 接口对象的 invoke 方法。不同的事件对应不同的 dispid 编码 ,我们可以在程序中判断 dispid 并做相应的处理。在上面的程序中 ,我们只处理了 beforenavigate2 事件 ,处理函数是 dobeforenavigate2,在该函数中 ,如果浏览的站点不是 'http://www.applevb.com/' 的话 ,程序会提示 :' 你不可以浏览其它站点 ' 并强行转到 http://www.applevb.com 。
很多的软件 ,象 " 护花使者 " 以及 "3721" 一类的中文网址 " 都是利用上面的原理来实现对 ie 浏览器事件响应的 ,例如 3721,当用户输入一个中文词并浏览时 ,com 组件可以在 beforenavigate2 事件中编写代码访问服务器并转到正确的站点上去。
以上程序在 win2k 、 delphi 5 下编写 win98 、 win2k 下编辑通过 ,如果大家需要源程序或者对于 com 编程需要有什么的指教的话 ,欢迎到我的主页 http://www.applevb.com 访问 ,我愿意同大家一起探讨。
DispIDList;