admin_server.asp

小游戏网站演示www.4399.io 拥有4万条游戏数据

	Response.Write " <tr>" & vbNewLine
	Response.Write " <td class=""TableRow1""height=24><U>服务器路径</U><BR>" & vbNewLine
	Response.Write " 可以使用HTML代码</td>" & vbNewLine
	Response.Write " <td class=""TableRow1"">" & vbNewLine
	Response.Write " <input type=""text"" name=""DownloadPath"" size=""60"" value="""
	Response.Write Rs_e("DownloadPath")
	Response.Write """>" & vbNewLine
	Response.Write " </td>" & vbNewLine
	Response.Write " </tr>" & vbNewLine
	Response.Write " <tr>" & vbNewLine
	Response.Write " <td height=30 class=""TableRow1""><U>所属类别</U></td>" & vbNewLine
	Response.Write " <td class=""TableRow1"">" & vbNewLine
	Response.Write " <select name=""servers"">" & vbNewLine
	Response.Write " <option value=""0"">做为主服务器分类</option>" & vbNewLine
	Response.Write " "
	SQL = "SELECT * FROM NC_DownServer WHERE ChannelID=" & ChannelID & " ORDER BY rootid,orders"
	Set Rs = Newasp.Execute(SQL)
	Do While Not Rs.EOF
		Response.Write "<option value=""" & Rs("downid") & """ "
		If Rs_e("parentid") = Rs("downid") Then Response.Write "selected"
		Response.Write ">"
		If Rs("depth") = 1 Then Response.Write "&nbsp;&nbsp;├ "
		If Rs("depth") > 1 Then
			For i = 2 To Rs("depth")
				Response.Write "&nbsp;&nbsp;│"
			Next
			Response.Write "&nbsp;&nbsp;├ "
		End If
		Response.Write Rs("DownloadName") & "</option>" & vbCrLf
		Rs.MoveNext
	Loop
	Rs.Close: Set Rs = Nothing
	Response.Write " </select> </td>" & vbNewLine
	Response.Write " </tr>" & vbNewLine
	Response.Write " <tr>" & vbNewLine
	Response.Write " <td height=30 class=""TableRow1""><U>使用下载服务器的权限</U></td>" & vbNewLine
	Response.Write " <td class=""TableRow1"">"
	Response.Write " <select name=""UserGroup"">" & vbNewLine
	Set RsObj = Newasp.Execute("SELECT GroupName,Grades FROM NC_UserGroup ORDER BY Groupid")
	Do While Not RsObj.EOF
		Response.Write Chr(9) & Chr(9) & "<option value=""" & RsObj("Grades") & """"
		If Rs_e("UserGroup") = RsObj("Grades") Then Response.Write " selected"
		Response.Write ">"
		Response.Write RsObj("GroupName")
		Response.Write "</option>" & vbCrLf
		RsObj.MoveNext
	Loop
	Set RsObj = Nothing
	Response.Write " </select> </td>" & vbNewLine
	Response.Write " </tr>" & vbNewLine
	Response.Write " <tr>" & vbNewLine
	Response.Write " <td height=24 class=""TableRow1""><U>下载所需点数</U></td>" & vbNewLine
	Response.Write " <td class=""TableRow1"">" & vbNewLine
	Response.Write " <input type=""text"" name=""DownPoint"" size=""10"" value='"
	Response.Write Rs_e("DownPoint")
	Response.Write "'>" & vbNewLine
	Response.Write "</td>" & vbNewLine
	Response.Write "</tr>" & vbNewLine
	Response.Write " <tr>" & vbNewLine
	Response.Write " <td class=""TableRow1""><U>是否直接显示下载地址</U></td>" & vbNewLine
	Response.Write " <td class=""TableRow1"">"
	Response.Write " <input type=radio name=isDisp value=""0"""
	If Rs_e("IsDisp") = 0 Then Response.Write "  checked"
	Response.Write "> 否&nbsp;&nbsp;"
	Response.Write " <input type=radio name=isDisp value=""1"""
	If Rs_e("IsDisp") = 1 Then Response.Write "  checked"
	Response.Write "> 是"
	Response.Write " </td>" & vbNewLine
	Response.Write " </tr>" & vbNewLine
	Response.Write " <tr>" & vbNewLine
	Response.Write " <td class=""TableRow1""><U>是否外部连接</U></td>" & vbNewLine
	Response.Write " <td class=""TableRow1"">"
	Response.Write " <input type=radio name=""IsOuter"" value=""0"""
	If Rs_e("IsOuter") = 0 Then Response.Write "  checked"
	Response.Write "> 否&nbsp;&nbsp;"
	Response.Write " <input type=radio name=""IsOuter"" value=""1"""
	If Rs_e("IsOuter") = 1 Then Response.Write "  checked"
	Response.Write "> 是&nbsp;&nbsp;"
	Response.Write " <input type=radio name=""IsOuter"" value=""2"""
	If Rs_e("IsOuter") = 2 Then Response.Write "  checked"
	Response.Write "> WEB迅雷专用下载地址&nbsp;&nbsp;"
	Response.Write " <input type=radio name=""IsOuter"" value=""3"""
	If Rs_e("IsOuter") = 3 Then Response.Write "  checked"
	Response.Write "> FLASHGET(快车)专用下载地址&nbsp;&nbsp;"
	Response.Write " <br><font color=""red"">注意：如果是外部连接，请在“服务器路径”中输入要转向的URL；<br>&nbsp;&nbsp;&nbsp;&nbsp;如果选择“迅雷或快车专用下载地址”，"
	Response.Write "请先注册<a href=""http://union.xunlei.com/"" target=""_blank""><font color=""blue"">迅雷联盟</font></a>|<a href=""http://union.flashget.com/"" target=""_blank""><font color=""blue"">快车联盟</font></a>，然后在<a href=""admin_config.asp""><font color=""blue"">基本设置</font></a>中输入相应的联盟ID</font></td>" & vbNewLine
	Response.Write " </tr>" & vbNewLine
	Response.Write " <tr>" & vbNewLine
	Response.Write " <td class=""TableRow1""height=24>&nbsp;</td>" & vbNewLine
	Response.Write " <td class=""TableRow1"">" & vbNewLine
	Response.Write " <input type=""submit"" name=""Submit"" class=button value=""保存修改"">" & vbNewLine
	Response.Write " </td>" & vbNewLine
	Response.Write " </tr>" & vbNewLine
	Response.Write " </table>" & vbNewLine
	Response.Write "</form>" & vbNewLine
	Set Rs_e = Nothing
