📄 admin_user.asp
字号:
<!--#include file="../conn.asp"-->
<!--#include file="const.asp"-->
<!-- #include file="../inc/MD5.asp" -->
<%
Dim Admin_Class,Uid
Call Master_Us()
Uid = Cid(Request("uid"))
Header()
Admin_Class=",6,"
Call Master_Se()
team.SaveLog ("用户管理 [包括：编辑用户，添加用户 ，合并用户 ，审核用户 ，工资管理 ] ")
Select Case Request("action")
Case "adduser"
Call adduser
Case "adduserok"
Call adduserok
Case "setuser"
Call Setuser
Case "setuserok"
Call setuserok
Case "findmembers"
Call findmembers
Case "members"
Call members
Case "editgroups"
Call editgroups
Case "editgroupsok"
Call editgroupsok
Case "editcredits"
Call editcredits
Case "editcreditsok"
Call editcreditsok
Case "editmedals"
Call editmedals
Case "editmedalsok"
Call editmedalsok
Case "annonces"
Call annonces
Case "edituserexc"
Call edituserexc
Case "Activation"
Call Activation
Case "getmoney"
Call getmoney
Case "getmoneyok"
Call getmoneyok
Case Else
Call Master_Se()
Call Main()
End Select
Sub getmoneyok
Dim ho,newMembers,newWageMach,Gs
NewMembers = Cid(Request.Form("newMembers"))
NewWageMach = Cid(Request.Form("newWageMach"))
for each ho in request.form("wagid")
Team.execute("Delete from ["&Isforum&"Wages] Where id="&ho)
next
If Request.form("wagid")="" Then
If NewMembers ="" Then SuccessMsg " 组名称不能为空。"
If team.execute("Select Members from ["&Isforum&"Wages] where Members='"&NewMembers&"' ").Eof Then
Set Gs = team.execute("Select ID,GroupName From ["&IsForum&"UserGroup] Where ID = "& NewMembers)
If Not Gs.Eof Then
team.execute("insert into ["&Isforum&"Wages] (Members,WageMach,WageGroupID) values ('"&Gs(1)&"',"&NewWageMach&","&Gs(0)&") ")
End if
Gs.Close:Set Gs=Nothing
Else
SuccessMsg " 此用户组已经存在! "
End If
End if
SuccessMsg " 工资图表设置完成。 "
End Sub
Sub getmoney
%>
<br>
<br>
<body Style="background-color:#8C8C8C" text="#000000" leftmargin="10" topmargin="10">
<form method="post" action="?action=getmoneyok">
<table cellspacing="1" cellpadding="4" width="95%" align="center" class="a2">
<tr class="a1">
<td>技巧提示</td>
</tr>
<tr class="a4">
<td><br>
<ul>
<li>TEAM's 支持对各用户组发放工资，此功能需要在基本选项里面开启交易积分设置 。
<li>打开此功能后，系统将在每月的第一天自动发放工资（工资名称为交易积分设置值）到用户账户 。
</ul></td>
</tr>
</table>
<BR>
<table cellspacing="1" cellpadding="3" border="0" width="95%" align="center" class="a2">
<tr class="a1">
<td align="center" colspan="3">本月工资额度管理</td>
</tr>
<tr class="a3">
<td align="center" width="80"><input type="checkbox" name="chkall" onclick="checkall(this.form, 'wagid')" class="a3">删? </td>
<td align="center">组对象</td><td align="center">工资额度</td>
</tr>
<tbody <%if team.Forum_setting(96)=0 Then%>disabled<%end if%>>
<%
Dim Rs,WsValue,m
i = 0
Set Rs= team.execute("Select ID,Members,WageMach,WageGroupID From ["&Isforum&"Wages]")
If Rs.Eof Then
Echo "<tr class=""a4"" align=""center""><td colspan=""3"">目前没有需要的发放工资的组对象</td></tr>"
Else
Do While Not Rs.Eof
i = i+1
Echo "<tr class=""a4"" align=""center""> "
Echo " <td><input type=""checkbox"" name=""wagid"" value="""&Rs(0)&"""></td> <td bgcolor=""#F8F8F8""> "&Rs(1)&" </td><td bgcolor=""#FFFFFF"">"&Rs(2)&"</td></tr> "
Rs.MoveNext
Loop
End if
Rs.Close:Set Rs=Nothing %>
<tr><td colspan="3" class="a4" height="2"></td></tr>
<tr class="a4" align="center">
<td>新增:</td>
<td><select name="newMembers" style="width:100%">
<option value=""> 请选择用户组 </option>
<%
Dim Gs
Set Gs = team.execute("Select ID,GroupName From ["&IsForum&"UserGroup] Where ID<>5 and ID<>6 and ID<>7 and ID<>28 Order By ID DEsc")
Do While Not Gs.Eof
Echo "<option value="""&Gs(0)&""">"&Gs(1)&" </option> "
Gs.MoveNext
Loop
Gs.Close:Set Gs=Nothing
%>
</select></td>
<td><input type="text" name="newWageMach" size="20" value="100"></td>
</tr>
</tbody>
</table>
<br><center>
<input type="submit" name="medalsubmit" value="提 交" <%if team.Forum_setting(96)=0 Then%>disabled<%end if%>>
</center></form>
<%
End Sub
Sub Activation
SuccessMsg " 未授权版本无法使用此功能。 "
End Sub
Sub editmedalsok
Dim tmp,newid
If Uid = "" Or Not isNumeric(Uid) Then
SuccessMsg " 参数错误 "
Else
newid=Split(Replace(Request.Form("newid")," ",""),",")
For i=0 To Ubound(newid)
If CID(Request.Form("medals"&i))>0 Then
If Request.Form("reason"&i)&"" = "" Then
SuccessMsg "您必须输入授予理由。"
End if
tmp = tmp & CID(Request.Form("medals"&i)) &"&&&"&Request.Form("reason"&i) & "$$$"
End if
Next
team.Execute("Update ["&Isforum&"User] set Medals='"&tmp&"' Where ID= "& Uid )
end if
SuccessMsg " 用户的勋章设置完成。 "
End Sub
Sub editmedals
Dim Rs,Rs1,Medals,u,i,Medalsinfo,Medaltext,MyMedals
Dim SetMys,SetMsg
If Uid = "" Or Not isNumeric(Uid) Then
SuccessMsg " 参数错误 "
Else
Set Rs = team.execute("Select UserName,Medals From ["&Isforum&"User] Where ID="& Uid)
If Rs.Eof Then
SuccessMsg " 指定的用户不存在。 "
Else
Set Rs1=team.execute("Select ID,MedalName,Medalimg From ["&Isforum&"Medals] Where MedalSet=1 Order By ID asc")
If Rs1.Eof Then
SuccessMsg " 目前没有启用的勋章，请到 <A HREF=""Admin_Change.asp?action=medals"">勋章编辑</A> 功能中设定可用的勋章后再编辑。 "
Else
MyMedals = Rs1.GetRows(-1)
End If
Rs1.Close:Set Rs1=Nothing
Echo "<br><br> "
Echo "<body Style=""background-color:#8C8C8C"" text=""#000000"" leftmargin=""10"" topmargin=""10"">"
Echo "<form method=""post"" action=""?action=editmedalsok&uid="&UID&""">"
Echo "<table cellspacing=""1"" cellpadding=""4"" width=""95%"" align=""center"" class=""a2"">"
Echo "<tr class=""a1"">"
Echo " <td colspan=""4"">勋章编辑 - "&Rs(0)&"</td>"
Echo "</tr>"
Echo "<tr class=""a4"" align=""center"">"
Echo " <td>勋章图片</td><td>名称</td><td>授予该勋章</td><td>授勋理由</td>"
Echo "</tr>"
If IsArray(MyMedals) Then
For i = 0 To UBound(MyMedals,2)
Echo "<tr align=""center""><Input Name=""newid"" type=""hidden"" value="""&MyMedals(0,i)&""">"
Echo " <td bgcolor=""#F8F8F8""><img src=""../images/plus/"&MyMedals(2,i)&" "" align=""absmiddle""></td><td bgcolor=""#FFFFFF"">"&MyMedals(1,i)&"</td>"
SetMys = "" : SetMsg = ""
If InStr(RS(1),"$$$")>0 Then
Medals = Split(RS(1),"$$$")
for U = 0 to ubound(Medals)-1
Medalsinfo = Split(Medals(u),"&&&")
If int(Medalsinfo(0)) = MyMedals(0,i) Then
SetMys = "checked"
SetMsg = Medalsinfo(1)
End If
Next
End If
Echo "<td bgcolor=""#F8F8F8""><input type=""checkbox"" name=""medals"&i&""" class=""radio"" value="""&MyMedals(0,i)&""" "&SetMys&"><td bgcolor=""#FFFFFF""><textarea name=""reason"&i&""" rows=""5"" cols=""30"">"& SetMsg &"</textarea></td></td></tr> "
Next
End If
Echo "</table><BR><br><center>"
Echo "<input type=""submit"" name=""medalsubmit"" value=""提 交"">"
Echo "</center></form><br><br>"
End if
End if
Rs.Close:Set Rs=Nothing
End Sub
Sub editcreditsok
If Uid = "" Or Not isNumeric(Uid) Then
SuccessMsg " 参数错误 "
Else
Dim Exters,i
For i = 0 to 7
If i = 0 Then
Exters = "Extcredits"&i&"="&Cid(Request.Form("extcreditsnew"&i&""))&""
Else
Exters = Exters & ",Extcredits"&i&"="&Cid(Request.Form("extcreditsnew"&i&""))&""
End if
Next
team.execute("Update ["&Isforum&"User] Set "&Exters&" Where ID="& Uid)
End if
SuccessMsg " 积分设置完成 。"
End Sub
Sub editcredits
Dim Gs,Value,i,m,Rs,u,UserInfo
If Uid = "" Or Not isNumeric(Uid) Then
SuccessMsg " 参数错误 "
Else
Set Rs = team.execute("Select Extcredits0,Extcredits1,Extcredits2,Extcredits3,Extcredits4,Extcredits5,Extcredits6,Extcredits7,UserName,LevelName From ["&Isforum&"User] Where ID="& Uid)
If Rs.Eof Then
SuccessMsg " 指定的用户不存在。 "
Else
%>
<br>
<br>
<body Style="background-color:#8C8C8C" text="#000000" leftmargin="10" topmargin="10">
<table cellspacing="1" cellpadding="4" width="95%" align="center" class="a2">
<tr class="a1">
<td>技巧提示</td>
</tr>
<tr class="a4">
<td><br>
<ul>
<li>TEAM's 支持对用户 8 种扩展积分的设置，只有被启用的积分才允许您进行编辑。
<li>对用户的积分，奖励为正数，惩罚为负数 。
</ul></td>
</tr>
</table>
<br>
<form name="input" method="post" action="?action=editcreditsok&uid=<%=UID%>">
<table cellspacing="1" cellpadding="4" width="95%" align="center" class="a2">
<tr class="a1">
<td colspan="10">编辑用户积分 - <%=Rs(8)%>(<%=Split(RS(9),"||")(0)%>)</td>
</tr>
<tr class="a3" align="center">
<td width="14%">用户详细积分</td>
<%
Dim ExtCredits,ExtSort
ExtCredits= Split(team.Club_Class(21),"|")
For U=0 to Ubound(ExtCredits)
ExtSort=Split(ExtCredits(U),",")
Echo " <td bgcolor=""#F8F8F8""> "
If ExtSort(3)="1" Then
Echo ExtSort(0)
Else
Echo " ExtCredits"&U&" "
End if
Echo " </td> "
Next
Echo " </tr><tr align=""center"" class=""a4""><td bgcolor=""#F8F8F8""> N/A </td>"
For U=0 to Ubound(ExtCredits)
ExtSort=Split(ExtCredits(U),",")
Echo " <td bgcolor=""#F8F8F8""> <input name=""extcreditsnew"&u&""" type=""text"" size=""3"" "
If ExtSort(3)="1" Then
Echo " value="""&RS(u)&""""
Else
Echo " value=""N/A"" disabled "
End if
Echo " ></td> "
Next
%>
</tr>
</table>
<br>
<center>
<input type="submit" name="creditsubmit" value="提 交">
</center>
</form>
<% End if
End if
End Sub
Sub editgroupsok
If Uid = "" Or Not isNumeric(Uid) Then
SuccessMsg " 参数错误 "
Else
Dim SQL,tmp,UserInfo
If Ucase(Trim(Request.Form("olduser"))) <> Ucase(Trim(Request.Form("usernamenew"))) Then
team.execute("Update ["&Isforum&"User] Set UserName='"&Trim(Request.Form("usernamenew"))&"' Where ID="& Uid )
Team.Execute("Update ["&Isforum&"Forum] Set UserName='"&Trim(Request.Form("usernamenew"))&"' Where UserName='"&Trim(Request.Form("olduser"))&"'")
Set RS = team.execute("Select TableName from TableList")
If Rs.Eof Then
Team.Execute("Update ["&Isforum&"Reforum] Set UserName='"&Trim(Request.Form("usernamenew"))&"' Where UserName='"&Trim(Request.Form("olduser"))&"'")
Else
Do While Not Rs.Eof
Team.Execute("Update ["&Isforum&""&RS(0)&"] Set UserName='"&Trim(Request.Form("usernamenew"))&"' Where UserName='"&Trim(Request.Form("olduser"))&"'")
Rs.Movenext
Loop
End If
Rs.Close:Set Rs=nothing
Team.Execute("Update ["&Isforum&"message] Set author='"&Trim(Request.Form("usernamenew"))&"' Where author='"&Trim(Request.Form("olduser"))&"'")
Team.Execute("Update ["&Isforum&"message] Set incept=''"&Trim(Request.Form("usernamenew"))&"' Where incept='"&Trim(Request.Form("olduser"))&"'")
Team.Execute("Update ["&Isforum&"upfile] Set UserName='"&Trim(Request.Form("usernamenew"))&"' Where UserName='"&Trim(Request.Form("olduser"))&"'")
tmp = "用户 "&Trim(Request.Form("olduser"))&" 已经改名为 "&Trim(Request.Form("usernamenew"))&" "
End if
If Request.Form("clearquestion") = 1 Then
team.execute("Update ["&Isforum&"User] Set Question='',Answer='' Where ID="& Uid)
End if
If not IsValidEmail(Request.Form("emailnew")) Then
SuccessMsg "邮件地址错误"
Else
Dim passwordnew
passwordnew = Request.Form("passwordnew")
UserInfo = Request.Form("qqnew") &"|"& Request.Form("icqnew") &"|"& Request.Form("yahoonew") &"|"& Request.Form("msnnew") &"|"& Request.Form("taobao") &"|"& Request.Form("alibuy")
If passwordnew <> "" Then
team.execute("Update ["&Isforum&"User] Set UserPass='"&MD5(Request.form("passwordnew"),16)&"',UserGroupID ="&Cid(Request.Form("mygroups"))&",Posttopic="&Cid(Request.Form("postsnew"))&",Postrevert="&Cid(Request.Form("postsre"))&",Goodtopic="&Cid(Request.Form("digestpostsnew"))&",Usermail='"&team.Checkstr(Request.Form("emailnew"))&"',Userhome='"&team.Checkstr(Request.Form("sitenew"))&"',Userface='"&team.Checkstr(Request.Form("avatarnew"))&"',UserCity='"&team.Checkstr(Request.Form("locationnew"))&"',UserSex="&Cid(Request.Form("gendernew"))&",Honor='"&team.Checkstr(Request.Form("honor"))&"',Birthday='"&Request.Form("bdaynew")&"',Sign='"&HtmlEncode(Request.Form("signaturenew"))&"',Degree="&Cid(Request.Form("totalnew"))&",RegIP='"&team.Checkstr(Request.Form("regipnew"))&"',Regtime='"&Request.Form("regdatenew")&"',Landtime='"&Request.Form("lastvisitnew")&"',UserInfo='"&team.Checkstr(UserInfo)&"' Where ID="& Uid )
Else
team.execute("Update ["&Isforum&"User] Set UserGroupID = "&Cid(Request.Form("mygroups"))&",Posttopic="&Cid(Request.Form("postsnew"))&",Postrevert="&Cid(Request.Form("postsre"))&",Goodtopic="&Cid(Request.Form("digestpostsnew"))&",Usermail='"&team.Checkstr(Request.Form("emailnew"))&"',Userhome='"&team.Checkstr(Request.Form("sitenew"))&"',Userface='"&team.Checkstr(Request.Form("avatarnew"))&"',UserCity='"&team.Checkstr(Request.Form("locationnew"))&"',UserSex="&Cid(Request.Form("gendernew"))&",Honor='"&team.Checkstr(Request.Form("honor"))&"',Birthday='"&Request.Form("bdaynew")&"',Sign='"&HtmlEncode(Request.Form("signaturenew"))&"',Degree="&Cid(Request.Form("totalnew"))&",RegIP='"&team.Checkstr(Request.Form("regipnew"))&"',Regtime='"&Request.Form("regdatenew")&"',Landtime='"&Request.Form("lastvisitnew")&"',UserInfo='"&team.Checkstr(UserInfo)&"' Where ID="& Uid )
End if
If Cid(Request.Form("oldgroup")) <> Cid(Request.Form("mygroups")) Then
Call SetUserMamdber(Cid(Request.Form("mygroups")),Uid)
End if
End if
SuccessMsg tmp & "<BR> 用户信息更新成功。"
End if
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -