PageRenderTime 28ms CodeModel.GetById 0ms RepoModel.GetById 1ms app.codeStats 0ms

/Wap/Space/Group.asp

https://github.com/joechen2010/health
ASP | 553 lines | 509 code | 23 blank | 21 comment | 0 complexity | c8e294fa35452f49b3c618d7433b3c88 MD5 | raw file
    

  1. <%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>

    2. 

  2. <%Response.ContentType = "text/vnd.wap.wml; charset=utf-8"%><?xml version="1.0" encoding="utf-8"?>

    3. 

  3. <!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.1//EN" "http://www.wapforum.org/DTD/wml_1.1.xml">

    4. 

  4. <!--#include file="../Conn.asp"-->

    5. 

  5. <!--#include file="../KS_Cls/Kesion.CommonCls.asp"-->

    6. 

  6. <!--#include file="../KS_Cls/Kesion.Label.CommonCls.asp"-->

    7. 

  7. <!--#include file="../KS_Cls/Kesion.SpaceCls.asp"-->

    8. 

  8. <%

    9. 

  9. Dim KSCls

    10. 

  10. Set KSCls = New Group

    11. 

  11. KSCls.Kesion()

    12. 

  12. Set KSCls = Nothing

    13. 

  13. 

    14. 

  14. Class Group

    15. 

  15.         Private KS,KSBCls,KSRFObj

    16. 

  16. 		Private TotalPut,RS,MaxPerPage

    17. 

  17. 		Private CurrentPage

    18. 

  18. 		Private ID,Template,TeamName,GroupAdmin

    19. 

  19. 		Private Sub Class_Initialize()

    20. 

  20. 			Set KS=New PublicCls

    21. 

  21. 			Set KSBCls=New BlogCls

    22. 

  22. 			Set KSRFObj=New Refresh

    23. 

  23. 		End Sub

    24. 

  24.         Private Sub Class_Terminate()

    25. 

  25. 		    Set KS=Nothing

    26. 

  26. 		    Set KSBCls=Nothing

    27. 

  27. 			Set KSRFObj=Nothing

    28. 

  28. 		End Sub

    29. 

  29. 		Public Sub Kesion()

    30. 

  30. 		    If KS.SSetting(0)=0 Then

    31. 

  31. 			   Call KS.ShowError("对不起！","对不起，本站点关闭空间站点功能！")

    32. 

  32. 			End If

    33. 

  33. 			ID=KS.ChkClng(KS.S("ID"))

    34. 

  34. 			If ID=0 Then Response.End()

    35. 

  35. 			Set RS=Server.CreateObject("ADODB.RECORDSET")

    36. 

  36. 			RS.Open "Select * From KS_Team Where ID=" & ID,Conn,1,1

    37. 

  37. 			If RS.Eof And RS.Bof Then

    38. 

  38. 			   Call KS.ShowError("对不起！","参数传递出错！")

    39. 

  39. 			End If

    40. 

  40. 			If RS("Verific")=0 Then

    41. 

  41. 			   Call KS.ShowError("对不起！","该圈子尚未审核!")

    42. 

  42. 			ElseIf RS("Verific")=2 Then

    43. 

  43. 			   Call KS.ShowError("对不起！","该圈子已被管理员锁定!")

    44. 

  44. 			End If

    45. 

  45. 			TeamName=RS("TeamName")

    46. 

  46. 			GroupAdmin=RS("UserName")

    47. 

  47. 			Template="<wml>" &vbcrlf

    48. 

  48. 			Template=Template & "<head>" &vbcrlf

    49. 

  49. 			Template=Template & "<meta http-equiv=""Cache-Control"" content=""no-Cache""/>" &vbcrlf

    50. 

  50. 			Template=Template & "<meta http-equiv=""Cache-Control"" content=""max-age=0""/>" &vbcrlf

    51. 

  51. 			Template=Template & "</head>" &vbcrlf

    52. 

  52. 			Template=Template & "<card id=""main"" title=""" & TeamName & """>" &vbcrlf

    53. 

  53. 			

    54. 

  54. 			Template=Template & KSRFObj.LoadTemplate(KS.WSetting(26))

    55. 

  55. 			Template=KSBCls.ReplaceGroupLabel(RS,Template)

    56. 

  56. 			Select Case KS.S("Action")

    57. 

  57. 			    Case "showtopic"'显示帖子列表

    58. 

  58. 				   Template=Replace(Template,"{$GroupMain}",ShowTopic)

    59. 

  59. 				Case "replay"'回复

    60. 

  60. 				   Template=Replace(Template,"{$GroupMain}",Replay)

    61. 

  61. 				Case "replaysave"'保存回复

    62. 

  62. 				   Call ReplaySave()

    63. 

  63. 				Case "users"'成员列表

    64. 

  64. 				   Template=Replace(Template,"{$GroupMain}",ShowUser)

    65. 

  65. 				Case "join"'申请加入圈子

    66. 

  66. 		  		   Template=Replace(Template,"{$GroupMain}",ShowJoin)

    67. 

  67. 				Case "joinsave"'保存申请加入圈子

    68. 

  68. 				   Template=Replace(Template,"{$GroupMain}",JoinSave)

    69. 

  69. 				Case "alldeltopic"'删除

    70. 

  70. 				   Template=Replace(Template,"{$GroupMain}",AllDelTopic)

    71. 

  71. 				Case "deltopic"'删除

    72. 

  72. 				   Template=Replace(Template,"{$GroupMain}",DelTopic)

    73. 

  73. 				Case "settop"'置顶设置

    74. 

  74. 				   Call SetTop()

    75. 

  75. 				Case "setbest"'精华设置

    76. 

  76. 				   Call SetBest()

    77. 

  77. 				Case "post"'发表新贴

    78. 

  78. 				   Template=Replace(Template,"{$GroupMain}",ShowPost)

    79. 

  79. 				Case "connectpost"

    80. 

  80. 				   Template=Replace(Template,"{$GroupMain}",ConnectPost)

    81. 

  81. 				Case "connectpostsave"

    82. 

  82. 				   Template=Replace(Template,"{$GroupMain}",ConnectPostSave)   

    83. 

  83. 				Case "topicsave"'保存发表

    84. 

  84. 				   Template=Replace(Template,"{$GroupMain}",TopicSave)

    85. 

  85. 				Case "info"'圈子信息

    86. 

  86. 				   Template=Replace(Template,"{$GroupMain}",ShowInfo)

    87. 

  87. 				Case Else'圈子主题列表

    88. 

  88. 				   Template=Replace(Template,"{$GroupMain}",TeamTopic)

    89. 

  89. 			End Select

    90. 

  90. 			Template=Template & "</card>" &vbcrlf

    91. 

  91. 			Template=Template & "</wml>" &vbcrlf

    92. 

  92. 			Response.Write Template

    93. 

  93. 			RS.Close:Set  RS=Nothing

    94. 

  94. 		End Sub

    95. 

  95. 		

    96. 

  96. 		Function Replay()

    97. 

  97. 		    Dim Tid:Tid=KS.Chkclng(KS.S("Tid"))

    98. 

  98. 			Replay = "【回复话题】<br/>"

    99. 

  99. 			IF Cbool(KSUser.UserLoginChecked)=false Then

    100. 

  100. 			   Replay = Replay &"登录后才可以参与该话题的讨论,如要参与讨论请先<a href=""../User/Login/?../Space/Group.asp?Action=replay&amp;ID=" & ID & "&amp;Tid=" & Tid & """>登录</a>到会员中心！"

    101. 

  101. 			Else

    102. 

  102. 			   On Error Resume Next

    103. 

  103. 			   'Replay = Replay &"Re:" & Conn.Execute("select Title from KS_TeamTopic where ID="& Tid )(0) & "<br/>"

    104. 

  104. 			   Replay = Replay &"回复内容:<input name=""Content" & Minute(Now) & Second(Now) & """ type=""text"" maxlength=""300"" emptyok=""false"" value=""""/>"

    105. 

  105. 			   Replay = Replay &"<anchor>回复<go href=""Group.asp?action=replaysave&amp;ID=" & ID & "&amp;Tid=" & Tid & "&amp;" & KS.WapValue & """ method=""post"">"

    106. 

  106. 			   Replay = Replay &"<postfield name=""Title"" value=""Re:" & Conn.Execute("select Title from KS_TeamTopic where ID="& Tid )(0) & """/>"

    107. 

  107. 			   Replay = Replay &"<postfield name=""Content"" value=""$(Content" & Minute(Now) & Second(Now) & ")""/>"

    108. 

  108. 			   Replay = Replay &"</go></anchor><br/>"

    109. 

  109. 			End If

    110. 

  110. 		End Function

    111. 

  111. 		

    112. 

  112. 

    113. 

  113. 		'保存回复

    114. 

  114. 		Function ReplaySave()

    115. 

  115. 		    Dim Tid:Tid=KS.chkclng(KS.S("Tid"))

    116. 

  116. 			Dim Title:Title=KS.S("Title")

    117. 

  117. 			Dim Content:Content=KS.S("Content")

    118. 

  118. 			If Content="" Then

    119. 

  119. 			   ReplaySave="请输入回复内容!"

    120. 

  120. 			   Exit Function

    121. 

  121. 			End If

    122. 

  122. 			If Cbool(KSUser.UserLoginChecked)=false Then

    123. 

  123. 			   ReplaySave="请先登录!"

    124. 

  124. 			   Exit Function

    125. 

  125. 			End If

    126. 

  126. 			Dim UserName:UserName=KS.R(KSUser.UserName)

    127. 

  127. 			Dim RS:set RS=server.createobject("adodb.recordset")

    128. 

  128. 			RS.Open "select * from KS_TeamTopic",Conn,1,3

    129. 

  129. 			RS.Addnew

    130. 

  130. 			RS("ParentID")=Tid

    131. 

  131. 			RS("TeamID")=ID

    132. 

  132. 			RS("Title")=Title

    133. 

  133. 			RS("Content")=Content

    134. 

  134. 			RS("Adddate")=Now

    135. 

  135. 			RS("UserIP")=KS.GetIP

    136. 

  136. 			RS("Status")=1

    137. 

  137. 			RS("UserName")=UserName

    138. 

  138. 			RS("IsBest")=0

    139. 

  139. 			RS("IsTop")=0

    140. 

  140. 			RS.Update

    141. 

  141. 			RS.Close:set RS=Nothing

    142. 

  142. 			Response.Redirect KS.GetDomain&"Space/Group.asp?Action=showtopic&ID="& ID & "&Tid=" & Tid & "&" & KS.WapValue & ""

    143. 

  143. 		End Function

    144. 

  144. 		

    145. 

  145. 		Function ShowJoin()

    146. 

  146. 		    IF Cbool(KSUser.UserLoginChecked)=false Then

    147. 

  147. 			   ShowJoin = "对不起，申请加入圈子之前必须先<a href=""../User/Login/?../Space/Group.asp?Action=showpost&amp;ID=" & ID & """>登录</a>到会员中心！<br/>"

    148. 

  148. 			   Exit Function

    149. 

  149. 			End If

    150. 

  150. 			If Not Conn.Execute("select UserName from KS_TeamUsers where UserName='" & KSUser.UserName & "' And TeamID=" & ID).EOF Then

    151. 

  151. 			   ShowJoin = "您不能再申请，产生的可能原因如下：<br/>"

    152. 

  152. 			   ShowJoin = ShowJoin & "您已申请过，未得到圈主的审核;<br/>"

    153. 

  153. 			   ShowJoin = ShowJoin & "您已是本圈子的成员，不需要再申请;<br/>"

    154. 

  154. 			   ShowJoin = ShowJoin & "您可能已被圈主邀请，但您还未在会员中心确认;<br/>"

    155. 

  155. 			   ShowJoin = ShowJoin & "【申请须知】<br/>"

    156. 

  156. 			   ShowJoin = ShowJoin & RS("Note")

    157. 

  157. 			   ShowJoin = ShowJoin & "<br/>"

    158. 

  158. 			   Exit Function

    159. 

  159. 			End If

    160. 

  160. 			ShowJoin = ShowJoin & "【申请加入】<br/>"

    161. 

  161. 			ShowJoin = ShowJoin & "申 请 人:" & KSUser.UserName & "<br/>"

    162. 

  162. 			ShowJoin = ShowJoin & "加入理由:<input name=""Reason" & Minute(Now) & Second(Now) & """ type=""text"" maxlength=""30"" value="""" emptyok=""false""/>"

    163. 

  163. 			ShowJoin = ShowJoin & "<anchor>提交申请<go href=""Group.asp?ID=" & ID & "&amp;Action=joinsave&amp;" & KS.WapValue & """ method=""post"">"

    164. 

  164. 			ShowJoin = ShowJoin & "<postfield name=""UserName"" value=""" & KSUser.UserName & """/>"

    165. 

  165. 			ShowJoin = ShowJoin & "<postfield name=""Reason"" value=""$(Reason" & Minute(Now) & Second(Now) & ")""/>"

    166. 

  166. 			ShowJoin = ShowJoin & "</go></anchor><br/><br/>"

    167. 

  167. 			ShowJoin = ShowJoin & "【申请须知】<br/>"

    168. 

  168. 			ShowJoin = ShowJoin & RS("Note")

    169. 

  169. 			ShowJoin = ShowJoin & "<br/>"

    170. 

  170. 		End Function

    171. 

  171. 		

    172. 

  172. 		'保存申请

    173. 

  173. 		Function JoinSave()

    174. 

  174. 		    Dim id:id=KS.chkclng(KS.S("id"))

    175. 

  175. 			Dim UserName:UserName=KS.R(KS.S("UserName"))

    176. 

  176. 			Dim Reason:Reason=KS.R(KS.S("Reason"))

    177. 

  177. 			If Reason="" Then

    178. 

  178. 			   JoinSave = "请输入加入圈子的理由!<br/><anchor><prev/>返回重写</anchor><br/>"

    179. 

  179. 			   Exit Function

    180. 

  180. 			End If

    181. 

  181. 			Dim RS:set RS=server.createobject("adodb.recordset")

    182. 

  182. 			RS.Open "select * from KS_TeamUsers where TeamID=" & id & " And UserName='" & UserName & "'",Conn,1,3

    183. 

  183. 			If RS.EOF Then

    184. 

  184. 			   RS.Addnew

    185. 

  185. 			   RS("TeamID")=ID

    186. 

  186. 			   RS("UserName")=UserName

    187. 

  187. 			   RS("Status")=2  '申请加入

    188. 

  188. 			   RS("Power")=0   '普通用户

    189. 

  189. 			   RS("Reason")=Reason

    190. 

  190. 			   RS("Applydate")=Now

    191. 

  191. 			   RS.Update

    192. 

  192. 			End If

    193. 

  193. 			RS.Close:set RS=Nothing

    194. 

  194. 			JoinSave = "你的申请已提交，请等待圈主的审核!<br/>"

    195. 

  195. 		End Function

    196. 

  196. 		

    197. 

  197. 		'续写

    198. 

  198. 		Function ConnectPost()

    199. 

  199. 		    Dim Tid:Tid=KS.Chkclng(KS.S("Tid"))

    200. 

  200. 			Set RST=Conn.Execute("select Content from ks_teamtopic where UserName='"&KSUser.UserName&"' and id="&tid&"")

    201. 

  201. 			If RST.EOF Then

    202. 

  202. 			   ConnectPost = "非法参数!<br/>"

    203. 

  203. 			Else

    204. 

  204. 			   ConnectPost = "非法参数!<br/>"

    205. 

  205. 			   ConnectPost = ConnectPost & "【贴子续写】<br/>"

    206. 

  206. 			   ConnectPost = ConnectPost & "尾部内容:" & Right(KS.LoseHtml(RST("Content")),20) & "<br/>"

    207. 

  207. 			   ConnectPost = ConnectPost & "追加内容:<input name=""Content" & Minute(Now) & Second(Now) & """ type=""text"" maxlength=""500"" value=""""/>"

    208. 

  208. 			   ConnectPost = ConnectPost & "<anchor>确定<go href=""Group.asp?Action=connectpostsave&amp;ID=" & ID & "&amp;Tid=" & Tid & "&amp;" & KS.WapValue & """ method=""post""><postfield name=""Content"" value=""$(Content" & Minute(Now) & Second(Now) & ")""/></go></anchor><br/>"

    209. 

  209. 			End If

    210. 

  210. 			RST.Close:Set RST=Nothing

    211. 

  211. 		End Function

    212. 

  212. 		

    213. 

  213. 		'续写保存

    214. 

  214. 		Function ConnectPostSave()

    215. 

  215. 		    Dim Tid:Tid=KS.Chkclng(KS.S("Tid"))

    216. 

  216. 			Set RST=Conn.Execute("select * from KS_TeamTopic where UserName='"&KSUser.UserName&"' And ID="&Tid&"")

    217. 

  217. 			If RST.EOF Then

    218. 

  218. 			   ConnectPostSave = "非法参数!<br/>"

    219. 

  219. 			Else

    220. 

  220. 			   Dim Content:Content=KS.S("Content")

    221. 

  221. 			   If Content="" Then

    222. 

  222. 			      ConnectPostSave = "出错提示，你没有输入续写内容！<br/><anchor><prev/>返回重写</anchor><br/>"

    223. 

  223. 			   Else

    224. 

  224. 			   Set RSObj=Server.CreateObject("Adodb.Recordset")

    225. 

  225. 			   RSObj.Open "select * from KS_TeamTopic where UserName='"&KSUser.UserName&"' And ID="&Tid&"",Conn,1,3

    226. 

  226. 			   RSObj("Content")=RST("Content") & Content

    227. 

  227. 			   RSObj.Update:RSObj.Close:Set RSObj=Nothing

    228. 

  228. 			   ConnectPostSave = "续写成功。<br/><a href=""Group.asp?Action=showtopic&amp;ID="&ID&"&amp;Tid="&Tid&"&amp;" & KS.WapValue & """>贴子查看</a><br/>"

    229. 

  229. 			   End IF

    230. 

  230. 			End If

    231. 

  231. 			RST.Close:Set RST=Nothing

    232. 

  232. 		End Function

    233. 

  233. 		

    234. 

  234. 		

    235. 

  235. 		'发表新贴

    236. 

  236. 		Function ShowPost()

    237. 

  237. 		    IF Cbool(KSUser.UserLoginChecked)=false Then

    238. 

  238. 			   ShowPost = "对不起，发表新贴之前必须先<a href=""../User/Login/?../Space/Group.asp?action=showpost&amp;ID="&ID&""">登录</a>到会员中心！<br/>"

    239. 

  239. 			   Exit Function

    240. 

  240. 			End If

    241. 

  241. 			If Conn.Execute("select UserName from KS_TeamUsers where UserName='"& KSUser.UserName & "' And TeamID=" & ID).EOF Then

    242. 

  242. 			   ShowPost = "对不起，你不是该圈子的成员，没有权利发表话题！<br/>"

    243. 

  243. 			   Exit Function

    244. 

  244. 			ElseIf Conn.Execute("select UserName from KS_TeamUsers where UserName='"& KSUser.UserName & "' And Status<>2 And TeamID=" & ID).EOF Then

    245. 

  245. 			   ShowPost = "对不起，你提交的申请还未得到确认，没有权利发表话题！<br/>"

    246. 

  246. 			   Exit Function

    247. 

  247. 			End If

    248. 

  248. 			ShowPost =""

    249. 

  249. 			ShowPost = ShowPost & "话题:<input name=""Topic" & Minute(Now) & Second(Now) & """ type=""text"" maxlength=""50"" emptyok=""false"" value=""""/><br/>"

    250. 

  250. 			ShowPost = ShowPost & "内容:<input name=""Content" & Minute(Now) & Second(Now) & """ type=""text"" emptyok=""false"" value=""""/><br/>"

    251. 

  251. 			ShowPost = ShowPost & "<anchor>OK,发表<go href=""Group.asp?Action=topicsave&amp;ID=" & ID & "&amp;" & KS.WapValue & """ method=""post"">"

    252. 

  252. 			ShowPost = ShowPost & "<postfield name=""UserName"" value=""" & KSUser.UserName &"""/>"

    253. 

  253. 			ShowPost = ShowPost & "<postfield name=""Topic"" value=""$(Topic" & Minute(Now) & Second(Now) & ")""/>"

    254. 

  254. 			ShowPost = ShowPost & "<postfield name=""Content"" value=""$(Content" & Minute(Now) & Second(Now) & ")""/>"

    255. 

  255. 			ShowPost = ShowPost & "</go></anchor><br/>"

    256. 

  256. 			ShowPost = ShowPost & "仅该圈子成员可以发起主题，非成员仅可以回复<br/>"

    257. 

  257. 		End Function

    258. 

  258. 		

    259. 

  259. 		'保存发表

    260. 

  260. 		Function TopicSave()

    261. 

  261. 		    Dim ID:ID=KS.Chkclng(KS.S("ID"))

    262. 

  262. 			Dim Topic:Topic=KS.R(KS.S("Topic"))

    263. 

  263. 			Dim Content:Content=KS.S("Content")

    264. 

  264. 			IF Topic="" Then

    265. 

  265. 			   TopicSave = "请输入讨论话题!<br/><anchor><prev/>返回重写</anchor><br/>"

    266. 

  266. 			End If

    267. 

  267. 			IF Content="" Then

    268. 

  268. 			   TopicSave = "请输入讨论内容!<br/><anchor><prev/>返回重写</anchor><br/>"

    269. 

  269. 			End If

    270. 

  270. 			Dim RS:set RS=Server.Createobject("adodb.recordset")

    271. 

  271. 			RS.Open "select * from KS_TeamTopic",Conn,1,3

    272. 

  272. 			RS.Addnew

    273. 

  273. 			RS("Title")=Topic

    274. 

  274. 			RS("Content")=Content

    275. 

  275. 			RS("TeamID")=ID

    276. 

  276. 			RS("ParentID")=0

    277. 

  277. 			RS("UserName")=KS.S("UserName")

    278. 

  278. 			RS("Adddate")=now

    279. 

  279. 			RS("UserIP")=KS.GetIP

    280. 

  280. 			RS("Status")=1

    281. 

  281. 			RS("IsBest")=0

    282. 

  282. 			RS("IsTop")=0

    283. 

  283. 			RS.Update

    284. 

  284. 			RS.Close:set RS=Nothing

    285. 

  285. 			TopicSave = "您的讨论话题发表成功！<br/>"

    286. 

  286. 		End Function

    287. 

  287. 		

    288. 

  288. 		'圈子信息

    289. 

  289. 		Function ShowInfo()

    290. 

  290. 		    ShowInfo = "【圈子信息】<br/>"

    291. 

  291. 			ShowInfo = ShowInfo &"<img src=""" & RS("PhotoUrl") & """ alt=""""/><br/>"

    292. 

  292. 			'ShowInfo = ShowInfo &"圈子名称:" & RS("TeamName") & "<br/>"

    293. 

  293. 			ShowInfo = ShowInfo &"创 建 者:" & RS("UserName") & "<br/>"

    294. 

  294. 			ShowInfo = ShowInfo &"创建时间:" & RS("Adddate") & "<br/>"

    295. 

  295. 			ShowInfo = ShowInfo &"成员人数:" & Conn.Execute("select Count(UserName)  from KS_TeamUsers where status=3 And TeamID=" & RS("ID"))(0) & "<br/>"

    296. 

  296. 			ShowInfo = ShowInfo &"主题回复:" & Conn.Execute("select Count(*) from KS_TeamTopic where ParentID=0 and TeamID=" & ID )(0) & "/" & Conn.Execute("select count(*) from KS_TeamTopic where ParentID<>0 and TeamID=" & ID )(0) & "<br/>"

    297. 

  297. 			ShowInfo = ShowInfo &"【管 理 员】<br/>"

    298. 

  298. 			Dim RSU:set RSU=Server.Createobject("adodb.recordset")

    299. 

  299. 			RSU.Open "select * from KS_User where UserName='" & RS("UserName") &"'",Conn,1,1

    300. 

  300. 			If Not RSU.EOF Then

    301. 

  301. 			   'Dim UserFaceSrc:UserFaceSrc=RSU("UserFace")

    302. 

  302. 			   'Dim FaceWidth:FaceWidth=KS.ChkClng(RSU("FaceWidth"))

    303. 

  303. 			   'Dim FaceHeight:FaceHeight=KS.ChkClng(RSU("FaceHeight"))

    304. 

  304. 			   'If Ucase(Left(UserFaceSrc,4))<>"http" Then UserFaceSrc="../" & UserFaceSrc

    305. 

  305. 			   'ShowInfo = ShowInfo &"<img src=""" & UserFaceSrc & """ width=""" & FaceWidth & """ height=""" & FaceHeight & """ alt=""""/><br/>"

    306. 

  306. 			   ShowInfo = ShowInfo &"<a href=""index.asp?u=" & RSU("UserName") & "&amp;" & KS.WapValue & """>" & RS("UserName") & "(" & RSU("Province") & RSU("City") & ")</a><br/>"

    307. 

  307. 			End If

    308. 

  308. 			RSU.Close:set RSU=Nothing

    309. 

  309. 		End Function

    310. 

  310.         

    311. 

  311. 		Function AllDelTopic()

    312. 

  312. 		    IF Cbool(KSUser.UserLoginChecked)=false Then

    313. 

  313. 			   AllDelTopic = "对不起，请先登录！<br/>"

    314. 

  314. 			   Exit Function

    315. 

  315. 			End If

    316. 

  316. 			Dim Tid:Tid=KS.Chkclng(KS.S("Tid"))

    317. 

  317. 			If Tid=0 Then Response.End

    318. 

  318. 			Dim RST:set RST=server.createobject("adodb.recordset")

    319. 

  319. 			RST.Open "select * from KS_TeamTopic where ID=" & Tid,Conn,1,3

    320. 

  320. 			If Not RST.EOF Then

    321. 

  321. 			   If RST("UserName")=KSUser.UserName or KSUser.UserName=GroupAdmin Then

    322. 

  322. 			      Conn.Execute("delete from KS_TeamTopic where ParentID=" & Tid & "")

    323. 

  323. 				  RST.Delete

    324. 

  324. 		       Else

    325. 

  325. 		          RST.Close:Set RST=Nothing

    326. 

  326. 				  AllDelTopic = "对不起，你没有删除的权限<br/>"

    327. 

  327. 		       End If

    328. 

  328. 			End If

    329. 

  329. 		    RST.Close:Set RST=Nothing

    330. 

  330. 			Response.Redirect KS.GetDomain&"Space/Group.asp?ID="& ID & "&" & KS.WapValue & ""

    331. 

  331. 		End Function

    332. 

  332. 

    333. 

  333. 		Function DelTopic()

    334. 

  334. 		    IF Cbool(KSUser.UserLoginChecked)=false Then

    335. 

  335. 			   DelTopic = "对不起，请先登录！<br/>"

    336. 

  336. 			   Exit Function

    337. 

  337. 			End If

    338. 

  338. 			Dim Pid:Pid=KS.Chkclng(KS.S("Pid"))

    339. 

  339. 			If Pid=0 Then Response.End

    340. 

  340. 			Dim RST:set RST=server.createobject("adodb.recordset")

    341. 

  341. 			RST.Open "select * from KS_TeamTopic where ID=" & Pid,Conn,1,3

    342. 

  342. 			If Not RST.EOF Then

    343. 

  343. 			   If RST("UserName")=KSUser.UserName or KSUser.UserName=GroupAdmin Then

    344. 

  344. 			      RST.Delete

    345. 

  345. 		       Else

    346. 

  346. 		          RST.Close:Set RST=Nothing

    347. 

  347. 				  DelTopic = "对不起，你没有删除的权限<br/>"

    348. 

  348. 		       End If

    349. 

  349. 			End If

    350. 

  350. 		    RST.Close:Set RST=Nothing

    351. 

  351. 			Response.Redirect KS.GetDomain&"Space/Group.asp?Action=showtopic&ID="& ID & "&Tid=" & KS.Chkclng(KS.S("Tid")) & "&" & KS.WapValue & ""

    352. 

  352. 		End Function

    353. 

  353. 

    354. 

  354. 		'置顶设置

    355. 

  355. 		Sub SetTop()

    356. 

  356. 		    Dim Tid:Tid=KS.Chkclng(KS.S("Tid"))

    357. 

  357. 		    Dim RS:set RS=Server.Createobject("adodb.recordset")

    358. 

  358. 			RS.Open "select IsTop from KS_TeamTopic where ID=" & Tid,Conn,1,3

    359. 

  359. 			If Not RS.EOF Then

    360. 

  360. 			   If RS(0)=1 Then

    361. 

  361. 			      RS(0)=0

    362. 

  362. 			   Else

    363. 

  363. 			      RS(0)=1

    364. 

  364. 			   End If

    365. 

  365. 			   RS.Update

    366. 

  366. 		    End If

    367. 

  367. 		    RS.Close:set RS=Nothing

    368. 

  368. 		    Response.Redirect "Group.asp?Action=showtopic&ID="& ID & "&Tid=" & Tid & "&" & KS.WapValue & ""

    369. 

  369. 		End Sub

    370. 

  370. 		

    371. 

  371. 		'精华设置

    372. 

  372. 		Sub SetBest()

    373. 

  373. 		    Dim Tid:Tid=KS.Chkclng(KS.S("Tid"))

    374. 

  374. 			Dim RS:set RS=Server.Createobject("adodb.recordset")

    375. 

  375. 			RS.Open "select IsBest from KS_TeamTopic where ID=" & Tid,Conn,1,3

    376. 

  376. 			If Not RS.EOF Then

    377. 

  377. 			   If RS(0)=1 Then

    378. 

  378. 			      RS(0)=0

    379. 

  379. 			   Else

    380. 

  380. 			      RS(0)=1

    381. 

  381. 			   End If

    382. 

  382. 			   RS.Update

    383. 

  383. 		    End If

    384. 

  384. 		    RS.Close:set RS=Nothing

    385. 

  385. 		    Response.Redirect "Group.asp?Action=showtopic&ID="& ID & "&Tid=" & Tid & "&" & KS.WapValue & ""

    386. 

  386. 		End Sub

    387. 

  387. 		

    388. 

  388. 		'圈子主题列表

    389. 

  389. 		Function TeamTopic()

    390. 

  390. 		    MaxPerPage =10

    391. 

  391. 			If KS.S("page") <> "" Then

    392. 

  392. 			   CurrentPage = KS.ChkClng(KS.G("page"))

    393. 

  393. 			Else

    394. 

  394. 			   CurrentPage = 1

    395. 

  395. 			End If

    396. 

  396. 			Dim Param:Param=" where TeamID=" & ID & " And ParentID=0"

    397. 

  397. 			If KS.Chkclng(KS.S("IsBest"))=1 Then Param=Param & " And IsBest=1 "

    398. 

  398. 			Dim RSObj:Set RSObj=Server.CreateObject("ADODB.RECORDSET")

    399. 

  399. 			RSObj.Open "select * from KS_TeamTopic "& Param & " Order by IsTop desc,Adddate desc" ,Conn,1,1

    400. 

  400. 			If RSObj.EOF And RSObj.Bof  Then

    401. 

  401. 			   TeamTopic = "没有任何讨论话题! <br/>"

    402. 

  402. 			Else

    403. 

  403. 			   TotalPut = RSObj.RecordCount

    404. 

  404. 			   If CurrentPage < 1 Then	CurrentPage = 1

    405. 

  405. 			   If (CurrentPage - 1) * MaxPerPage > totalPut Then

    406. 

  406. 			      If (TotalPut Mod MaxPerPage) = 0 Then

    407. 

  407. 				     CurrentPage = TotalPut \ MaxPerPage

    408. 

  408. 				  Else

    409. 

  409. 				     CurrentPage = TotalPut \ MaxPerPage + 1

    410. 

  410. 				  End If

    411. 

  411. 			   End If

    412. 

  412. 			   If CurrentPage >1 And (CurrentPage - 1) * MaxPerPage < TotalPut Then

    413. 

  413. 			      RSObj.Move (CurrentPage - 1) * MaxPerPage

    414. 

  414. 			   Else

    415. 

  415. 			      CurrentPage = 1

    416. 

  416. 			   End If

    417. 

  417. 			   Dim I

    418. 

  418. 			   Do While Not RSObj.EOF

    419. 

  419. 			      If RSObj("IsTop")=1 Then TeamTopic = TeamTopic & "[顶]"

    420. 

  420. 				  If RSObj("isbest")=1 Then TeamTopic = TeamTopic & "[精]"

    421. 

  421. 				  TeamTopic = TeamTopic & "<a href=""Group.asp?Action=showtopic&amp;ID=" & ID & "&amp;Tid=" & RSObj("ID") & "&amp;" & KS.WapValue & """>" & ((I+1)+CurrentPage*MaxPerPage)-MaxPerPage &"." & RSObj("Title") & "(" & Conn.Execute("select Count(id) from KS_TeamTopic where ParentID=" & RSObj("ID"))(0) & ")</a><br/>"

    422. 

  422. 				  'TeamTopic = TeamTopic & "作者:<a href=""Space.asp?UserName=" & RSObj("UserName") & "&amp;" & KS.WapValue & """>" & RSObj("UserName") & "</a> "

    423. 

  423. 				  'TeamTopic = TeamTopic & "" & KS.DateFormat(RSObj("AddDate"),17) & "<br/>"

    424. 

  424. 				  RSObj.MoveNext

    425. 

  425. 				  I = I + 1

    426. 

  426. 				  If I >= MaxPerPage Then Exit Do

    427. 

  427. 			   Loop

    428. 

  428. 			   TeamTopic = TeamTopic & KS.ShowPagePara(TotalPut, MaxPerPage, "Group.asp", True, "个", CurrentPage, "ID=" & ID & "&amp;IsBest=" & IsBest & "&amp;" & KS.WapValue & "")

    429. 

  429. 			   TeamTopic = TeamTopic & "<br/>"

    430. 

  430. 			End If

    431. 

  431. 			RSObj.Close:Set RSObj=Nothing

    432. 

  432. 		End Function

    433. 

  433. 		

    434. 

  434. 		'会员列表

    435. 

  435. 		Function ShowUser()

    436. 

  436. 		    MaxPerPage =10

    437. 

  437. 			If KS.S("page") <> "" Then

    438. 

  438. 			   CurrentPage = KS.ChkClng(KS.G("page"))

    439. 

  439. 			Else

    440. 

  440. 			   CurrentPage = 1

    441. 

  441. 			End If

    442. 

  442. 			Dim RSObj:set RSObj=server.createobject("adodb.recordset")

    443. 

  443. 			RSObj.open "select * from KS_TeamUsers where TeamID=" &ID & " and Status=3",Conn,1,1

    444. 

  444. 			If Not RSObj.EOF Then

    445. 

  445. 			   TotalPut = RSObj.RecordCount

    446. 

  446. 			   If CurrentPage < 1 Then	CurrentPage = 1

    447. 

  447. 			   If (CurrentPage - 1) * MaxPerPage > totalPut Then

    448. 

  448. 			      If (TotalPut Mod MaxPerPage) = 0 Then

    449. 

  449. 				     CurrentPage = TotalPut \ MaxPerPage

    450. 

  450. 				  Else

    451. 

  451. 				     CurrentPage = TotalPut \ MaxPerPage + 1

    452. 

  452. 				  End If

    453. 

  453. 			   End If

    454. 

  454. 			   If CurrentPage >1 And (CurrentPage - 1) * MaxPerPage < TotalPut Then

    455. 

  455. 			      RSObj.Move (CurrentPage - 1) * MaxPerPage

    456. 

  456. 			   Else

    457. 

  457. 			      CurrentPage = 1

    458. 

  458. 			   End If

    459. 

  459. 			   Dim I

    460. 

  460. 			   Do While Not RSObj.EOF

    461. 

  461. 			      ShowUser = ShowUser & "<a href=""Space.asp?UserName="&RSObj("UserName")&"&amp;" & KS.WapValue & """>"&RSObj("UserName")&"</a><br/>"

    462. 

  462. 				  RSObj.MoveNext

    463. 

  463. 				  I = I + 1

    464. 

  464. 				  If I >= MaxPerPage Then Exit Do

    465. 

  465. 			   Loop

    466. 

  466. 			   ShowUser = ShowUser & KS.ShowPagePara(TotalPut, MaxPerPage, "Group.asp", True, "个", CurrentPage, "Action=ShowUsers&amp;ID=" & ID & "&amp;IsBest=" & IsBest & "&amp;" & KS.WapValue & "")

    467. 

  467. 			   ShowUser = ShowUser & "<br/>"

    468. 

  468. 			End If

    469. 

  469. 			RSObj.Close:Set RSObj=Nothing

    470. 

  470. 		End Function

    471. 

  471. 		

    472. 

  472. 		'显示帖子列表

    473. 

  473. 		Function ShowTopic()

    474. 

  474. 		    Dim Tid:Tid=KS.Chkclng(KS.S("Tid"))

    475. 

  475. 			Dim RS:set RS=server.createobject("adodb.recordset")

    476. 

  476. 			RS.Open "select b.UserName,b.UserFace,b.UserID,a.* from KS_TeamTopic a ,KS_User b where a.UserName=b.UserName And a.ID=" &Tid,Conn,1,1

    477. 

  477. 			If RS.EOF And RS.BOF Then

    478. 

  478. 			   RS.Close:set RS=Nothing

    479. 

  479. 			   ShowTopic = "参数传递出错!<br/>"

    480. 

  480. 			   Exit Function

    481. 

  481. 		    End If

    482. 

  482. 			ShowTopic = "<b>"&RS("Title")&"</b><br/>"

    483. 

  483. 			If KS.Chkclng(KS.S("Page"))<1 Then

    484. 

  484. 			   ShowTopic = ShowTopic & "作者:<a href=""Space.asp?UserName=" & RS(0) & "&amp;" & KS.WapValue & """>" & RS(0) & "</a> " & KS.DateFormat(RS("Adddate"),17) & "<br/>"

    485. 

  485. 			   Dim Content

    486. 

  486. 			   Content=KS.UBBToHTML(KS.LoseHtml(KS.HTMLToUBB(KS.ReplaceTrim(KS.GetEncodeConversion(RS("Content"))))))

    487. 

  487. 			   ShowTopic = ShowTopic & ""&KS.ContentPagination(Content,200,"Group.asp?Action=showtopic&amp;ID="& ID &"&amp;Tid=" & RS("ID") & "&amp;" & KS.WapValue & "",False,False)&""

    488. 

  488. 			   ShowTopic = ShowTopic & "<br/>"

    489. 

  489. 			End If

    490. 

  490. 			If Cbool(KSUser.UserLoginChecked)=False Then

    491. 

  491. 			   ShowTopic = ShowTopic & "登录后才可以参与该贴子的讨论！如要参与讨论请先<a href=""../User/Login/?../Space/Group.asp?Action=showtopic&amp;ID="&ID&"&amp;Tid="&Tid&""">免费注册登陆</a>！<br/>"

    492. 

  492. 			Else

    493. 

  493. 			   ShowTopic = ShowTopic & "<a href=""Group.asp?Action=replay&amp;ID="&ID&"&amp;Tid="&RS("ID")&"&amp;" & KS.WapValue & """>回复(" & Conn.Execute("select Count(ID) from KS_TeamTopic where ParentID=" & Tid)(0) & ")</a> "

    494. 

  494. 			End If

    495. 

  495. 			If RS(0)=KSUser.UserName or KSUser.UserName=GroupAdmin Then

    496. 

  496. 			   ShowTopic = ShowTopic & "<a href=""Group.asp?Action=connectpost&amp;ID="&ID&"&amp;Tid="&RS("ID")&"&amp;" & KS.WapValue & """>续写</a> "

    497. 

  497. 			   ShowTopic = ShowTopic & "<a href=""Group.asp?Action=alldeltopic&amp;ID="&ID&"&amp;Tid="&RS("ID")&"&amp;" & KS.WapValue & """>删除</a> "

    498. 

  498. 			   If KSUser.UserName=GroupAdmin Then

    499. 

  499. 			      If RS("istop")=1 Then

    500. 

  500. 				     ShowTopic = ShowTopic & "<a href=""Group.asp?Action=settop&amp;ID="&ID&"&amp;tid="&RS("ID")&"&amp;" & KS.WapValue & """>取消置顶</a> "

    501. 

  501. 				  Else

    502. 

  502. 				     ShowTopic = ShowTopic & "<a href=""Group.asp?Action=settop&amp;ID="&ID&"&amp;tid="&RS("ID")&"&amp;" & KS.WapValue & """>设为置顶</a> "

    503. 

  503. 				  End If

    504. 

  504. 				  If RS("isbest")=1 Then

    505. 

  505. 				     ShowTopic = ShowTopic & "<a href=""Group.asp?Action=setbest&amp;ID="&ID&"&amp;tid="&RS("ID")&"&amp;" & KS.WapValue & """>取消精华</a>"

    506. 

  506. 				  Else

    507. 

  507. 				     ShowTopic = ShowTopic & "<a href=""Group.asp?Action=setbest&amp;ID="&ID&"&amp;tid="&RS("ID")&"&amp;" & KS.WapValue & """>设为精华</a>"

    508. 

  508. 				  End If

    509. 

  509. 			   End If

    510. 

  510. 			End If

    511. 

  511. 			ShowTopic = ShowTopic & "<br/>"

    512. 

  512. 			

    513. 

  513. 			MaxPerPage=10

    514. 

  514. 			

    515. 

  515. 			CurrentPage=KS.ChkClng(KS.S("Page"))

    516. 

  516. 			If CurrentPage<=0 Then CurrentPage=CurrentPage+1

    517. 

  517. 			Dim RSP:set RSP=Server.Createobject("adodb.recordset")

    518. 

  518. 			RSP.Open "select b.UserName,b.UserID,b.UserFace,a.* from KS_TeamTopic a, KS_User b where a.UserName=b.UserName and ParentID=" & Tid & " order by Adddate desc",Conn,1,1

    519. 

  519. 			If Not RSP.EOF Then

    520. 

  520. 			   TotalPut = RSP.Recordcount   

    521. 

  521. 			   If CurrentPage < 1 Then	CurrentPage = 1

    522. 

  522. 			   If (CurrentPage - 1) * MaxPerPage > totalPut Then

    523. 

  523. 			      If (TotalPut Mod MaxPerPage) = 0 Then

    524. 

  524. 				     CurrentPage = TotalPut \ MaxPerPage

    525. 

  525. 				  Else

    526. 

  526. 				     CurrentPage = TotalPut \ MaxPerPage + 1

    527. 

  527. 				  End If

    528. 

  528. 			   End If

    529. 

  529. 			   If CurrentPage >1 And (CurrentPage - 1) * MaxPerPage < TotalPut Then

    530. 

  530. 			      RSP.Move (CurrentPage - 1) * MaxPerPage

    531. 

  531. 			   Else

    532. 

  532. 			      CurrentPage = 1

    533. 

  533. 			   End If

    534. 

  534. 			   Do While Not RSP.EOF

    535. 

  535. 			      ShowTopic = ShowTopic & KS.LoseHtml(KS.HTMLCode(RSP("Content"))) & "<br/>"

    536. 

  536. 				  ShowTopic = ShowTopic & "<a href=""Space.asp?UserName=" & RSP(0) & "&amp;" & KS.WapValue & """>" & RSP(0) & "</a> " & KS.DateFormat(RSP("Adddate"),17) & ""

    537. 

  537. 				  If RS(0)=KSUser.UserName or KSUser.UserName=GroupAdmin Then

    538. 

  538. 				     ShowTopic = ShowTopic & "<a href=""Group.asp?Action=deltopic&amp;ID=" & ID & "&amp;Tid=" & RS("ID") & "&amp;Pid=" & RSP("ID") & "&amp;" & KS.WapValue & """>删除</a>"

    539. 

  539. 				  End If

    540. 

  540. 				  ShowTopic = ShowTopic & "<br/>"

    541. 

  541. 			      RSP.MoveNext

    542. 

  542. 				  I = I + 1

    543. 

  543. 				  If I >= MaxPerPage Then Exit Do

    544. 

  544. 			   Loop

    545. 

  545. 			   ShowTopic = ShowTopic & KS.ShowPagePara(TotalPut, MaxPerPage, "Group.asp", True, "个", CurrentPage, "Action=showtopic&amp;ID=" & ID & "&amp;Tid=" & Tid & "&amp;" & KS.WapValue & "")

    546. 

  546. 			   ShowTopic = ShowTopic & "<br/>"

    547. 

  547. 			End If

    548. 

  548. 			RSP.Close:set RSP=Nothing			

    549. 

  549. 			RS.Close:set RS=Nothing

    550. 

  550. 		End Function

    551. 

  551. 		

    552. 

  552. End Class

    553. 

  553. %>
    554.