倾家荡产求 杀广告窗口的源码(在未下载前就杀除窗口的) (91分)

谢谢大家帮助...

还有一个小问题一个软件如何在设定好的时间自动退出自己呢? 比如需要设置在开启软件30分钟后关闭自身.

广告窗口杀手
作者 官本和
简介 一个屏蔽IE弹出广告窗口的源程序

大小 18KB
下载 http://mydelphi.8u8.com/ym2.htm
-----------
让应用程序自身删除
http://mydelphi.8u8.com/wd4.htm
再加个定时器就可以了

下载上面的软件看看，顺便接接分

退出自己只需要加个定时器就已经足够

to yczjs, 这个源码我用过了 它只能再打开广告页面以后关闭,不能提前拦截

to takashiki, 能不能给一个详细的代码? 退出自身,不是删除自身

TO:lailongmen,退出自身的意思是退出本程序吧?
放一个Timer,时间设为1800000(就是30分钟),代码就是 close;

不会这么简单的问题吧?
那个去广告我也想知道答案

顶～

[^] 有高人知道吗

这个问题我也随便说点，下不为例，我只灌水，不太想回答问题。
思路有 2：
1.这个东东必须在 ie 下使用。那么你首先需要知道 ie 插件的概念，过滤 pop 脚本。
2.这个东东用在其它用途，只要过滤 pop 脚本就可以了。
另外，不写代码，使用 ie6 以上版本，在“安全”选项里定义安全操作内容也可以。

装个google工具栏就有了，比3721的好用多哩！

hugdog (陈省) <<Delphi 深度探索>>的附书原码

{-----------------------------------------------------------------------------
Unit Name: CIEBHO
Author: hubdog(陈省)
Email: hubdog@263.net
Purpose: 演示如何实现一个可以阻断广告弹出的BHO
History:
2003-4-23 创建本单元
-----------------------------------------------------------------------------}

unit CIEBHO;

{$WARN SYMBOL_PLATFORM OFF}

interface

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

type
TTIEAdvBHO = class(TComObject, IObjectWithSite, IDispatch)
private
FIESite: IUnknown;
FIE: IWebBrowser2;
FCPC: IConnectionPointContainer;
FCP: IConnectionPoint;
FCookie: Integer;
protected
//IObjectWithSite接口方法定义
function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
//IDispatch接口方法定义
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 = '{D032570A-5F63-4812-A094-87D007C23012}';

implementation

uses ComServ, Sysutils, ComConst;

{ TTIEAdvBHO }

procedure TTIEAdvBHO.DoBeforeNavigate2(const pDisp: IDispatch; var URL,
Flags, TargetFrameName, PostData, Headers: OleVariant;
var Cancel: WordBool);
begin
if FIE.ToolBar=0 then FIE.Quit;
end;

procedure TTIEAdvBHO.DoNewWindow2(var ppDisp: IDispatch;
var Cancel: WordBool);
begin
//判断页面是否显示完全
// Debugger.LogMsg('NewWindow2');
// if FIE.ReadyState<>REFRESH_COMPLETELY then
// begin
// //不完全，禁止
// Cancel:=False;
// ppDisp:=FIE.Application;
// 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;
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;

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 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);
Result := S_OK;
case DispId of
// 251://NEWWINDOW2事件ID
// begin
// DoNewWindow2(IDispatch(dps.rgvarg^[pDispIds^[0]].pdispval^),
// dps.rgvarg^[pDispIds^[1]].pbool^);
// end;
250://BeforeNaviage2事件id
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^);
end;
253://OnQuit事件ID
begin
FCP.Unadvise(FCookie);
end;
else
Result := DISP_E_MEMBERNOTFOUND;
end;
finally
if (bHasParams) then
FreeMem(pDispIds, iDispIdsSize);
end;
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);
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;
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.

多人接受答案了。