dispbbs.asp

JSP ACCESS版的论坛源码 深圳盈盈通

			"　用户魅力：<img src=pic/bar5.gif width="&int(userCP/1000)*4&" height=8 title="&userCP&"><br>"
	response.write "&nbsp;&nbsp;注册日期: "& year(addtime) &"-"& month(addtime) &"-"& day(addtime)
	response.write "<BR> &nbsp;&nbsp;发表文章: "&article&" <img src="""" width=0 height=4><BR></td>"&_
			"<td bgcolor="&bgcolor&" width=1 height=100% rowspan=2>"&_ 
            "<table width=1 height=""100%"" cellpadding=0 cellspacing=0 bgcolor="&Tabletitlecolor&">"&_
            "<tr><td width=1></td></tr></table></td>"&_
			"<td bgcolor="&bgcolor&" valign=top width=* height=""95%""><img src="""" width=0 height=4><BR>"&_
            "&nbsp; <a href=javascript:openScript('messanger.asp?action=new&touser="&HTMLEncode(username)&"',420,320)>"&_
			"<img src=pic/message.gif border=0 alt=给"&HTMLEncode(username)&"发送一个短消息></a>&nbsp;"&_
            "<a href=javascript:openScript('dispuser.asp?name="&HTMLEncode(username)&"',350,300)>"&_
			"<img src=pic/profile.gif border=0 alt=查看"&HTMLEncode(username)&"的个人资料></a>&nbsp;"&_
            "<a href=queryResult.asp?type=2&txtuser="&HTMLEncode(username)&"&selBoard="&cstr(boardid)&" target=_blank><img src=pic/find.gif border=0 alt=搜索"&HTMLEncode(username)&"在"&boardtype&"的所有贴子></a>&nbsp; "

	if useremail<>"" then
		response.write "<A href='mailto:"& htmlencode(useremail) &"'><IMG alt='点击这里发送电邮给"& HTMLEncode(username) &"' border=0 src='pic/email.gif'></A>&nbsp;" 
    end if
	if oicq<>"" then
	on error resume next
	Dim T,Start,Length,PicURL_1
	T=GetURL("http://search.tencent.com/cgi-bin/friend/oicq_find?oicq_no="&oicq&"") 
	Start=Instr(1,T,"ShowResult("+chr(34)) 
	Start=Instr(Start,T,"http://") 
	Length=Instr(Start,T,chr(34)+","+chr(34))-Start 
	PicURL_1=Mid(T,Start,Length) 
	response.write "<a href=http://search.tencent.com/cgi-bin/friend/user_show_info?ln="&oicq&" target=_blank title="""&htmlencode(username)&"["&oicq&"]的QQ情况""><img src="&PicURL_1&" width=16 height=16 border=0>OICQ</a>&nbsp;"
	end if
	if homepage<>"" then
		response.write "<A href='"& htmlencode(homepage) &"' target=_blank><IMG alt='访问"& HTMLEncode(username) &"的主页'  border=0 src='pic/homepage.gif'></A>&nbsp; "
	end if

	response.write "<a href=reannounce.asp?boardid="&boardid&"&rootid="&rootid&"&id="&announceid&"&reply=true>"&_
			"<img src=pic/reply.gif border=0 alt=引用回复这个贴子></a>&nbsp; "&_
            "<BR><hr width=""100%"" size=1 color=#777777>"&_
            "<table cellpadding=0 cellspacing=0 width=""95%"" style=""TABLE-LAYOUT: fixed"">"&_
            "<tr><td width=32 align=left valign=top>"
	if instr(Expression,"face")>0 then
		response.write "<img src='images/"& Expression &"' border=0 alt=发贴心情>"
	end if
	response.write "&nbsp;</td><td style=""LEFT: 0px; WIDTH: 100%; WORD-WRAP: break-word"">"&_
			"<font face=宋体 color=#333333>" 
	response.write "<b>"& htmlencode(topic) &"</b><br>"& ubbcode(body) 
