<%
Dim ChannelID
ChannelID = 1
'替代 check.asp
Dim AdminName, AdminPass, AdminID, ErrorStr
Dim SQLAdmin, RsAdmin, AdminRandomCode
ErrorStr = "确认身份失败！您没有使用当前功能的权限。如果有什么问题，请联系管理员。"
If InStr(Newasp.ScriptName, "editor") > 0 Or InStr(Newasp.ScriptName, "admin_label") > 0 Or InStr(Newasp.ScriptName, "admin_collect") > 0 Then AdminPage = True
'If Newasp.CheckPost = False And AdminPage = False Then
'ErrMsg = "
您提交的数据不合法，为了系统安全，不允许直接输入地址访问本系统的后台管理页面。因为你执行了非法操作，请您退出本系统！"
'Response.Redirect("showerr.asp?action=error&message=" & server.URLEncode(errmsg) & "")
'Response.End
'End If
Call AdminCookiesToSession
Session("AdminName") = Newasp.CheckBadstr(Request("adminname"))
Session("AdminPass") = md5(Trim(Replace(Request("password"), "'", "")))
AdminName = Newasp.CheckBadstr(Session("AdminName")) '管理员名称
AdminPass = Newasp.CheckBadstr(Session("AdminPass")) '管理员密码
AdminID = Newasp.ChkNumeric(Session("AdminID")) '管理员ID
AdminRandomCode = Trim(Session("AdminRandomCode")) '管理员登陆随机码
If AdminName = "" Then
ErrMsg = ErrMsg + "[err]缺少管理员用户名[/err]"
Response.write (ErrMsg)
Response.End
End If
'If IsAdminValidate Then
' If AdminValidateCode <> Session("validate") Or Len(Session("validate")) = 0 Then
' ErrMsg = ErrMsg + "非法登陆！您的IP我们已经记录在案。"
' Response.redirect ("showerr.asp?action=error&Message=" & Server.URLEncode(ErrMsg) & "")
' Response.End
' End If
'Else
' If Len(Session("validate")) > 0 Then
' ErrMsg = ErrMsg + "非法登陆！您的IP我们已经记录在案。"
' Response.redirect ("showerr.asp?action=error&Message=" & Server.URLEncode(ErrMsg) & "")
' Response.End
' End If
'End If
SQLAdmin ="SELECT id,isLock,RandomCode,isAloneLogin FROM NC_Admin WHERE username='" & AdminName & "' And password='" & AdminPass & "'"
Set RsAdmin = Newasp.Execute(SQLAdmin)
If RsAdmin.BOF And RsAdmin.EOF Then
Session.Abandon
Response.Cookies(Admin_Cookies_Name) = ""
RsAdmin.Close:set RsAdmin = Nothing
'Response.Redirect "admin_login.asp"
Response.write ("[err]帐号密码错误[/err]")
Response.End
Else
Session("AdminID")=RsAdmin("id")
AdminID = Newasp.ChkNumeric(Session("AdminID")) '管理员ID
If RsAdmin("isLock") <> 0 Then
ErrMsg = "你的用户名已被锁定,你不能登陆！如要开通此帐号，请联系管理员。"
RsAdmin.Close:set RsAdmin = Nothing
'Response.Redirect("showerr.asp?action=error&message=" & server.URLEncode(errmsg) & "")
'Response.End
Response.write ("[err]你的用户名已被锁定，请联系管理员[/err]")
Response.End
End If
' If RsAdmin("isAloneLogin") <> 0 And Trim(RsAdmin("RandomCode")) <> AdminRandomCode then
' Session.Abandon
' Response.Cookies(Admin_Cookies_Name) = ""
' ErrMsg = "对不起，为了系统安全，本系统不允许两个人使用同一个管理员帐号进行登录！因为现在有人已经在其他地方使用此管理员帐号进行登录了，所以你将不能继续进行后台管理操作。你可以点此重新登录。"
' Response.Redirect("showerr.asp?action=error&message=" & server.URLEncode(errmsg) & "")
' RsAdmin.Close:set RsAdmin = Nothing
' Response.End
' End If
End If
RsAdmin.Close:Set RsAdmin = Nothing
Dim sChannelName,sChannelDir,sModuleName,rsChannel,ChannelModuleID
'ChannelID = Newasp.ChkNumeric(Request("ChannelID"))
If ChannelID > 0 Then
ChannelID = CLng(ChannelID)
If ChannelID <> 9999 Then
Set rsChannel = Newasp.Execute("Select ChannelID From NC_Channel where ChannelType < 2 And ChannelID = " & ChannelID)
If Not (rsChannel.BOF And rsChannel.EOF) Then
Newasp.ReadChannel(ChannelID)
sChannelName = Newasp.ChannelName
sChannelDir = Replace(Newasp.ChannelDir, "/", "")
sModuleName = Newasp.ModuleName
ChannelModuleID = CInt(Newasp.modules)
End If
rsChannel.Close:Set rsChannel = Nothing
End If
Else
ChannelID = 0
End If
Public Function DeleteHtmlFile(classid,id,HtmlFileDate)
If CInt(Newasp.IsCreateHtml)=0 Then Exit Function
On Error Resume Next
Dim rsClass,sHtmlFileName,sHtmlFilePath
SQL = "SELECT HtmlFileDir FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & CLng(classid)
Set rsClass = Newasp.Execute(SQL)
If Not(rsClass.BOF And rsClass.EOF) Then
sHtmlFileName = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, HtmlFileDate,rsClass("HtmlFileDir"),classid,id,1,"")
If Newasp.BindDomain = "0" Then
sHtmlFilePath = ""
Else
If Len(Newasp.NamedPath) > 2 Then
sHtmlFilePath = Newasp.NamedPath
Else
sHtmlFilePath = Server.MapPath(Newasp.InstallDir & Newasp.ChannelDir)
End If
End If
Newasp.FileDelete(sHtmlFilePath & sHtmlFileName)
End If
rsClass.Close:Set rsClass = Nothing
End Function
Public Function ChkAdmin(para)
On Error Resume Next
Dim i, TempAdmin, Adminflag
ChkAdmin = False
AdminFlag = Replace(Session("Adminflag"), "'", "''")
If para = "" Then Exit Function
If AdminFlag = "" Or IsEmpty(AdminFlag) Then Exit Function
If CInt(Session("AdminGrade")) = 999 Then
ChkAdmin = True
Exit Function
Else
If Adminflag = "" Then
ChkAdmin = False
Exit Function
Else
tempAdmin = Split(Adminflag, ",")
For i = 0 To UBound(tempAdmin)
If Trim(LCase(tempAdmin(i))) = Trim(LCase(para)) Then
ChkAdmin = True
Exit For
End If
Next
End If
End If
End Function
Public Function ChkAdminPurview(flag,username)
On Error Resume Next
Dim i, TempAdmin, Adminflag, BlnAdminflag
ChkAdminPurview = False
BlnAdminflag = False
If flag = "" Then Exit Function
Adminflag = Replace(Session("Adminflag"), "'", "''")
If AdminFlag = "" Or IsEmpty(AdminFlag) Then Exit Function
If CInt(Session("AdminGrade")) = 999 Then
ChkAdminPurview = True
Exit Function
Else
If Trim(Adminflag) = "" Then
ChkAdminPurview = False
Exit Function
Else
tempAdmin = Split(Adminflag, ",")
For i = 0 To UBound(tempAdmin)
If LCase(Trim(tempAdmin(i))) = LCase(Trim(flag)) Then
BlnAdminflag = True
Exit For
End If
Next
End If
End If
If BlnAdminflag = True Then
If Trim(username) = Trim(Session("AdminName")) Then
ChkAdminPurview = True
Exit Function
Else
ChkAdminPurview = False
Exit Function
End If
Else
ChkAdminPurview = False
Exit Function
End If
End Function
Public Sub AdminCookiesToSession()
If Session("AdminName") = "" And UseAdminCookies Then
Session("AdminName") = Newasp.CheckStr(Request.Cookies(Admin_Cookies_Name)("AdminName"))
Session("AdminPass") = Newasp.CheckStr(Request.Cookies(Admin_Cookies_Name)("AdminPass"))
Session("AdminGrade") = Newasp.CheckStr(Request.Cookies(Admin_Cookies_Name)("AdminLevel"))
Session("Adminflag") = Newasp.CheckStr(Request.Cookies(Admin_Cookies_Name)("Adminflag"))
Session("AdminStatus") = Newasp.CheckStr(Request.Cookies(Admin_Cookies_Name)("AdminStatus"))
Session("AdminRandomCode") = Newasp.CheckStr(Request.Cookies(Admin_Cookies_Name)("RandomCode"))
Session("AdminID") = Newasp.CheckStr(Request.Cookies(Admin_Cookies_Name)("AdminID"))
If IsAdminValidate Then
Session("validate") = Newasp.CheckStr(Request.Cookies(Admin_Cookies_Name)("validate"))
End If
End If
End Sub
%>
<%
Server.ScriptTimeout = 99999
'Admin_header
'=====================================================================
' 软件名称：新云网站管理系统
' 当前版本：NewAsp Site Management System Version 3.0
' 文件名称：admin_article.asp
' 更新日期：2006-12-20
' 官方网站：新云网络(www.newasp.net) QQ：94022511
'=====================================================================
' Copyright 2003-2007 newasp.net - All Rights Reserved.
' newasp is a trademark of newasp.net
'=====================================================================
'ET增加正则查询函数
dim picpatrn
picpatrn="![]()
]*src *= *(?:""|')?([^""' ]+\.(?:gif|jpg|bmp|png))(?:""|'| |/>|>)+"
Function Regone(patrn, strng)
Dim regEx, Matches,ms,RetStr ' Create variable.
Set regEx = New RegExp ' Create a regular expression.
RetStr=""
regEx.Pattern = patrn ' Set pattern.
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = false ' Set global applicability.
Set Matches = regEx.Execute(strng) ' Execute search.
if Matches.count>0 then
Set ms=Matches(0)
if not isnull(trim(ms.submatches(0))) then RetStr=trim(ms.submatches(0))
end if
Regone = RetStr
End Function
'Dim Action
Dim i,ii,isEdit,RsObj
Dim keyword,FindWord,strClass
Dim maxperpage,CurrentPage,totalnumber,TotalPageNum
Dim s_ClassName,ClassID,ChildStr,FoundSQL,isAccept,selArticleID
Dim TextContent,ArticleTop,ArticleBest,ArticleID,ForbidEssay,ArticleAccept
dim ETAuthor,ETComeFrom,ETcolorMode,ETFontMode,ETstar,ETPointNum,ETUserGroup,ETAllHits,ETImageUrl,ETAutoPages,ETSpecialID
dim ETBriefTopic
Dim InstallDir_ChannelDir
InstallDir_ChannelDir = Trim(Newasp.InstallDir & Newasp.ChannelDir)
ubb.BasePath = InstallDir_ChannelDir
ubb.setUbbcode = Join(Newasp.setUserEditor,"|")
ubb.Keyword = Newasp.ContentKeyword
'ChannelID = Newasp.ChkNumeric(Request("ChannelID"))
'If Trim(Request("isAccept")) <> "" Then
' isAccept = 0
'Else
isAccept = 1
'End If
'If CInt(ChannelID) = 0 Then ChannelID = 1
'Action = LCase(Request("action"))
Action = "save"
'Select Case Trim(Action)
'Case "save"
Call SaveArticle
'Case "modify"
' Call ModifyArticle
'Case "add"
' isEdit = False
' Call ArticleEdit(isEdit)
'Case "edit"
' isEdit = True
' Call ArticleEdit(isEdit)
'Case "del"
' Call ArticleDel
'Case "batdel"
' Call PageTop
' Call BatcDelete
'Case "alldel"
' Call AllDelArticle
'Case "view"
' Call ArticleView
'Case "renew"
' Call ArticleRenew
'Case "setting"
' Call PageTop
' Call BatchSetting
'Case "saveset"
' Call SaveSetting
'Case "move"
' Call PageTop
' Call BatchMove
'Case "savemove"
' Call SaveMove
'Case "reset"
' Call ResetDateTime
'Case Else
' Call showmain
'End Select
If FoundErr = True Then
'ReturnError(ErrMsg)
response.Write(ErrMsg) '出现错误
ELSE
response.Write("1") '成功
End If
'Admin_footer
'SaveLogInfo(AdminName)
CloseConn
Private Sub CheckSave()
If Trim(Request("title")) = "" Then
FoundErr = True
ErrMsg = ErrMsg + "" & sModuleName & "标题不能为空！"
End If
If Len(Request("title")) => 200 Then
FoundErr = True
ErrMsg = ErrMsg + "" & sModuleName & "标题不能超过200个字符！"
End If
If Trim(Request.Form("ColorMode")) = "" Then '标题颜色
ETcolorMode="0"
ELSE
ETcolorMode=Trim(Request.Form("ColorMode"))
End If
If Trim(Request.Form("FontMode")) = "" Then '标题字体
ETFontMode="0"
ELSE
ETFontMode=Trim(Request.Form("FontMode"))
End If
If Len(Request.Form("Related")) => 220 Then '相关文章
FoundErr = True
ErrMsg = ErrMsg + "相关" & sModuleName & "不能超过220个字符！"
End If
If Trim(Request.Form("Author")) = "" Then '作者
ETAuthor="不详"
else
ETAuthor=Trim(Request.Form("Author"))
End If
If Trim(Request.Form("ComeFrom")) = "" Then '来源
ETComeFrom="不详"
else
ETComeFrom=Trim(Request.Form("ComeFrom"))
End If
If Trim(Request.Form("PointNum")) = "" Then '所需点数
ETPointNum="0"
ELSE
ETPointNum=Trim(Request.Form("PointNum"))
End If
If Trim(Request.Form("star")) = "" Then '文章星级
ETstar="3"
ELSE
ETstar=Trim(Request.Form("star"))
End If
If Not IsNumeric(ETstar) Then
ETstar="3"
End If
If Trim(Request.Form("UserGroup")) = "" Then '浏览等级
ETUserGroup="0"
ELSE
ETUserGroup=Trim(Request.Form("UserGroup"))
End If
If Not IsNumeric(ETUserGroup) Then
ETUserGroup="0"
End If
If Not IsNumeric(Request("ClassID")) Then
FoundErr = True
ErrMsg = ErrMsg + "该一级分类已经有下属分类，不能添加" & sModuleName & "！"
Exit Sub
End If
If Trim(Request("ClassID")) = 0 Then
FoundErr = True
ErrMsg = ErrMsg + "该分类是外部连接，不能添加" & sModuleName & "！"
End If
If Trim(Request.Form("AllHits")) = "" Then '初始点击
ETAllHits="0"
else
ETAllHits=Trim(Request.Form("AllHits"))
End If
If Not IsNumeric(Request("AllHits")) Then
ETAllHits="0"
End If
If Trim(Request.Form("AutoPages")) <> "1" Then '自动分页
ETAutoPages=0
else
ETAutoPages=1
End If
If Trim(Request.Form("SpecialID")) = "" Then '专题ID
ETSpecialID="0"
else
ETSpecialID=Trim(Request.Form("SpecialID"))
End If
If Trim(Request.Form("BriefTopic")) = "" Then '话题
ETBriefTopic="0"
else
ETBriefTopic=Trim(Request.Form("BriefTopic"))
End If
If Not IsNumeric(ETBriefTopic) Then
ETBriefTopic="0"
End If
If Not IsNumeric(ETSpecialID) Then
FoundErr = True
ErrMsg = ErrMsg + "专题ID参数错误！"
Exit Sub
End If
TextContent = Request("content")
If Trim(TextContent) = "" Then
FoundErr = True
ErrMsg = ErrMsg + "" & sModuleName & "内容不能为空！"
End If
if Trim(Request("isImageurl"))="1" then 'ET增加参数isImageurl判断是否使用首页图片，取内容里第一个图
ETImageUrl=regone(picpatrn,TextContent)
else
ETImageUrl=""
end if
If Newasp.setAdminEditor(0) <> 0 Then
TextContent = Newasp.HTMLEncodes(TextContent)
End If
TextContent = Html2Ubb(Re_Replace(TextContent, InstallDir_ChannelDir, "[InstallDir_ChannelDir]"))
ArticleTop = Newasp.ChkNumeric(Request.Form("isTop"))
ArticleBest = Newasp.ChkNumeric(Request.Form("isBest"))
ForbidEssay = Newasp.ChkNumeric(Request.Form("ForbidEssay"))
'ArticleAccept = Newasp.ChkNumeric(Request.Form("isAccept"))
ArticleAccept="1"
End Sub
Private Sub SaveArticle()
CheckSave
If Founderr = True Then Exit Sub
Set Rs = Server.CreateObject("ADODB.Recordset")
SQL = "select * from NC_Article where (ArticleID is null)"
Rs.Open SQL,Conn,1,3
Rs.Addnew
Rs("ChannelID") = ChannelID
Rs("ClassID") = Trim(Request("ClassID"))
Rs("SpecialID") = ETSpecialID
Rs("title") = Newasp.ChkFormStr(Request("title"))
Rs("subtitle") = ""
Rs("ColorMode") = ETColorMode
Rs("FontMode") = ETFontMode
Rs("content") = TextContent
Rs("Related") = Newasp.ChkFormStr(Request.Form("Related"))
Rs("Author") = ETAuthor
Rs("ComeFrom") = ETComeFrom
Rs("star") = ETstar
Rs("isTop") = ArticleTop
Rs("AllHits") = CLng(ETAllHits)
Rs("DayHits") =CLng(ETAllHits)
Rs("WeekHits") = CLng(ETAllHits)
Rs("MonthHits") = CLng(ETAllHits)
Rs("HitsTime") = Now()
'Rs("WriteTime") = Formatime(Trim(Request.Form("WriteTime")))
Rs("WriteTime") = Now()
Rs("HtmlFileDate") = Trim(Newasp.HtmlRndFileName)
Rs("username") = Trim(AdminName)
Rs("isBest") = ArticleBest
Rs("BriefTopic") = ETBriefTopic
Rs("ImageUrl") = ETImageUrl
'Rs("UploadImage") = Trim(Request.Form("UploadFileList"))&""
Rs("UserGroup") =ETUserGroup
Rs("PointNum") = ETPointNum
Rs("isUpdate") = 1
Rs("isAccept") = ArticleAccept
Rs("ForbidEssay") = ForbidEssay
Rs("AlphaIndex") = Newasp.ReadAlpha(ubb.CheckSpecialChar(Request.Form("title")))
Rs("AutoPages") = ETAutoPages
Rs.update
Rs.Close
Rs.Open "select top 1 ArticleID from NC_Article where ChannelID=" & ChannelID & " order by ArticleID desc", Conn, 1, 1
ArticleID = Rs("ArticleID")
Rs.Close:Set Rs = Nothing
ClassUpdateCount Request.Form("ClassID"),1
Call RemoveCache
Dim url
If CInt(Newasp.IsCreateHtml) <> 0 Then
Response.Write "" & vbCrLf
url = "admin_makenews.asp?ChannelID=" & ChannelID & "&ArticleID=" & ArticleID & "&showid=0"
Call ScriptCreation(url,ArticleID)
SQL = "SELECT TOP 1 ArticleID FROM NC_Article WHERE ChannelID=" & ChannelID & " And isAccept <> 0 And ArticleID < " & ArticleID & " ORDER BY ArticleID DESC"
Set Rs = Newasp.Execute(SQL)
If Not (Rs.EOF And Rs.BOF) Then
url = "admin_makenews.asp?ChannelID=" & ChannelID & "&ArticleID=" & Rs("ArticleID") & "&showid=0"
Call ScriptCreation(url,Rs("ArticleID"))
End If
Rs.Close
Set Rs = Nothing
End If
'Succeed("恭喜您！添加新的" & sModuleName & "成功。点击此处查看该" & sModuleName & "点击此处继续添加" & sModuleName & "")
End Sub
Private Function ClassUpdateCount(sortid,stype)
Dim rscount,Parentstr
On Error Resume Next
Set rscount = Newasp.Execute("SELECT ClassID,Parentstr FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & CLng(sortid))
If Not (rscount.BOF And rscount.EOF) Then
Parentstr = rscount("Parentstr") &","& rscount("ClassID")
If CInt(stype) = 1 Then
Newasp.Execute ("UPDATE [NC_Classify] SET ShowCount=ShowCount+1,isUpdate=1 WHERE ChannelID = "& ChannelID &" And ClassID in (" & Parentstr & ")")
Else
Newasp.Execute ("UPDATE [NC_Classify] SET ShowCount=ShowCount-1,isUpdate=1 WHERE ChannelID = "& ChannelID &" And ClassID in (" & Parentstr & ")")
End If
End If
Set rscount = Nothing
End Function
Private Sub RemoveCache()
Newasp.DelCahe "RenewStatistics"
Newasp.DelCahe "TotalStatistics"
End Sub
%>