给一个我很早做的反黄软件的代码，是基于SPI的。
//------------------------------------------------------------------------------
function WSPSend(s: TSocket;
lpBuffers: LPWSABUF;
dwBufferCount: DWORD;
var lpNumberOfBytesSent: DWORD;
dwFlags: DWORD;
lpOverlapped: LPWSAOVERLAPPED;
lpCompletionRoutine: LPWSAOVERLAPPED_COMPLETION_ROUTINE;
lpThreadId: LPWSATHREADID;
var lpErrno: Integer): Integer; stdcall;
var
Acl :Integer;
begin
dbPrint('WSPSend...');
try
// 调用控制函数CheckSend，检查允许放行，同时这个函数会纪录封包信息。
Acl:=cCheckAcl.CheckSend(s,
lpBuffers,
dwBufferCount,
lpNumberOfBytesSent,
dwFlags,
lpOverlapped,
lpCompletionRoutine,
lpThreadId,
lpErrno);
case Acl of
XF_DENY:
begin
xxShutDown(s);
lpErrno:=WSAECONNABORTED;
Result:=SOCKET_ERROR;
end;
XF_APPEND:
begin
Result:=0;
end;
else
begin
// 调用底层函数对发送请求进行转发
Result:=NextProcTable.lpWSPSend(s,
lpBuffers,
dwBufferCount,
lpNumberOfBytesSent,
dwFlags,
lpOverlapped,
lpCompletionRoutine,
lpThreadId,
lpErrno);
end;
end;
except
Result:=-1;
dbError('WSPSend Error');
end;
end;
function TCheckAcl.GetHttpSend(Session: PSession; lpBuffers: LPWSABUF;
dwBufferCount: DWORD; var lpNumberOfBytesSent: DWORD; dwFlags: DWORD;
lpOverlapped: LPWSAOVERLAPPED;
lpCompletionRoutine: LPWSAOVERLAPPED_COMPLETION_ROUTINE;
lpThreadId: LPWSATHREADID; var lpErrno: Integer): integer;
var
sHost :array[0..255] of char;
nHost :integer;
sGet :array[0..255] of char;
nGet :integer;
Buf :array[0..512] of char;
Len :integer;
sUrl :array[0..255] of char;
i,j :integer;
iStart:integer;
iEnd :integer;
Data :TObject;
begin
Result:=XF_PASS;
sc.Enter;
try
if ((lpBuffers.Buf[0]<>'g') and (lpBuffers.Buf[0]<>'G')) or
((lpBuffers.Buf[1]<>'e') and (lpBuffers.Buf[1]<>'E')) or
((lpBuffers.Buf[2]<>'t') and (lpBuffers.Buf[2]<>'T')) then
begin
Exit;
end;
Len:=lpBuffers.len;
if Len>SizeOf(Buf) then
begin
Len:=SizeOf(Buf)-1;
end;
FillChar(Buf,SizeOf(Buf),0);
FillChar(sHost,Sizeof(sHost),0);
FillChar(sGet,Sizeof(sGet),0);
FillChar(sUrl,Sizeof(sUrl),0);
Move(lpBuffers.Buf^,Buf,Len);
try
// Get内容
for i:=4 to Len do
begin
if (Buf=' ') or (Buf=#13) then
begin
Break;
end;
end;
if i>=Len then
begin
Exit;
end;
nGet:=i-3;
if nGet>255 then
begin
Exit;
end;
Move(Buf[4],sGet[0],i-3);
except
on e:exception do
begin
dbPrint('Get Http infor: %s',[e.Message]);
Exit;
end;
end;
try
// URl内容
iStart:=0;
for j:=5 to Len-5 do
begin
if (Buf[j+0]='H') and
(Buf[j+1]='o') and
(Buf[j+2]='s') and
(Buf[j+3]='t') and
(Buf[j+4]=':') then
begin
iStart:=j + 5;
Break;
end;
end;
if iStart=0 then
begin
Exit;
end;
iEnd:=0;
for i:=iStart to Len do
begin
if (Buf=#13) then
begin
iEnd:=i-1;
Break;
end;
if (Buf >= 'A') and (Buf <= 'Z') then
begin
Inc(Buf,32);
end;
end;
if iEnd=0 then
begin
dbPrint('Invalid Host');
Exit;
end;
nHost:=0;
for i:=iStart to iEnd do
begin
if Buf<>' ' then
begin
sHost[nHost]:=Buf;
Inc(nHost);
end;
end;
except
on e:exception do
begin
dbPrint('Get Http Host: %s',[e.Message]);
Exit;
end;
end;
//dbPrint('Host:' + sHost);
//dbPrint('Host Len:' + inttostr(nHost));
try
// 获得顶级域名
for i:=0 to nHost do
begin
if sHost='.' then
begin
if (i=3) and ((sHost[0] + sHost[1] + sHost[2])='www') then
begin
Move(sHost,sUrl,Len);
end
else
begin
sUrl:='wwww';
Move(sHost,sUrl[3],nHost -i + 1);
end;
Break;
end;
end;
if i>=Len then Exit;
except
on e:exception do
begin
dbPrint('Get Http Url:' + e.Message);
Exit;
end;
end;
try
FillChar(Session^.sHost,sizeof(Session^.sHost),0);
Session^.sHost:='http://';
// 太长则退出
if (nGet + nHost)>(Sizeof(Session^.sHost)-6) then
begin
dbPrint('too long host name!');
Exit;
end;
Move(sHost[0],Session^.sHost[7],nHost);
Move(sGet[0],Session^.sHost[nHost+7],nGet);
except
on e:exception do
begin
dbError('Copy to Error 2:' + sGet);
Exit;
end;
end;
// 非特定网站的拦截
if (NdisHookRec^.ChildWebFilter) and (ChildWebFilter<>nil) then
begin
if (not ChildWebFilter.Find(sHost,Data)) and
(not ChildWebFilter.Find(IPToStr(Session.ulRemoteIP),Data)) and
(not ChildWebFilter.Find(sUrl,Data)) then
begin
dbPrint('! ' + sHost);
// 发送到服务器
if NdisHookRec^.MsgHandle<>0 then
begin
SendMsg(MSG_LOADURL,@Session.sHost[0],strLen(@Session.sHost[0]));
end;
Result:=XF_DENY;
Exit;
end;
end;
// 特定网站的拦截
if NdisHookRec^.PornWebFilter and (AdultWebFilter<>nil) then
begin
if AdultWebFilter.Find(sHost,Data) or
AdultWebFilter.Find(IPToStr(Session.ulRemoteIP),Data) or
AdultWebFilter.Find(sUrl,Data) then
begin
dbPrint('= ' + sHost);
// 发送到服务器
if NdisHookRec^.MsgHandle<>0 then
begin
SendMsg(MSG_LOADURL,@Session.sHost[0],strLen(@Session.sHost[0]));
end;
Result:=XF_DENY;
Exit;
end;
end;
finally
sc.Leave;
end;
end;