if not isnull(isvote) and isvote=1 and announceid=rootid then
	set vrs=conn.execute("select vote,votenum,votetype,voteuser from vote where announceid="&announceid&"")

	vote=split(vrs("vote"),"|")
	votenum=split(vrs("votenum"),"|")
	response.write "<table border=0 cellpadding=0 cellspacing=3 width=""95%"" align=center><tr>"
	response.write "<td colSpan=2>以下为投票内容：</td></tr>"
	response.write "<form action=postvote.asp?boardid="&boardid&"&announceid="&announceid&"&action="&vrs("votetype")&" method=POST>"
	for m = 0 to ubound(vote)
	if cint(vrs("votetype"))=0 then
		vote_1=""&vote_1&""&m+1&".  <input type=radio name=postvote value="""&m&""">"&vote(m)&"<br>"
	else
		vote_1=""&vote_1&""&m+1&".  <input type=checkbox name=postvote_"&m&" value="""&m&""">"&vote(m)&"<br>"
	end if
	next
	response.write "<tr><td width=""60%"">"&vote_1&"</td>"
	vote_1=""
	for m = 0 to ubound(votenum)
		votenum_1=""&votenum_1&"票数：<font color=#990000><b>"&votenum(m)&"</b></font><br>"
	next
	response.write "<td width=""40%"" valign=top><span style=""LINE-HEIGHT: 200%;"">"&votenum_1&"</span></td></tr>"
	votenum_1=""
	if membername="" then
	response.write "<tr><td colSpan=2><br><font color=#990000>您还没有登陆，不能进行投票。</font></td>"
	else
	if instr(vrs("voteuser"),membername)>0 then
	response.write "<tr><td colSpan=2><br><font color=#990000>您已经投过票了，请看结果吧。</font></td>"
	else
	response.write "<tr><td colSpan=2><br><input type=submit name=Submit value='投 票'></td>"
	end if
	end if
	response.write "</form>"
	response.write "</tr></table>"
	set vrs=nothing
end if
if signflag=1 then
	if sign<>"" then
		response.write "<p>------------------------<br>"& ubbcode(sign)
	end if
end if
	response.write "</font> </td><td width=16> </td></tr></table></td></tr><tr>"&_ 
			"<td class=bottomline bgcolor="&bgcolor&" valign=bottom> "&_
            "<hr width=100% size=1 color=#777777>"&_
            "<table width=100% cellpadding=0 cellspacing=0><tr><td align=left valign=bottom> "
	if membername<>"" then
		if username=membername or memberclass = grade19 or memberclass = grade20  then
			response.write "&nbsp; <a href=editannounce.asp?boardid="&boardid&"&rootid="&rootid&"&id="&announceid&"><img src=pic/edit.gif border=0 alt=编辑这个贴子></a>"
		end if
	end if
	response.write "</td><td align=left valign=bottom> 发贴时间： "&dateandtime&" </td>"&_
			"<td align=left valign=bottom> <img src=pic/ip.gif border=0 width=13 height=15 alt="""">  " 
	if IpFlag=0 then
		if memberclass=grade19 or memberclass=grade20 then
		response.write ip
		else
        	response.write getip(ip)
		end if
	else
		response.write ip 
        end if
	response.write "</td><td align=right nowarp valign=bottom width=110>"
	if memberclass=grade19 or memberclass=grade20 then
		if announceid<>rootid then				
		response.write "<a href=admin_postings.asp?action=dele&boardID="&boardID&"&ID="&announceID&"&rootid="&rootID&"&username="&server.URLencode(username)&" title=注意：本操作将删除单个贴子，不能恢复><img src=PIC/delete.gif border=0></a> "
		end if
		response.write "<a href=admin_postings.asp?action=copy&boardID="&boardID&"&ID="&announceID&"&rootid="&rootID&" title=复制单个贴子到别的版面><img src=PIC/copy.gif border=0></a>  "
		if isbest=0 then
			response.write "<a href=admin_postings.asp?action=isbest&boardID="&boardID&"&ID="&announceID&"&rootid="&rootID&" title=将单个贴子加入精华><img src=PIC/jing.gif border=0></a>" 
		else
			response.write "<a href=admin_postings.asp?action=nobest&boardID="&boardID&"&ID="&announceID&"&rootid="&rootID&" title=解除本贴子精华状态><img src=PIC/jing.gif border=0></a>" 
		end if
	end if
	response.write "</td><td align=right valign=bottom width=4> </td></tr></table>"&_
			"<img src="""" width=0 height=4><BR></td></tr></table></td>"&_
			"<td bgcolor="&Tablebackcolor&" valign=middle width=1 height=24> </td></tr></table>"
	response.write "<table cellpadding=0 cellspacing=0 border=0 width=""95%"" bgcolor="&Tablebackcolor&" align=center>"&_
			"<tr><td height=1> </td></tr></table>"
	 	i=i+1
	 	if k>=Maxtitlelist then exit for
		next
		arrRow=null
	end sub

	sub listpage()
  	dim n
  	if (totalrec mod Maxtitlelist)=0 then
     		n= totalrec \ Maxtitlelist
  	else
     		n= (totalrec \ Maxtitlelist)+1
  	end if
	response.write "<table border=0 cellpadding=0 cellspacing=3 width=""95%"" align=center>"&_
			"<tr><td valign=middle nowrap>"&_
			"<span class=smallFont>页次：<strong>"&star&"</strong>/<strong>"&n&"</strong>页"&_
			"每页<strong>"&Maxtitlelist&"</strong> 本主题贴数<strong>"&totalrec&"</strong></td>"&_
			"<td valign=middle nowrap><div align=right><p>分页： "
	   for p=1 to n
	       if p=int(star) then
	          response.write "<font color=red><b>>"+Cstr(p)+"<</b></font> "
		   else
		      response.write "<a href='dispbbs.asp?boardid="&boardid&"&rootid="&rootid&"&id="&announceid_1&"&star="+Cstr(p)+"'>[<b>"+Cstr(p)+"</b>]</a>   "
		   end if
	next
	response.write "</p></div></td></tr></table>"
	response.write "<table cellpadding=0 cellspacing=0 border=0 width=""95%"" align=center>"&_
			"<tr bgcolor="&Tabletitlecolor&"><td align=left width=90% valign=middle> <font color="&TableFontcolor&">&nbsp;<b>*快速回复</b>："&htmlencode(topic_1)&"</font></td>"&_
			"<td width=10% align=right valign=middle height=24> <a href=#top><img src=pic/gotop.gif border=0>顶端</a>&nbsp;</td></tr></table>"
%>
<!--#include file="inc/code.asp"-->
<%
	response.write "<TABLE cellSpacing=1 cellPadding=1 width=""95%"" border=0 align=center>"&_
			"<TBODY> <TR bgColor="&tablebackcolor&"><TD vAlign=top colSpan=3> "&_
			"<TABLE cellSpacing=0 cellPadding=3 width=""100%"" bgColor="&tabletitlecolor&" border=0>"&_
			"<form action=SaveReAnnounce.asp?method=fastreply&boardID="&boardid&" method=POST  name=frmAnnounce onSubmit=submitonce(this)>"&_
			"<input type=hidden name=followup value="&AnnounceID_1&">"&_
			"<input type=hidden name=rootID value="&RootID&">"&_
			"<input type=hidden name=topic value='Re:"&topic_1&"'>"&_
			"<INPUT TYPE=hidden name=boardtype value="&htmlencode(boardtype)&">"&_
			"<TBODY><TR bgColor="&tablebody&"><TD noWrap width=100>你的用户名:</TD>"&_
            "<TD><INPUT maxLength=25 size=15 value="""&membername&""" name=username>"&_
            "&nbsp;&nbsp; <A href=reg.asp>还没注册?</A> 密码:"&_ 
            "<INPUT type=password maxLength=13 size=15 value="""&memberword&""" name=passwd>"&_
            "&nbsp;&nbsp; <A href=lostpass.asp>忘记密码?</A> </TD></TR>"&_
			"<TR bgColor="&atablebody&"> <TD vAlign=top noWrap><b>内容</b><br>"&_
             "<INPUT type=checkbox value=yes name=emailflag>"&_
            "邮件回复<br> <INPUT type=checkbox CHECKED value=yes name=signflag>"&_
            "显示签名 "&_
                       	 "</TD><TD> "&_
	"<TEXTAREA name="&session("antry")&" cols=75 rows=6 wrap=VIRTUAL title=可以使用Ctrl+Enter直接提交贴子></TEXTAREA>"&_
            "</TD></TR><TR bgColor="&tablebody&"><TD noWrap colspan=2 align=center>"&_ 
	"<input type=Submit value=OK!发表我的回应帖子 name=Submit>"&_	
            "&nbsp;<input type=reset name=Clear value=清空内容！>"&_
            "[<font color="&alertfont&">Ctrl+Enter直接提交贴子</font>] </TD>"&_
			"</TR></FORM></TBODY></TABLE></TD></TR> </TBODY> </TABLE>"
	if err.number<>0 then err.clear
	end sub

   	sub chkInput
		'on error resume next
	if request("boardid")="" then
		founderr=true
		Errmsg=Errmsg+"<br>"+"<li>请指定论坛版面。"
	elseif not isInteger(request("boardid")) then
		founderr=true
		Errmsg=Errmsg+"<br>"+"<li>非法的版面参数。"
	else
		boardid=request("boardid")
	end if
	if request("id")="" then
		founderr=true
		Errmsg=Errmsg+"<br>"+"<li>请指定相关贴子。"
	elseif not isInteger(request("id")) then
		founderr=true
		Errmsg=Errmsg+"<br>"+"<li>非法的贴子参数。"
	else
		AnnounceID_1=request("id")
	end if
	if request("RootID")="" then
		founderr=true
		Errmsg=Errmsg+"<br>"+"<li>请指定相关贴子。"
	elseif not isInteger(request("RootID")) then
		founderr=true
		Errmsg=Errmsg+"<br>"+"<li>非法的贴子参数。"
	else
		RootID=request("RootID")
	end if
	if request("star")="" then
		star=1
	elseif not isInteger(request("star")) then
		star=1
	else
		star=request("star")
	end if
    	end sub

	function isbgcolor(num)
	n=num mod 2
	if n=1 then
		isbgcolor=true
	else
		isbgcolor=false
	end if
	end function

	set rs=nothing
	Call endConnection()
	response.write "<p> "
	if memberclass=grade19 or memberclass=grade20 then
		response.write "<TABLE cellSpacing=0 cellPadding=0 width=""95%"" border=0 align=center>"&_
				"<tr valign=center> <td width =100% align=right> "&_
				"<a href=admin_postings.asp?action=lock&boardID="&boardID&"&ID="&announceID_1&"&rootid="&rootID&" title=锁定本主题>锁定</a> "&_
				"  | <a href=admin_postings.asp?action=unlock&boardID="&boardID&"&ID="&announceID_1&"&rootid="&rootID&" title=将本主题解开锁定>解锁</a>"&_
				"  | <a href=admin_postings.asp?action=delete&boardID="&boardID&"&ID="&announceID_1&"&rootid="&rootID&"&username="&server.urlencode(username)&" title=注意：本操作将删除本主题所有贴子，不能恢复>删除</a>"&_ 
				"  | <a href=admin_postings.asp?action=move&boardID="&boardID&"&ID="&announceID_1&"&rootid="&rootID&" title=移动主题>移动</a>  |  "
	if istop=0 then
		response.write "<a href=admin_postings.asp?action=istop&boardID="&boardID&"&ID="&announceID_1&"&rootid="&rootID&" title=将本主题固顶>固顶</a>"
	else
		response.write "<a href=admin_postings.asp?action=notop&boardID="&boardID&"&ID="&announceID_1&"&rootid="&rootID&" title=将本主题固顶状态解除>解固</a>"
	end if
	response.write "  | <a href=""admin_news.asp?boardid="&boardid&""">发布公告</a>  | <a href=""admin_alldel.asp?boardid="&boardid&""">批量删除</a>"
	response.write "</td></tr></table>"
	end if 

