marcoscb.asp

程序网络论坛HigroupBBS v4.00 默认管理员帐号密码都是Marcos

<!--#include file="MarcosMD.asp"-->
<!--#include file="MarcosUBB.asp"-->
<!--#include file="MarcosPB.asp"-->
<%
	rem ================= HigroupBBS V 4.00, Powered By Marcos 2004.10 ====================
	rem ======================== All Rights Reserved By Higroup ===========================
	rem ============== 全部ASP程序代码编写由Marcos(孙华)完成,联系QQ26696782 =================

	dim rs,conn
	dim m,ip,sql,styleRoot,database1,database2,noGuest,queryTimes
	dim sTime,rs_sys
	const listNum=25
	const showNum=8
	const newTopicFen=10
	const newReplyFen=5
	ip=request.serverVariables("REMOTE_ADDR")

	queryTimes=0
	session.timeOut=40
	const isSafe=false '防刷新机制关闭
	const beSafe=true '强安全认证机制开启

	haveNewMess()

	if isSafe=true then
		noRefresh(3)
	end if
	
	if getApp("skinIdList")="" or getPost("updateAllSkin")="True" then
		getConn()
		updateAllSkin()
		updateSysInfo()
		closeConn()
	end if

	noGuest=getApp("noGuest")

	updateUsage(getValue(m&"mySkinId"))
	
	if getApp("isHalted") then
		thePage=lcase(request.serverVariables("URL"))

		i=instrRev(thePage,"/")
		if i>0 then
			thePage=mid(thePage,i+1)
		end if

		thePage=left(thePage,5)&right(thePage,4)

		if not(thePage="admin.asp" or thePage="login.asp") then
			echo getApp("haltInfo")
			echo "<div align=right><a href=""login.asp"">[管理登录]</a></div>"
			response.end
		end if
	end if

	sub getConn()
		dim db,connStr
		on error resume next
		db=server.mapPath("DataBase\MarcosDB%5C")
		database1=db
		database2=server.mapPath("DataBackup\")
		set rs=server.CreateObject("adodb.recordset")
		set conn=server.CreateObject("adodb.connection")
		connStr="Provider=Microsoft.Jet.Oledb.4.0;Data source=" & db
		conn.open(connStr)
		if err then
			err.clear
			echo "数据库连接出错!"
			set rs=nothing
			set conn=nothing
			response.end
		end if
	end sub

	sub closeConn()
		conn.close()
		set rs=nothing
		set conn=nothing
	end sub
	
	function getStrLen(str)
		getStrLen=0
		for i=1 to len(str)
			if asc(mid(str,i,1))>0 and asc(mid(str,i,1))<256 then
				getStrLen=getStrLen+1
			 else
				getStrLen=getStrLen+2
			end if
		next
	end function
	
	function getPageTwo(num,topicId,boardId)
		dim i,iPage
		if (num/showNum)=fix(num/showNum) then
			iPage=fix(num/showNum)
		 else
			iPage=fix(num/showNum)+1
		end if
		if iPage=1 or iPage=0 then
			exit function
		end if
		if getPost("topicId")="" then
			maxNum=3
			getPageTwo="&raquo;"
		 else
			maxNum=6
			getPageTwo=""
		end if
		for i=1 to maxNum
			if i>iPage then
				exit for
			end if
			getPageTwo=getPageTwo & "<a href=""topicShow.asp?boardId=" & boardId & "&boardName=" & boardName & "&topicId=" & topicId & "&page=" & i & """><font {$font"&i&"}>" & i & "</font></a> "
		next
		if iPage>maxNum then
			getPageTwo=getPageTwo & "... <a href=""topicShow.asp?boardId=" & boardId & "&boardName=" & boardName & "&topicId=" & topicId & "&page=" & iPage & """><font {$font"&i&"}>" & iPage & "</font></a>"
		end if
		if maxNum=6 then
			getPageTwo=replace(getPageTwo,"{$font"&page&"}","class=warningColor")
		end if
	end function
	
	function getUserLevel(n,m)
		if m="999" then
			getUserLevel="论坛管理员"
			exit function
		end if
		if n<100 then
			getUserLevel="小虫子"
		end if
		if n>=100 and n<=500 then
			getUserLevel="爬爬虫"
		end if
		if n>=501 and n<=1000 then
			getUserLevel="鼻涕虫"
		end if
		if n>=1001 and n<=2000 then
			getUserLevel="笨笨猪"
		end if
		if n>=2001 and n<=3500 then
			getUserLevel="泡泡龙"
		end if
		if n>=3501 and n<=5000 then
			getUserLevel="小飞侠"
		end if
		if n>=5001 and n<=6000 then
			getUserLevel="网迷六级"
		end if
		if n>=6001 and n<=7000 then
			getUserLevel="网侠七级"
		end if
		if n>=7001 and n<=9000 then
			getUserLevel="网侠八级"
		end if
		if n>=9001 and n<=10000 then
			getUserLevel="网侠九级"
		end if
		if n>10000 then
			getUserLevel="世外高人"
		end if
	end function
	
	function getAvilableUser(userList)
		dim sql,rs_sys
		userList=replace(userList,",","','")
		sql="select userName from Marcos_User where userName in('"&userList&"')"
		set rs_sys=conn.execute(sql)
		do until rs_sys.eof
			getAvilableUser=getAvilableUser&","&rs_sys(0)
			rs_sys.movenext
		loop
		if getAvilableUser<>"" then
			getAvilableUser=mid(getAvilableUser,2)
		end if
		queryTimes=queryTimes+1
	end function

	sub isIn()
		dim rs
		if getValue("userId")="" then
			echo "<script>alert('该操作要求登录!');location.href='login.asp';</script>"
			response.end
		end if
		if beSafe=true then
			sql="select userId,passWord,isLocked,userName from Marcos_User where userId="&getValue("userId")
			set rs=conn.execute(sql)
			if rs.eof then
				echo "对不起,帐号密码错误或者帐号已经被删除!"
				closeConn()
				response.end
			 else
				if trim(getValue("passWord"))<>trim(rs(1)) then
					echo "对不起,帐号密码错误或者帐号已经被删除!"
					closeConn()
					response.end
				end if
			end if
			if rs(2)=true then
				echo "对不起,您正在使用的帐号已被管理员锁定,请和管理员联系!"
				closeConn()
				response.end
			end if
			setValue "userName",rs(3)
		end if
		queryTimes=queryTimes+1
	end sub
	
	function getStatusImg(n)
		select case n
			case 0
				img="normalTopic.gif"
				alt="暂时还没有回复"
			case 1,2,3,4,5,6,7,8,9,10
				img="haveReply.gif"
				alt="普通主题"
			case else
				img="topTopic.gif"
				alt="回复数超过10个的贴子"
		end select
		if rs("islocked")=true then
			img="lockedTopic.gif"
			alt="锁定的主题"
		end if
		getStatusImg=img & "$$$" & alt
	end function
	
	function getUserPic(thePic)
		thePic=enCode(thePic)
		if thePic=""  then
			getUserPic="images/001/alpha.gif"
			exit function
		end if
		if instr(thePic,",")>0 then
			on error resume next
			userPic=split(thePic,",")(0)
			width=split(thePic,",")(2)
			height=split(thePic,",")(1)
			if height>210 then
				height=210
			end if
			if width>180 then
				width=180
			end if
			thePic=userPic & """ height=""" & height & """ width=""" & width
		 else
			thePic=thePic & """ height=""120"" width=""120"
		end if
		getUserPic=thePic
	end function
	
	function isExists(theUser)
		dim sql
		sql="select userName from Marcos_User where userName='" & theUser & "'"
		set rs_sys=conn.execute(sql)
		if rs_sys.eof then
			isExists=false
		 else
			isExists=true
		end if
		queryTimes=queryTimes+1
	end function
	
	function canReg(theUser)
		dim i
		dim str
		canReg=true
		str="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
		if theUser="" then
			echo "用户名不可以为空!"
			response.end
		end if
		for i=1 to len(theUser)
			if not(asc(mid(theUser,i,1))<0 and asc(mid(theUser,i,1))<256) then
				if instr(str,mid(theUser,i,1))<=0 then
					canReg=false
					exit for
				end if
			end if
		next
	end function
	
	sub canSet(classId)
		isIn()
		if canSetTrue(classId)=false then
			echo "<script>alert('对不起,您无权进行此操作!');history.back();</script>"
			closeConn()
			response.end
		end if
	end sub
	
	function canSetTrue(classId)
		canSetTrue=false
		if isAdminTrue() or isManagerTrue(classId) then
			canSetTrue=true
		end if
	end function
	
	sub isAdmin()
		if not isAdminTrue() then
			echo "权限不允许,请不要越权操作!"
			closeConn()
			response.end
		end if
	end sub

	function isAdminTrue()
		dim sql,rs_sys
		isAdminTrue=false
		if getValue("userLevel")="999" then
			sql="select userLevel from Marcos_User where userId="&getValue("userId")
			set rs_sys=conn.execute(sql)
			if rs_sys(0)="999" then
				isAdminTrue=true
			end if
			queryTimes=queryTimes+1
		end if
	end function
	
	sub isManager()
		dim sql,rs_sys,managerList

		if isAdminTrue() then
			exit sub
		end if
		
		sql="select boardManagerList from Marcos_Board where topBoardId<>0"
		set rs_sys=conn.execute(sql)
		do until rs_sys.eof
			if fixNull(rs_sys(0))<>"" then
				managerList=managerList&","&rs_sys(0)
			end if
			rs_sys.movenext
		loop
		if managerList<>"" then
			managerList=managerList&","
		end if
		if instr(managerList,","&getValue("userName")&",")<=0 or trim(managerList)="" then
			echo "<script>alert('对不起,系统限制只有管理员和版主才能发起投票!');history.back();</script>"
			closeConn()
			response.end
		end if
		queryTimes=queryTimes+1
	end sub
	
	function isManagerTrue(classId)
		dim i,sql,rs_sys,boardManagerList
		isManagerTrue=false
		if getValue("userId")="" then
			exit function
		end if
		sql="select boardManagerList from Marcos_Board where boardId="&classId
		set rs_sys=conn.execute(sql)
		if rs_sys.eof then
			response.write("参数错误!")
			closeConn()
			response.end
		end if
		boardManagerList=split(fixNull(rs_sys(0)),",")
		for i=0 to uBound(boardManagerList)
			if boardManagerList(i)=getValue("userName") then
				isManagerTrue=true
				exit for
			end if
		next
		queryTimes=queryTimes+1
	end function
	
	function nowWhere(nowPlace,nowPlaceLink)
		if len(nowPlace)>16 then
			nowPlace=left(nowPlace,16)&"..."
		end if
		if getValue("userNameEx")="" then
			application(m&"visitorNum")=application(m&"visitorNum")+1
			setValue "userName","游客"&application(m&"visitorNum")
			setValue "userNameEx","游客"&application(m&"visitorNum")
		 else
		 	if getValue("userName")="" then
				setValue "userName",getValue("userNameEx")
			end if
		end if
		
		if noGuest="True" and instr(getValue("userName"),"游客")>0 then
			exit function
		end if
		
		if session(m&"onlineFlag")<>"26696782" then
			sql="select onlineId from Marcos_Online where userName='"&getValue("userName")&"'"
			set rs_sys=conn.execute(sql)
			if rs_sys.eof then
				sql="insert into Marcos_Online(userName,lastLoginIP) values('"&getValue("userName")&"','"&ip&"')"
				conn.execute(sql)
			end if
			session(m&"onlineFlag")="26696782"
		end if
		sql="update Marcos_Online set lastActiveTime='"&now()&"',lastPlace='"&nowPlace&"',lastPlaceLink='"&nowPlaceLink&"' where userName='"&getValue("userName")&"'"
		conn.execute(sql)
	end function
	
	sub updatePostInfo(classId)
		dim sql,rs_sys,lastPostInfo
		sql="select topicTitle,userName,addTime,topicId from Marcos_Topic where boardId="&classId&" and isRecycled=false order by lastReplyTime desc"
		set rs_sys=conn.execute(sql)
		if not rs_sys.eof then
			lastPostInfo="标题:<a href=""topicShow.asp?boardId="&classId&"&topicId="&rs_sys(3)&""">"&_
						left(rs_sys(0),5)&"..</a><br>作者:<a href=""userInfo.asp?userName="&rs_sys(1)&""" target=_blank>"&_
						rs_sys(1)&"</a><br>时间:"&mid(rs_sys(2),6,len(mid(rs_sys(2),6))-3)
			sql="update Marcos_Board set lastPostInfo='"&lastPostInfo&"' where boardId="&classId
		 else
			sql="update Marcos_Board set lastPostInfo='' where boardId="&classId
		end if
		conn.execute(sql)
	end sub
	
	sub noRefresh(refreshTime)
		dim i,refreshPage,pageList
		refreshPage=lcase(request.serverVariables("URL"))
		pageList="$index.asp$topicList.asp$topicShow.asp$voteList.asp$voteShow.asp$online.asp$"

		i=instrRev(refreshPage,"/")
		if i>0 then
			refreshPage=mid(refreshPage,i+1)
		end if

		if instr(lcase(pageList),"$"&refreshPage&"$")<=0 then
			exit sub
		end if

		refreshPage=left(refreshPage,5)&right(refreshPage,4)
		if refreshPage="admin.asp" then
			exit sub
		end if

		refreshPage=refreshPage&"?"&request.queryString

		if session("refreshTime")="" then
			session("refreshTime")=timer()
			session("refreshPage")=refreshPage
		 else
			if (timer()-session("refreshTime"))<=refreshTime and session("refreshPage")=refreshPage then 
				response.write "<font size=2>对不起，请不要恶意刷新页面，防刷新机制已经打开，"&refreshTime&"秒后自动打开正确页面。</font>"
				response.write "<meta http-equiv=""refresh"" content="""&refreshTime&""">"
				session("refreshTime")=timer()
				session("refreshPage")=refreshPage
				response.end
			end if
			session("refreshTime")=timer()
			session("refreshPage")=refreshPage
		end if
	end sub
	
	sub echo(str)
		if instr(str,"{$styleRoot}")>0 then
			str=replace(str,"{$styleRoot}",styleRoot)
		end if
		if instr(str,"{$borderColor}")>0 then
			str=replace(str,"{$borderColor}",getApp("borderColor_"&mySkinId))
		end if
		if instr(str,"{$tableWidth}")>0 then
			str=replace(str,"{$tableWidth}",getApp("tableWidth_"&mySkinId))
		end if
		response.write(str)
	end sub
	
	sub locate(url)
		response.redirect(url)
	end sub
	
	sub setValue(var,val)
'		response.cookies(m & var)=val
		if var=m&"mySkinId" or var="userNameEx" then
			response.cookies(m&var)=val
			response.cookies(m&"userNameEx").expires=now()+365
		end if
		session(m & var)=val
	end sub
	
	function getValue(var)
'		getValue=trim(request.cookies(m & var))
		getValue=trim(session(m&var))
		if var=m&"mySkinId" or var="userNameEx" then
			getValue=trim(request.cookies(m&var))
		end if
	end function

	function getPost(var)
		getPost=rTrim(request.form(var))
		if getPost="" then
			getPost=rTrim(request.queryString(var))
		end if
		if var="title" then
			getPost=lTrim(getPost)
		end if
	end function
	
	function fixNull(str)
		if isNull(str) then
			fixNull=""
		 else
			fixNull=str
		end if
	end function
%>