admin_login.asp

个人网站比较简短

        FoundErr = True
        ErrMsg = ErrMsg & "<li>服务器脚本解释引擎（VBScript）版本过低，请联系您的空间商或服务器管理员更新。</li>"
        ErrMsg = ErrMsg & "<li><a href='http://www.microsoft.com/downloads/release.asp?ReleaseID=33136' target='_blank'><font color='green'>脚本解释引擎下载地址</font></a></li>"
    End If

    If UserName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>用户名不能为空！</li>"
    End If
    If Password = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>密码不能为空！</li>"
    End If
    If CheckCode = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>验证码不能为空！</li>"
    End If
    If Trim(Session("CheckCode")) = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>你在管理登录停留的时间过长，导致验证码失效。请重新返回登录页面进行登录。</li>"
    End If
    If CheckCode <> Session("CheckCode") Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>您输入的验证码和系统产生的不一致，请重新输入。</li>"
    End If
    If EnableSiteManageCode = True And AdminLoginCode <> SiteManageCode Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>您输入的后台管理认证码不对，请重新输入（请区分大小写）。</li>"
    End If
    If FoundErr = True Then
        Exit Sub
    End If
    
    ComeUrl = Trim(Request.ServerVariables("HTTP_REFERER"))

    Password = MD5(Password, 16)
    Set rs = Server.CreateObject("adodb.recordset")
    sql = "select * from PE_Admin where Password='" & Password & "' and AdminName='" & UserName & "'"
    rs.Open sql, Conn, 1, 3
    If rs.bof And rs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>用户名或密码错误！！！</li>"
    Else
        If Password <> rs("Password") Then
            FoundErr = True
            ErrMsg = ErrMsg & "<br><li>用户名或密码错误！！！</li>"
        End If
    End If
    If FoundErr = True Then
        Call InsertLog(1, -1, UserName, UserTrueIP, "登录失败", ComeUrl, "")
        Session("AdminName") = ""
        Session("AdminPassword") = ""
        Session("RndPassword") = ""
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If
    UserName = rs("UserName")
    RndPassword = GetRndPassword(16)
    rs("LastLoginIP") = UserTrueIP
    rs("LastLoginTime") = Now()
    rs("LoginTimes") = rs("LoginTimes") + 1
    rs("RndPassword") = RndPassword
    rs.Update
    Call InsertLog(1, 0, UserName, UserTrueIP, "登录成功", ComeUrl, "")

    InstallDir = GetInstallDir(Trim(Request.ServerVariables("SCRIPT_NAME")), 1)
    Site_Sn = Replace(Replace(LCase(Request.ServerVariables("SERVER_NAME") & InstallDir), "/", ""), ".", "")
    Response.Cookies(Site_Sn)("AdminName") = rs("AdminName")
    Response.Cookies(Site_Sn)("AdminPassword") = rs("Password")
    Response.Cookies(Site_Sn)("RndPassword") = RndPassword
    Response.Cookies(Site_Sn)("AdminLoginCode") = AdminLoginCode
    rs.Close

    sql = "select UserID,UserPassword,LastPassword,LastLoginIP,LastLoginTime,LoginTimes from PE_User where UserName='" & UserName & "'"
    rs.Open sql, Conn, 1, 3
    If Not (rs.bof And rs.EOF) Then
        rs("LastPassword") = RndPassword
        rs("LastLoginIP") = UserTrueIP
        rs("LastLoginTime") = Now()
        rs("LoginTimes") = rs("LoginTimes") + 1
        rs.Update
        Response.Cookies(Site_Sn)("UserName") = UserName
        Response.Cookies(Site_Sn)("UserPassword") = rs("UserPassword")
        Response.Cookies(Site_Sn)("LastPassword") = RndPassword
        Session("UserID") = rs("UserID")
    End If
    rs.Close
    Set rs = Nothing

    Call CloseConn
    Response.Redirect "Admin_Index.asp"
End Sub

Sub Logout()
    Conn.Execute ("update PE_Admin set LastLogoutTime=" & PE_Now & "  where AdminName='" & ReplaceBadChar(Trim(Request.Cookies(Site_Sn)("AdminName"))) & "'")
    Response.Cookies(Site_Sn)("AdminName") = ""
    Response.Cookies(Site_Sn)("AdminPassword") = ""
    Response.Cookies(Site_Sn)("RndPassword") = ""
    Response.Cookies(Site_Sn)("UserName") = ""
    Response.Cookies(Site_Sn)("UserPassword") = ""
    Response.Cookies(Site_Sn)("LastPassword") = ""
    Response.Cookies(Site_Sn)("UnreadMsg") = ""
    Call CloseConn
    Response.Redirect "../Index.asp"
End Sub

'****************************************************
'过程名：WriteErrMsg
'作  用：显示错误提示信息
'参  数：无
'****************************************************
Sub WriteErrMsg()
    Response.Write "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
    Response.Write "<link href='Admin_Style.css' rel='stylesheet' type='text/css'></head><body>" & vbCrLf
    Response.Write "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
    Response.Write "  <tr align='center'><td height='22' class='title'><strong>错误信息</strong></td></tr>" & vbCrLf
    Response.Write "  <tr><td height='100' class='tdbg' valign='top'><b>产生错误的可能原因：</b><br>" & ErrMsg & "</td></tr>" & vbCrLf
    Response.Write "  <tr align='center'><td class='tdbg'><a href='Admin_Login.asp'>&lt;&lt; 返回登录页面</a></td></tr>" & vbCrLf
    Response.Write "</table>" & vbCrLf
    Response.Write "</body></html>" & vbCrLf
End Sub

Sub InsertLog(LogType, ChannelID, UserName, UserIP, LogContent, ScriptName, PostString)
    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") = LogType
    rsLog("ChannelID") = ChannelID
    rsLog("LogTime") = Now()
    rsLog("UserName") = UserName
    rsLog("UserIP") = UserIP
    rsLog("LogContent") = LogContent
    rsLog("ScriptName") = ScriptName
    rsLog("PostString") = PostString
    rsLog.Update
    rsLog.Close
    Set rsLog = Nothing
End Sub

'**************************************************
'函数名：GetInstallDir
'作  用：如果是当前页面在管理后台或者用户后台,就取他上一级的目录为系统安装路径,如果当前页面在根目录下,就取当前路径
'参  数：ScriptName ----路径名称
'        ParentLevel ---- 1 系统安装路径,0 当前路径
'返回值：返回路径
'**************************************************
Function GetInstallDir(ByVal ScriptName, ParentLevel)
    Dim i, strTemp
    GetInstallDir = "/"
    If ScriptName = "" Or IsNull(ScriptName) Then Exit Function
    If ParentLevel > 1 Then ParentLevel = 1
    If ParentLevel = 0 Then
        strTemp = Left(ScriptName, InStrRev(ScriptName, "/"))
    ElseIf ParentLevel = 1 Then
        i = InStrRev(ScriptName, "/") - 1
        If i < 1 Then i = 1
        strTemp = Left(ScriptName, InStrRev(ScriptName, "/", i))
    End If
    If Right(strTemp, 1) <> "/" Then strTemp = strTemp & "/"
    GetInstallDir = strTemp
End Function
%>