📄 class_qq.asp
字号:
<%
'Oblog Group Class
'Class_Group.asp
'teamusers中state的状态
'teamusers: state 1有效;2申请加入3被邀请4 副管理员 5 管理员
'拒绝后删除该记录,无论通过还是删除，系统会自动发一条消息给用户
Class Class_Team
Public Group_id,Group_Name,Group_Ico,CssFile,Group_Links,Group_Creater,Group_ManagerId,Group_ManagerName,Group_CreateTime
Public Group_Placard
Public PageFrameWork,PageBody,ShowMode,ErrMsg
Private iPage,Sql,rs,imMode,pid,icoGood,icoTop,icoBlog
Private Sub Class_initialize()
Set rs=Server.CreateObject("Adodb.RecordSet")
iPage=20
On Error Resume Next
If Not IsObject(conn) Then Link_DataBase
pid=1
' icoBlog="<img src=""oBlogStyle/level/tu-001.gif"" border=0 title=""日志发布"" />"
' icoTop="<img src=""oBlogStyle/level/light.gif"" border=0 title=""置顶"" />"
' icoGood="<img src=""oBlogStyle/level/good.gif"" border=0 title=""精华"" />"
icoBlog="[日志]"
icoTop="[置顶]"
icoGood="[精华]"
End Sub
Private Sub Class_terminate()
On Error Resume Next
If IsObject(conn) Then conn.Close: Set conn = Nothing
If ErrMsg<>"" Then Response.Write ErrMsg
End Sub
Public Property Let GroupId(byval Value)
Group_id=Int(Value)
rs.Open "Select * From oblog_team Where teamid=" & Group_id,conn,1,1
If rs.Eof Then
Response.Write "目标" &P_QQ_NAME& "不存在!"
Response.End
Else
If rs("iState") = 1 Then
Response.Write "目标" &P_QQ_NAME& "尚未被管理员审核!"
Response.End
ElseIf rs("iState") = 2 Then
Response.Write "目标" &P_QQ_NAME& "被锁定!"
Response.End
End if
End If
rs.Filter="iState=3"
If Not Rs.EOF Then
Group_Name=rs("t_name")
Group_Ico=rs("t_ico")
Group_CreateTime=rs("CreateTime")
Group_ManagerId=rs("ManagerId")
Group_ManagerName=rs("ManagerName")
Call GetTheme
Call IsManager
Group_Links=rs("t_links")
Else
Response.Write "目标" &P_QQ_NAME& "已经被删除!"
Response.End
End If
rs.Close
Set rs=Nothing
End Property
Public Sub Show
PageFrameWork=MakeMainPage()
iMode=Request("mode")
Select Case ShowMode
Case 1
PageBody=GetIndexList(iMode)
Case 2
PageBody=ShowPost(pid)
Case 3
PageBody=GetUser(Group_id)
Case Else
PageBody=ErrMsg
End Select
'If ShowMode Then
PageFrameWork=Replace(PageFrameWork,"$group_list$",PageBody)
Response.Write PageFrameWork
PageFrameWork=""
End Sub
'显示单一日志及回复
Public Sub ShowPost(pid)
Dim sRet,sPost,sReply,sEditor
GetPost pid,sPost,sReply
sRet=MakeMainPage()
sRet=Replace(sRet,"$group_posts$",sPost)
sRet=Replace(sRet,"$group_replys$",sReply)
Response.Write sRet
sRet=""
End Sub
'显示日志列表
Public Sub ShowList(iType)
Dim sRet
sRet=MakeMainPage()
sRet=Replace(sRet,"$group_replys$","")
sRet=Replace(sRet,"$group_posts$",GetIndexList(iType))
Response.Write sRet
sRet=""
End Sub
Public Sub ShowUsers()
Dim sRet
sRet=MakeMainPage()
sRet=Replace(sRet,"$group_replys$","")
sRet=Replace(sRet,"$group_posts$",GetUsers)
Response.Write sRet
sRet=""
End Sub
Public Sub ShowInfo()
Dim sRet
sRet=MakeMainPage()
sRet=Replace(sRet,"$group_replys$","")
sRet=Replace(sRet,"$group_posts$",GetInfo)
Response.Write sRet
sRet=""
End Sub
Public Sub ShowLinksForm()
Dim sRet
sRet=MakeMainPage()
sRet=Replace(sRet,"$group_replys$","")
sRet=Replace(sRet,"$group_posts$",LinksForm)
Response.Write sRet
sRet=""
End Sub
Public Sub ShowPlacardForm()
Dim sRet
sRet=MakeMainPage()
sRet=Replace(sRet,"$group_replys$","")
sRet=Replace(sRet,"$group_posts$",PlacardForm)
Response.Write sRet
sRet=""
End Sub
Public Sub PostForm()
Dim sRet
sRet=MakeMainPage()
sRet=Replace(sRet,"$group_replys$","")
sRet=Replace(sRet,"$group_posts$",CommentForm(postid))
Response.Write sRet
sRet=""
End Sub
Public Sub ShowJoinForm()
Dim sRet
sRet=MakeMainPage()
sRet=Replace(sRet,"$group_replys$","")
sRet=Replace(sRet,"$group_posts$",JoinForm(Group_id))
Response.Write sRet
sRet=""
End Sub
Public Sub ActionJoin()
Dim sRet
sRet=MakeMainPage()
sRet=Replace(sRet,"$group_replys$","")
sRet=Replace(sRet,"$group_posts$",AcceptJoin())
Response.Write sRet
sRet=""
End Sub
'群组帖子的几种获取类型;1: 全部，不分圈;2：某圈全部;3：某圈精华;4：某圈某人;5:最新发布;6:最新回复;
Function GetIndexList(iMode)
Dim SqlPart,sRet,sRet1,i,r
Dim rs,lPage,lAll,lPages,sTitle,sMBar
Select Case iMode
Case "1"
SqlPart=" And isbest=1 "
Case "2"
SqlPart=" And isblog=1 "
Case "3"
SqlPart=" And isblog=0 "
Case Else
End Select
G_P_Filename="group.asp?gid=" & Group_id & "&mode="&imode&"&page="
sRet=""
Set rs=Server.CreateObject("Adodb.RecordSet")
Sql="Select * from (select top 500 isbest,istop,logid,postid,topic,author,replys,lastupdate From oblog_teampost Where teamid=" & Group_id & " And iDepth=0 And isTop=1 " & SqlPart & " Order By Lastupdate Desc"
Sql= Sql & " union "
Sql= Sql & " Select top 500 isbest,istop,logid,postid,topic,author,replys,lastupdate From oblog_teampost Where teamid=" & Group_id & " And iDepth=0 And isTop=0 " & SqlPart & " Order by Lastupdate desc ) DERIVEDTBL ORDER BY istop DESC , lastupdate DESC"
rs.Open Sql,conn,1,1
'response.Write(sql)
'Set rs=oblog.Execute(Sql)
If rs.Eof Then
rs.Close
sRet="<div>目前还没有任何主题<div>"
GetIndexList=sRet
sRet=""
Exit Function
End If
'分页
If Request("page") = "" Or Request("page") ="0" then
lPage = 1
Else
lPage = Int(Request("page"))
End If
lAll=INT(rs.recordcount)
'设置缓存大小 = 每页需显示的记录数目
rs.CacheSize = iPage
rs.PageSize = iPage
rs.movefirst
lPages = rs.PageCount
If lPage>lPages Then lPage=lPages
rs.AbsolutePage = lPage
Do While Not rs.Eof And i < rs.PageSize
'写内容
sTitle=""
If rs("isbest")=1 Then
sTitle= icoGood & sTitle
End If
If rs("istop")=1 Then
sTitle= icoTop & sTitle
End If
If rs("logid")>0 Then sTitle= icoBlog & sTitle
if int(i/2)*2=i then r=1 else r=2
sRet1="<td class='s1'>"&sTitle&"<a href='group.asp?gid="& Group_Id &"&pid=" & rs("postid")&"' title=""标题"&OB_IIF(rs("topic"),"无题")&""">"&OB_IIF(rs("topic"),"无题")&"</a></td>"
sRet1=sRet1&"<td class='s2'><a href='go.asp?user="&rs("author")&"' title=""作者"&rs("author")&""">"&rs("author")&"</td>"
sRet1=sRet1&"<td class='s3'>"&rs("replys")&"</td>"
sRet1=sRet1&"<td class='s4'>"&rs("Lastupdate")&"</td>"
sRet1="<tr class='r"&r&"'>"&sRet1&"</tr>"
sRet=sRet & sRet1 & vbcrlf
i=i+1
rs.MoveNext
Loop
rs.Close
Set rs=Nothing
'生成一个底部分页条
sRet="<table id='indexlist'><tbody><tr class='top'><td class='s1'>话题</td><td class='s2'>作者</td><td class='s3'>回复</td><td class='s4'>最后更新</td></tr>"&sRet&"</tbody></table>"
sRet=sRet & "<div id=team_post_pages>" & PageBarNum(lAll,iPage,lPage,G_P_Filename) & "</div>"
'兼容脚本错误
sRet= sRet & vbcrlf & "<div id=""comment_list""></div>"
GetIndexList=sRet
sRet=""
End Function
Function GetUsers()
Dim sRet
Dim rs,lPage,lAll,lPages,i
G_P_Filename="group.asp?gid=" & Group_id & "&cmd="&cmd&"&page="
Sql="Select a.userid,a.province,a.city,username,nickname,blogname,user_icon1,log_count,user_group,scores From oblog_user a,"
Sql= Sql & "(Select userid,state From oblog_teamusers Where Teamid=" & Group_id & ") b Where a.userid=b.userid and b.state>2 Order By b.state Desc"
Set rs=Server.CreateObject("Adodb.RecordSet")
rs.open sql,conn,1,1
If rs.EOF Then
GetUsers="<div id=""user_list""> 管理员帐号不存在或者已经被删除 </div>"
Exit Function
End if
If Request("page") = "" Or Request("page") ="0" then
lPage = 1
Else
lPage = Int(Request("page"))
End If
lAll=INT(rs.recordcount)
'设置缓存大小 = 每页需显示的记录数目
rs.CacheSize = iPage
rs.PageSize = iPage
rs.movefirst
lPages = rs.PageCount
If lPage>lPages Then lPage=lPages
rs.AbsolutePage = lPage
Do While Not rs.Eof and i < rs.PageSize
sRet= sRet & "<ul><li class=""u1""><img src=""" & OB_IIF(rs("user_icon1"),"images/ico_default.gif") & """ border=0 width=48 height=48></li>" & vbcrlf
sRet= sRet & "<li class=""u2""><a href=""go.asp?userid=" & rs("userid") & """ target=_blank>" & rs("username") &"</a></li>" & vbcrlf
sRet= sRet & "<li class=""u3"">(" & rs("province") & rs("city") &")</li>" & vbcrlf
sRet= sRet & "</ul>" & vbcrlf
i=i+1
rs.Movenext
Loop
rs.Close
Set rs=Nothing
sRet=sRet & "<div id=team_post_pages>" & PageBarNum(lAll,iPage,lPage,G_P_Filename) & "</div>"
GetUsers="<div id=""user_list"">" & sRet & "</div>"
sRet=""
End Function
Sub SaveComment()
Dim title,content,author,userid,url,sql,rs,pid,iDepth,modify
modify=trim(request("modify"))
author=Request.Form("username")
pid=Request("pid")
If pid="" Then
pid=0
iDepth=0
Else
iDepth=1
End If
pid=Int(pid)
title=RemoveHtml(Request.Form("commenttopic"))
content=Request.Form("oblog_edittext")
'验证码校验
if oblog.CacheConfig(30)=1 Then
If request("CodeStr")="" then
oblog.showok "验证码错误，请返回刷新后重新输入！",""
exit sub
Else
if not oblog.codepass then
oblog.showok "验证码错误，请返回刷新后重新输入！",""
exit sub
end if
End If
end if
If Len(content)=0 Or Len(content)>50000 Then
oblog.showok "发布的内容不能为空，且长度不能大于50000",""
exit sub
End If
If oblog.checkuserlogined() Then
Author= oblog.l_uname
userid=oblog.l_uid
Else
End If
If pid=0 Then
If IsMember=false Then
oblog.showok "非本" &P_QQ_NAME& "成员不可以发起主题，仅可回复，您可以申请加入该" &P_QQ_NAME& "",""
exit sub
End If
End If
Set rs=Server.CreateObject("Adodb.RecordSet")
rs.Open "Select * From oblog_teampost Where postid=" & pid,conn,1,3
If rs.Eof Then
If pid>0 Then
rs.Close
Set rs=Nothing
ErrMsg= "目标主题不存在"
Exit Sub
End If
else
If IsManager=false and modify="1" then
if rs("userid")<>oblog.l_uid then
rs.Close
Set rs=Nothing
ErrMsg= "无权限"
Exit Sub
end if
end if
End If
if modify<>"1" then
rs.AddNew
rs("teamid")=Group_Id
rs("author")=Author
rs("parentid")=pid
rs("iDepth")=iDepth
rs("logid")=0
rs("userid")=userid
rs("addip")=oblog.userip
rs("addtime")=ServerDate(Now)
rs("LastUpdate")=ServerDate(Now)
rs("ispass")=1
rs("istop")=0
rs("isbest")=0
end if
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -