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" %>> 关闭 <input type="radio" name="wss_isused" value="1"<% If NewAsp.Wss_IsUsed=1 Then Response.Write " checked" %>> 开启 </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/> <a href="http://intf.cnzz.com/" target="_blank">WSS</a> 一直致力于精确时实的网站流量统计分析,并且通过不断的努力为贵网站提供更快速、更直观、更准确的统计服务。<br/><br/> <b>申请失败情况下错误代码:</b><br/> -1 表示key有误(<a href="http://bbs.newasp.net" target="_blank">请联系我们</a>),<br/> -2 表示该域名长度有误(1~64),<br/> -3 表示域名输入有误(比如输入汉字),<br/> -4 表示域名插入数据库有误(<a href="http://bbs.newasp.net" target="_blank">请联系我们</a>),<br/> -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"><script src='http://pw.cnzz.com/c.php?id=<%=NewAsp.Wss_SiteID%>&l=2' language='JavaScript' charset='gb2312'></script></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 %>