End Sub
'================================================
'过程名：savenew
'作  用：保存新的服务器
'================================================
Sub savenew()
	Dim downid,rootid,ParentID
	Dim depth,orders,Maxrootid
	Dim strParent,neworders
	Dim DownloadPath,Server_Url
	
	On Error Resume Next
	'保存添加服务器信息
	If Request.Form("DownloadName") = "" Then
		ErrMsg = ErrMsg + "<br>" + "<li>请输入服务器名称。"
		FoundErr = True
		Exit Sub
	End If
	If Request.Form("servers") = "" Then
		ErrMsg = ErrMsg + "<br>" + "<li>请选择服务器。"
		FoundErr = True
		Exit Sub
	End If
	If Request.Form("DownloadPath") = "" Then
		ErrMsg = ErrMsg + "<br>" + "<li>服务器路径不能为空。"
		FoundErr = True
		Exit Sub
	End If
	Server_Url = Replace(Request.Form("DownloadPath"), "\", "/")
	If Right(Server_Url, 1) <> "/" Then
		DownloadPath = Server_Url
	Else
		DownloadPath = Server_Url
	End If
	Set Rs = CreateObject("adodb.recordset")
	If Request.Form("servers") <> "0" Then
		SQL = "SELECT rootid,downid,depth,orders,strparent FROM NC_DownServer WHERE downid=" & Request("servers")
		Rs.Open SQL, Conn, 1, 1
		rootid = Rs(0)
		ParentID = Rs(1)
		depth = Rs(2)
		orders = Rs(3)
		If depth + 1 > 2 Then
			ErrMsg = "<li>本系统限制最多只能有2级子服务器</li>"
			FoundErr = True
			Exit Sub
		End If
		strParent = Rs(4)
		Rs.Close
		neworders = orders
		SQL = "SELECT MAX(orders) FROM NC_DownServer WHERE ParentID=" & Request("servers")
		Rs.Open SQL, Conn, 1, 1
		If Not (Rs.EOF And Rs.BOF) Then
			neworders = Rs(0)
		End If
		If IsNull(neworders) Then neworders = orders
		Rs.Close
		Newasp.Execute ("UPDATE NC_DownServer SET orders=orders+1 WHERE orders>" & CInt(neworders) & "")
	Else
		SQL = "SELECT MAX(rootid) FROM NC_DownServer"
		Rs.Open SQL, Conn, 1, 1
		If Rs.BOF And Rs.EOF Then
			Maxrootid = 1
		Else
			Maxrootid = Rs(0) + 1
		End If
		If IsNull(Maxrootid) Then Maxrootid = 1
		Rs.Close
	End If
	If Maxrootid = 0 Then Maxrootid = 1
	
	SQL = "SELECT downid FROM NC_DownServer WHERE downid=" & Request("newdownid")
	Rs.Open SQL, Conn, 1, 1
	If Not (Rs.EOF And Rs.BOF) Then
		ErrMsg = "<li>您不能指定和别的服务器一样的序号。</li>"
		FoundErr = True
		Exit Sub
	Else
		downid = CLng(Request("newdownid"))
	End If
	Rs.Close
	
	SQL = "SELECT * FROM NC_DownServer"
	Rs.Open SQL, Conn, 1, 3
	Rs.AddNew
	If Request("servers") <> "0" Then
		Rs("depth") = depth + 1
		Rs("rootid") = rootid
		Rs("orders") = neworders + 1
		Rs("parentid") = Request.Form("servers")
		If strParent = "0" Then
			Rs("strparent") = Request.Form("servers")
		Else
			Rs("strparent") = strParent & "," & Request.Form("servers")
		End If
	Else
		Rs("depth") = 0
		Rs("rootid") = Maxrootid
		Rs("orders") = 0
		Rs("parentid") = 0
		Rs("strparent") = 0
	End If
	Rs("child") = 0
	Rs("downid") = Request.Form("newdownid")
	Rs("DownloadName") = Replace(Newasp.ChkFormStr(Request.Form("DownloadName")), "|", "")
	Rs("DownloadPath") = Replace(DownloadPath, "|", "")
	Rs("isDisp") = Request.Form("isDisp")
	Rs("UserGroup") = Request.Form("UserGroup")
	Rs("ChannelID") = Request.Form("ChannelID")
	Rs("DownPoint") = CLng(Request.Form("DownPoint"))
	Rs("isLock") = 0
	Rs("IsOuter") = Newasp.ChkNumeric(Request.Form("IsOuter"))
	Rs("selfont") = Trim(Request.Form("selfont"))
	Rs("AllDownHits") = 0
	Rs("DayDownHits") = 0
	Rs("HitsTime") = Now()
	Rs.Update
	Rs.Close
	If Request("servers") <> "0" Then
		If depth > 0 Then Newasp.Execute ("update NC_DownServer set child=child+1 where downid in (" & strParent & ")")
		Newasp.Execute ("update NC_DownServer set child=child+1 where downid=" & Request("servers"))
	End If
	SucMsg = "<li>服务器添加成功！</li>"
	Succeed (SucMsg)
	Set Rs = Nothing
End Sub
'================================================
'过程名：saveedit
'作  用：保存编辑
'================================================
Sub saveedit()
	Dim newdownid,Maxrootid,ParentID
	Dim depth,Child,strParent,rootid
	Dim iparentid,istrparent
	Dim trs,brs,mrs,k
	Dim nstrparent,mstrparent,ParentSql
	Dim boardcount,DownloadPath,Server_Url
	
	On Error Resume Next
	If CLng(Request("editid")) = CLng(Request("servers")) Then
		ErrMsg = "<li>所属服务器不能指定自己</li>"
		ReturnError (ErrMsg)
		Exit Sub
	End If
	Server_Url = Replace(Request.Form("DownloadPath"), "\", "/")
	If Right(Server_Url, 1) <> "/" Then
		DownloadPath = Server_Url
	Else
		DownloadPath = Server_Url
	End If
	Set Rs = CreateObject("adodb.recordset")
	SQL = "SELECT * FROM NC_DownServer WHERE downid=" & CLng(Request("editid"))
	Rs.Open SQL, Conn, 1, 3
	newdownid = Rs("downid")
	ParentID = Rs("parentid")
	iparentid = Rs("parentid")
	strParent = Rs("strparent")
	depth = Rs("depth")
	Child = Rs("child")
	rootid = Rs("rootid")
	If ParentID = 0 Then
		If CLng(Request("servers")) <> 0 Then
			Set trs = Newasp.Execute("select rootid from NC_DownServer where downid=" & Request("servers"))
			If rootid = trs(0) Then
				ErrMsg = "<li>您不能指定该服务器的下属服务器作为所属服务器</li>"
				FoundErr = True
				Exit Sub
			End If
		End If
	Else
		Set trs = Newasp.Execute("select downid from NC_DownServer where strparent like '%" & strParent & "%' and downid=" & Request("servers"))
		If Not (trs.EOF And trs.BOF) Then
			ErrMsg = "<li>您不能指定该服务器的下属服务器作为所属服务器</li>"
			FoundErr = True
			Exit Sub
		End If
	End If
	If ParentID = 0 Then
		ParentID = Rs("downid")
		iparentid = 0
	End If
	Rs("DownloadName") = Replace(Newasp.ChkFormStr(Request.Form("DownloadName")), "|", "")
	Rs("DownloadPath") = Replace(DownloadPath, "|", "")
	Rs("isDisp") = Request.Form("isDisp")
	Rs("UserGroup") = Request.Form("UserGroup")
	Rs("ChannelID") = Request.Form("ChannelID")
	Rs("DownPoint") = Newasp.CheckNumeric(Request.Form("DownPoint"))
	Rs("isLock") = 0
	Rs("IsOuter") = Newasp.ChkNumeric(Request.Form("IsOuter"))
	Rs("selfont") = Trim(Request.Form("selfont"))
	Rs.Update
	Rs.Close
	Set Rs = Nothing
	Set mrs = Newasp.Execute("select max(rootid) from NC_DownServer")
	Maxrootid = mrs(0) + 1
	If CLng(ParentID) <> CLng(Request("servers")) And Not (iparentid = 0 And CInt(Request("servers")) = 0) Then
		If iparentid > 0 And CInt(Request("servers")) = 0 Then
			Newasp.Execute ("update NC_DownServer set depth=0,orders=0,rootid=" & Maxrootid & ",parentid=0,strparent='0' where downid=" & newdownid)
			strParent = strParent & ","
			Set Rs = Newasp.Execute("select count(*) from NC_DownServer where strparent like '%" & strParent & "%'")
			boardcount = Rs(0)
			If IsNull(boardcount) Then
				boardcount = 1
			Else
				boardcount = boardcount + 1
			End If
			Newasp.Execute ("update NC_DownServer set child=child-" & boardcount & " where downid=" & iparentid)
			For i = 1 To depth
				Set Rs = Newasp.Execute("select parentid from NC_DownServer where downid=" & iparentid)
				If Not (Rs.EOF And Rs.BOF) Then
					iparentid = Rs(0)
					Newasp.Execute ("update NC_DownServer set child=child-" & boardcount & " where downid=" & iparentid)
				End If
			Next
			If Child > 0 Then
				i = 0
				Set Rs = Newasp.Execute("select * from NC_DownServer where strparent like '%" & strParent & "%'")
				Do While Not Rs.EOF
					i = i + 1
					mstrparent = Replace(Rs("strparent"), strParent, "")
					Newasp.Execute ("update NC_DownServer set depth=depth-" & depth & ",rootid=" & Maxrootid & ",strparent='" & mstrparent & "' where downid=" & Rs("downid"))
					Rs.MoveNext
				Loop
			End If
		ElseIf iparentid > 0 And CInt(Request("servers")) > 0 Then
			Set trs = Newasp.Execute("select * from NC_DownServer where downid=" & Request("servers"))
			strParent = strParent & ","
			Set Rs = Newasp.Execute("select count(*) from NC_DownServer where strparent like '%" & strParent & "%'")
			boardcount = Rs(0)
			If IsNull(boardcount) Then boardcount = 1
			Newasp.Execute ("update NC_DownServer set orders=orders + " & boardcount & " + 1 where rootid=" & trs("rootid") & " and orders>" & trs("orders") & "")
			Newasp.Execute ("update NC_DownServer set depth=" & trs("depth") & "+1,orders=" & trs("orders") & "+1,rootid=" & trs("rootid") & ",ParentID=" & Request("servers") & ",strparent='" & trs("strparent") & "," & trs("downid") & "' where downid=" & newdownid)
			i = 1
			SQL = "select * from NC_DownServer where strparent like '%" & strParent & "%' order by orders"
			Set Rs = Newasp.Execute(SQL)
			Do While Not Rs.EOF
				i = i + 1
				istrparent = trs("strparent") & "," & trs("downid") & "," & Replace(Rs("strparent"), strParent, "")
				Newasp.Execute ("update NC_DownServer set depth=depth+" & trs("depth") & "-" & depth & "+1,orders=" & trs("orders") & "+" & i & ",rootid=" & trs("rootid") & ",strparent='" & istrparent & "' where downid=" & Rs("downid"))