同ip反查域名ASP代码分享

前两天想写一段同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