<%@Language = VBScript CodePage=936%> <%Option Explicit%> <% '====================================================== '程序名称: QQ个性签名（心路历程）查看页 '作者: greensea | http://www.gsea.com.cn '完成于: 2007年8月17日 广西百色 ' '提醒：未经他人允许而查看对方的个性签名记录是不好的行为 '====================================================== '定义变量 Dim xmlhttp, NewElement, XMLDom, xslt Dim TotalPage, QQNumber, tmpQQNumber, CurrentPage, i Dim EmotionURL, result Dim XMLHttpError '设置文档头以避免IE认为这是标准XML文件，否则ASP执行出错的话IE会认为这是不合法的XML文件而导致页面无法显示 Response.ContentType = "text/html" EmotionURL = "http://e.cnc.qzone.qq.com/cgi-bin/cgi_emotion_indexlist.cgi?uin={$QQ}&emotionarchive={$page}" '获取QQ心路历程的地址 '获取信息并处理 '|-从 QueryString 获取数据 tmpQQNumber = Request.QueryString("qq") CurrentPage = Request.QueryString("page") '|-过滤QQ号码中的非数字字符 -->其实在提交的时候已经用JS做了限制，所以这个过滤是可有可无的 For i = 1 To Len(tmpQQNumber) If IsNumeric(Mid(tmpQQNumber, i, 1)) Then QQNumber = QQNumber & Mid(tmpQQNumber, i, 1) Next '|-过滤QQ号码的前导0（零） Do While Mid(QQNumber, 1, 1) = "0" QQNumber = Mid(QQNumber, 2, Len(QQNumber)) Loop 'L------------------------- '检查数据，如果QQ为空的话就创建一个XML文档，并通过XSLT解析后输出 If QQNumber = "" Then '首页 Set XMLDom = Server.CreateObject("Microsoft.XMLDOM") XMLDom.LoadXML("") Set xslt = Server.CreateObject("Microsoft.XMLDOM") xslt.Load(Server.MapPath("main.xslt")) '|-输出结果 result = XMLDom.transformNode(xslt.DocumentElement) result = Replace(result, "&", "&") result = Replace(result, "", "") Response.Write result Response.End End If '----------------------------首页部分结束------------------------------------------------ '--------------------------------获取心路历程部分----------------------------------------- '设置页码 If CurrentPage < -1 Or CurrentPage = "" Or CurrentPage = 0 Then CurrentPage = -1 End If CurrentPage = Int(CurrentPage) '创建XMLHTTP对象 EmotionURL = Replace(EmotionURL, "{$QQ}", QQNumber) EmotionURL = Replace(EmotionURL, "{$page}", CurrentPage) Set xmlhttp = Server.CreateObject("Microsoft.XMLHTTP") xmlhttp.open "GET", EmotionURL, False 'On Error Resume Next '容错，防止进行http请求时发生意外 '发送请求获取QQ空间的心路历程数据 xmlhttp.send Set XMLDom = xmlhttp.ResponseXML '返回一个XMLDOM对象 '错误处理（目前主要防止xmlhttp请求超时） If Err Then Set XMlDom = Server.CreateObject("Microsoft.XMLDOM") '发生错误的话则无法返回XMLDOM对象，因此需要创建一个 XMLDom.LoadXML("") '载入一个XML文件 Select Case Err.number Case &H800c0005 'xmlhttp请求失败的错误代码 XMLDom.getElementsByTagName("error")(0).Text = "获取心路历程失败了，请刷新页面再试一次。（连接到QQ空间超时）" Case Else XMLDom.getElementsByTagName("error")(0).Text = "发生未知错误，错误代码：0x" & Hex(Err.number) & "，错误描述：" & Err.description End Select XMLHttpError = True End If '判断此Q号是否开通了QQ空间或将心情保存到QQ空间 If XMLDom.getElementsByTagName("error").Length <> 0 And Not XMLHTTPError Then XMLDom.getElementsByTagName("error")(0).Text = "这个QQ还没有开通QQ空间呢，或者是他/她的空间设置了访问限制，或者是他/她没有写过个性签名。" End If '如果有错误则加上QQ号 If XMLDom.getElementsByTagName("error").Length <> 0 Then Set NewElement = XMLDom.CreateElement("QQNumber") '创建一个名为QQNumber的节点 NewElement.Text = QQNumber '设置QQNumber节点的文本 XMLDom.DocumentElement.AppendChild(NewElement) '在error节点插入QQNumber节点 End If '通过XSLT转换 '|-首先插入QQ号码 If XMLDom.GetElementsByTagName("rss").Length > 0 Then Set NewElement = XMLDom.CreateElement("QQNumber") NewElement.Text = QQNumber XMLDom.GetElementsByTagName("rss")(0).AppendChild(NewElement) End If '|-进行xslt转换 Set xslt = Server.CreateObject("Microsoft.XMLDOM") '创建一个新的XMLDOM对象用来载入XSLT文件 xslt.Load(Server.MapPath("main.xslt")) '载入XSLT文件 '|-输出结果 result = XMLDom.TransformNode(xslt.DocumentElement) result = (Replace(result, "&", "&")) '用XSLT对XMLDom进行转换，并将转换结果的 & 替换为 & result = Replace(result, "", "") '因为从QQ返回的数据里面 < > & 是经过HTMLEncode的，而进行XSLT以后又会进行一次HTMLEncode，因此这里要把在XSLT转换中被替换成 & 的 & 替换回来，这样才能正确显示签名中的HTML字符 Response.Write result '调试用的 = =|| 'Response.Clear 'Response.Write XMLDOM.xml %>