www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/adminhtry/admin_wss.asp

    <!--#include file="setup.asp"-->
<!--#include file="check.asp"-->
<!--#include file="../inc/md5.asp"-->
<%
Admin_header
'=====================================================================
' 软件名称:新云网站管理系统
' 当前版本:NewAsp Site Management System Version 3.1
' 文件名称:admin_wss.asp
' 更新日期:2008-01-12
' 官方网站:新云网络(www.newasp.net www.newasp.cn) QQ:94022511
'=====================================================================
' Copyright 2003-2008 newasp.net - All Rights Reserved.
' newasp is a trademark of newasp.net
'=====================================================================
Dim Action
If Not ChkAdmin("9999") Then
	Server.Transfer("showerr.asp")
	Response.End
End If
Action = LCase(Request("action"))
Select Case Trim(Action)
	Case "save"
		Call savewss
	Case Else
		Call showmain
End Select
If FoundErr = True Then
	ReturnError(ErrMsg)
End If
Admin_footer
SaveLogInfo(AdminName)
CloseConn
Sub showmain()
Dim Wss_IsUsed,Wss_SiteID,Wss_PassWord,Wss_Domain,Wss_Key
If Len(NewAsp.Wss_Domain) < 3 Then
	Wss_Domain = Request.ServerVariables("SERVER_NAME")
Else
	Wss_Domain = NewAsp.Wss_Domain
End If
If Len(NewAsp.Wss_SiteID) < 3 Then
	Wss_SiteID = ""
Else
	Wss_SiteID = NewAsp.Wss_SiteID
End If
If Len(NewAsp.Wss_PassWord) < 3 Then
	Wss_PassWord = ""
Else
	Wss_PassWord = NewAsp.Wss_PassWord
End If
%>
<table border="0" align="center" cellpadding="3" cellspacing="1" class="TableBorder">
<form name="myform" method="post" action="?action=save">
<tr>
	<th colspan="2">WSS流量统计设置</th>
</tr>
<tr>
	<td class="TableRow1" width="20%" align="right"><u>WSS统计域名</u>:</td>
	<td class="TableRow1" width="80%"><input type="text" name="Wss_Domain" size="35" value="<%=Wss_Domain%>"> 
		<font color="red">* </font>
	</td>
</tr>
<tr>
	<td class="TableRow2" align="right"><u>WSS统计站点ID</u>:</td>
	<td class="TableRow2"><input type="text" name="Wss_SiteID" size="35" value="<%=Wss_SiteID%>"> 
		<font color="red">* 如果你已经注册过WSS请输入你的站点ID</font>
	</td>
</tr>
<tr>
	<td class="TableRow1" align="right"><u>WSS统计登录密码</u>:</td>
	<td class="TableRow1"><input type="text" name="Wss_PassWord" size="35" value="<%=Wss_PassWord%>"> 
		<font color="red">* 如果你已经注册过WSS请输入你的登录密码</font>
	</td>
</tr>
<tr>
	<td class="TableRow2" align="right"><u>是否开启WSS统计功能</u>:</td>
	<td class="TableRow2">
	<input type="radio" name="wss_isused" value="0"<%
	If NewAsp.Wss_IsUsed=0 Then Response.Write " checked"
	%>> 关闭&nbsp;&nbsp;
	<input type="radio" name="wss_isused" value="1"<%
	If NewAsp.Wss_IsUsed=1 Then Response.Write " checked"
	%>> 开启&nbsp;&nbsp;
	</td>
</tr>
<tr>
	<td class="TableRow1" align="right"><u>申请WSS统计</u>:</td>
	<td class="TableRow1"><input type="checkbox" name="apply" value="1"/> 
		<font color="red">* 如果你是第一次申请请选择</font>
	</td>
</tr>
<tr>
	<td class="TableRow2" align="right"></td>
	<td class="TableRow2">
	<input type="submit" value="保存设置" name="B1" class="Button"></td>
</tr>
</form>
<tr>
	<td class="TableRow1" colspan="2"><b>说明</b><br/>&nbsp;&nbsp;<a href="http://intf.cnzz.com/" target="_blank">WSS</a> 一直致力于精确时实的网站流量统计分析,并且通过不断的努力为贵网站提供更快速、更直观、更准确的统计服务。<br/><br/>
	<b>申请失败情况下错误代码:</b><br/>
