<% dim rs,sql dim boardid,boardtype dim star,totalrec,p dim tableback,tabletitle,tablebody,atablebody dim tablefont,tablecontent,alertfont dim strAllowForumCode,strAllowHTML,strIMGInPosts dim strIcons,strflash dim bgcolor,abgcolor,namestyle dim guestlist,onlineUserList dim arrrow,view dim Announceid,topic,dateandtime,body,Expression,ip,rootid,signflag,isbest dim isvote,username,useremail,homepage,oicq,sign,userclass,title,width dim uheight,article,face,addtime,userWealth,userEP,userCP if boardmaster or master then guestlist="" else guestlist=" lockboard<>2 and " end if stats="浏览帖子" if foundErr then call nav() call headline(2) call error() else call chkInput() if founderr then call nav() call headline(2) call error() else call boardtop() if founderr then call nav() call headline(2) call error() else call nav() call headline(2) call subOnline() call announceinfo() call listpage() if founderr then call error() end if end if end if call endline() sub boardtop() sql="select boardtype,boardskin,Tableback,Tabletitle,Tablebody,aTablebody,TableFont,TableContent,AlertFont,strAllowForumCode,strAllowHTML,strIMGInPosts,strIcons,strflash,Forumlogo from board where "&guestlist&" boardID="&cstr(boardid) set rs=server.createobject("adodb.recordset") rs.open sql,conn,1,1 if not(rs.bof and rs.eof) then arrRow=rs.getrows rs.close : set rs=nothing boardtype=arrRow(0,0) boardskin=arrRow(1,0) Tablebackcolor=arrRow(2,0) Tabletitlecolor=arrRow(3,0) Tablebody=arrRow(4,0) aTablebody=arrRow(5,0) TableFontcolor=arrRow(6,0) TableContent=arrRow(7,0) AlertFont=arrRow(8,0) strAllowForumCode=arrRow(9,0) strAllowHTML=arrRow(10,0) strIMGInPosts=arrRow(11,0) strIcons=arrRow(12,0) strflash=arrRow(13,0) Forumlogo=arrRow(14,0) else founderr=true Errmsg=Errmsg+"
"+"

