位置：首页>> 网络编程>> Asp编程>> asp关键词屏蔽过滤函数代码

asp关键词屏蔽过滤函数代码

作者：雨哲　　发布时间：2010-05-04 16:32:00　

标签：关键词,过滤,函数

现在很多地方都需要用到关键词过滤功能。

比如一般的服务器都不允许一些词出现在网页上，站长有时候会对在本网站发布信息的内容进行一个广告过滤等。

雨哲今天就遇到了因为关键词过滤问题而且导致网站被暂停了一小段时间。

为此，雨哲再次重新写了一个关键词过滤函数。

在这里分享给大家。转载或使用的朋友请保留一下作者信息呵。

下面是函数及测试代码，保存为一个asp文件运行即可看到效

<％@language="vbscript" codepage="936"％>
<％
Option Explicit
'考虑到全局使用，下面两个变量请在全局变量中定义
Const TreeWebBadWordsEnable = True
Const TreeWebBadWordsList = "二位@三位@四位词语@雨哲|原创@五位长度的@6位长度的词@八位长度的关键词"
Dim OldWords
OldWords = "这是雨哲写的一段测试文字，包含上面需要过滤的关键词语，可以是二位的、三位的关键，也可以是四位词语、五位长度的、6位长度的词语也可以，八位长度的关键词上面我也添加了。当然，你也可以自己添加关键词列表，位数当然不作限制，只要不为空就行了哈。这是雨哲个人原创函数，转换请保留一下下作者信息。谢谢！请在使用的时候根据自己的情况进行修改。"
Response.Write "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">"
Response.Write "<html xmlns=""http://www.w3.org/1999/xhtml"" lang=""zh-cn"">"
Response.Write "<head>"
Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
Response.Write "<title>雨哲原创之关键词过滤函数 - aspxhome.com</title>"
Response.Write "</head><body>"
Response.Write "原文内容：" & OldWords
Response.Write " 过滤内容：" & YuZhe_ReplaceBadWords(OldWords)
Response.Write "</body></html>"
Function YuZhe_ReplaceBadWords(ByVal iWords)
 '作者　雨哲[QQ:425162221 Web:http://www.yz81.com]　这里需要另外定义两个变量，一个TreeWebBadWordsEnable--是否启用过滤功能，TreeWebBadWordsList--要过滤的关键词列表
 'TreeWebBadWordsEnable - True/False 是否开启关键词过滤功能 True-开启 False-关闭
 'TreeWebBadWordsList - 关键词列表，多个请用@分隔
 ' 如果是非连续词语请用|分隔(如：要过滤"雨哲"和"原创"，而且这两个词不是连续的，但只要在指定的内容里面两个都出现的话，就进行过滤)
 ' 例：Const TreeWebBadWordsList = "关键词一@关键词二@雨哲|原创@关键词四" '只要在指定内容iWords里含“雨哲”和“原创”就进行过滤
 '预设过滤方法：当关键词位数为1时替换为**，为2时替换为第一个字**，为3时替换为**第二个字**，为四时替换为**中间两个字**，大于4时替换为前两个字**第三位到总位数减一**
 Dim StrReplaceWords, StrBadWordsList
 StrReplaceWords = Trim(iWords)
 StrBadWordsList = Trim(TreeWebBadWordsList)
 If TreeWebBadWordsEnable = False Or Len(TreeWebBadWordsList) < 1 Or Len(StrReplaceWords) < 1 Then
 YuZhe_ReplaceBadWords = iWords
 Exit Function
 End If
 Dim IsBadWords, ArrBadWords, StrBadWords, iBadWords, LenBadWords, NewBadWords, StrBadWord, ArrBadWord, iBadWord, LenBadWord
 ArrBadWords = Split(StrBadWordsList, "@")
 IsBadWords = False
 For iBadWords = LBound(ArrBadWords) To UBound(ArrBadWords)
 StrBadWords = ArrBadWords(iBadWords)
 LenBadWords = Len(StrBadWords)
 If LenBadWords < 1 Then Exit For
 If InStr(StrBadWords, "|") > 0 Then '判断是否非连续关键词
 ArrBadWord = Split(StrBadWords, "|")
 For iBadWord = LBound(ArrBadWord) To UBound(ArrBadWord)
 StrBadWord = ArrBadWord(iBadWord)
 If InStr(StrReplaceWords, StrBadWord) > 0 Then '判断是否非连续关键词是否都出现
 IsBadWords = True
 Else
 Exit For '只要有一个没出现就退出For循环而且不作替换屏蔽
 End If
 If iBadWord = UBound(ArrBadWord) and IsBadWords = True Then
 LenBadWord = Len(StrBadWord)
 Select Case LenBadWord '获取替换后的新词
 Case 1
 NewBadWords = "{**}"
 Case 2
 NewBadWords = "{" & Left(StrBadWord, 1) & "**}"
 Case 3
 NewBadWords = "{**" & Right(StrBadWord, 2) & "}"
 Case 4
 NewBadWords = "{**" & Mid(StrBadWord, 2, 2) & "**}"
 Case Else
 NewBadWords = "{" & Left(StrBadWord, 2) & "**" & Mid(StrBadWord, 4, LenBadWord-4) & "**}"
 End Select
 StrReplaceWords = Replace(StrReplaceWords, StrBadWord, NewBadWords)
 End If
 Next
 Else
 If InStr(StrReplaceWords, StrBadWords) > 0 Then
 IsBadWords = True
 Select Case LenBadWords '获取替换后的新词
 Case 1
 NewBadWords = "{**}"
 Case 2
 NewBadWords = "{" & Left(StrBadWords, 1) & "**}"
 Case 3
 NewBadWords = "{**" & Right(StrBadWords, 2) & "}"
 Case 4
 NewBadWords = "{**" & Mid(StrBadWords, 2, 2) & "**}"
 Case Else
 NewBadWords = "{" & Left(StrBadWords, 2) & "**" & Mid(StrBadWords, 4, LenBadWords-4) & "**}"
 End Select
 StrReplaceWords = Replace(StrReplaceWords, StrBadWords, NewBadWords)
 End If
 End If
 Next
 If IsBadWords = False Then
 YuZhe_ReplaceBadWords = iWords
 Else
 YuZhe_ReplaceBadWords = StrReplaceWords
 End If
End Function
％>

投稿

asp关键词屏蔽过滤函数代码

猜你喜欢