topic.asp

这个论坛也不错．适合做毕业设计的

<!--#INCLUDE FILE="config.asp" -->
<script language="JavaScript">
function openWindow(url) {
  popupWin = window.open(url, 'new_page', 'width=420,height=360')
}
</script>
<%
Function CreateTitle(postnum)
ON ERROR RESUME NEXT
strtitle=""
dim Title(15)
dim Num(15)
Title(0)="战士"
Title(1)="侠客"
Title(2)="骑士"
Title(3)="爱心骑士"
Title(4)="将军"
Title(5)="法师"
Title(6)="大法师"
Title(7)="小精灵"
Title(8)="爱心精灵"
Title(9)="精灵王"
Title(10)="小天使"
Title(11)="爱心天使"
Title(12)="大天使"
Title(13)="守护神"
Title(14)="守护天王"
Title(15)="究极天王"
Num(0)=5
Num(1)=50
Num(2)=100
Num(3)=150
Num(4)=250
Num(5)=350
Num(6)=500
Num(7)=650
Num(8)=850
Num(9)=1100
Num(10)=1400
Num(11)=1700
Num(12)=2100
Num(13)=2500
Num(14)=3000
Num(15)=3600
if postnum<Num(0) then
  strtitle="论坛新成员"
else
  for i=0 to 15
    if postnum>=Num(i) then strtitle= Title(i)
  next
  if strtitle="" then strtitle="论坛元老"
end if
CreateTitle= strtitle
End Function

Function Ubb2Html(str, showemot, showimg)
ON ERROR RESUME NEXT
if not str<>"" then exit function
  tmpstr="u雪b人b"
  str=UbbStr(str,"url")
  str=UbbStr(str,"quote")
  str=UbbStr(str,"color")
  str=UbbStr(str,"size")
  if showemot then
    for i=1 to 16
      str=replace(str,":em"&i&":","<img src='emot/em"&i&".gif'>",1,6,1)
      str=replace(str,":em"&i&":","",1,-1,1)
    next
  end if
  if showimg then
    str=UbbStr(str,"img")
    str=UbbStr(str,"swf")
  end if
  str=replace(str,"[b]","<b>",1,-1,1)
  str=replace(str,"[/b]","</b>",1,-1,1)
  str=replace(str,"[i]","<i>",1,-1,1)
  str=replace(str,"[/i]","</i>",1,-1,1)
  str=replace(str,"[br]","<br>",1,-1,1)
  str=replace(str,"["&tmpstr,"[",1,-1,1)
  str=replace(str,tmpstr&"]","]",1,-1,1)
  str=replace(str,"/"&tmpstr,"/",1,-1,1)
  Ubb2Html=str
End Function

function ubbstr(ubb_str,UbbKeyWord)
ON ERROR RESUME NEXT
tmpstr="u雪b人b"
beginstr=1
endstr=1
do while UbbKeyWord="url" or UbbKeyWord="color" or UbbKeyWord="size"
  beginstr=instr(beginstr,ubb_str,"["&UbbKeyWord&"=",1)
  if beginstr=0 then exit do
  endstr=instr(beginstr,ubb_str,"]",1)
  if endstr=0 then exit do
  LUbbKeyWord=UbbKeyWord
  beginstr=beginstr+len(lUbbKeyWord)+2
  text=mid(ubb_str,beginstr,endstr-beginstr)
  codetext=replace(text,"[","["&tmpstr,1,-1,1)
  codetext=replace(codetext,"]",tmpstr&"]",1,-1,1)
  codetext=replace(codetext,"/","/"&tmpstr,1,-1,1)
  select case UbbKeyWord
    case "color"
	ubb_str=replace(ubb_str,"[color="&text&"]","<font color='"&text&"'>",1,1,1)
	ubb_str=replace(ubb_str,"[/color]","</font>",1,1,1)
    case "size"
	if IsNumeric(text) then
	if text>6 then text=6
	if text<1 then text=1
	ubb_str=replace(ubb_str,"[size="&text&"]","<font size='"&text&"'>",1,1,1)
	ubb_str=replace(ubb_str,"[/size]","</font>",1,1,1)
	end if
    case "url"
	ubb_str=replace(ubb_str,"[url="&text&"]","<a href='"&codetext&"' target=_blank>",1,1,1)
	ubb_str=replace(ubb_str,"[/url]","</a>",1,1,1)
  end select
loop