&nbsp;&nbsp;-1 表示key有误(<a href="http://bbs.newasp.net" target="_blank">请联系我们</a>),<br/>
&nbsp;&nbsp;-2 表示该域名长度有误(1~64),<br/>
&nbsp;&nbsp;-3 表示域名输入有误(比如输入汉字),<br/>
&nbsp;&nbsp;-4 表示域名插入数据库有误(<a href="http://bbs.newasp.net" target="_blank">请联系我们</a>),<br/>
&nbsp;&nbsp;-5 表示同一个IP用户调用页面超过阀值,阀值暂定为10。
</td>
</tr>
<%
If NewAsp.Wss_IsUsed=1 And Len(NewAsp.Wss_Domain)>3 And Len(NewAsp.Wss_SiteID)>3 And Len(NewAsp.Wss_PassWord)>3 Then
%>
<tr>
	<td class="TableRow2" align="right"><u>统计代码</u>:</td>
	<td class="TableRow2">
	<textarea name="wsscode" rows="3" cols="70">&lt;script src='http://pw.cnzz.com/c.php?id=<%=NewAsp.Wss_SiteID%>&l=2' language='JavaScript' charset='gb2312'&gt;&lt;/script&gt;</textarea>
	</td>
</tr>
<%
End If
%>
</table>
<%

End Sub

Sub savewss()
	If Len(Request.Form("wss_domain")) < 3 Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>您的域名输入错误!</li>"
		Exit Sub
	End If
	Dim XmlDoc,XmlNode,Xml_Files
	Dim apply : apply = NewAsp.ChkNumeric(Request.Form("apply"))
	Xml_Files = "../inc/newasp.config"
	Xml_Files = Server.MapPath(Xml_Files)
	Set XmlDoc = Server.CreateObject("Msxml2.FreeThreadedDOMDocument" & MsxmlVersion)
	If XmlDoc.Load(Xml_Files) Then
		Set XmlNode = XmlDoc.documentElement.selectSingleNode("rs:data/z:row[@id=0]")
		If apply = 0 Then
			XmlNode.attributes.getNamedItem("wss_siteid").text = NewAsp.CheckStr(Trim(Request.Form("wss_siteid")))
			XmlNode.attributes.getNamedItem("wss_password").text = NewAsp.CheckStr(Trim(Request.Form("wss_password")))
		Else
			If Len(Request.Form("wss_domain")) > 3 Then
				Dim strWssData
				Dim strURL,strDomain,strKey
				strDomain = NewAsp.CheckStr(Trim(Request.Form("wss_domain")))
				md5type = 32
				strKey = Md5(strDomain&"Ba4KLoqS")
				strURL = "http://intf.cnzz.com/user/companion/newasp.php?domain="&strDomain&"&key=" & strKey
				strWssData = GetWssData(strURL)
				If InStr(strWssData,"@") > 0 Then
					Dim WssArray
					WssArray = Split(strWssData, "@")
					XmlNode.attributes.getNamedItem("wss_siteid").text = Trim(WssArray(0))
					XmlNode.attributes.getNamedItem("wss_password").text = Trim(WssArray(1))
				Else
					FoundErr = True
					ErrMsg = ErrMsg + "<li>申请WSS失败!</li>"
					If strWssData <> "" Then ErrMsg = ErrMsg + "<li>错误代码:" & strWssData & "</li>" & strKey
					Exit Sub
				End If
			End If
		End If
		XmlNode.attributes.getNamedItem("wss_isused").text = NewAsp.ChkNumeric(Request.Form("wss_isused"))
		XmlNode.attributes.getNamedItem("wss_domain").text = NewAsp.CheckStr(Trim(Request.Form("wss_domain")))
		XmlDoc.save Xml_Files
		Set XmlNode = Nothing
	End If
	Set XmlDoc = Nothing
	Succeed("<li>恭喜您!保存WSS设置成功。</li><script>parent.leftFrame.location='admin_left.asp';</script>")
End Sub
Function GetWssData(ByVal strURL)
	On Error Resume Next
	Dim xmlhttp,TextBody
	Set xmlhttp = Server.CreateObject("msxml2.ServerXMLHTTP")
	xmlhttp.setTimeouts 65000, 65000, 65000, 65000
	xmlhttp.Open "GET",strURL,false
	xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
	xmlhttp.send()
	'TextBody = strAnsi2Unicode(xmlhttp.responseBody)
	TextBody = xmlhttp.responseText
	Set xmlhttp = Nothing
	GetWssData = TextBody
End Function
Function strAnsi2Unicode(asContents)
	Dim len1,i,varchar,varasc
	strAnsi2Unicode = ""
	len1=LenB(asContents)
	If len1=0 Then Exit Function
	  For i=1 to len1
	  	varchar=MidB(asContents,i,1)
	  	varasc=AscB(varchar)
	  	If varasc > 127  Then
	  		If MidB(asContents,i+1,1)<>"" Then
	  			strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
	  		End If
	  		i=i+1
	     Else
	     	strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
	     End If	
	  Next
End Function
%>