您选择的版面不存在或者您没有权限察看该版面。" end if conn.execute("update bbs1 set hits=hits+1 where announceID="&announceid&"") sql="Select B.AnnounceID,B.boardID,B.UserName,B.Topic,B.dateandtime,B.body,B.Expression,B.ip,B.rootid,B.signflag,B.isbest,B.isvote,U.username,U.useremail,U.homepage,U.oicq,U.sign,U.userclass,U.title,U.width,U.height,U.article,U.face,U.addDate,U.userWealth,U.userEP,U.userCP,B.hits from bbs1 B inner join [user] U on U.username=B.username where B.boardid="&boardid&" and B.announceid="&announceid set rs=server.createobject("adodb.recordset") rs.open sql,conn,1,1 if not(rs.bof and rs.eof) then arrRow=rs.getrows rs.close : set rs=nothing Announceid=arrRow(0,0) boardid=arrRow(1,0) username=arrRow(2,0) topic=arrRow(3,0) dateandtime=arrRow(4,0) body=arrRow(5,0) Expression=arrRow(6,0) ip=arrRow(7,0) rootid=arrRow(8,0) signflag=arrRow(9,0) isbest=arrRow(10,0) isvote=arrRow(11,0) username=arrRow(12,0) useremail=arrRow(13,0) homepage=arrRow(14,0) oicq=arrRow(15,0) sign=arrRow(16,0) userclass=arrRow(17,0) title=arrRow(18,0) width=arrRow(19,0) uheight=arrRow(20,0) article=arrRow(21,0) face=arrRow(22,0) addtime=arrRow(23,0) userWealth=arrRow(24,0) userEP=arrRow(25,0) userCP=arrRow(26,0) view=arrRow(27,0) stats=""&boardtype&"浏览："&topic&"" if isnumeric(userclass) then if userclass=18 then namestyle="filter:glow(color=green,strength=2)" elseif userclass=19 then namestyle="filter:glow(color=#660099,strength=2)" elseif userclass=20 then namestyle="filter:glow(color=#FF3333,strength=2)" else namestyle="filter:glow(color=#798AB7,strength=2)" end if end if if isbgcolor(i)=false then bgcolor=tablebody abgcolor=atablebody else bgcolor=atablebody abgcolor=tablebody end if else foundErr = true ErrMsg=ErrMsg+"
"+"

您指定的贴子不存在

" end if end sub sub announceinfo() response.write ""&_ ""&_ ""&_ "

"&_ "

"&_ "

"&_ "

您是本帖的第 "&view&" 个阅读者

" response.write ""&_ "

" response.write " "&_ ""&_ ""&_ "

"&_ ""&_ ""&_ "

"&_ " * 贴子主题： "&htmlencode(topic)&"

"&_ "

"&_ " "&_ " 把本贴打包邮递

"&_ " "&_ " 把本贴加入论坛收藏夹

"&_ " "&_ " 发送本页面给朋友

"&_ "

"&_ ""&_ "

" call showannounce() end sub sub showannounce() 'response.write height response.write ""&_ ""&_ ""&_ "

"&_ ""&_ ""&_ ""&_ "

"&_ " "&isOnline(username)&" "&htmlencode(username)&"

" if TitleFlag and title<>"" then response.write "　头衔："&htmlencode(title)&"
" response.write "

" if isnumeric(userclass) then select case userclass case 1 response.write "

" case 2 response.write "

" case 3 response.write "

" case 4 response.write "

" case 5 response.write "

" case 6 response.write "

" case 7 response.write "

" case 8 response.write "

" case 9 response.write "

" case 10 response.write "

" case 11 response.write "

" case 12 response.write "

" case 13 response.write "

" case 14 response.write "

" case 15 response.write "

" case 16 response.write "

" case 17 response.write "

" case 18 response.write "

" case 19 response.write "

" case 20 response.write "

" end select response.write "
  等级："& grade(userclass) &"
" end if if FromFlag=0 then if boardmaster or master then comefrom=address(ip) else comefrom="保密" end if else comefrom=address(ip) end if response.write "　财产："&userWealth&"
"&_ "　经验："&userEP&"
"&_ "　魅力："&userCP&"
" response.write "  注册："& year(addtime) &"-"& month(addtime) &"-"& day(addtime) response.write "
  文章："&article&"
  鉴定："&comefrom&"
"&_ "

"&_ ""&_ "

"&_ " "&_ " 给"&HTMLEncode(username)&"发送一个短消息

"&_ ""&_ "

"&_ "

搜索"&HTMLEncode(username)&"在"&boardtype&"的所有贴子

" if useremail<>"" then response.write "

" 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 "

OICQ " end if if homepage<>"" then response.write "

" end if response.write ""&_ " 引用回复这个贴子

"&_ "

"&_ ""&_ "

" if instr(Expression,"face")>0 then response.write " 发贴心情

" end if response.write "

"&_ "" response.write ""& htmlencode(topic) &"
"& ubbcode(body) if not isnull(isvote) and cint(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 "" response.write "" response.write "" for m = 0 to ubound(vote) if cint(vrs("votetype"))=0 then vote_1=""&vote_1&""&m+1&". "&vote(m)&"
" else vote_1=""&vote_1&""&m+1&". "&vote(m)&"
" end if next response.write "" vote_1="" for m = 0 to ubound(votenum) votenum_1=""&votenum_1&"票数："&votenum(m)&"
" next response.write "" votenum_1="" if membername="" then response.write "" else if instr(vrs("voteuser"),membername)>0 then response.write "" else response.write "" end if end if response.write "" response.write "

以下为投票内容：
"&vote_1&"	"&votenum_1&"
您还没有登陆，不能进行投票。
您已经投过票了，请看结果吧。

" set vrs=nothing end if if signflag=1 then if sign<>"" then response.write "

------------------------
"& ubbcode(sign) end if end if response.write "

"&_ "

"&_ ""&_ "

" if membername<>"" then if username=membername or boardmaster or master then response.write "

" end if end if response.write "

发贴时间： "&dateandtime&"

" if IpFlag=0 then if boardmaster or master then response.write arrRow(7,i) else response.write getip(arrRow(7,i)) end if else response.write arrRow(7,i) end if response.write "

" if boardmaster or master then if announceid<>rootid then response.write "

" end if response.write "

" if isbest=0 then response.write "

" else response.write "

" end if end if response.write "

"&_ "

" response.write ""&_ "

" arrRow=null end sub sub listpage() response.write ""&_ ""&_ "

*快速回复："&htmlencode(topic)&"

顶端

" response.write ""&_ "

"&_ ""&_ ""&_ ""&_ ""&_ ""&_ ""&_ ""&_ ""&_ "

你的用户名:	"&_ " 还没注册? 密码:"&_ ""&_ " 忘记密码?
内容 "&_ " HTML标签： " if strAllowHTML=0 then response.write "不可用 " else response.write "允许 " end if response.write " UBB标签： " if strAllowForumCode=0 then response.write "不可用 " else response.write "允许" end if response.write " 贴图标签： " if strIcons=0 then response.write "不可用" else response.write "允许" end if response.write " Flash标签：" if strflash=0 then response.write "不可用" else response.write "允许" end if response.write " 表情字符转换：" if strIMGInPosts=0 then response.write "不可用" else response.write "允许" end if response.write " 上传图片：" if Uploadpic=0 then response.write "不可用" else response.write "允许" end if response.write " 最多"&AnnounceMaxBytes\1024&"KB	"&_ ""&_ "
"&_ ""&_ "邮件回复 "&_ "显示签名	"&_ ""&_ " "&_ "[Ctrl+Enter直接提交贴子]

" if err.number<>0 then err.clear end sub sub chkInput 'on error resume next if request("boardid")="" then founderr=true Errmsg=Errmsg+"
"+"

请指定论坛版面。" elseif not isInteger(request("boardid")) then founderr=true Errmsg=Errmsg+"
"+"

非法的版面参数。" else boardid=request("boardid") end if if request("id")="" then founderr=true Errmsg=Errmsg+"
"+"

请指定相关贴子。" elseif not isInteger(request("id")) then founderr=true Errmsg=Errmsg+"
"+"

非法的贴子参数。" else AnnounceID=request("id") end if if request("RootID")="" then founderr=true Errmsg=Errmsg+"
"+"

请指定相关贴子。" elseif not isInteger(request("RootID")) then founderr=true Errmsg=Errmsg+"
"+"

非法的贴子参数。" 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 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=" 在线，有人找我吗？

" else isonline=" 掉线，给我留言吧！

" 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 %>