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 "<b>原文内容：</b>" & OldWords
Response.Write "<br><br><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
％>


 

标签：关键词,过滤,函数
0
投稿

猜你喜欢

  • Python动态导入模块和反射机制详解

    2023-07-16 14:02:10

  • python目标检测YoloV4当中的Mosaic数据增强方法

    2022-03-29 06:48:14

  • Python语言描述KNN算法与Kd树

    2021-07-24 05:10:35

  • python中fastapi设置查询参数可选或必选

    2021-11-04 12:25:18

  • 自动定时备份sqlserver数据库的方法

    2024-01-13 20:45:14

  • 如何修改vue-treeSelect的高度

    2024-05-08 09:33:55

  • 如何从Python字符串中删除最后一个分号或者逗号

    2023-12-22 07:29:53

  • 解决pip install psycopg2出错问题

    2023-01-22 01:41:09

  • pytorch 实现二分类交叉熵逆样本频率权重

    2021-04-29 00:25:29

  • 在JavaScript中，为什么要尽可能使用局部变量？

    2009-03-01 12:38:00

  • Python Matplotlib简易教程(小白教程)

    2023-12-29 05:31:57

  • golang mysql的连接池的具体使用

    2024-01-14 11:52:10

  • 使用CSS选择器创建个性化链接样式

    2009-06-02 13:07:00

  • 分享Python文本生成二维码实例

    2023-12-16 09:42:28

  • Mysql 如何查询时间段交集

    2024-01-22 09:27:32

  • CPQuery 解决拼接SQL的新方法

    2012-11-30 20:01:46

  • go doudou开发gRPC服务快速上手实现详解

    2024-05-05 09:33:11

  • git本地分支和stash内容报错消失的问题

    2023-10-19 01:48:47

  • 浅析PEP572: 海象运算符

    2023-06-28 10:56:10

  • 教你两步解决conda安装pytorch时下载速度慢or超时的问题

    2022-04-12 17:19:59
    • asp之家 网络编程 m.aspxhome.com