admin.asp

软件介绍：国内最完善功能最齐全的多级会员程序.主要功能涵盖所有多级会员管理所需,超强大会员自定义编辑功能

sub loginbody()		'登陆界面%>
<table width="780" border="1" cellspacing="2" cellpadding="5" align="center" bordercolor="#FFFFFF"> 
   <tr bordercolor="#666666"><td width="100%" colspan=2 align=right>
	   <a href="default.asp"><img src="images/home.gif" border=0 alt="返回首页"></a>
	   <a href="upfile.asp"><img src="images/newpage.gif" border=0 alt="签写留言"></a>
   </td></tr>
	 <tr bordercolor="#666666"><td width="100%" colspan=2 align=center bgcolor=#DEE5EF><B>管理员登陆 非请勿入</B></td></tr>
		<form method="POST" action="?action=login" onsubmit="return Validator(this)">
      <tr bordercolor="#666666"><td width="40%" align="right" bgcolor="#DEE5EF">用户名：</td>
          <td width="60%"><input type="text" name="name" size="20" maxlength=20></td></tr>
       <tr bordercolor="#666666"><td align="right" bgcolor="#DEE5EF">密 码：</td>
          <td><input type="password" name="passd" size="20" maxlength=20></td></tr>
        <tr bordercolor="#666666"><td width="100%" colspan=2 align=center><input type="submit" value=" 进 入 " name="B1"></td></tr>
		</form>
</table>
<script Language="JavaScript">
<!--
function Validator(theForm)
{
  if (theForm.name.value == "")
  {
    alert("请输入用户名！");
    theForm.name.focus();
    return (false);
  }
  if (theForm.passd.value == "")
  {
    alert("请输入密码！");
    theForm.passd.focus();
    return (false);
  }
  return (true);
}
//-->
</script>
<%end sub
sub modifyadmin()		'帐号管理
	dim name,passd1,passd2
	dim isnameerr,ispassderr
	isnameerr=False
	ispassderr=False
	name=replace(request.form("username"),"'","&#39;")
	passd1=replace(request.form("userpassd1"),"'","")
	passd2=replace(request.form("userpassd2"),"'","")
			SqlData="select top 1 administrator,password from Admin"
			Rs.open SqlData,Conn,1,3
			if (len(name)>=6) then
				Rs(0)=name
				session("postname")=name
			else
				isnameerr=True
			end if
			if (len(passd1)>=6) and (passd1=passd2) then Rs(1)=md5(passd1) else ispassderr=True
			if (Not isnameerr) or (Not ispassderr) then Rs.update
			Rs.close
			Set Rs=Nothing
			Conn.close
			Set Conn=Nothing
	DoWhat="帐号管理操作成功"
	if Not isnameerr then	WhatErr="<LI><font color=red>帐号被修改</font>，" else WhatErr="<LI>帐号未被修改，"
	if Not ispassderr then WhatErr=WhatErr & "<font color=red>密码被修改</font>；</LI>" else WhatErr=WhatErr & "密码未被修改；</LI>"
end sub

sub modifyconfig()		'基本设置
	LybName=replace(request.form("LybName"),"'","&#39;")
	HomePage=replace(request.form("HomePage"),"'","")
	KeyWord=replace(request.form("KeyWord"),"'","&#39;")
	Descrip=replace(request.form("Descrip"),"'","&#39;")
	MainNote=replace(request.form("MainNote"),"'","&#39;")
	CopyRight=replace(request.form("CopyRight"),"'","&#39;")
	UpJpgFile=replace(request.form("UpJpgFile"),"'","")
	AbleFileExt=replace(request.form("AbleFileExt"),"'","")
	HomePageNO=request.form("HomePageNO")
	HotPageNO=request.form("HotPageNO")
	fsize=request.form("fsize")
	if isempty(HomePageNO) or (not isnumeric(HomePageNO)) then 
		HomePageNO=1
	elseif cint(HomePageNO)<1 or cint(HomePageNO)>30 then 
		HomePageNO=1
	end if
	if isempty(HotPageNO) or (not isnumeric(HotPageNO)) then 
		HomePageNO=1
	elseif cint(HotPageNO)<1 or cint(HotPageNO)>30 then 
		HomePageNO=1
	end if
	if isempty(fsize) or (not isnumeric(fsize)) then fsize=200
	if HomePage>"" and left(HomePage,7)<>"http://" then HomePage="http://" & HomePage
	SqlData="update Config set LybName='" & LybName & "',HomePage='" & HomePage & "',keyword='" & KeyWord & "',descrip='" & Descrip & "',"&_
					"MainNote='" & MainNote & "',copyright='" & CopyRight & "',UpJpgFile='" & UpJpgFile & "',AbleFileExt='" & AbleFileExt & "',"&_
					"homepageno=" & HomePageNO & ",hotpageno=" & HotPageNO & ",fsize=" & fsize
	Conn.Execute(SqlData)
	DoWhat="基本设置成功"
