前两天想写一段同ip反查域名的代码,在很多网站上找了半天,最后在一个英文站上看见可以通过live.com的搜索结果提取此类信息,于是写了下面一段:程序只是测试成功,没有进行优化,查询效率有点低!
<%
Dim strPage
Function GetPage2(Path)
t = GetBody(Path)
GetPage2=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("adodb.stream")
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
Public Function GetDomain(TempStr,matchstr)
set reg=new Regexp
reg.Multiline=True
reg.Global=True
reg.IgnoreCase=true
reg.Pattern=matchstr
Set matches = reg.execute(TempStr)
For Each match in matches
if not instr(GetDomain,match.Value)>0 then
GetDomain=GetDomain&match.Value
end if
Next
End Function
dim i
for i=1 to 15
strPage=strPage&GetPage2("http://cnweb.search.live.com/results.aspx?q=ip%3A59.54.54.167&first="&i&"1")
next
strPage=GetDomain(strPage,"<cite>(.*?)\/")
strPage=replace(strPage,"<cite>","<li class=classli>")
strPage=replace(strPage,"</","</")
strPage=replace(strPage,"/","</li>")
strPage=replace(strPage,"<<","<")
strPage=GetDomain(strPage,"<li(.*?)\/li>")
response.write strPage
%>
来自:www.cnwebmaster.info演示:http://www.cnwebmaster.info/tool/tip.asp(临时演示地址)
提示“网站综合信息查询工具”本人正在开发!届时你只需要输入一个域名将得到很多有关于这个域名的信息!不需要象有些网站一样,查个东西需要输入很多次!
交流请联系QQ:39100642