www.gusucode.com > cso中国seo优化html整站源码程序 > manage/query/yahoo.asp
<% wd=Request("d") If Request("s")="yahoos" Then YahooUrl="http://www.yahoo.cn/s?p=linkdomain%3A"&wd&"&pid=hp&v=web" Else YahooUrl="http://www.yahoo.cn/s?p=site%3A"&wd&"&pid=hp&v=web" End If TempStr= getHTTPPage(YahooUrl) dim YahooWebSite 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 YahooWebSite=match1.Value Next Set matches = Nothing Set reg = Nothing YahooWebSite=Replace(YahooWebSite,"找到相关网页","") YahooWebSite=Replace(YahooWebSite,"条,用时","") YahooWebSite=Replace(YahooWebSite,"约","") YahooWebSite=Replace(YahooWebSite,",","") YahooWebSite=Replace(YahooWebSite,"","") %> <html><head> <title><%=wd%>在Yahoo搜索引擎中的收录情况查询 | 中国站长之家 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-color:#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 YahooWebSite="" Then Response.Write "<a href=""http://search.cn.yahoo.com/search?p=site%3A"&wd&"&ei=UTF-8&meta=all"" target=""_blank""><font color=#FF3300><b>x</b></font></a>" Else Response.Write ("<a href=""http://search.cn.yahoo.com/search?p=site%3A"&wd&"&ei=UTF-8&meta=all"" target=""_blank"" title="""&YahooWebSite&" "&wd&""">"&YahooWebSite&"</a>") End If %> </div></body></html> <% Function getHTTPPage(Path) t = GetBody(Path) getHTTPPage=BytesToBstr(t,"UTF-8") 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 %>