end sub

sub modifybadwords()	'脏话过滤
dim BadWordsContent,LeftBadWord,RightBadWord
BadWordsContent=replace(request.form("BadWords"),"'","&#39;")
if BadWordsContent="" then BadWordsContent="操你妈=***" & VBCrlf & "妈的=*的"
RowBadWord=Split(BadWordsContent,VBCrlf)
For ii=Lbound(RowBadWord) to Ubound(RowBadWord)
	ColBadWord=Split(RowBadWord(ii),"=")
	LeftBadWord=LeftBadWord & "|" & ColBadWord(0)
	RightBadWord=RightBadWord & "|" & ColBadWord(1)
Next
Conn.Execute("update Config set Badwords='" & Mid(LeftBadWord,2) & "',Badwords1='" & Mid(RightBadWord,2) & "'")
DoWhat="脏话过滤设置成功"
end sub

sub modifydelly()		'留言管理
	DoWhat="留言删除管理"
	if request.form("DelAll")=1 then
		Conn.execute("delete from Data")		
		WhatErr="<LI>已清空所有留言！</LI>"
	else
		Dim PeopleDot,PeopleRe,LyYear,LyMonth,LyDay
		PeoPleDot=Trim(Request.form("PeopleDot"))
		PeoPleRe=Trim(Request.form("PeopleRe"))
		LyYear=Trim(Request.form("LyYear"))
		LyMonth=Trim(Request.form("LyMonth"))
		LyDay=Trim(Request.form("LyDay"))
		if (PeoPleDot>"" and Isnumeric(PeoPleDot)) then	
			Conn.execute("delete from Data where SubMainNumber=0 and counter<" & Cint(PeoPleDot))			
			WhatErr="<LI>已删除所有人气值低于" & PeoPleDot & "的主题！</LI>"
		end if
		if (PeoPleRe>"" and Isnumeric(PeoPleRe)) then	
			Conn.execute("delete from Data where SubMainNumber=0 and report<" & Cint(PeoPleRe))
			WhatErr=WhatErr & "<LI>已删除所有回复值低于" & PeoPleRe & "的主题！</LI>"
		end if
		if LyYear>"" and LyMonth>"" and LyDay>"" and Isnumeric(LyYear) and Isnumeric(LyMonth) and Isnumeric(LyDay) then
			Dim DelDate
			DelDate	=Cstr(LyYear)+Cstr(LyMonth)+Cstr(LyDay)
			Conn.execute("delete from Data where SubMainNumber=0 and (Cstr(Year(writetime))+Cstr(Month(writetime))+Cstr(Day(writetime)))<" & DelDate)
			WhatErr=WhatErr & "<LI>已删除所有在" & LyYear & "年" & LyMonth & "月" & LyDay & "日之前发表的主题！</LI>"
		end if
	end if
end sub

sub clearly()	'清空无效数据
	DoWhat="清理数据库"
	Rs.Open "select SubMainNumber from Data where SubMainNumber>0",conn,1,1
	if (Rs.eof and Rs.bof) then
		WhatErr="<LI>没有找到无效的留言数据；</LI>"
	else
		Dim RsC,i
		i=0
		Set RsC=Server.CreateObject("ADODB.Recordset")
		Do While Not Rs.eof
			RsC.Open "select id from Data where id=" & Rs(0),conn,1,1
			if (RsC.eof and RsC.bof) then
				Conn.execute("delete from Data where SubMainNumber=" & Rs(0))
				i=i+1
			end if
			RsC.close
		Rs.movenext
		loop
		WhatErr="<LI>删除了" & i & "条无效数据；</LI>"
	end if
	Rs.close
	Set Rs=nothing
	Set RsC=nothing
	Conn.close
	Set Conn=nothing
end sub

Function CompactDB(dbPath)
Dim fso, Engine, strDBPath,JET_3X
strDBPath = left(dbPath,instrrev(DBPath,"\"))
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(dbPath) Then
	fso.CopyFile dbpath,strDBPath & "temp.mdb"
	Set Engine = CreateObject("JRO.JetEngine")
	Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb", _
	"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb"
	fso.CopyFile strDBPath & "temp1.mdb",dbpath
	fso.DeleteFile(strDBPath & "temp.mdb")
	fso.DeleteFile(strDBPath & "temp1.mdb")
	Set fso = nothing
	Set Engine = nothing
	CompactDB="你的数据库" & dbpath & ", 已经压缩成功!"
Else
	CompactDB="数据库名称或路径不正确，请重试!"
End If
End Function

call HeadHtml()		'网页头函数
if (Not iserr) then
	call FounderErr()
else
	if session("admin") then
		call adminbody()
	else		
		call loginbody()
		if session("times")=0 then session("BackUrl")=ToUrl
	end if
end if
call FootHtml()		'网页尾函数%>