www.gusucode.com > cso中国seo优化html整站源码程序 > manage/query/baidu.asp
<% wd=Request("d") If Request("s")="baidus" Then BaiduUrl="http://www.baidu.com/s?wd=domain%3A"&wd&"&cl=3" Else BaiduUrl="http://www.baidu.com/s?wd=site%3A"&wd&"&cl=3" End If TempStr= getHTTPPage(BaiduUrl) dim BaiduWebSite set reg=new Regexp reg.Multiline=True reg.Global=Flase reg.IgnoreCase=true reg.Pattern="找到相关网页((.|\n)*?)篇,用时" Set matches = reg.execute(TempStr) For Each match1 in matches BaiduWebSite=match1.Value Next Set matches = Nothing Set reg = Nothing BaiduWebSite=Replace(BaiduWebSite,"找到相关网页","") BaiduWebSite=Replace(BaiduWebSite,"篇,用时","") BaiduWebSite=Replace(BaiduWebSite,"约","") BaiduWebSite=Replace(BaiduWebSite,",","") BaiduWebSite=Replace(BaiduWebSite,"","") %> <html><head> <title><%=wd%>在Baidu搜索引擎中的收录情况查询 | 义乌站长之家 173158.net</title> <meta name="robots" content="noindex,nofollow" /> <meta http-equiv="Content-Type" content="text/html; charset=gb2312" /> <meta content="Copyright 2007 173158.net" name="Copyright" /> <meta content="Hans He" name="Author"> <style type="text/css"> body{margin:0px;background:#DDD;FONT-FAMILY:"Arial","Helvetica","ans-serif";} A:link,A:visited { COLOR: #0066CC; FONT-SIZE: 12px; font-weight:bold;TEXT-DECORATION:underline;} A:active,A:hover{COLOR:#FF3300;FONT-SIZE: 12px; font-weight:bold;TEXT-DECORATION: underline;} </style> </head> <body> <div align="center"> <% If BaiduWebSite="" Then Response.Write "<a href=http://www.baidu.com/s?wd=site%3A"&wd&"&cl=3 target=_blank title='数据获取出错,请稍后重新查询! 173158.net'><font color=#FF3300><b>0</b></font></a>" Else If Request("s")="baidus" Then Response.Write ("<a href=""http://www.baidu.com/s?wd=domain%3A"&wd&"&cl=3"" target=""_blank"" title="""&BaiduWebSite&" "&wd&""">"&BaiduWebSite&"</a>") Else Response.Write ("<a href=""http://www.baidu.com/s?wd=site%3A"&wd&"&cl=3"" target=""_blank"" title="""&BaiduWebSite&" "&wd&""">"&BaiduWebSite&"</a>") End If End If %> </div></body></html> <% Function getHTTPPage(Path) t = GetBody(Path) getHTTPPage=BytesToBstr(t,"GB2312") End function Function GetBody(url) on error resume next Set Retrieval = CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Get", url, False, "", "" .Send GetBody = .ResponseBody End With Set Retrieval = Nothing End Function Function BytesToBstr(body,Cset) dim objstream set objstream = Server.CreateObject("ado"&"db.str"&"eam") objstream.Type = 1 objstream.Mode =3 objstream.Open objstream.Write body objstream.Position = 0 objstream.Type = 2 objstream.Charset = Cset BytesToBstr = objstream.ReadText objstream.Close set objstream = nothing End Function %>