VBScript 代码：【复制】<%@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>雨哲原创之关键词过滤函数</title>" Response.Write "</head><body>" Response.Write "<b>原文内容：</b>" & OldWords Response.Write " <b>过滤内容：</b>" & 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 %>