beginstr=1
do
  beginstr=instr(beginstr,ubb_str,"["&UbbKeyWord&"]",1)
  if beginstr=0 then exit do
  endstr=instr(beginstr,ubb_str,"[/"&UbbKeyWord&"]",1)
  if endstr=0 then exit do
  LUbbKeyWord=UbbKeyWord
  beginstr=beginstr+len(lUbbKeyWord)+2
  text=mid(ubb_str,beginstr,endstr-beginstr)
  codetext=replace(text,"[","["&tmpstr,1,-1,1)
  codetext=replace(codetext,"]",tmpstr&"]",1,-1,1)
  codetext=replace(codetext,"/","/"&tmpstr,1,-1,1)
  select case UbbKeyWord
    case "url"
	ubb_str=replace(ubb_str,"["&UbbKeyWord&"]"&text,"<a href='"&codetext&"' target=_blank>"&codetext,1,1,1)
	ubb_str=replace(ubb_str,"<a href='"&codetext&"' target=_blank>"&codetext&"[/"&UbbKeyWord&"]","<a href="&codetext&" target=_blank>"&codetext&"</a>",1,1,1)
    case "img"
	ubb_str=replace(ubb_str,"[img]"&text,"<table width='100%' align=center border='0' cellspacing='0' cellpadding='0' style='TABLE-LAYOUT: fixed'><tr><td><a href='"&codetext&"' target=_blank><img src="&codetext,1,1,1)
	ubb_str=replace(ubb_str,"[/img]"," border=0 alt='点击打开新窗口'></a></td></tr></table>",1,1,1)
    case "quote"
	atext=replace(text,"[img]","",1,-1,1)
	atext=replace(atext,"[/img]","",1,-1,1)
	atext=replace(atext,"[swf]","",1,-1,1)
	atext=replace(atext,"[/swf]","",1,-1,1)
	atext=replace(atext,"&lt;br&gt;","<br>",1,-1,1)
	ubb_str=replace(ubb_str,"[quote]"&text,"<blockquote>引用<hr height=1 noshade class='sft'>"&atext,1,1,1)
	ubb_str=replace(ubb_str,"[/quote]","<hr height=1 noshade class='sft'></blockquote><br>",1,1,1)
    case "swf"
	ubb_str=replace(ubb_str,"[swf]"&text,"Flash动画:<br>"&text&"<br><object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' width='420' height='360'><param name=movie value='"&codetext&"'><param name=quality value=high><embed src='"&codetext&"' quality=high type='application/x-shockwave-flash' width='420' height='360'></embed></object>",1,1,1)
	ubb_str=replace(ubb_str,"[/swf]","</embed></object>",1,1,1)
  end select
loop
ubbstr=ubb_str
end function


set my_conn= Server.CreateObject("ADODB.Connection")
my_Conn.Open ConnString

if Request.form("voteid")<> "" then
  voteid= Request.form("voteid")
else
  voteid= Request.QueryString("voteid")
end if
if Request.form("topic_id")<> "" then
  topic_id= Request.form("topic_id")
else
  topic_id= Request.QueryString("topic_id")
end if
if Request.form("topic_title")<> "" then
  topic_title= Request.form("topic_title")
else
  topic_title= Request.QueryString("topic_title")
end if
if Request.form("forum_id")<> "" then
  forum_id= Request.form("forum_id")
else
  forum_id= Request.QueryString("forum_id")
end if
if Request.form("forum_title")<> "" then
  forum_title= Request.form("forum_title")
else
  forum_title= Request.QueryString("forum_title")
end if
if IsNumeric(voteid) and Request.Cookies("User")("Name")<>"" and Request.QueryString("vote")="yes" then
  strsql = "select T_VoteNumber, T_VoteUser from topics where Topic_id = " & cint(topic_id)
  set rs = my_conn. Execute (strsql)
  user_array = split(rs("T_VoteUser"), "|")
  num_array = split(rs("T_VoteNumber"), "|")
  i=0
  struser= ""
  vote=true
  do until i>ubound(user_array)
    if user_array(i)<> "" then struser = struser + user_array(i) + "|"
    if user_array(i) = Request.Cookies("User")("Name") then vote=false
    i=i+1
  loop
  if vote then
    i=0
    strnum=""
    do until i>ubound(num_array)
      if num_array(i)<>"" and i = cint(voteid) then num_array(i) = cstr(cint(num_array(i))+1)
      strnum = strnum + num_array(i) + "|"
      i=i+1
    loop
    'struser= left(struser, len(struser)-1
    struser=struser & Request.Cookies("User")("Name")
    strnum= left(strnum, len(strnum)-1)
    strsql= "update topics set T_VoteUser = '" & struser & "', T_VoteNumber = '" & strnum & "' where topic_id = " & topic_id
    my_conn.Execute (strsql)
  end if