sub readRe()
	dim rs1,ID
	set rs1=conn.execute("select reAnn from [user] where username='"&membername&"' and reAnn is not null")
	if not (rs1.eof and rs1.bof) then
		ID=split(rs1("reAnn"),"|")(1)
		if ID=rootID then
			conn.execute ("update [user] set reAnn=null where username='"&membername&"'")
		end if
	end if
	rs1.close
	set rs1=nothing
end sub

sub subOnline
	sql="select username from online"
	set rs=server.createobject("adodb.recordset")
	rs.open sql,conn,1,1
	onlineUserList=rs.getstring(2,,,chr(13))
	onlineUserList=chr(13)&onlineUserList
	rs.close
	set rs=nothing
end sub

function isOnline(username)
	if instr(onlineUserList,chr(13)&username&chr(13))>0 then
		isonline="<img src=pic/online1.gif alt=在线，有人找我吗？>"
	else
		isonline="<img src=pic/offline1.gif alt=掉线，给我留言吧！>"
	end if
end function

Function GetURL(url) 
on error resume next
Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
With Retrieval 
.Open "GET", url, False, "", "" 
.Send 
GetURL = .ResponseText 
End With 
Set Retrieval = Nothing 
End Function 
Function GetIp(IP)
ips=Split(ip,".")
GetIp=ips(0)&"."&ips(1)&".*.*"
end Function
%>
<!--#include file=footer.asp -->
</BODY>
</HTML>