首页 Delphi资料 好文收藏 股海冲浪 自制小软件 E4A易安卓手机编程 ASP资料 Python PHP资料 在线字典 留言板
　

　

全面监视IE，截获IE信息，控制IE

     阅读 751 次    更新时间：2014/4/20    

全面监视IE，截获IE信息，控制IE

新建一个ActiveX Library，保存为IEBHO.dpr，然后新建一个名为TIEAdvBHO的COM Object，然后保存生成的文件为CIEBHO.pas

CIEBHO.pas 代码如下

unit CIEBHO;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
Windows, ActiveX, Classes, ComObj, Shdocvw,dialogs;

type
TIEAdvBHOFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;

type
TTIEAdvBHO = class(TComObject, IObjectWithSite, IDispatch)
private
FIESite: IUnknown;
FIE: IWebBrowser2;//有了这个对象，你可像操作自己的空间一样操作被监控的IE
FCPC: IConnectionPointContainer;
FCP: IConnectionPoint;
FCookie: Integer;
-------------{可能收到的事件}--------------
procedure DoStatusTextChange(const Text: WideString);
procedure DoProgressChange(Progress: Integer; ProgressMax: Integer);
procedure DoCommandStateChange(Command: Integer; Enable: WordBool);
procedure DoDownloadBegin;
procedure DoDownloadComplete;
procedure DoTitleChange(const Text: WideString);
procedure DoPropertyChange(const szProperty: WideString);
procedure DoNavigateComplete2(const pDisp: IDispatch; var URL: OleVariant);
procedure DoDocumentComplete(const pDisp: IDispatch; var URL: OleVariant);
procedure DoOnQuit;
procedure DoOnVisible(Visible: WordBool);
procedure DoOnToolBar(ToolBar: WordBool);
procedure DoOnMenuBar(MenuBar: WordBool);
procedure DoOnStatusBar(StatusBar: WordBool);
procedure DoOnFullScreen(FullScreen: WordBool);
procedure DoOnTheaterMode(TheaterMode: WordBool);
-------------{可能收到的事件}--------------
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;stdcall;
procedure DoNewWindow2(var ppDisp: IDispatch; var Cancel: WordBool);
procedure DoBeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var Flags: OleVariant;var TargetFrameName: OleVariant; var PostData: OleVariant;var Headers: OleVariant; var Cancel: WordBool);
end;

const
Class_TIEAdvBHO: TGUID = '{D132570A-5F63-4812-A094-87D007C23012}';

implementation

uses ComServ, Sysutils, ComConst;

{ TTIEAdvBHO }

procedure TTIEAdvBHO.DoStatusTextChange(const Text: WideString);
begin

end;

procedure TTIEAdvBHO.DoProgressChange(Progress: Integer; ProgressMax: Integer);
begin

end;

procedure TTIEAdvBHO.DoCommandStateChange(Command: Integer; Enable: WordBool);
begin

end;

procedure TTIEAdvBHO.DoDownloadBegin;
begin

end;

procedure TTIEAdvBHO.DoDownloadComplete;
begin

end;

procedure TTIEAdvBHO.DoTitleChange(const Text: WideString);
begin

end;

procedure TTIEAdvBHO.DoPropertyChange(const szProperty: WideString);
begin

end;

procedure TTIEAdvBHO.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.baidu.com/'then begin
// Showmessage('你不可以浏览其它站点');
// Cancel:=True;
//URL:='http://www.baidu.com';
// FIE.Navigate2(URL,Flags,TargetFrameName,PostData,Headers);
//FIE.Quit;
// end;
//FIE.Navigate2(URL,Flags,TargetFrameName,PostData,Headers);
showmessage(url);

end;

procedure TTIEAdvBHO.DoNewWindow2(var ppDisp: IDispatch; var Cancel: WordBool);
begin

end;

procedure TTIEAdvBHO.DoNavigateComplete2(const pDisp: IDispatch; var URL: OleVariant);
begin

end;

procedure TTIEAdvBHO.DoDocumentComplete(const pDisp: IDispatch; var URL: OleVariant);
begin

