admin_filter.asp

个人网站比较简短

    Response.Write "   </td>" & vbCrLf
    Response.Write " </tr>" & vbCrLf
    Response.Write "</table>" & vbCrLf
    Response.Write "</form>" & vbCrLf
End Sub
'=================================================
'过程名：SaveFileter
'作  用：保存过滤
'=================================================
Sub SaveFileter()
    Dim rsFilters, SqlItem
    Dim FilterName, ItemID, FilterID, FilterObject, FilterType, FilterContent, FisString, FioString, FilterRep, Flag
    
    FilterName = Trim(Request.Form("FilterName"))
    ItemID = Trim(Request.Form("ItemID"))
    FilterID = PE_CLng(Trim(Request("FilterID")))
    FilterObject = Request.Form("FilterObject")
    FilterType = Request.Form("FilterType")
    FilterContent = Request.Form("FilterContent")
    FisString = Request.Form("FisString")
    FioString = Request.Form("FioString")
    FilterRep = Request.Form("FilterRep")
    Flag = Trim(Request.Form("Flag"))
                                  
    If FilterName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>过滤名称不能为空</li>"
    End If

    If ItemID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请选择过滤所属项目</li>"
    Else
        ItemID = CLng(ItemID)

        If ItemID = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请选择过滤所属项目</li>"
        End If
    End If

    If FilterObject = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请选择过滤对象</li>"
    Else
        FilterObject = PE_CLng(FilterObject)
    End If

    If FilterType = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请选择过滤类型</li>"
    Else
        FilterType = PE_CLng(FilterType)

        If FilterType = 1 Then
            If FilterContent = "" Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>过滤的内容不能为空</li>"
            End If

            If Len(FilterContent) >= 50 Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>过滤内容不能超过50字符,简单过滤用于屏蔽脏话等非法词汇,如果您要过滤html请用高级过滤</li>"
            End If

        ElseIf FilterType = 2 Then

            If FisString = "" Or FioString = "" Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>开始/结束标记不能为空</li>"
            End If

        Else
            FoundErr = True
            ErrMsg = ErrMsg & "<li>参数错误,请从有效链接进入</li>"
        End If
    End If

    If FoundErr = True Then
        Exit Sub
    End If

    If FoundErr <> True Then
        SqlItem = "select top 1 *  from PE_Filters"
        If FilterID <> 0 Then
            SqlItem = SqlItem & " where FilterID=" & FilterID
        End If

        Set rsFilters = Server.CreateObject("adodb.recordset")
        rsFilters.Open SqlItem, Conn, 1, 3
        If FilterID = 0 Then
            rsFilters.addnew
        End If
        rsFilters("FilterName") = FilterName
        rsFilters("ItemID") = ItemID
        rsFilters("FilterObject") = FilterObject
        rsFilters("FilterType") = FilterType

        If FilterType = 1 Then
            rsFilters("FilterContent") = FilterContent
        ElseIf FilterType = 2 Then
            rsFilters("FisString") = FisString
            rsFilters("FioString") = FioString
        End If

        rsFilters("FilterRep") = FilterRep

        If Flag = "Yes" Then
            rsFilters("Flag") = True
        Else
            rsFilters("Flag") = False
        End If

        rsFilters.Update
        rsFilters.Close
        Set rsFilters = Nothing
        If FilterID = 0 Then
            Call WriteSuccessMsg("<li>已经成功添加了过滤项目!", "Admin_Filter.asp?Action=main")
        Else
            Call WriteSuccessMsg("<li>已经成功修改了过滤项目!", "Admin_Filter.asp?Action=main")
        End If
    Else
        Exit Sub
    End If
End Sub
'=================================================
'过程名：Del
'作  用：删除过滤项目
'=================================================
Sub Del()
    Dim FilterID, sql
    FilterID = Trim(Request("FilterID"))
	If IsValidID(FilterID) = False Then
		FilterID = ""
	End If

    If FilterID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>ID不能为空</li>"
    Else

        If InStr(FilterID, ",") > 0 Then
            sql = "Delete From [PE_Filters] Where FilterID In (" & FilterID & ")"
        Else
            sql = "Delete From [PE_Filters] Where FilterID=" & FilterID
        End If

        Conn.Execute (sql)
		Call WriteSuccessMsg("<li>已经成功删除过滤项目!", "Admin_Filter.asp?Action=main")
    End If
End Sub
'=================================================
'过程名：DelAll
'作  用：清空过滤所有项目
'=================================================
Sub DelAll()
    Conn.Execute ("Delete From PE_Filters")
    Call WriteSuccessMsg("<li>已经成功清空过滤所有项目!", "Admin_Filter.asp?Action=main")
End Sub
'=================================================
'过程名：SetFlag
'作  用：是否启用
'=================================================
Sub SetFlag()
    Dim FilterID
    FilterID = Trim(Request("FilterID"))

    If FilterID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>ID不能为空</li>"
        Exit Sub
    Else
        If PE_CLng(Trim(Request("FilterFlag"))) = 1 Then
            sql = "update PE_Filters set Flag=" & PE_True & " where FilterID=" & PE_CLng(FilterID)
        Else
            sql = "update PE_Filters set Flag=" & PE_False & " where FilterID=" & PE_CLng(FilterID)
        End If
        Conn.Execute (sql)
    End If

    Response.Redirect "Admin_Filter.asp?Action=main"
End Sub
'*************************  类模块主区域结束  *******************************
'==================================================
'过程名：ShowItem_Option
'作  用：显示项目名称
'参  数：ItemID ------项目ID
'==================================================
Sub ShowItem_Option(ItemID)
    Dim SqlI, RsI
    SqlI = "select ItemID,ItemName from PE_Item order by ItemID desc"
    Set RsI = Server.CreateObject("adodb.recordset")
    RsI.Open SqlI, Conn, 1, 1
    Response.Write "<select Name=""ItemID"" ID=""ItemID"" >"

    If RsI.EOF And RsI.BOF Then
        Response.Write "<option value=""0"">请添加项目</option>"
    Else
        Response.Write "<option value=""0"" "

        If ItemID = -1 Then
            Response.Write " Selected"
        End If

        Response.Write ">请选择项目</option>"
        
        Do While Not RsI.EOF
            Response.Write "<option value=" & """" & RsI("ItemID") & """" & ""

            If ItemID = RsI("ItemID") Then
                Response.Write " Selected"
            End If

            Response.Write ">" & RsI("ItemName")
            Response.Write "</option>"
            RsI.MoveNext
        Loop

    End If

    Response.Write "<option value=""-1"" "

    If ItemID = -1 Then
        Response.Write " Selected"
    End If

    Response.Write ">公用项目</option>"
    Response.Write "</select>"
    RsI.Close
    Set RsI = Nothing
End Sub

%>