%
'最后修改:2010-3-19by 小易
'勋章图片数目,默认是10,如果想增加直接把该数字改大并在Dv_plus/medal/images/下添加对应编号的图片。
Const MedalPicNum = 10
If Dvbbs.UserId = 0 Then
Response.redirect "showerr.asp?ErrCodes=
游客没有查看勋章插件的权限,请先登陆。&action=OtherErr"
Reseponse.end
end if
If Cint(dvbbs.Forum_Setting(104))=0 Then
Response.redirect "showerr.asp?ErrCodes=
勋章功能已被管理员关闭。&action=OtherErr"
Reseponse.end
end if
Dvbbs.LoadTemplates("")
Dvbbs.Stats = "荣誉勋章"
Dvbbs.Nav
Dvbbs.Head_Var 0,0,"荣誉勋章","medal_index.asp"
Dvbbs.Name = "Medal"
Medal_Nav()
Select Case Request("action")
Case "users" :
Call Users()
Case "medal" :
Call Medal()
Case "award" :
Call Award()
Case "saveaward" :
Call SaveAward()
Case "remedal" :
Call ReAward()
Case "awardlog" :
Call AwardLog()
Case "savemedal" :
Call SaveMedal()
Case "delmedal" :
Call DelMedal()
Case Else :
Call Main()
End Select
Dvbbs.Footer()
Dvbbs.PageEnd()
'功能菜单
Sub Medal_Nav()
Dim Html
Html = "
我的勋章 | 获奖名单"
If Dvbbs.Master Then
Html = Html & " | 勋章管理 | 颁发勋章 | 颁发记录"
End If
Html = Html & "
"
Response.Write Html
End Sub
'我的勋章
Sub Main()
Dim Html,Rs,Data,i,MedalData
If Dvbbs.ObjIsEmpty() Then ReloadCache()
MedalData = Dvbbs.Value
Html = "
我的勋章
勋章名称
颁奖人
获奖原因
获奖时间
"
Set Rs = Dvbbs.Execute("SELECT M.MedalName,M.MedalPic,L.AwardUser,L.AwardDesc,L.AddTime FROM Dv_Medal M,Dv_MedalLog L WHERE M.id = L.MedalId AND L.UserId ="&Dvbbs.UserId)
If Not Rs.Eof Then
Data = Rs.GetRows(-1)
For i = 0 To Ubound(Data,2)
Html = Html & "
"&Data(0,i)&"
"&Data(2,i)&"
"&Data(3,i)&"
"&Data(4,i)&"
"
Next
Else
Html = Html & "
暂无勋章...
"
End If
Rs.Close : Set Rs = Nothing
Html = Html & "
"
Html = Html & "
勋章列表
图标
名称
说明
"
If IsArray(MedalData) Then
For i = 0 To UBound(MedalData,2)
Html = Html & "
"&MedalData(1,i)&"
"&MedalData(3,i)&"
"
Next
End If
Html = Html & "
"
Response.write Html
End Sub
'获奖名单
Sub Users()
Dim Html,Users,UserMedal(1),Medals,Rs,Rs2,i,j,k
Dim Page,Url,TotalCount,PageSize,TotalPage,StarNum,EndNum
Page = 1 : TotalCount = 1 : PageSize = 1 : Url = "action=users"
Html = ""
Html = Html & "
获奖名单
用户
勋章
"
Rem 分页
Dim mypage,truekeyword
truekeyword=" TyMedaled=1"
PageSize=10 '定义分页每一页的记录数
If Not isobject(conn) then ConnectionDatabase
If IsSqlDataBase =1 Then
Set mypage=new Pager
else
Set mypage=new Pager2
end if
mypage.getconn=conn '得到数据库连接
mypage.pagesize=PageSize
mypage.TableName="Dv_User" '要查询的表名
mypage.Tablezd=" UserId,UserName,UserMedal"
mypage.KeyName="UserId"
mypage.OrderType=1
mypage.PageWhere=truekeyword
mypage.GetStyle =1
Set Rs=mypage.getrs()
TotalCount = mypage.int_totalRecord
Set mypage = nothing
If Not (rs.bof And rs.eof) Then
Users=rs.getrows(-1):rs.close:Set rs=Nothing
Set Rs2 = Dvbbs.Execute("SELECT id,MedalName,MedalDesc,MedalPic FROM Dv_Medal")
Medals = Rs2.GetRows(-1)
Rs2.Close : Set Rs2 = Nothing
If IsArray(Users) Then
for i=0 to ubound(Users,2)
UserMedal(0) = Split(Users(2,i),",")
UserMedal(1) = ""
For j = 0 To Ubound(UserMedal(0))
For k = 0 To Ubound(Medals,2)
If Clng(UserMedal(0)(j)) = Clng(Medals(0,k)) Then
UserMedal(1) = UserMedal(1) & " "
Exit For
End If
Next
Next
Html = Html & "
"&Users(1,i)&"
"&UserMedal(1)&"
"
Next
end if
Else
rs.close:Set rs=Nothing
Html = Html & "
暂无...
"
End If
Page=Cint(Request("Page"))
if page<1 then Page=1
Html = Html & "
"
Response.write Html
End Sub
'勋章管理
Sub Medal()
If Not Dvbbs.Master Then ShowMsg "对不起,你不是管理员,不能进入管理页面!" : Exit Sub
Dim Html,Rs,PicStr,i,Data,TyUsed
Html = " "
Response.write Html
End Sub
'保存奖项
Sub SaveMedal()
If Not Dvbbs.Master Then ShowMsg "对不起,你不是管理员,不能进入管理页面!" : Exit Sub
Dim id,m_name,m_desc,m_pic,i
id = Dvbbs.Checkstr(Dvbbs.iHtmlEncode(Request.Form("id")))
m_name = Dvbbs.Checkstr(Dvbbs.iHtmlEncode(Request.Form("m_name")))
m_desc = Dvbbs.Checkstr(Dvbbs.iHtmlEncode(Request.Form("m_desc")))
m_pic = Dvbbs.Checkstr(Dvbbs.iHtmlEncode(Request.Form("m_pic")))
If Request("type")="add" Then
If m_name <> "" And m_pic <> "" Then
Dvbbs.Execute("INSERT INTO Dv_Medal (MedalName,MedalDesc,MedalPic) VALUES ('"&m_name&"','"&m_desc&"','"&m_pic&"')")
ReloadCache()
Response.Redirect "medal_index.asp?action=medal"
Else
ShowMsg "奖项名称和奖项图片不能为空!",""
End If
ElseIf Request("type")="edit" Then
Rem fish 修复编辑出错
id=Replace(id,", ",", ")
m_name=Replace(m_name,", ",", ")
m_desc=Replace(m_desc,", ",", ")
m_pic=Replace(m_pic,", ",", ")
id = Split(id,", ") : m_name = Split(m_name,", ") : m_desc = Split(m_desc,", ") : m_pic = Split(m_pic,", ")
For i = 0 To Ubound(id)
Dvbbs.Execute("UPDATE Dv_Medal SET MedalName = '"&m_name(i)&"',MedalDesc = '"&m_desc(i)&"',MedalPic = '"&m_pic(i)&"' WHERE id = "&id(i))
Next
ReloadCache()
Response.Redirect "medal_index.asp?action=medal"
End If
End Sub
'删除奖项
Sub DelMedal()
If Not Dvbbs.Master Then ShowMsg "对不起,你不是管理员,不能进入管理页面!" : Exit Sub
Dim Id,Rs,Data,i,j,UserMedal(1),TyMedaled
Id = Trim(Request.QueryString("id"))
If isNumeric(Id) Then
Set Rs = Dvbbs.Execute("SELECT UserId,UserName,UserMedal FROM Dv_User WHERE TyMedaled=1")
If Not Rs.Eof Then
Data = Rs.GetRows(-1)
For i = 0 To Ubound(Data,2)
UserMedal(0) = Split(Data(2,i),",")
For j = 0 To Ubound(UserMedal(0))
If UserMedal(0)(j) <> Id Then
If UserMedal(1) = "" Then
UserMedal(1) = UserMedal(0)(j)
Else
UserMedal(1) = UserMedal(1) & "," & UserMedal(0)(j)
End If
End If
Next
TyMedaled=1
if UserMedal(1)="" then TyMedaled=0
Dvbbs.Execute("UPDATE Dv_User SET UserMedal = '"&UserMedal(1)&"',TyMedaled="&TyMedaled&" WHERE UserId = "&Data(0,i))
Next
End If
Rs.Close : Set Rs = Nothing
Dvbbs.Execute("DELETE FROM Dv_Medal WHERE id = "&Id)
Dvbbs.Execute("DELETE FROM Dv_MedalLog WHERE MedalId = "&Id)
ReloadCache()
ShowMsg "操作成功!","medal_index.asp?action=medal"
Else
ShowMsg "请不要传递非法参数!","medal_index.asp?action=medal"
End If
End Sub
'颁发页面
Sub Award()
If Not Dvbbs.Master Then ShowMsg "对不起,你不是管理员,不能进入管理页面!" : Exit Sub
Dim Html,Options,Rs
Set Rs = Dvbbs.Execute("SELECT id,MedalName FROM Dv_Medal")
Do While Not Rs.Eof
Options = Options & ""
Rs.MoveNext
Loop
Rs.Close : Set Rs = Nothing
Html = ""
Response.Write Html
End Sub
'保存颁发
Sub SaveAward()
If Not Dvbbs.Master Then ShowMsg "对不起,你不是管理员,不能进入管理页面!" : Exit Sub
Dim Rs,UserName,MedalId,Desc,UserInfo,UserMedal(1),i,MedalName
UserName = Dvbbs.Checkstr(Dvbbs.iHtmlEncode(Request.Form("UserName")))
MedalId = Dvbbs.CheckNumeric(Request.Form("MedalId"))
Desc = Dvbbs.Checkstr(Dvbbs.iHtmlEncode(Request.Form("Desc")))
If UserName = "" Or MedalId = "" Or Desc = "" Then
ShowMsg "每一项都必须填写,请返回填写完整!","" : Exit Sub
End If
If isNumeric(MedalId) Then
MedalName = Dvbbs.Execute("SELECT MedalName FROM Dv_Medal WHERE id = "&MedalId)(0)
If MedalName = "" Or isNull(MedalName) Then
ShowMsg "不存在该奖项,请不要传递非法参数!","" : Exit Sub
End If
Set Rs = Dvbbs.Execute("SELECT UserId,UserName,UserMedal FROM Dv_User WHERE UserName = '"&UserName&"'")
If Not Rs.Eof Then
UserInfo = Rs.GetRows(1)
If UserInfo(2,0) <> "" Then
UserMedal(0) = Split(UserInfo(2,0),",")
UserMedal(1) = UserInfo(2,0)
For i = 0 To Ubound(UserMedal(0))
If CLng(UserMedal(0)(i)) = CLng(MedalId) Then
ShowMsg ""&UserName&" 已经拥有该勋章,不能重复颁发!","" : Exit Sub
End If
Next
UserMedal(1) = UserMedal(1) & "," & MedalId
Else
UserMedal(1) = MedalId
End If
Dvbbs.Execute("UPDATE Dv_User Set UserMedal = '"& UserMedal(1) &"',TyMedaled=1 WHERE UserId = "&UserInfo(0,0))
Dvbbs.Execute("INSERT INTO Dv_MedalLog (UserId,UserName,MedalId,AwardUser,AwardDesc) VALUES ("&UserInfo(0,0)&",'"&UserInfo(1,0)&"',"&MedalId&",'"&Dvbbs.MemberName&"','"&Desc&"')")
ShowMsg "勋章 "&MedalName&" 已经成功颁发给 "&UserName&"","medal_index.asp?action=awardlog"
Else
ShowMsg "不存在该用户,请返回检查您的输入是否正确!",""
End If
End If
End Sub
'颁发日志
Sub AwardLog()
If Not Dvbbs.Master Then ShowMsg "对不起,你不是管理员,不能进入管理页面!" : Exit Sub
Dim Html,Rs,Data,i,UserName,Sql
Dim Page,Url,TotalCount,PageSize,TotalPage,StarNum,EndNum
Page = 1 : TotalCount = 1 : PageSize = 1
UserName = Dvbbs.Checkstr(Dvbbs.iHtmlEncode(Request.QueryString("u")))
Html = ""
Html = Html & "
颁发记录
"
hTML = Html & "
获奖者
勋章名称
颁发者
颁发原因
颁发时间
操作
"
If UserName <> "" Then
Url = "action=awardlog&u="&UserName
Sql = "SELECT L.*,M.MedalName,M.MedalPic,M.id FROM Dv_MedalLog L,Dv_Medal M WHERE L.MedalId = M.Id AND L.UserName = '"&UserName&"' ORDER BY L.id DESC"
Else
Url = "action=awardlog"
Sql = "SELECT L.*,M.MedalName,M.MedalPic,M.id FROM Dv_MedalLog L,Dv_Medal M WHERE L.MedalId = M.Id ORDER BY L.id DESC"
End If
Set Rs = Dvbbs.Execute(Sql)
If Not Rs.Eof Then
Data = Rs.GetRows(-1)
'---分页设置---
TotalCount = Ubound(Data,2) + 1
PageSize = 10
TotalPage = Int(TotalCount / PageSize)
Page = Clng(Request.QueryString("page"))
If TotalPage = 0 Then TotalPage = 1
If PageSize * TotalPage < TotalCount Then TotalPage = TotalPage + 1
If Not isNumeric(Page) Or Page="" Or Page < 1 Then Page = 1
If Page > TotalPage Then Page = TotalPage
StarNum = (Page-1) * PageSize
EndNum = Page * PageSize
If EndNum > TotalCount Then EndNum = TotalCount
For i = StarNum To EndNum - 1
Html = Html & "
"
Response.write Html
End Sub
'收回勋章
Sub ReAward()
If Not Dvbbs.Master Then ShowMsg "对不起,你不是管理员,不能进入管理页面!" : Exit Sub
Dim UserId,MedalId,LogId,Rs,UserInfo,UserMedal(1),i,TyMedaled
UserId = Request("uid") : MedalId = Request("mid") : LogId = Request("lid")
If Not (isNumeric(UserId) And isNumeric(MedalId) And isNumeric(LogId)) Then
ShowMsg "参数错误,请不要尝试传递非法参数!","" : Exit Sub
End If
Set Rs = Dvbbs.Execute("SELECT UserId,UserName,UserMedal,TyMedaled from Dv_User WHERE UserId = "&Clng(UserId))
If Not Rs.Eof Then
UserInfo = Rs.GetRows(1)
UserMedal(0) = Split(UserInfo(2,0),",")
TyMedaled=0
For i = 0 To Ubound(UserMedal(0))
If UserMedal(0)(i) <> MedalId Then
If UserMedal(1) = "" Then
UserMedal(1) = UserMedal(0)(i)
Else
UserMedal(1) = UserMedal(1) & "," & UserMedal(0)(i)
End If
End If
Next
if UserMedal(1)<>"" then TyMedaled=1
Dvbbs.Execute("UPDATE Dv_User SET UserMedal = '"&UserMedal(1)&"',TyMedaled="&TyMedaled&" WHERE UserId = "&Clng(UserId))
Dvbbs.Execute("DELETE FROM Dv_MedalLog WHERE id = "&Clng(LogId))
ShowMsg "成功收回 "&UserInfo(1,0)&"的勋章!","medal_index.asp?action=awardlog"
Else
ShowMsg "用户不存在!",""
End If
End Sub
Sub ReloadCache()
Dim Rs
Set Rs = Dvbbs.Execute("SELECT id,MedalName,MedalPic,MedalDesc FROM Dv_Medal")
Dvbbs.RemoveCache()
If Not Rs.Eof Then
Dvbbs.Value = Rs.GetRows(-1)
Else
Dvbbs.Value = ""
End If
Rs.Close : Set Rs = Nothing
End Sub
Sub ShowMsg(Msg,url)
Dim Html
Html = "
提示信息
"&Msg&"
"
Else
Html = Html & "javascript:window.location='"&url&"'"" value='点击返回' />