end if

page=Request.QueryString("page")
  if not IsNumeric(page) then page=1
  if page>1 then
  page = cint(page)
else
  page = 1
end if

Function FormatStr(String)
  on Error resume next
  String = Replace(String, CHR(13), "")
  String = Replace(String, CHR(10) & CHR(10), "</P><P>")
  String = Replace(String, CHR(10), "<BR>")
  FormatStr = String
End Function

Sub GetFirst
strSql = "SELECT Members.M_Name, Members.M_Country, Members.M_Face, Members.M_Email, Members.M_Homepage, Members.M_Title, Members.M_Posts, Members.M_OtherFace, Members.M_OtherFace_Width, Members.M_OtherFace_Height, Members.M_ICQ, Members.M_Msn, Members.Member_id"
strSql = strSql & ", Topics.T_date, Topics.T_subject, Topics.T_Sig, Topics.T_Message, Topics.T_VoteItem, Topics.T_VoteNumber, Topics.T_VoteUser, Topics.T_VoteTime, Topics.T_Originator, Topics.Topic_ID "
strSql = strSql & "FROM Members INNER JOIN Topics ON Members.Member_id = Topics.T_Originator "
strSql = strSql & "where topics.topic_id = " &  topic_id

set rs = my_conn.Execute (strSql)

If rs.Eof or rs.Bof then
	Response.Write "<tr><td colspan=5>无任何话题</td></tr>"
Else
		  Response.Write "<tr>"
	      Response.Write "<td bgcolor='" & CellColor1 & "' valign=top><table border=0 width=100% cellspacing=0 cellpadding=3 class=sft style='filter:glow(color=" & HeadColor & ",strength=1)'><tr><td>" & rs("M_name") & "</td></tr></table>"&"头衔:"
		
	      if rs("M_Title")="/" then
	        Response.Write CreateTitle(rs("M_Posts"))
	      else
	        Response.Write rs("M_Title")
	      end if
	      Response.Write "<br>来自:"&rs("M_Country")&"<br>发帖:"&rs("M_Posts")&"<br><img src='"
	      if RTrim(rs("M_OtherFace"))<>"" then
Response.Write rs("M_OtherFace") & "' width='" & rs("M_OtherFace_Width") &"' height='" & rs("M_OtherFace_Height")
else
Response.Write rs("M_Face")
end if
Response.Write "'></img></td>"
Response.Write "<td bgcolor='" & CellColor1 & "' valign='top'>发表于: " &  rs("T_Date") & ""
Response.Write "&nbsp;&nbsp;<a href=""Javascript:openWindow('viewuser.asp?name=" & rs("m_name") & "')""><img src='images/profile.gif' alt='查看作者档案' border=0>资料</a>"
 Response.Write "&nbsp;&nbsp;<a href='mailto:" & rs("M_Email") & "'><img src='images/email.gif' alt='给作者发送电子邮件' border=0>邮件</a>"
Response.Write "&nbsp;&nbsp;<a href=""Javascript:openWindow('" & rs("m_homepage") & "')""><img src='images/homepage.gif' alt='访问作者主页' border=0>主页</a>"
%>&nbsp;&nbsp;<a href="Javascript:openWindow('viewip.asp?topic_id=<%=topic_id%>')"><img src="images/ip.gif" alt='查看IP地址' border=0>ＩＰ</a><%
if rs("M_ICQ") <> "0" then
 %>&nbsp;&nbsp;<a href="Javascript:openWindow('http://search.tencent.com/cgi-bin/friend/user_show_info?ln=<%=rs("M_ICQ")%>')"><img src="images/qq.gif" alt="QQ号码:<%=rs("M_ICQ")%>" border=0>ＱＱ</a><%
end if
if rs("M_MSN") <> "0" then
%>&nbsp;&nbsp;<img src="images/msn.gif" border=0 alt="MSN号码:<%=rs("M_Msn")%>">ＭＳＮ</a><%
end if
Response.Write "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a href='post.asp?method=editTopic&reply_id=" & Rs("Topic_ID") & "&auth=" & rs("T_Originator") & "&forum_title=" & server.URLEncode(forum_title) & "&topic_title=" & server.Urlencode(topic_title) & "&forum_id=" & forum_id & "&topic_id=" & topic_id &"'><img src='images/edit.gif' alt='编辑修改' border=0>编辑</a>"
%>