end;

procedure TTIEAdvBHO.DoOnQuit;
begin

end;

procedure TTIEAdvBHO.DoOnVisible(Visible: WordBool);
begin

end;

procedure TTIEAdvBHO.DoOnToolBar(ToolBar: WordBool);
begin

end;

procedure TTIEAdvBHO.DoOnMenuBar(MenuBar: WordBool);
begin

end;

procedure TTIEAdvBHO.DoOnStatusBar(StatusBar: WordBool);
begin

end;

procedure TTIEAdvBHO.DoOnFullScreen(FullScreen: WordBool);
begin

end;

procedure TTIEAdvBHO.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^[i] := dps.cArgs - 1 - i;
if (dps.cNamedArgs <= 0) then
Exit;
for i := 0 to dps.cNamedArgs - 1 do
pDispIds^[dps.rgdispidNamedArgs^[i]] := i;
end;

function TTIEAdvBHO.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
dps: TDispParams absolute Params;
bHasParams: boolean;
pDispIds: PDispIdList;
iDispIdsSize: integer;
begin
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 TTIEAdvBHO.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;

function TTIEAdvBHO.GetSite(const riid: TIID;
out site: IInterface): HResult;//ie在后面可能调取getsite获取本服务的接口
begin
if Supports(FIESite, riid, site) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;

function TTIEAdvBHO.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
pointer(TypeInfo) := nil;
end;

function TTIEAdvBHO.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
Count := 0;
end;
function TTIEAdvBHO.SetSite(const pUnkSite: IInterface): HResult;
begin
Result := E_FAIL;
//保存接口
FIESite := pUnkSite;
if not Supports(FIESite, IWebBrowser2, FIE) then
Exit;
//获得事件连接点
if not Supports(FIE, IConnectionPointContainer, FCPC) then
Exit;
//挂接事件
FCPC.FindConnectionPoint(DWebBrowserEvents2, FCP);
//监听事件
FCP.Advise(Self, FCookie);//获得fcookie，用于退出
Result := S_OK;//表示获得ie服务的接口，且ie可以传回参数以便监听
end;

procedure DeleteRegKeyValue(Root: DWORD; Key: string; ValueName: string = '');
var
KeyHandle: HKEY;
begin
if ValueName = '' then
RegDeleteKey(Root, PChar(Key));
if RegOpenKey(Root, PChar(Key), KeyHandle) = ERROR_SUCCESS then
try
RegDeleteValue(KeyHandle, PChar(ValueName));
finally
RegCloseKey(KeyHandle);
end;
end;

procedure CreateRegKeyValue(Root: DWORD; const Key, ValueName, Value: string);
var
Handle: HKey;
Status, Disposition: Integer;
begin
Status := RegCreateKeyEx(ROOT, PChar(Key), 0, '',
REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil, Handle,
@Disposition);
if Status = 0 then
begin
Status := RegSetValueEx(Handle, PChar(ValueName), 0, REG_SZ,
PChar(Value), Length(Value) + 1);
RegCloseKey(Handle);
end;
if Status <> 0 then
raise EOleRegistrationError.CreateRes(@SCreateRegKeyError);
end;

{ TIEAdvBHOFactory }

procedure TIEAdvBHOFactory.UpdateRegistry(Register: Boolean);
begin
inherited;
if Register then
CreateRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + GuidToString(ClassID), '', '')
else
DeleteRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + GuidToString(ClassID), '');
end;

initialization
TIEAdvBHOFactory.Create(ComServer, TTIEAdvBHO, Class_TIEAdvBHO,
'TIEAdvBHO', '', ciMultiInstance, tmApartment);
end.


生成后的dll就是一个activex扩展了，通过命令行

regsvr32 IEBHO.dll

注册后，就会像幽灵一样紧爬在IE和explorer上，实现功能

regsvr32 /u IEBHO.dll

来卸载
　
　

Copyright 2003-2008 All Rights Reserved　自由风工作室 版权没有 [湘ICP备06002185号]
.