📄 common.asp

📁 一个很好的bbs论坛！可以用作毕业设计
💻 ASP
字号:
<%

'all variables must be declared
option explicit
dsn="DBQ=" & Server.Mappath("db/forum.mdb") & ";Driver={Microsoft Access Driver (*.mdb)};"
response.buffer=true
dim line,records,str2,str3
line = "<img src='images/line.gif' width=600 height=1><br><br>相关帖子:<br>"

'set buffering to true
response.buffer=true

'declaring variables
dim dsn,conn,rs,sql
dsn="DBQ=" & Server.Mappath("db/forum.mdb") & ";Driver={Microsoft Access Driver (*.mdb)};"



sub header()
	response.write "<HTML><HEAD><link rel='stylesheet' href='style.css'><title>bbs</title>"
	response.write "<TITLE>bbs</TITLE></HEAD><body>"
	response.write "<table border=0 width=600 cellpadding=0 cellspacing=0>"
	response.write "<tr><td><!img src='images/title.gif'></tr></td>"
end sub




sub admin()
	'response.write "<br><br> <A HREF='admin/index.asp'>控制面版</a><br><br>  <A HREF='reg.asp'>用户注册</a>"
end sub



sub connect()
	set conn=server.createobject("adodb.connection")
	set rs=server.createobject("adodb.recordset")
	conn.open dsn
end sub



sub close()
	rs.close
	set rs=nothing
	conn.close
	set conn=nothing
end sub



sub footer()
	response.write "<table><tr><td><br>"
	response.write "<img src='images/line.gif' width=600 height=1><br><br>"
	response.write "<font size=-1>程序设计:wayeah</font>"
	response.write "</table></body></html>"

end sub



'this function is ordering the child messages
sub displayMessages(layer,parent_id)
	'declaring
	dim sql_order	' sql string
	dim rs_order	' recordset object
	dim arVal()	' our array
	dim idx		' our array index

	'create recordset
	set rs_order=server.createObject("adodb.recordset")

	'find child with thread_parent=his parent id
	sql_order = "SELECT id,forumID,name,subject,email,mesDate,thread_parent,thread_id FROM mestbl WHERE (thread_parent<>0) AND (forumID=" &fid& ") AND (thread_id = " & parent_id & ")"
	rs_order.open sql_order,conn

	
	Do until rs_order.EOF
		idx = idx +1
		redim preserve arVal(7,idx)
		arVal(0,idx) = rs_order("thread_id")	'this is the thread of the ring-0 thread
		arVal(1,idx) = rs_order("id")		'this is the actual id for the thread itself
		arVal(2,idx) = rs_order("thread_parent")	'this is the parent thread directly attatched to this thread (id)
		arVal(3,idx) = rs_order("name")
		arVal(4,idx) = rs_order("email")
		arVal(5,idx) = rs_order("subject")
		arVal(6,idx) = rs_order("mesdate")
		arVal(7,idx) = rs_order("forumid")
		rs_order.movenext
	loop
	
	rs_order.close
	set rs_order = nothing
	call DisplayMsg_s(1,idx, arVal, parent_id)

End Sub	




sub DisplayMsg_s(layer,index, arValues, pid)
	dim t
	dim mesid, name, email, subject, mesdate, fid, tid, str
	dim MessageSpacing,spaceing
	
	for t = 1 to index
	if arValues(2, t) = pid then
		mesid=arValues(1, t)
		name=arValues(3, t)
		email=arValues(4, t)
		subject=arValues(5, t)
		mesdate=arValues(6, t)
		fid=arValues(7, t)
		tid=arValues(0, t)
		image="<img src='images/news.gif' border=0>"
		spaceing=""
		for MessageSpacing=1 to layer
			spaceing=spaceing & "&nbsp;&nbsp;&nbsp;"
		next
		
		str= "<tr><td>" & spaceing & image & "<font face='Tahoma,Arial' size='-1'>"
		str=str& "<a href='show.asp?id=" & mesid & "&fid="&fid&"&tid="&tid&"'>" & arValues(5, t) & "</a>" & " - <b>" &  arValues(3, t)
		str=str& "</b>&nbsp;&nbsp;" &   arValues(6, t)
		str=str & "</b></td></tr>"
		
		'printing details
		Response.Write str & "</font>"
		
		'calling again to find more childs - if not rs_order=nothing
	    	call DisplayMsg_s(layer+1,index, arValues, mesid)

	end if
	next
		

end sub


