📄 thread.asp
字号:
End if
Next
Else
If IsSqlDataBase = 1 Then
TagWhere = " Topic like '%"&HtmlEncode(UClass(21,0))&"%' "
Else
TagWhere = " InStr(1,LCase(Topic),LCase('"&HtmlEncode(UClass(21,0))&"'),0)<>0 "
End if
End If
Set Gs = team.execute("Select Top 5 ID,Topic,UserName,Views,Replies,Lasttime From ["&Isforum&"Forum] Where deltopic=0 and "&TagWhere&" and Not (ID="&tID&") order By Lasttime Desc")
If Gs.Eof And Gs.Bof Then
Exit Function
Else
Tagtmp = "<table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""6"" align=""center"" Class=""a2""><tr class=""tab1""><td> 相关主题 </td><td> 作者 </td><td> 回复/查看 </td><td> 最后更新 </td></tr>"
Do While not Gs.Eof
Tagtmp = Tagtmp & "<tr class=""altbg2"" onMouseOver=""this.className='altbg1'"" onMouseOut=""this.className='altbg2'""><td><a href=""thread.asp?tid="&Gs(0)&""" target=""_blank"">"&Gs(1)&"</a></td><td align=""center""> "&Gs(2)&" </td><td align=""center""> "&Gs(3)&" / "&Gs(4)&"</td> <td align=""center""> "&Gs(5)&" </td></tr> "
Gs.MoveNext
Loop
Tagtmp = Tagtmp & " </table> "
End If
Gs.Close:Set Gs=Nothing
AboutTipoc = Tagtmp
End Function
Private Function TestUserRead()
TestUserRead = True
If Int(UClass(18,0))>0 Then TestUserRead = False
If team.ManageUser Then TestUserRead = True
If team.UserLoginED Then
If Trim(TK_UserName)=Trim(UClass(2,0)) Then TestUserRead = True
If Cid(Team.Group_Browse(1)) > Cid(UClass(18,0)) Then TestUserRead = True
End if
End Function
Private Sub ActionLive()
Dim Vs,Rs
Set Vs = team.execute("Select PlayName,PlayClass,PlayCity,PlayFrom,Playto,Playplace,PlayCost,PlayGender,PlayNum,PlayStop,PlayUserNum From ["&IsForum&"Activity] Where RootID="& tID )
If Vs.Eof And Vs.Bof Then
Exit Sub
Else
tmp = Replace(tmp,"{$postactionsinfo}",Team.PostHtml (10))
tmp = Replace(tmp,"{$paytopic}",Vs(0))
tmp = Replace(tmp,"{$playclass}",Vs(1))
tmp = Replace(tmp,"{$playtime}",iif(Vs(4)<>"",VS(3) &" 至 " & Vs(4) & " 商定",Vs(3)))
tmp = Replace(tmp,"{$playcity}",Vs(2)&" " & Vs(5))
tmp = Replace(tmp,"{$playmoney}",Vs(6)&"")
tmp = Replace(tmp,"{$playsex}",iif(Vs(7)=0,"不限",iif(Vs(7)=1,"男性","女性")))
tmp = Replace(tmp,"{$playnum}",Vs(8))
tmp = Replace(tmp,"{$playaction}",Vs(10))
tmp = Replace(tmp,"{$playclosetime}",Vs(9))
End If
If Vs(10) > 0 Then
Set Rs = team.execute("Select PlayUser,PlayClass,Playtext From ["&IsForum&"ActivityUser] Where RootID="& tID &" and PlayUser='"&tk_UserName&"'")
If Rs.Eof Then
tmp = Replace(tmp,"{$msgs}","")
tmp = Replace(tmp,"{$myinfos}","")
tmp = Replace(tmp,"{$disabled}","")
Else
tmp = Replace(tmp,"{$msgs}","Display:None")
tmp = Replace(tmp,"{$myinfos}",IIF(Rs(1) = 0,"<tr><td class=""altbg1"" Colspan=""2"">您的加入申请已发出，请等待发起者的审批</td></tr>","<tr><td class=""altbg1"" Colspan=""2"">"& RS(2) &" </td></tr>"))
tmp = Replace(tmp,"{$disabled}","disabled")
End If
Else
tmp = Replace(tmp,"{$msgs}","")
tmp = Replace(tmp,"{$myinfos}","")
tmp = Replace(tmp,"{$disabled}","")
End if
Vs.Close:Set Vs=Nothing
End Sub
Private Sub PollAction
Dim Vs,Checktmp,Vote,Numvote,i,umvote,vmp,ump,vip
Set Vs = team.execute("Select PollClose,Pollday,PollMax,Polltime,Pollmult,Polltopic,PollResult,PollUser From ["&IsForum&"Fvote] Where RootID="& tID)
If Not Vs.Eof Then
tmp = Replace(tmp,"{$postactionsinfo}",Team.PostHtml (11))
Vote=Split(Vs(5),"|")
Numvote=Split(Vs(6),"|")
vmp = ""
umvote = 0
for i = 0 to ubound(Numvote)
umvote = umvote + Numvote(i)
next
for i = 0 to ubound(vote)
If umvote = 0 Then umvote = 1
Checktmp = IIf(Vs(4)=1,"<input type=""checkbox"" name=""pollanswers"&i&""" value=""1"" onclick='checkbox(this)' class=""radio"">","<input type=""radio"" name=""pollanswers"" value="""&i&""" onclick='checkbox(this)' class=""radio"">")
If Vs(7)<>"" Then
If Instr(Vs(7),"$#$")>0 Then
If Instr(Vs(7),TK_UserName&"$#$")>0 Then Checktmp = ""
Else
If "|"&Trim(Vs(7))&"$$" = "|"&Trim(TK_UserName)&"$$" Then Checktmp = ""
End if
End if
vmp = vmp & "<tr><td class=""altbg1"" width=""22%"">"&Checktmp&" "&vote(i)&"</td><td class=""altbg2""><div class=""percent""><div style=""width:"&(Numvote(i)/umvote)*500&" ""></div></div><div class=""percenttxt""> "&Formatnumber((Numvote(i)/umvote)*100)&"<u>(%)</u></div></td></tr>"
next
tmp = Replace(tmp,"{$votetitle}",UClass(1,0))
tmp = Replace(tmp,"{$alllpost}",iif(Vs(4)=1,"(多选，最多"&Vs(2)&"项)","(单选)"))
If Request("showvoters")="yes" Then
ump = "<tr><td class=""altbg1"" colspan=""2""><B>参与投票的会员:</B><BR><BR>"
If Vs(7)<>"" Then
If Instr(VS(7),"$#$")>0 Then
vip = Split(VS(7),"$#$")
for i = 0 to ubound(vip)
ump = ump & " <img src="""&team.styleurl&"/gm5.gif"" border=""0"" align=""absmiddle""> <a href=""Profile.asp?username="&vip(i)&""" target=""_blank""> "& vip(i) &" </a> "
next
Else
ump = ump & " <img src="""&team.styleurl&"/gm5.gif"" border=""0"" align=""absmiddle""> <a href=""Profile.asp?username="&VS(7)&""" target=""_blank""> "& VS(7) &" </a> "
End if
End if
ump = ump & "</td></tr>"
End if
tmp = Replace(tmp,"{$voteshow}",vmp)
tmp = Replace(tmp,"{$ponum}",iif(Vs(4)=1,Cid(Vs(2)),0))
tmp = Replace(tmp,"{$yesorno}",iif(Request("showvoters")="yes","no","yes"))
tmp = Replace(tmp,"{$polluser}",iif(Request("showvoters")="yes",ump,""))
tmp = Replace(tmp,"{$display}",iif(Instr(Vs(7),"|"&TK_UserName&"|")>0 or Cid(Vs(0))=1 or DateDiff("d",CDate(Vs(3)),Date())>Cid(Vs(1)),"disabled=disabled",""))
End if
Vs.Close:Set Vs=Nothing
End Sub
Private Function ReMyTopic
Dim Maxpage,Maxi,ReGetNoName
Dim Trs,SQL,Rs2,UNext,i
Maxpage = Int(team.Forum_setting(20))
ReGetNoName = 0
If Page<2 Then
Maxi=1
Else
Maxi=Page*Maxpage+1-Maxpage
End If
SQL=" Select T.ID,T.topicid,T.Username,T.Content,T.Posttime,T.Lock,T.Reward,T.ReTopic,U.Levelname,U.Posttopic,U.Postrevert,U.Goodtopic,U.Regtime,U.Landtime,U.Birthday,U.UserSex,U.Sign,U.UserInfo,U.Honor,U.Userface,U.ID,U.Degree,U.Postblog,U.UserCity,U.UserUp,U.Extcredits0,U.Extcredits1,U.Extcredits2,U.Extcredits3,U.Extcredits4,U.Extcredits5,U.Extcredits6,U.Extcredits7,U.Members,U.Medals From ["&Isforum & UClass(19,0)&"] T Inner Join ["&IsForum&"User] U On U.UserName=T.UserName Where T.topicid="& tID &" Order By T.ID ASC "
Set Rs2 = Server.CreateObject ("Adodb.RecordSet")
If Not IsObject(Conn) Then ConnectionDatabase
Rs2.Open SQL,Conn,1,1,&H0001
PageNum = Abs(int(-Abs(UClass(5,0)/Maxpage))) '页数
Page = CheckNum(Page,1,1,1,PageNum) '当前页
If Rs2.Eof and Rs2.Bof Then
Set Rs2 = Nothing
Set Rs2 = Server.CreateObject ("Adodb.RecordSet")
SQL = "Select ID,topicid,Username,Content,Posttime,Lock,Reward,ReTopic From ["& Isforum & UClass(19,0) &"] Where topicid="&tID&" Order By Reward Asc,ID ASC"
Rs2.Open Sql,Conn,1,1,&H0001
If Rs2.Eof and Rs2.Bof Then
team.Error "参数错误"
End If
ReGetNoName = 1
End If
Rs2.AbsolutePosition=(Page-1)*Maxpage+1
Trs = Rs2.GetRows(Maxpage)
SqlQueryNum = SqlQueryNum+1
Rs2.Close:Set Rs2=Nothing
If Not IsArray(Trs) Then
Exit Function
End If
'T.ID=0,T.topicid=1,T.Username=2,T.Content=3,T.Posttime=4,T.Lock=5,T.Reward=6,T.ReTopic=7,U.Levelname=8,U.Posttopic=9,U.Postrevert=10,U.Goodtopic=11,U.Regtime=12,U.Landtime=13,U.Birthday=14,U.UserSe=15,U.Sign=16,U.UserInfo=17,U.Honor=18,U.Userface=19,U.ID=20,U.Degree=21,U.Postblog=22,U.UserCity=23,U.UserUp=24,U.Extcredits0=25,U.Extcredits1=26,U.Extcredits2=27,U.Extcredits3=28,U.Extcredits4=29,U.Extcredits5=30,U.Extcredits6=31,U.Extcredits7=32,U.Members=33,U.Medals=34
Dim tmp1
tmp1 = ""
For i=0 To Ubound(Trs,2)
Maxi = Maxi+1
tmp1 = tmp1 & Team.PostHtml (5)
tmp1 = Replace(tmp1,"{$rid}",Trs(0,i))
tmp1 = Replace(tmp1,"{$reid}",Trs(0,i))
tmp1 = Replace(tmp1,"{$nameid}",Trs(0,i))
tmp1 = Replace(tmp1,"{$reward}",IIF(Cid(UClass(20,0))=1 and Cid(Trs(6,i))=1,"<Img Src="""&team.StyleUrl&"/flag.Gif"" Border=""0"" Align=""AbsMiddle""> <b>最佳答案</b>",""))
tmp1 = Replace(tmp1,"{$maxi}","#"&Maxi)
tmp1 = Replace(tmp1,"{$mod}",iif(Maxi Mod 2=1,"a4","a3"))
tmp1 = Replace(tmp1,"{$smallimg}","")
tmp1 = Replace(tmp1,"{$topic}",iif(Trs(7,i)<>"",Trs(7,i),"回复："& UClass(1,0)))
Dim MyLocks
If CID(Trs(5,i)) = 1 Then
If team.ManageUser Then
Mylocks = UBB_Code(UserBad(Trs(3,i),Trs(2,i))) & "<br /><font color=""red"">==此帖已被锁定==</font>"
Else
Mylocks = "<br /><font color=""red"">==此帖已被锁定==</font>"
End If
Else
Mylocks = UBB_Code(UserBad(Trs(3,i),Trs(2,i)))
End if
tmp1 = Replace(tmp1,"{$content}",Mylocks)
tmp1 = Replace(tmp1,"{$username}",Trs(2,i))
tmp1 = Replace(tmp1,"{$lasttime}",Trs(4,i))
tmp1 = Replace(tmp1,"{$isrept}",Trs(0,i))
tmp1 = Replace(tmp1,"{$ismanage}",IIf(team.ManageUser,"<input type=""checkbox"" name=""ismanage"" value="&Trs(0,i)&" class=""radio"">",""))
tmp1 = Replace(tmp1,"{$fortopuser}",team.AdvShows(4))
If ReGetNoName = 1 Then
tmp1 = Replace(tmp1,"{$birthday}","")
tmp1 = Replace(tmp1,"{$usex}","")
tmp1 = Replace(tmp1,"{$sign}","")
tmp1 = Replace(tmp1,"{$userqq}","")
tmp1 = Replace(tmp1,"{$honor}","")
tmp1 = Replace(tmp1,"{$userimg}","")
tmp1 = Replace(tmp1,"{$uid}","0")
tmp1 = Replace(tmp1,"{$levelname}","游客")
tmp1 = Replace(tmp1,"{$regtime}","未注册")
tmp1 = Replace(tmp1,"{$postcount}","0")
tmp1 = Replace(tmp1,"{$online}","<img src="&team.Styleurl&"/offline.gif border='0' align='absmiddle' alt='此用户未登陆!'>")
tmp1 = Replace(tmp1,"{$masterimg}","")
tmp1 = Replace(tmp1,"{$userext}","")
tmp1 = Replace(tmp1,"{$mycity}","")
tmp1 = Replace(tmp1,"{$userMedals}","")
tmp1 = Replace(tmp1,"{$reaction}","")
Else
If GetNoName=0 Then
tmp1 = Replace(tmp1,"{$reaction}",IIf(CID(UClass(20,0))=0 And CID(UClass(49,0))=1,IIf(Trim(UClass(2,0))<>Trim(Trs(2,i)) and Trim(UClass(2,0))=Trim(TK_UserName),"<a href=""Command.asp?action=bestanswer&tid="&tID&"&rid="&Trs(0,i)&""" onclick=""checkclick('您确认要把该回复选为“最佳答案”吗？')"" title=""将该回复选为“最佳答案”""><img src="""&team.StyleUrl&"/right.gif"" border=""0"" />最佳答案</a>",""),""))
Else
tmp1 = Replace(tmp1,"{$reaction}","")
End If
tmp1=Replace(tmp1,"{$birthday}",Astro(Trs(14,i)))
tmp1=Replace(tmp1,"{$usex}",GetUseSex(Trs(15,i)))
tmp1=Replace(tmp1,"{$sign}",iif(Trs(16,i)&""="","","<img src="""&team.Styleurl&"/line.gif"" border=""0""><br><div style=""overflow: hidden; max-height: 6em; maxHeight: 77px;"">"& Sign_Code(Trs(16,i),CID(Split(Trs(8,i),"||")(4))) &"</div>"))
tmp1 = Replace(tmp1,"{$userqq}",iif(Split(Trs(17,i),"|")(0)&""="","","<a target=blank href=http://wpa.qq.com/msgrd?V=1&Uin="&Split(Trs(17,i),"|")(0)&"&Site=team5.cn&Menu=yes><img border=""0"" SRC=http://wpa.qq.com/pa?p=1:"&Split(Trs(17,i),"|")(0)&":5 alt=""点击这里给我发消息"" onerror=""javascript:this.src='images/qqerr.gif'""></a>"))
tmp1=Replace(tmp1,"{$honor}",IIf(Trs(18,i)<>"",Trs(18,i)&"<br>",""))
tmp1=Replace(tmp1,"{$userimg}",iif(Trs(19,i)&""="","","<img src="""&Trs(19,i)&""" border=""0"" onload='javascript:if(this.width>100)this.width=100;if(this.height>100)this.height=100;'onerror='javascript:this.src=""images/face/error.gif""'><br>"))
tmp1 = Replace(tmp1,"{$uid}",Trs(20,i))
tmp1 = Replace(tmp1,"{$levelname}",Split(Trs(8,i),"||")(0))
tmp1 = Replace(tmp1,"{$stylename}",Split(Trs(8,i),"||")(1))
tmp1 = Replace(tmp1,"{$regtime}",FormatDateTime(Trs(12,i),1))
tmp1 = Replace(tmp1,"{$postcount}",Trs(9,i)+Cid(Trs(10,i)))
tmp1 = Replace(tmp1,"{$online}",Iif(InStr(UserOnlineinfos,"$$"&Trs(2,i)&"$$")>0, "<img src="&team.Styleurl&"/online.gif border='0' align='absmiddle' alt='此用户在线!
共计在线时长"&Trs(21,i)&"分钟'>","<img src="&team.Styleurl&"/offline.gif border='0' align='absmiddle' alt='此用户离线!
共计在线时长"&Trs(21,i)&"分钟'>"))
tmp1 = Replace(tmp1,"{$masterimg}",UserStar(Split(Trs(8,i),"||")(3))&"<br>" & IIF(Split(Trs(8,i),"||")(2)&""="","","<img src="""&Split(Trs(8,i),"||")(2)&""" border=""0"">") &"<BR>")
Dim Emp,U,UserMedals
emp = ""
If CID(Trs(11,i))>0 Then
emp = emp & "精华 " & Trs(11,i) & " <br />"
End if
for u = 0 to ubound(ExtCredits)
If Split(ExtCredits(u),",")(4) =1 Then
emp = emp & ""& Split(ExtCredits(u),",")(0) & " "& Trs(25+u,i) &" "& Split(ExtCredits(u),",")(1) &" <br />"
End if
Next
tmp1 = Replace(tmp1,"{$userext}",emp)
tmp1 = Replace(tmp1,"{$mycity}",iif(Trs(23,i)<>""," 来自 "&Trs(23,i)&" <br>",""))
If Trs(34,i)<>"" Then
UserMedals = "" :Emp=""
If Instr(Trs(34,i),"$$$")>0 Then
UserMedals = Split(Trs(34,i),"$$$")
For u = 0 to Ubound(UserMedals)-1
Emp = Emp & "<img src=""images/plus/medal"&Split(UserMedals(u),"&&&")(0)&".gif"" align=""absmiddle"" alt="""&Split(UserMedals(u),"&&&")(1)&"""> "
Next
tmp1 = Replace(tmp1,"{$userMedals}",Emp)
End if
Else
tmp1 = Replace(tmp1,"{$userMedals}","")
End if
End If
Next
ReMyTopic = tmp1
End Function
Private Sub Class_Terminate()
Err.Clear
If IsObject(Conn) Then Conn.Close:Set Conn=Nothing
If IsObject(Cache) Then Cache.Close:Set Cache=Nothing
If IsObject(MyThread) Then team.Close:Set MyThread=Nothing
Response.End
End Sub
End Class
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -