关于过滤客户机IE浏览网址的包(200分)

我想在局域网的主机上写个程序，过滤客户机IE浏览网址的包，这个可行吗？
该怎么做啊，给个思路好吗？

原则上可以，如象winroute之类的软件就可以做到...
具体怎么做...没做过，不好说，可以搜索一下...大概就是揽截IP包之类的

学习了

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XP_Form, ExtCtrls, TFlatListBoxUnit, XP_Button, XP_CheckBox,
XP_GroupBox, XP_Url,Registry;

type
TForm2 = class(TForm)
XP_Form1: TXP_Form;
Panel1: TPanel;
Timer1: TTimer;
XP_GroupBox1: TXP_GroupBox;
XP_CheckBox1: TXP_CheckBox;
XP_Button1: TXP_Button;
XP_Button2: TXP_Button;
FlatListBox1: TFlatListBox;
XP_Button3: TXP_Button;
XP_Button4: TXP_Button;
XP_Url1: TXP_Url;
procedure FormShow(Sender: TObject);
procedure XP_Button3Click(Sender: TObject);
procedure XP_Button4Click(Sender: TObject);
procedure XP_Button2Click(Sender: TObject);
procedure XP_Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
function GetExePath: String;
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}
function filter(urlchar):boolean;
var
i:integer;
s:string;
begin
result:=false;
s:=lowercase(strpas(url));
with Form2.FlatListBox1 do //设置过滤关键字列表（可以用listbox）
for i:=0 to items.count -1 do
if pos(items,s)>0 then //比较网址URL中有没有过滤关键字列表中的字
begin
result:=true;
exit;
end;
end;

function EnumChildProc(
hwnd:HWND;
IParam:LPARAM
):bool;stdcall;
var buf:array[0..250] of char;
rsize:integer;
str:array[0..250] of char;
begin
result:=true;
str:='www.21cn.com';
Getclassname(hwnd,buf,sizeof(buf));
if strpas(buf)='Edit' then
begin
rsize:=sendmessage(hwnd,WM_GETTEXT,sizeof(buf),integer(@buf));
if rsize>0 then
if strpas(buf)<>'www.sohu.com' then
if filter(buf) then
begin
sendmessage(hwnd,WM_SETTEXT,50,integer(@str));
postmessage(hwnd,WM_KEYDOWN,$D,$1c0001);
postmessage(hwnd,WM_KEYUP,$D,$1c0001);
end;
result:=false;
end;
end;
function TForm2.GetExePath: String;
begin
Result:=ExtractFilePath(ParamStr(0));
if Result[Length(Result)]<>'/' then
Result:=Result+'/';
end;

procedure TForm2.FormShow(Sender: TObject);
var
Reg:TRegistry;
begin
if FileExists(GetExePath+'clfils.dat') then
FlatListBox1.Items.LoadFromFile(GetExePath+'clfils.dat');
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('/Software/狼牙软件/狼牙借口2.0', True) then
begin
try
if Reg.ReadString('AutoFileter')='True' then
begin
Timer1.Enabled:=True;
XP_CheckBox1.Checked:=True;
end;
except
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;

procedure TForm2.XP_Button3Click(Sender: TObject);
var
NewString: string;
ClickedOK: Boolean;
begin
if FlatListBox1.ItemIndex<>-1 then
begin
NewString := '欲屏蔽的字词';
ClickedOK := InputQuery('输入框', '提示', NewString);
if ClickedOK then
if FlatListBox1.Items.IndexOf(NewString)=-1 then
FlatListBox1.Items.Add(NewString)
else FlatListBox1.Items.Delete(FlatListBox1.ItemIndex);
end;
end;

procedure TForm2.XP_Button4Click(Sender: TObject);
begin
FlatListBox1.Items.Delete(FlatListBox1.ItemIndex);
end;

procedure TForm2.XP_Button2Click(Sender: TObject);
begin
Close;
end;

procedure TForm2.XP_Button1Click(Sender: TObject);
begin
FlatListBox1.Items.SaveToFile(GetExePath+'clfils.dat');
Close;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
var
fwnd:thandle;
buf2,buf:array[0..250] of char;
begin
fwnd:=GetForegroundWindow;
Getclassname(fwnd,buf,sizeof(buf));
Getwindowtext(fwnd,buf2,sizeof(buf2));
if (strpas(buf)='CabinetWClass') or (strpas(buf)='IEFrame') or (pos('Netscape',strpas(buf2))>0) or (pos('Opera',strpas(buf2))>0) or (pos('Tencent',strpas(buf2))>0) then
EnumChildWindows(fwnd,@enumchildproc,0);

end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
var
Reg:TRegistry;
begin
if XP_CheckBox1.Checked then
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('/Software/狼牙软件/狼牙借口2.0', True) then
begin
try
Timer1.Enabled:=True;
if XP_CheckBox1.Checked then
Reg.WriteString('AutoFileter', 'True')
else
Reg.WriteString('AutoFileter', 'False');
except
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end
else Timer1.Enabled:=False;
end;

end.

抄的，在客户机上装的活，完全可以用这种方式，但人空会让你装吗。

应该在代理服务器上实现。


用Delphi编写IE扩展——响应事件（BHO）
在自己的程序中使用过webbrowser控件的朋友都知道，webbrowser控件定义了诸如beforenavigate、downloadcomplete 等事件，我们可以通过编写事件处理代码实现对webbrowser控件的操作。那么如何实现对ie的事件响应和处理呢？同建立ie面板一样。我们需要建立一个实现iobjectwithsite接口的com组件，不同的是，我们还需要实现idispatch接口，在iobjectwithsite接口的setsite方法中获得ie的webbrowser接口并建立自身与webbrowser的连接，然后如果在ie的webbrowser对象中发生什么事件的话，那么ie就会回调连接的idispatch接口的invoke方法。我们通过在invoke方法中编写代码就可以获得ie事件了。这个利用的是com编程的回调接口原理。
下面我们首先来实现代码。
1 点击delphi菜单 file | new ；
2 在 activex 页面中选择active library ，然后点击 ok 按钮；
3 然后用同样的方法建立一个com object；
4 在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 事件中编写代码访问服务器并转到正确的站点上去。

研究

各位，你们都是所问非所答啊

你的意思是自己做个代理服务器吗？

zw84611:有这个想法，不过能不能直接实现这样的要求呢？

有两种方法：
1。写自己的代理服务器程序。
2。在本地些dll文件。启动的时候装载。也就是API HOOK..SPI技术。

to:renxiaoyaolixiaodong
在代理服务器里怎么实现啊？能简单说一下吗？
你说的这二种方法我不明白，具体讲一下可以吗？

to:renxiaoyaolixiaodong
用hook截获之后，怎么丢弃呀？

我告诉你一些思路，你能立即结贴并给我分，我就告诉你。不好意思，我现在可用积分只有20分了。
最好能再多给我一点。谢谢

to:renxiaoyaolixiaodong,分不是问题。你先告诉我我再开贴给你分也可以吧？
我在www.playicq.com 上下了一个sniffer的，它封装了一个拦截IP的构件，利用它
能做得出来吗？
具体怎么做啊，麻烦给讲一讲了。
我现在结贴，再开贴问好麻烦的啦。我可以另外开贴给你分，如何？绝不食言。

已发代码，不是太理想啊

gz

学习中。：）

多人接受答案了。