sub sendAllFamily(tid,maxid,fid)
	dim body,email,link,rs_send
	set rs_send=server.createObject("adodb.recordset")
	sql="select email,id,thread_id from mestbl"
	sql=sql & " where (thread_id="& tid & " or id="& tid & ") and id<>" & maxid &""
	sql=sql & "and forumid="&fid&" and isChecked=1"
	'sql=sql & "and forumid="&fid
	'response.write sql'***debug
	rs_send.open sql,conn
	do while not rs_send.eof
		'change it to point to you server!
		link="http://www.tip.co.il/myforum/demo/show.asp?fid=" & fid & "&id=" & maxid & "&tid=" & tid
		email=rs_send("email")
		response.write email
		body="A new message has been posted in a thread you asked us watch for you on "
		body=body & "myforum discussion forum.For your convenience, the address of the new "
		body=body & "message is   " & link
		Dim objCDO
		Set objCDO = Server.CreateObject("CDONTS.NewMail")
		objCDO.To = email
		objCDO.From = "wayeah@21cn.com"
		objCDO.Subject = "A new message has been posted in myforum!"
		objCDO.Body = body
		objCDO.Send
	rs_send.movenext
	loop
	rs_send.close
	set rs_send=nothing
end sub




sub maxRec()
		set rs_maxid=server.createobject("adodb.recordset")
		sql_maxid = "select max(id) as maxid from mestbl" 
		Set rs_maxid = Conn.Execute(sql_maxid) 
		maxid = rs_maxid("maxid")'new id
		rs_maxid.close
		set rs_maxid=nothing
end sub








'this function is ordering the child messages
sub displayMessages1(layer,parent_id)
	'declaring
	dim sql_order	' sql string
	dim rs_order	' recordset object
	dim arVal()	' our array
	dim idx		' our array index

	'create recordset
	set rs_order=server.createObject("adodb.recordset")

	'find child with thread_parent=his parent id
	sql_order = "SELECT id,forumID,name,subject,email,mesDate,thread_parent,thread_id FROM mestbl WHERE (thread_parent<>0) AND (forumID=" & fid & ")"
	rs_order.open sql_order,conn

	
	Do until rs_order.EOF
		idx = idx +1
		redim preserve arVal(7,idx)
		arVal(0,idx) = rs_order("thread_id")	'this is the thread of the ring-0 thread
		arVal(1,idx) = rs_order("id")		'this is the actual id for the thread itself
		arVal(2,idx) = rs_order("thread_parent")	'this is the parent thread directly attatched to this thread (id)
		arVal(3,idx) = rs_order("name")
		arVal(4,idx) = rs_order("email")
		arVal(5,idx) = rs_order("subject")
		arVal(6,idx) = rs_order("mesdate")
		arVal(7,idx) = rs_order("forumid")
		rs_order.movenext
	loop
	rs_order.close
	set rs_order = nothing

	call DisplayMsg_s1(1,idx, arVal, parent_id)
	
End Sub	




sub DisplayMsg_s1(layer,index, arValues, pid)
	dim t
	dim mesid, name, email, subject, mesdate, fid, tid, str
	dim MessageSpacing,spaceing
	
	for t = 1 to index
	if arValues(2, t) = pid then
		mesid=arValues(1, t)
		name=arValues(3, t)
		email=arValues(4, t)
		subject=arValues(5, t)
		mesdate=arValues(6, t)
		fid=arValues(7, t)
		tid=arValues(0, t)
		image="<img src='images/news.gif' border=0>"
		spaceing=""
		for MessageSpacing=1 to layer
			spaceing=spaceing & "&nbsp;&nbsp;&nbsp;"
		next
	
		str= "<tr><td>" & spaceing & image & "<font face='Tahoma,Arial' size='-1'>"
		str=str& "<a href='show.asp?id=" & mesid & "&fid="&fid&"&tid="&tid&"'>" & arValues(5, t) & "</a>" & " - <b>" &  arValues(3, t)
		str=str& "</b>&nbsp;&nbsp;" &   arValues(6, t)
		str=str & "</b>"
		
		'printing details
		Response.Write str & "</font>"
		if cint(request("id")) = cint(mesid) then
			response.write urHereImg
		end if
		response.write "</td></tr>"
		'calling again to find more childs - if not rs_order=nothing
	    	call DisplayMsg_s1(layer+1,index, arValues, mesid)

	end if
	next
		

end sub
%>
⌨️ 快捷键说明

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