⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 save.asp

📁 在线考试系统
💻 ASP
字号:
<%@ Language=VBScript %>

<% option explicit %>

<% Response.Buffer =true %>

<!-- #include file="conn_forum.asp" -->
<!-- #include file="conn_member.asp" -->
<!-- #include file="inc_session.asp" -->

<%
	dim uid
	dim iArea
	dim iId
	dim sTitle
	dim sFace
	dim sContent

	dim sAuthor		'//src theme
	dim iHit		'//src theme
	dim iReply		'//src theme
	dim iSelected	'//src theme


	'//init
	sTitle=""
	sFace=""
	sAuthor=""
	iHit=0
	iReply=0
	iSelected=0


	uid=GetSession()

	iArea=clng(Request("Area"))
	iId  =clng(Request("ParentId"))

	if iId=-1 then
		sTitle=RemoveBad(trim(Request("Title")))
		sFace=clng(Request("face"))
		sFace="f" & Right("000" & sFace,3) & ".gif"
	end if

	sContent=Request("content")

	'-------------------------- Check all blank ------------------
	if sContent="" or (iId=-1 and sTitle="") then
		%>
		<script language="VBScript">
			history.back
		</script>
		<%
		Response.End
	end if

	if uid="" then
		%>
		<script language="VBScript">
			history.back
			window.open "relogin.asp","ReLogin","width=300,height=230,status=no,toolbar=no,menubar=no,location=no,resizable=yes,scrollbars=no"
		</script>
		<%
		Response.End
	end if

	'====================== Start Save =====================

	dim rs
	set rs=Server.CreateObject ("ADODB.Recordset")

	'------- Update old theme (reply need only) -------
	if iId <> -1 then
		rs.Open "SELECT * FROM tContent WHERE ThemeId=" & iId,connf,3 ,3

		if rs.BOF and rs.EOF then
			Response.Write "theme error!"
			Response.End
		end if

		if rs("lock")=1 then
			response.Write "theme had locked!"
			Response.End
		end if

		rs("date")=date()
		rs("time")=time()
		rs("replyCount")=clng(rs("replyCount"))+1
		rs("replier")=uid

		'//get src theme info
		sTitle=rs("Theme")

		sAuthor=rs("author")
		sFace=rs("icon")
		iHit=rs("hit")
		iReply=rs("replycount")
		iSelected=rs("selected")

		rs.Update
		rs.Close
	end if




	'------- CONTENT --------
	dim iTid	'//new theme id that get from DBEngine auto

	rs.Open "tcontent",connf,3 ,3
	rs.AddNew
	rs("AreaId")=iArea
	rs("ParentId")=iId
	rs("Theme")=sTitle
	rs("author")=uid
	if iId=-1 then
		rs("date")=date()
		rs("time")=time()
	end if
	rs("writetime")=now()		
	rs("icon")=sFace
	rs("hit")=0
	rs("replyCount")=0
	rs("replier")=""
	rs("content")=sContent
	rs("lock")=0
	rs("selected")=0
	rs.Update

	if iId=-1 then
		iTid=rs("Themeid")
	else
		iTid=iId
	end if

	rs.Close


	'------- INDEX --------
	rs.Open "SELECT * FROM tIndex WHERE areaID=" & iArea,connf,3 ,3

	if rs.BOF and rs.EOF then
		Response.Write "Index error!"
		Response.End
	end if

	rs("lastAuthor")=uid
	rs("lasttime")=Now()
	rs("lastTheme")=sTitle
	rs("lastThemeId")=iTid
	if iId=-1 then
		rs("themecount")=clng(rs("themecount"))+1
	else
		rs("replyCount")=clng(rs("replyCount"))+1
	end if

	rs.Update
	rs.Close


	'-------- RECENT -------
	dim iCount
	rs.Open "SELECT * FROM tRecent",connf,3 ,3
	if rs.BOF and rs.EOF then
		iCount=0
	else
		rs.MoveLast
		rs.MoveFirst
		iCount=rs.RecordCount
	end if
	rs.Close

	rs.Open "SELECT * FROM tRecent WHERE themeid=" & iTid ,connf,3 ,3
	if rs.BOF and rs.EOF then
		rs.Close
		rs.Open "SELECT * FROM tRecent ORDER BY Time",connf,3,3
		if icount>12 then rs.Delete '//delete the oldest one
		rs.AddNew
	end if

	rs("ThemeID")=iTid
	rs("AreaID")=iArea
	rs("Theme")=sTitle
	rs("Time")=now()
	rs("Hit")=iHit
	rs("replyCount")=iReply
	rs("Icon")=sFace
	rs("selected")=iSelected

	if iId=-1 then
		rs("Author")=uid
		rs("Replier")=""
	else
		rs("Author")=sAuthor
		rs("Replier")=uid
	end if

	rs.Update
	rs.Close


	'------- update user information ------
	if uid<>"" then
		
		dim rsm
		set rsm=Server.CreateObject ("ADODB.Recordset")
		rsm.Open "SELECT * FROM tmember WHERE uid='" & uid & "'" ,connm,3 ,3

		if rsm.BOF and rsm.EOF then
			Response.Write "User id Error!"
			Response.End
		else

			dim lScore
			dim lLevel
			lScore=rsm("score")
			lLevel=rsm("level")
			lScore=lScore+5

			if lScore>= 0 and lScore<100 then
				lLevel=1
			elseif lScore>= 100 and lScore<500 then
				lLevel=2
			elseif lScore>= 500 and lScore< 1000 then
				lLevel=3
			elseif lScore>= 1000 and lScore< 1500 then
				lLevel=4
			elseif lScore>= 1500 and lScore< 2500 then
				lLevel=5
			elseif lScore>= 2500 and lScore< 3000 then
				lLevel=6
			elseif lScore>= 3000 and lScore< 3500 then
				lLevel=7
			elseif lScore>= 3500 and lScore< 4000 then
				lLevel=8
			elseif lScore>= 4000 and lScore< 5000 then
				lLevel=9
			elseif lScore>= 5000 then
				lLevel=10
			end if

			if lScore>=10000 then lscore=10000

			rsm("writetimes")=clng(rsm("writetimes"))+1
			rsm("score")=lScore
			rsm("level")=lLevel
			rsm.Update
		end if
		rsm.Close
		set rsm=nothing
		call closeconnm

	end if


	'//----- update Config -----
	rs.Open "tConfig",connf,3 ,3
	if rs.BOF and rs.EOF then
		rs.AddNew
		if iId=-1 then
			rs("themeCount")=1
		else
			rs("replyCount")=1
		end if
	else
		if iId=-1 then
			rs("themeCount")=clng(rs("themeCount"))+1
		else
			rs("replyCount")=clng(rs("replyCount"))+1
		end if
	end if
	rs.Update
	rs.Close


	set rs=nothing
	call closeconnf

	'------------------------
	if iId=-1 then
		Response.Redirect "listtheme.asp?area=" & iArea
	else
		Response.Redirect "viewtheme.asp?area=" & iArea & "&id=" & iId
	end if



%>

<%

Function RemoveBad(ori)
	dim ns
	if len(ori)=0 then exit function
	ns=Replace(ori,"&","&amp;")
	ns=Replace(ns,"<","&lt;")
	ns=Replace(ns,">","&gt;")
	ns=Replace(ns,vbcrlf,"<br>")
	ns=Replace(ns,chr(34),"&quot;")
	RemoveBad=ns
End Function

%>



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -