<!--#include file="setup.asp"-->
<!--#include file="../inc/md5.asp"-->
<%



Dim ChannelID
ChannelID = 1
'替代 check.asp

Dim AdminName, AdminPass, AdminID, ErrorStr
Dim SQLAdmin, RsAdmin, AdminRandomCode
ErrorStr = "<li>确认身份失败！您没有使用当前功能的权限。</li><li>如果有什么问题，请联系管理员。</li>"
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 = "<br><li><font color=red>您提交的数据不合法，为了系统安全，不允许直接输入地址访问本系统的后台管理页面。</font></li><li>因为你执行了非法操作，<a href=logout.asp target=_top class=showmeun>请您退出本系统！</a></li>"
	'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 + "<li>非法登陆！您的IP我们已经记录在案。<li>"
'		Response.redirect ("showerr.asp?action=error&Message=" & Server.URLEncode(ErrMsg) & "")
'		Response.End
'	End If
'Else
'	If Len(Session("validate")) > 0 Then
'		ErrMsg = ErrMsg + "<li>非法登陆！您的IP我们已经记录在案。<li>"
'		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 = "<li>你的用户名已被锁定,你不能登陆！如要开通此帐号，请联系管理员。</li>"
		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 = "<li><font color='red'>对不起，为了系统安全，本系统不允许两个人使用同一个管理员帐号进行登录！</font></li><li>因为现在有人已经在其他地方使用此管理员帐号进行登录了，所以你将不能继续进行后台管理操作。</li><li>你可以<a href='admin_login.asp' target='_top' class=showmeun>点此重新登录</a>。</li>"
'		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
%>
<!--#include file="../inc/ubbcode.asp"-->
<!--#include file="../inc/cls_editor.asp" -->
<%
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="<img [^>]*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 + "<li>" & sModuleName & "标题不能为空！</li>"
	End If
	If Len(Request("title")) => 200 Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>" & sModuleName & "标题不能超过200个字符！</li>"
	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 + "<li>相关" & sModuleName & "不能超过220个字符！</li>"
	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 + "<li>该一级分类已经有下属分类，不能添加" & sModuleName & "！</li>"
		Exit Sub
	End If
	If Trim(Request("ClassID")) = 0 Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>该分类是外部连接，不能添加" & sModuleName & "！</li>"
	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 + "<li>专题ID参数错误！</li>"
		Exit Sub
	End If
	TextContent =  Request("content")

	If Trim(TextContent) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>" & sModuleName & "内容不能为空！</li>"
	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 "<IE:Download ID=CreationID STYLE=""behavior:url(#default#download)"" />" & 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("<li>恭喜您！添加新的" & sModuleName & "成功。</li><li><a href=admin_article.asp?action=view&ChannelID=" & ChannelID & "&ArticleID=" & ArticleID & ">点击此处查看该" & sModuleName & "</a></li><li><a href=?action=add&ChannelID=" & ChannelID & "&classid=" & Request.Form("ClassID") & "><font color=blue>点击此处继续添加" & sModuleName & "</font></a></li>")
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
%>

