chkpurview.asp

一本关于大学的书

<!--#include file="../conn.asp"-->
<!--#include file="../inc/function.asp"-->
<%
Dim cUrl, RndPassword
Dim AdminName, AdminPassword, AdminPurview, PurviewPassed
Dim AdminPurview_Channel, AdminPurview_Others
Dim rsGetAdmin, sqlGetAdmin
Dim arrPurview(10), PurviewIndex, strThisFile
Dim Channel, Name, TrueIP, Content
Dim ChannelID, sqlChannel, rsChannel, ChannelName, ChannelShortName, ChannelDir, ModuleType, ModuleName, SheetName
Dim PurviewLevel

If UserTrueIP = "" Then
    TrueIP = Trim(Request.ServerVariables("HTTP_X_FORWARDED_FOR"))
    If TrueIP = "" Then TrueIP = Request.ServerVariables("REMOTE_ADDR")
Else
    TrueIP = UserTrueIP
End If

ComeUrl = Trim(Request.ServerVariables("HTTP_REFERER"))
If ComeUrl = "" Then
    Response.Write "<br><p align=center><font color='red'>对不起，为了系统安全，不允许直接输入地址访问本系统的后台管理页面。</font></p>"
    Call Insert_Pur_Log
    Response.End
Else
    cUrl = Trim("http://" & Request.ServerVariables("SERVER_NAME"))
    If UBound(Split(ComeUrl, ":")) > 1 Then
        cUrl = cUrl & ":" & Request.ServerVariables("SERVER_PORT")
    End If
    cUrl = cUrl & Request.ServerVariables("SCRIPT_NAME")
    Dim temp1, temp2
    temp1 = LCase(Left(ComeUrl, InStrRev(ComeUrl, "/") - 1))
    temp2 = LCase(Left(cUrl, InStrRev(cUrl, "/") - 1))
    If Left(temp1, InStrRev(temp1, "/")) <> Left(temp2, InStrRev(temp2, "/")) Then
        Response.Write "<br><p align=center><font color='red'>对不起，为了系统安全，不允许从外部链接地址访问本系统的后台管理页面。</font></p>"
        Call Insert_Pur_Log
        Response.End
    End If
End If

AdminName = ReplaceBadChar(Trim(Request.Cookies(Site_Sn)("AdminName")))
AdminPassword = ReplaceBadChar(Trim(Request.Cookies(Site_Sn)("AdminPassword")))
RndPassword = ReplaceBadChar(Trim(Request.Cookies(Site_Sn)("RndPassword")))
If AdminName = "" Or AdminPassword = "" Or RndPassword = "" Then
    Call Insert_Pur_Log
    Response.redirect "../" & AdminDir & "/Admin_login.asp"
    Call CloseConn
End If

FoundErr = False
ErrMsg = ""

sqlGetAdmin = "select * from PE_Admin where AdminName='" & AdminName & "' and Password='" & AdminPassword & "'"
Set rsGetAdmin = Server.CreateObject("adodb.recordset")
rsGetAdmin.Open sqlGetAdmin, Conn, 1, 1
If rsGetAdmin.bof And rsGetAdmin.EOF Then
    Call Insert_Pur_Log
    rsGetAdmin.Close
    Set rsGetAdmin = Nothing
    Call CloseConn
    Response.redirect "Admin_login.asp"
Else
    If rsGetAdmin("EnableMultiLogin") <> True And Trim(rsGetAdmin("RndPassword")) <> RndPassword Then
        Response.Write "<br><p align=center><font color='red'>对不起，为了系统安全，本系统不允许两个人使用同一个管理员帐号进行登录！</font></p><p>因为现在有人已经在其他地方使用此管理员帐号进行登录了，所以你将不能继续进行后台管理操作。</p><p>你可以<a href='Admin_Login.asp' target='_top'>点此重新登录</a>。</p>"
        Call Insert_Pur_Log
        rsGetAdmin.Close
        Set rsGetAdmin = Nothing
        Call CloseConn
        Response.End
    End If
End If
AdminPurview = rsGetAdmin("Purview")
AdminPurview_Others = rsGetAdmin("AdminPurview_Others")

