DELPHI如何 编写 IIS的ISAPI过滤

[qxh0724]

我想写一个过滤网站非法关键字的过滤器（DLL），参考网上的代码如下，应该在下面打星号的地方写替换函数但是不知道怎么写，比如我想把非法字符"黄色"替换成"#"。希望朋友们能提供代码例子，谢谢


library Project1;


uses
SysUtils,
Classes,
Windows,
Isapi4 in 'Isapi4.pas',
func in 'func.pas',

{$R *.res}

exports
GetFilterVersion,
HttpFilterProc,

TerminateFilter;
begin
end.

##################################################

unit func;

interface
uses Windows, Classes, SysUtils,Dialogs,Isapi4, CVCode,DB, ADODB, ActiveX, SyncObjs;

function HttpFilterProc(var pfc: THTTP_FILTER_CONTEXT; Notificationtype: DWORD;
pvNotification: Pointer): DWORD; stdcall;
function GetFilterVersion(var Ver: THTTP_FILTER_VERSION): BOOL; stdcall;
function TerminateFilter(dwFlags: DWORD): BOOL; stdcall;

function exec(tmp:pchar):pchar;

implementation


function GetFilterVersion(var Ver: THTTP_FILTER_VERSION): BOOL;
begin

{$IFDEF DEBUG}
OutputDebugString('Call GetFilterVersion ...');
{$ENDIF}
OutputDebugString('Initialization ThreadLimit Filter...');

// Sets the filter version number.
Ver.dwFilterVersion := HTTP_FILTER_REVISION;
// Sets the filter description.
Ver.lpszFilterDesc := 'File access control filter.';
// Registers for the notifications.
Ver.dwFlags := SF_NOTIFY_ORDER_DEFAULT
or SF_NOTIFY_NONSECURE_PORT
or SF_NOTIFY_PREPROC_HEADERS
or SF_NOTIFY_AUTHENTICATION
or SF_NOTIFY_END_OF_REQUEST
or SF_NOTIFY_END_OF_NET_SESSION;

Result := TRUE;
end;


function HttpFilterProc (var pfc : THTTP_FILTER_CONTEXT;Notificationtype : DWORD ; pvNotification : Pointer) : DWORD ; stdcall ;
var
p : PHTTP_FILTER_RAW_DATA ;
i : integer ;
pc : pchar ;
// OnSendRawData _处理SF_NOTIFY_SEND_RAW_DATA 消息
function OnSendRawData : DWORD ;
begin
try
p := PHTTP_FILTER_RAW_DATA (pvNotification) ;
pc := p^.pvInData ;
if p^.cbInBuffer > 2 then
if (pc[0] = 'H') and (pc[1] = 'T') and (pc[2] = 'T') and (pc[3] = 'P') and (pc[4] = '/') then
pfc.pFilterContext:= pointer (0) ;
case integer(pfc.pFilterContext) of
0 , 3 : //check header , check MIME
begin
pfc.pFilterContext:= pointer(2) ;
i := 0 ;
while i < p^.cbInBuffer-4 -1 do
begin
if(pc[i] = '/') and (pc[i+1]='h') and (pc[i+2]='t') and (pc[i+3]='m') then
begin
pfc. pFilterContext:=pointer(1);
break ;
end ;
inc(i) ;
end ; // endof while
end ; // case 0
1 : // HTML data
begin
pfc. pFilterContext := pointer(1); // convert pc
**************************
**************************
替换关键字函数 不知道怎么写？？？？？？？？？？？？？？？？
**************************
**************************
end ;
end ; // end of case
result := SF_STATUS_REQ_NEXT_NOTIFICATION ;// return success ( always but exception) , call next filter(if exists)
except
Result := SF_STATUS_REQ_ERROR ;
end ;
end ; // func OnSendrawdata

begin
try
case NotificationType of
$80: // SF_NOTIFY_END_OF_REQUEST
begin
pfc. pFilterContext := pointer (0) ;
Result := SF_STATUS_REQ_NEXT_NOTIFICATION ;
end ;
SF_NOTIFY_SEND_RAW_DATA:
Result := OnSendRawData ;
else
Result := SF_STATUS_REQ_NEXT_NOTIFICATION ;
end ;
except
on E: Exception do
begin
result := SF_STATUS_REQ_NEXT_NOTIFICATION ;
end ;
end ;
end ;


function TerminateFilter(dwFlags: DWORD): BOOL;
begin
Result := TRUE;
end;


end.

[mygodsos]

路过帮顶
=============
11月6日，论坛升级公告，积分已经做了调整！
http://topic.csdn.net/u/20081107/11/b27dc75f-14b1-4594-9de3-5b18d9e36a11.html
此次调整增加了两个新的可用分获取渠道：
1：帖子被推荐（加精）后，帖主可以获得88分的可用分奖励；
2：帖子结帖后会返还帖主50%的悬赏分，无满意结帖不返还分数；
3：接下来会不断增加新的可用分获取途径，比如参与活动赠送等，请大家多关注；

