class_qq.asp

来自「是个不错的文件代码,希望大家好好用,」· ASP 代码 · 共 1,046 行 · 第 1/3 页

			sRet= sRet & "</ul>" & vbcrlf
			rs.MoveNext
		Loop
		GetInfo=GetInfo&"<div id=""user_list""><h1>" &P_QQ_NAME& "管理员</h1>"&sRet&"</div>"
	end  function

	'获取相关的群组列表信息
	Function GetTeams(byval sNumber,byval sType)
		Dim Sql,rs,sRet,sField1,sField2
		Select Case sType
			Case 1
				' hot 最热,回复最多
				sField1="icount2"
				sField2="icount2 Desc"
			Case 2
				'active 最积极,发表文章最多
				sField1="icount1"
				sField2="icount1 Desc"
			Case 3
				'最庞大
				sField1="icount0"
				sField2="icount0 Desc"
			Case 4
				'最新加入
				sField= "icount0"	
				sField= "teamid Desc"		
		End Select
		Sql="Select top " & sNumber & " teamid,t_name, " &  sField & " From oblog_team Order by " & sField
		Set rs=oblog.Execute(Sql)
		If rs.Eof Then
			sRet="<li>还没有任何" & P_QQ_Name &"信息</li>"
		Else
			Do While Not rs.Eof
				sRet=sRet & "<li><a href=""group.asp?Group_id=" & rs(0) & """ target=_blank>" & rs(1) & "</a>(" & rs(2) & ")</li>"
				rs.Movenext
			Loop	
		End If
		Set rs=Nothing
		GetHotTeams=sRet
		sRet=""
	End Function
	
	Function CommentForm(id)
		Dim sRet,sTopic,sContent,modify,sql
		modify=trim(request("modify"))
		If oblog.checkuserlogined()=false Then
			CommentForm="<p><a href='login.asp?fromurl=group.asp?cmd="&cmd&"$gid="&Group_Id&"$pid="&id&"'>您必须登录后才能进行回复或者发起新的主题</a></p>"
			Exit Function
		End If
		if trim(request("modify"))="1" and id<>"" then
			if IsManager=true then
				sql="select * from oblog_teampost where postid="&clng(id)
			else
				sql="select * from oblog_teampost where postid="&clng(id)&" and userid="&oblog.l_uid
			end if
			set rs=oblog.execute(sql)
			if not rs.eof then
				sTopic=rs("topic")
				sContent=rs("content")
			end if
		end if
		sRet="<div id=""form_comment""><a name=""add_comment""></a><form action='group.asp?cmd=save&gid="&Group_Id&"&pid=" & id &"&modify="&trim(request("modify"))&"' method='post' name='commentform' id='commentform'>"& vbcrlf 
		sRet=sRet&"<div id=""ad_teamcomment""><script src='ad/ad_teamcommentjs.htm'></script></div>"
		sRet=sRet & "<ul><p>" & oblog.l_uname & " , 欢迎您参与" &P_QQ_NAME& "讨论,在此处发布的内容将不显示在您的博客中</p></ul>"
		If Id="" Then sRet=sRet & "<ul>仅该" &P_QQ_NAME& "成员可以发起主题，非成员仅可以回复</ul>"
		sRet=sRet & "<ul style=""display:none"">昵称：<input name='UserName' type='text' id='UserName' size='15' maxlength='20' value='' /></ul>" & vbcrlf 
		sRet=sRet & "<ul style=""display:none;"">密码：<input name='Password' type='password' id='Password' size='15' maxlength='20' value='' /> (游客无须输入密码)</ul>" & vbcrlf 
		sRet=sRet & "<ul style=""display:none;"">主页：<input name='homepage' type='text' id='homepage' size='42' maxlength='50' value='http://' /></ul>"  & vbcrlf 
		If Id="" or modify="1" Then sRet=sRet & "<ul>标题：<input name='commenttopic' type='text' id='commenttopic' size='50' maxlength='50' value='"&sTopic&"' /></ul>"  & vbcrlf 
		sRet=sRet & "<ul>" & vbcrlf 
		if id="" or modify="1" then
			sRet=sRet & "<div id=""oblog_edit""><textarea id=""oblog_edittext"" name=""oblog_edittext"" style=""width:400px;height:250px; display:none"" >"&sContent&"</textarea></div> " & vbcrlf
		else
			sRet=sRet & "<div id=""oblog_edit""><img src=""images/loading.gif""></div> " & vbcrlf
		end if 
		sRet=sRet & "</ul>" & vbcrlf 
		sRet=sRet & "<ul><span id=""ob_code""></span><input type='submit' value=' 提交 '></ul>" & vbcrlf 
		sRet=sRet & "</form></div>"& vbcrlf
		if oblog.CacheConfig(30)=1 Then 
			sRet=sRet & "<script>"&oblog.htm2js_div("验证码：<input name=""CodeStr"" type=""text"" size=""6"" maxlength=""4"" /> "&oblog.getcode,"ob_code")&"</script>"
		end if
		if id<>"" and modify<>"1" then
			sRet=sRet & "<script>function addcode(){return true;}</script>"
			sRet=sRet & "<script src=""commentedit.asp""></script>"
		else
			sRet=sRet&"<script type='text/javascript'>_editor_url  = '"&C_Editor&"';_editor_lang = 'ch';</script><script type='text/javascript' src='"&C_Editor&"/htmlarea.js'></script><script type='text/javascript'>oblog_editors = null;oblog_init    = null;oblog_config  = null;oblog_plugins = null;oblog_editortype=2;"&vbcrlf&"oblog_init = oblog_init ? oblog_init : function()"&vbcrlf&"{oblog_editors = oblog_editors ? oblog_editors :['oblog_edittext'];oblog_config = oblog_config ? oblog_config : new HTMLArea.Config(oblog_editortype);oblog_editors   = HTMLArea.makeEditors(oblog_editors, oblog_config, oblog_plugins);HTMLArea.startEditors(oblog_editors);window.onload = null;};window.onload   = oblog_init;</script>"
		end if
		CommentForm=sRet
		sRet=""
	End Function 
	
	
	
	Function GetTheme()
		Dim oFso,oStream,sRet,objReg
		If Application(cache_name&"_group_theme_main")="" Then
			Application.Lock
			'模板
			Set oFso=Server.CreateObject(oblog.CacheCompont(1))
			Set oStream=oFSO.OpenTextFile(Server.Mappath("common/group/default/group.htm"),1,False)
			sRet = oStream.ReadAll
			Application(cache_name&"_group_theme_main")=sRet
			Set oStream=oFSO.OpenTextFile(Server.Mappath("common/group/default/post.htm"),1,False)
			sRet = oStream.ReadAll
			Application(cache_name&"_group_theme_post")=sRet
			Set oStream=oFSO.OpenTextFile(Server.Mappath("common/group/default/reply.htm"),1,False)
			sRet = oStream.ReadAll
			Application(cache_name&"_group_theme_reply")=sRet
			Set oStream=oFSO.OpenTextFile(Server.Mappath("common/group/default/more.htm"),1,False)
			sRet = oStream.ReadAll
			Application(cache_name&"_group_theme_more")=sRet
			'广告
			'Set oStream=oFSO.OpenTextFile(Server.Mappath("ad/ad_teamtop.htm"),1,False)
'			sRet = oStream.ReadAll
'			Application(cache_name&"_group_ad_teamtop")=sRet
'			Set oStream=oFSO.OpenTextFile(Server.Mappath("ad/ad_teamlinks.htm"),1,False)
'			sRet = oStream.ReadAll
'			Application(cache_name&"_group_ad_teamlinks")=sRet
'			Set oStream=oFSO.OpenTextFile(Server.Mappath("ad/ad_teamcomment.htm"),1,False)
'			sRet = oStream.ReadAll
'			Application(cache_name&"_group_ad_teamcomment")=sRet
'			Set oStream=oFSO.OpenTextFile(Server.Mappath("ad/ad_teambot.htm"),1,False)
'			sRet = oStream.ReadAll
'			Application(cache_name&"_group_ad_teambot")=sRet
			Application.Unlock
			sRet=""
			Set oStream=Nothing
			Set oFso=Nothing
		End If	
	End Function
	
	Function IsManager()
		IsManager=false
		imMode=0
		If oblog.CodeCookie(Group_ManagerName)=Request.Cookies(cookies_name)("username") Then
			If oblog.checkuserlogined()=true Then
				imMode=1
				IsManager=true
			End If
		End If
	End Function
	
	Function IsMember()
		Dim rs
		IsMember=false
		If oblog.checkuserlogined()=true Then
			Set rs=oblog.Execute("Select id From oblog_teamusers Where state>2 and teamid=" & Group_id & " And userid=" & oblog.l_uid )
			If Not rs.Eof Then
				IsMember=true
			End If
			Set rs=Nothing
		End If
	End Function
	'----------------------------------------------------
	'群组管理功能模块
	'----------------------------------------------------
	'申请加入模块
	Function JoinForm(id)
		Dim sRet,rs
		If oblog.checkuserlogined()=false Then
			JoinForm="<p><a href='login.asp?fromurl=group.asp?cmd=join$gid="&Group_id&"'>您必须先登录后才能申请加入</a></p>"
			Exit Function
		End If
		'判断加入条件
		Set rs=oblog.execute("Select joinlimit,joinscores,icount0 From oblog_team Where teamid="& int(id))
		If rs.Eof Then
			
			ErrMsg="目标" &P_QQ_NAME& "不存在!"
			Response.End
		End If
		Select Case rs(0)
			Case 1
			Case 2
				ErrMsg="本" &P_QQ_NAME& "只能由组长发出邀请，不能申请加入"
			Case 3
				If oblog.l_uscores<rs(1) Then
					ErrMsg="加入本" &P_QQ_NAME& "需要至少 " & rs(1) & " 点积分,您的积分不足"
				End If
		End Select
		if rs(2)>=p_Group_MaxUser then
			ErrMsg="本" &P_QQ_NAME& "成员已达到系统上限"&p_Group_MaxUser&"人。"
		end if
		Set rs=Nothing
		If ErrMsg<>"" Then	
			JoinForm=ErrMsg		
			Exit Function
		End If
		'是否任何人都可以加入
		sRet="<form action=group.asp?cmd=savejoin&gid="&Group_id&" method=""post"">" & vbcrlf
		sRet=sRet & oblog.DecodeCookie(Request.Cookies(cookies_name)("username")) & ",请填写您的申请信息<br/>"
		sRet=sRet & "<textarea cols=50 rows=6 maxlength=200 name=info></textarea><br/>"
		sRet=sRet & "<input type=""submit"" value="" 提交 "">"
		sRet=sRet & "</form>"
		JoinForm=sRet
	End Function
	'批准模块
	Function AcceptJoin()
		Dim rs,sql,sRet,ustate
		'判断用户是否登录
		If oblog.checkuserlogined()=false Then
			AcceptJoin="<p>您必须登录后才能进行申请操作</p>"			
			Exit Function
		End If
		ustate=2
		'判断加入条件
		Set rs=oblog.execute("Select joinlimit,joinscores From oblog_team Where teamid="& int(Group_id))
		If rs.Eof Then			
			ErrMsg="目标" &P_QQ_NAME& "不存在!"
			Response.End
		End If
		Select Case rs(0)
			Case -1
				ustate=3
			Case 1
			Case 2
				ErrMsg="本" &P_QQ_NAME& "只能由组长发出邀请，不能申请加入"
			Case 3
				If oblog.l_uscores<rs(1) Then
					ErrMsg="加入本" &P_QQ_NAME& "需要至少 " & rs(1) & " 点积分,您的积分不足"
				End If
		End Select
		If ErrMsg<>"" Then	
			AcceptJoin=ErrMsg		
			Exit Function
		End If
		'判断之前是否已加入或申请
		Sql="Select * From oblog_teamusers Where teamid=" & Group_id & " And userid=" & oblog.l_uid
		Set rs=Server.CreateObject("Adodb.Recordset")
		rs.Open Sql,conn,1,3
		If Not rs.Eof Then
			Select Case rs("state")
				Case 3
					sRet="您已经是该" &P_QQ_NAME& "的成员。"
				Case 1
					sRet="您已经被邀请,请进入您的后台接受或拒绝该" &P_QQ_NAME& "的邀请。"
				Case 2
					sRet="您已经发出申请,请等待管理员审核。"
				Case 5
					sRet="您是该" &P_QQ_NAME& "管理员,不需要进行申请。"
			End Select
		Else
			'判断条件
			rs.AddNew
			rs("teamid")=Group_Id
			rs("userid")=oblog.l_uid
			rs("state")=ustate
			rs("info")= left(request("info"),200)
			rs("icount")=0
			rs("addtime")=Now
			rs.Update
			if ustate=3 then
				sRet="您已加入此" &P_QQ_NAME& "。"
			else
				sRet="您已成功发送申请,正在等待管理员审核。"
			end if
		End If
		rs.Close
		Set rs=Nothing
		AcceptJoin=sRet
	End Function
	
	'修改有情连接模块
	Function LinksForm()
		Dim sRet		
		sRet="<div id=""form_comment""><form action='group.asp?cmd=savelinks&gid="&Group_Id&"' method='post' name='commentform' id='commentform' onSubmit='return Verifycomment()'>"& vbcrlf 
		sRet=sRet & "<ul><p>请修改您的友情连接</p></ul>"
		sRet=sRet & "<ul style=""display:none"">昵称：<input name='UserName' type='text' id='UserName' size='15' maxlength='20' value='' /></ul>" & vbcrlf 
		sRet=sRet & "<ul style=""display:none;"">密码：<input name='Password' type='password' id='Password' size='15' maxlength='20' value='' /> (游客无须输入密码)</ul>" & vbcrlf 
		sRet=sRet & "<ul style=""display:none;"">主页：<input name='homepage' type='text' id='homepage' size='42' maxlength='50' value='http://' /></ul>"  & vbcrlf 
		sRet=sRet & "<ul><input type='hidden' name='edit' id='edit' value='' />" & vbcrlf 
		sRet=sRet & "<div id=""oblog_edit""></div> " & vbcrlf 
		sRet=sRet & "</ul>" & vbcrlf 
		sRet=sRet & "<ul><span id=""ob_code""></span><input type='submit' value=' 提交 '></ul>" & vbcrlf 
		sRet=sRet & "</form></div>"& vbcrlf 
		sRet=sRet & "<script src=""commentedit.asp""></script>"
		LinksForm=sRet
		sRet=""
	End Function 
	Function SaveLinks()
		'判断是否为管理员
		If IsManager=false Then
			ErrMsg= "你没有权限进行此操作"
			Exit Function
		End If
		Dim rs,content
		content=Request.Form("oblog_edittext")
		Set rs=Server.CreateObject("Adodb.Recordset")
		rs.Open "Select * From oblog_team Where teamid=" & Group_Id,conn,1,3
		rs("links")=oblog.Ubb_comment(EncodeJP(oblog.InterceptStr(oblog.filt_badword(content),250)))
		rs.Update
		rs.Close
		Set rs=Nothing
		Response.Redirect "group.asp?gid=" & Group_id
	End Function
	'修改站点公告模块
	Function PlacardForm()
		Dim sRet		
		sRet="<div id=""form_comment""><form action='group.asp?cmd=saveplacard&gid="&Group_Id&"' method='post' name='commentform' id='commentform' onSubmit='return Verifycomment()'>"& vbcrlf 
		sRet=sRet & "<ul><p>请修改您的" &P_QQ_NAME& "公告</p></ul>"
		sRet=sRet & "<ul style=""display:none"">昵称：<input name='UserName' type='text' id='UserName' size='15' maxlength='20' value='' /></ul>" & vbcrlf 
		sRet=sRet & "<ul style=""display:none;"">密码：<input name='Password' type='password' id='Password' size='15' maxlength='20' value='' /> (游客无须输入密码)</ul>" & vbcrlf 
		sRet=sRet & "<ul style=""display:none;"">主页：<input name='homepage' type='text' id='homepage' size='42' maxlength='50' value='http://' /></ul>"  & vbcrlf 
		sRet=sRet & "<ul><input type='hidden' name='edit' id='edit' value='' />" & vbcrlf 
		sRet=sRet & "<div id=""oblog_edit""></div> " & vbcrlf 
		sRet=sRet & "</ul>" & vbcrlf 
		sRet=sRet & "<ul><span id=""ob_code""></span><input type='submit' value=' 提交 '></ul>" & vbcrlf 
		sRet=sRet & "</form></div>"& vbcrlf 
		sRet=sRet & "<script src=""commentedit.asp""></script>"
		PlacardForm=sRet
		sRet=""
	End Function
	Function SavePlacard()
		'判断是否为管理员
		If IsManager=false Then
			ErrMsg= "你没有权限进行此操作"
			Exit Function
		End If
		Dim rs,content
		content=Request.Form("oblog_edittext")
		Set rs=Server.CreateObject("Adodb.Recordset")
		rs.Open "Select * From oblog_team Where teamid=" & Group_Id,conn,1,3
		rs("announce")=oblog.Ubb_comment(EncodeJP(oblog.InterceptStr(oblog.filt_badword(content),250)))
		rs.Update
		rs.Close
		Set rs=Nothing
		Response.Redirect "group.asp?gid=" & Group_id
	End Function
	'解散模块(暂不启用)
	
	function getminilist()
		Dim rs,Sql,sRet
		Sql="Select top 20 topic,postid,author,teamid From oblog_teampost Where iDepth=0 And teamid=" & Group_id & " Order By postid Desc"
		Set rs=oblog.Execute(Sql)
		If rs.Eof Then
			sRet="<li>-<li>"
		Else
			Do While Not rs.Eof
				sRet=sRet & "<li><a href=""group.asp?gid="&rs(3)&"&pid="&rs(1)&""">" & RemoveHtml(rs(0))&"</a> ("&rs(2)&")</li>"
				rs.MoveNext
			Loop
		End if
		Set rs=Nothing
		getminilist=sRet
		sRet=""
	end function
	
End Class
%>