If AdminPurview = 1 Then
    PurviewPassed = True
Else
    If PurviewLevel = 0 Then      '不进行权限检查
        PurviewPassed = True
    Else
        If AdminPurview > PurviewLevel Then
            PurviewPassed = False
        Else
            PurviewPassed = CheckPurview_Other(AdminPurview_Others, PurviewLevel_Others)
        End If
    End If
End If
If PurviewLevel > 0 Then
    rsGetAdmin.Close
    Set rsGetAdmin = Nothing
End If

If PurviewPassed = False Then
    Response.Write "<br><p align=center><font color='red'>对不起，你没有此项操作的权限。</font></p>"
    Response.End
End If

Function CheckPurview_Other(AllPurviews, strPurview)
    If IsNull(AllPurviews) Or AllPurviews = "" Or strPurview = "" Then
        CheckPurview_Other = False
        Exit Function
    End If
    CheckPurview_Other = False
    If InStr(AllPurviews, ",") > 0 Then
        Dim arrPurviews, i
        arrPurviews = Split(AllPurviews, ",")
        For i = 0 To UBound(arrPurviews)
            If Trim(arrPurviews(i)) = strPurview Then
                CheckPurview_Other = True
                Exit For
            End If
        Next
    Else
        If AllPurviews = strPurview Then
            CheckPurview_Other = True
        End If
    End If
End Function

Function CheckClassMaster(AllMaster, MasterName)
    If IsNull(AllMaster) Or AllMaster = "" Or MasterName = "" Then
        CheckClassMaster = False
        Exit Function
    End If
    CheckClassMaster = False
    If InStr(AllMaster, "|") > 0 Then
        Dim arrMaster, i
        arrMaster = Split(AllMaster, "|")
        For i = 0 To UBound(arrMaster)
            If Trim(arrMaster(i)) = MasterName Then
                CheckClassMaster = True
                Exit For
            End If
        Next
    Else
        If AllMaster = MasterName Then
            CheckClassMaster = True
        End If
    End If
End Function

Function Insert_Pur_Log()
    Action = ""
    Channel = -1
    If ComeUrl = "" Then
        Content = "直接地址输入访问后台"
        Name = ""
    ElseIf LCase(Left(ComeUrl, InStrRev(ComeUrl, "/"))) <> LCase(Left(cUrl, InStrRev(cUrl, "/"))) Then
        Content = "外部链接访问后台"
        Name = ""
    ElseIf AdminName = "" Or RndPassword = "" Then
        Content = "管理员未登录"
        Name = ""
    ElseIf rsGetAdmin.bof And rsGetAdmin.EOF Then
        Content = "用户名或密码错误"
        Name = AdminName
    ElseIf rsGetAdmin("EnableMultiLogin") <> True And Trim(rsGetAdmin("RndPassword")) <> RndPassword Then
        Content = "两人使用同一管理员帐号"
        Name = AdminName
    Else
        Channel = 0
        Name = AdminName
        Content = "登录成功"
    End If
    Dim sqlLog, rsLog
    sqlLog = "select top 1 * from PE_Log"
    Set rsLog = Server.CreateObject("Adodb.RecordSet")
    rsLog.Open sqlLog, Conn, 1, 3
    rsLog.addnew
    rsLog("LogType") = 1
    rsLog("ChannelID") = Channel
    rsLog("LogTime") = Now()
    rsLog("UserName") = Name
    rsLog("UserIP") = TrueIP
    rsLog("LogContent") = Content
    rsLog("ScriptName") = ComeUrl
    rsLog("PostString") = ""
    rsLog.Update
    rsLog.Close
    Set rsLog = Nothing
End Function

Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "+,',--,%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    tempChar = Replace(tempChar, "@@", "@")
    ReplaceBadChar = tempChar
End Function

Function PE_CLng(ByVal str1)
    If IsNumeric(str1) Then
        PE_CLng = CLng(str1)
    Else
        PE_CLng = 0
    End If
End Function

Function PE_CDbl(ByVal str1)
    If IsNumeric(str1) Then
        PE_CDbl = CDbl(str1)
    Else
        PE_CDbl = 0
    End If
End Function
%>