[CruelYoung123]

要网上搜。。。记得以前搜到过delphi的例子

[panrongzeng]

      for i:=0 to SensitiveList.Count-1 do
      begin
        if pos(SensitiveList[i],moText.Text)<>0 then
        begin
          Application.MessageBox(pchar('内容中有敏感字“'+SensitiveList[i]+'”！'),'提示',MB_ICONINFORMATION);
          exit;
        end;
      end;

SensitiveList[i]为敏感字列表，moText.Text为目标文本

[withcsharp]

这是 我以前写的 你参考一下

if clen > 0 then
begin
pfc_rec.headlen := 0;
pfc_rec.contentlen := clen;
pfc_rec.buffLen_write := 0;
pfc_rec.buffLen_AllocMem := clen + 1024 * 4; //ΪHTTPͷº̰fc_rec Ԥ´4k
pfcBuff := pfc.AllocMem(pfc, pfc_rec.buffLen_AllocMem, 0);
Move(pfc_rec, pfcBuff^, sizeof(pfc_rec));
pfc.pFilterContext := pfcBuff; //will convert
end;

function HttpFilterProc(var pfc: THTTP_FILTER_CONTEXT; Notificationtype: DWORD;
pvNotification: Pointer): DWORD;

function OnSEND: DWORD;
var
s: string;
size: DWORD;
clen, i: integer;
pfcBuff: Pointer;
pfc_rec: Tpfc_rec;
vname: string;
Buffer: string;
function getv: boolean;
begin
size := 255;
setlength(Buffer, Size);
result := TFilterGetServerVariableProc(pfc.GetServerVariable)(pfc, pchar(vname), @(Buffer[1]), Size);
setlength(Buffer, Size);
end;
begin
setlength(s, 255);
size := 254;
pfc.pFilterContext := nil;

//TFilterGetServerVariableProc = function (var pfc{: THTTP_FILTER_CONTEXT};
//VariableName: PChar; Buffer: Pointer; var Size: DWORD ): BOOL stdcall;


vname := 'ALL_HTTP';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'AUTH_TYPE';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'CONTENT_LENGTH';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'CONTENT_TYPE';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'GATEWAY_INTERFACE';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'HTTP_ACCEPT';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'PATH_INFO';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'PATH_TRANSLATED';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'QUERY_STRING';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'REMOTE_ADDR';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'REMOTE_HOST';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'REMOTE_USER';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'REQUEST_METHOD';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'SCRIPT_NAME';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'SERVER_NAME';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'SERVER_PORT';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'SERVER_PROTOCOL';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := 'SERVER_SOFTWARE';
if getv then sendmsgtoMonitor(vname + ':' + Buffer);
vname := '';
Buffer := '';
with THTTP_FILTER_PREPROC_HEADERS(pvNotification^) do
begin
if TGetHeaderProc(GetHeader)(pfc, 'Content-type:', s[1], size) then
begin
SetLength(s, size);
s := trim(s);
sendmsgtoMonitor('Content-type:' + s);

if checkWillConvert(s) then
begin
setlength(s, 255);
size := 254;
if TGetHeaderProc(GetHeader)(pfc, 'Content-Length:', s[1], size) then
begin
SetLength(s, size);
s := trim(s);
sendmsgtoMonitor('Content-Length:' + s);
clen := StrToIntDef(s, 0);
if clen > 0 then
begin
pfc_rec.headlen := 0;
pfc_rec.contentlen := clen;
pfc_rec.buffLen_write := 0;
pfc_rec.buffLen_AllocMem := clen + 1024 * 4; //ΪHTTPͷº̰fc_rec Ԥ´4k
pfcBuff := pfc.AllocMem(pfc, pfc_rec.buffLen_AllocMem, 0);
Move(pfc_rec, pfcBuff^, sizeof(pfc_rec));
pfc.pFilterContext := pfcBuff; //will convert
end;
end;
end;
end;
end;
s := '';
Result := SF_STATUS_REQ_NEXT_NOTIFICATION;
end;

[withcsharp]

如果 你是只是 替换 就简单
我的 那个 可能 以前是 转换 + 广告的

[Im17benteng]

楼上的程序会漏掉很多关键词

iis6以后向client发送数据是分包的

如果数据量一大就会出现
包1的尾字为关
包2的头为键词
这样关键词这三个字就替换不了

还有,http头中包含加长的附带数据如长Cookie+长URL,长URL参数等

你的程序就会出错

http头中的数据包含关键词而程序替换了,替换后http请求有可能会出错

没有重设Conteng-Length大小会导致内存益出

正确的方法是把发向Client的数据阻塞累加,分离http头与内容,替换内容中的关键词,重设置Conteng-Length重新向Client发送数据

替换关键词建议使用正则表达式,处理速度会比你这样遍历快很多