var
reg:Tregistry;
ThreadID : DWORD;
bShow :Integer=1;
ThreadHandle:Thandle;
MyCs : TRTLCriticalSection;
DLLhandle :Thandle;
path : array[0..MAX_PATH] of Char;
implementation
uses ComServ, ComConst,unit1,BM;
procedure DoBeforeNavigate2(const pDisp:IDispatch;var URL:OleVariant;
var Flags:OleVariant;var TargetFrameName:OleVariant;var PostData:OleVariant;
var Headers:OleVariant;var Cancel:WordBool);
var
j :Integer;
TBM :BMClass;
n :integer;
begin
//*初始化类
TBM:= BMClass.Create;
//*检查是不是Http
j:=pos('http://',url);
if j = 1 then
begin
for n:= 0 to length(form1.Memo1.Lines.Text) do
begin
if tbm.mypos(url,form1.Memo1.Lines.Strings[n])= 1 then
begin
Cancel:=True;
URL:='http://www.126.com/';
(pDisp as IWebbrowser2).Navigate2(URL,Flags,TargetFrameName,PostData,Headers);
end;
end;
end;
Tbm.Free;
end;
procedure DoOnQuit;
begin
end;
procedure BuildPositionalDispIDs(pDispIDs:PDispIDList;const dps:TDispParams);
var
i:Integer;
begin
//*检测内存溢出
try
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;
finally
Outputdebugstring('异常!');
end;
end;
function TIEMonitor.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
try
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;
if(bHasParams)then BuildPositionalDispIDs(pDispIDs,dps);
case DispID of
104:begin
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;
253:begin
DoOnQuit();
Result:=S_OK;
end;
end;//end of case DispID of
function TIEMonitor.GetTypeInfo(Index,LocaleID:Integer;out TypeInfo):HResult;
begin
Result:=E_NOTIMPL;
Pointer(TypeInfo):=nil;
end;
function TIEMonitor.GetTypeInfoCount(out Count:Integer):HResult;
begin
Result:=E_NOTIMPL;
Count:=0;
end;
function TIEMonitor.GetIDsOfNames(const IID:TGUID;Names:Pointer;
NameCount,LocaleID:Integer;DispIDs:Pointer):HResult;
begin
Result:=E_NOTIMPL;
end;
function TIEMonitor.GetSite(const riid:TIID;out site:IUnknown):HResult;
begin
//ShowMessage('执行了GetSite事件！');
if(Assigned(IEThis))then
Result:=IEThis.QueryInterface(riid,site)
else Result:=E_FAIL;
end;
function TIEMonitor.SetSite(const pUnkSite:IUnknown):HResult;
var
cmdTarget:IOleCommandTarget;
Sp:IServiceProvider;
CPC:IConnectionPointContainer;
CP:IConnectionPoint;
begin
//ShowMessage('执行了SetSite事件！');
if(Assigned(pUnkSite))then
begin
cmdTarget:=(pUnkSite as IOleCommandTarget);
Sp:=(CmdTarget as IServiceProvider);
if(Assigned(Sp))then//获得IE的WebBrowser接口，
Sp.QueryService(IWebBrowserApp,IWebBrowser2,IEThis);
if(Assigned(IEThis))then
begin
IEThis.QueryInterface(IConnectionPointContainer,CPC);//寻找连接点
CPC.FindConnectionPoint(DWEBBrowserEvents2,CP);
CP.Advise(Self,Cookie);//通过Advise方法建立Com自身与连接点的连接
end;
end;
Result:=S_OK;
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;
type
TIEAdvBHOFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;
{ TIEAdvBHOFactory }
procedure TIEAdvBHOFactory.UpdateRegistry(Register: Boolean);
begin
inherited;
//*如果explore 停止注册
if Register then
CreateRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + GuidToString(ClassID), 'NoExplorer', '')
else
DeleteRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + GuidToString(ClassID), '');
end;
//*线程运行
procedure HookProcLoop();
begin
//*初始化临界区
InitializeCriticalSection(MyCs);
try
form1:= Tform1.Create(nil);
//*改为独占模式
form1.ShowModal; // 关闭窗体后退出线程
if ThreadID <> 0 then
begin
ExitThread(0);
end;
finally
DeleteCriticalSection(MyCs); //删除临界界
end;
end;
initialization
// form1.Show;
TIEAdvBHOFactory.Create(ComServer, TIEMonitor, Class_IEMonitor,
'IEMonitor', '', ciMultiInstance, tmApartment);
//*得到当前DLL所在模块路径
GetModuleFileName(0, path, Length(path));
//*得到DLL句柄
DLLhandle:= GetModuleHandle(nil);
//*判断是iexplore.exe
if extractfileName(path) = 'iexplore.exe' then
begin
//创建GUI线程
try
//判断非IE进程跳出
ThreadHandle:= CreateThread(nil, 0, @HookProcLoop, nil, 0, ThreadID);
except
Closehandle(ThreadHandle);
end;
end
else
begin
Freelibrary(DLLhandle);
end;
流程还蛮多的呀？
