<% '最后修改: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 & "" Next Else Html = Html & "" End If Rs.Close : Set Rs = Nothing Html = Html & "
    我的勋章
    勋章名称颁奖人获奖原因获奖时间
    "&Data(0,i)&""&Data(2,i)&""&Data(3,i)&""&Data(4,i)&"
    暂无勋章...

    " Html = Html & "
    " If IsArray(MedalData) Then For i = 0 To UBound(MedalData,2) Html = Html & "" Next End If Html = Html & "
    勋章列表
    图标名称说明
    "&MedalData(1,i)&""&MedalData(3,i)&"
    " 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) & ""&Medals(1,k)&" " Exit For End If Next Next Html = Html & "" 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 & "
    获奖名单
    用户勋章
    "&Users(1,i)&""&UserMedal(1)&"
    暂无...
    " Response.write Html End Sub '勋章管理 Sub Medal() If Not Dvbbs.Master Then ShowMsg "对不起,你不是管理员,不能进入管理页面!" : Exit Sub Dim Html,Rs,PicStr,i,Data,TyUsed Html = "
    " Set Rs = Dvbbs.Execute("SELECT Id,MedalName,MedalDesc,MedalPic FROM [Dv_Medal]") If Not Rs.Eof Then Data = Rs.GetRows(-1) For i = 0 To Ubound(Data,2) TyUsed=TyUsed&Data(3,i)&"," Html = Html & "" Next Html = Html & "" Else Html = Html & "" End If Rs.Close : Set Rs = Nothing For i = 1 to MedalPicNum PicStr = PicStr & " 0 then PicStr=PicStr & "disabled" PicStr = PicStr & " />  " Next Html = Html & "
    勋章管理
    编号奖项名称相关说明勋章图片图片演示操作
    删除
    暂无...

    添加奖项
    奖项名称
    奖项说明
    奖项图片"&PicStr&"
    " 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 & "" Next End If Html = Html & "
    颁发记录
    获奖者勋章名称颁发者颁发原因颁发时间操作
    "&Data(2,i)&" "&Data(7,i)&""&Data(4,i)&""&Data(5,i)&""&Data(6,i)&"收回勋章
    用户名:
    " 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='点击返回' />" End If Response.Write Html End Sub %>