<%
Response.Expires =-1
Response.AddHeader "Cache-control", "No-cache"
Response.AddHeader "Pragma", "No-cache"
Wd=request ("D")
If Request ("s") = "Googles" Then
googleurl= "Http://www.google.cn/search"? hl=zh-cn&q=link%3a "&WD
Else
googleurl=" Http://www.google.cn/search?hl=zh-CN&q=site%3A " &WD
End If
tempstr= gethttppage (googleurl)
Dim googlewebsite
Set Reg=new Regexp
Reg. Multiline=true
Reg. Global=flase
Reg. Ignorecase=true
Reg. Pattern= "Get about <b> (. | N) *?) </b> results "
Set matches = Reg.execute (TEMPSTR)
for each match1 in matches
Googlewebsite=match1. Value
Next
Set matches = Nothing
Set reg = Nothing
Googlewebsite=replace (Googlewebsite, "Get about <b>", ""
Googlewebsite=replace (Googlewebsite, "</b> results", "")
Googlewebsite=replace (Googlewebsite, ",", "")
Googlewebsite=replace (Googlewebsite, "", "")
If googlewebsite= "" Then
If Request ("s") = "Googles" Then
Response.Write ("document.write" "<a href= ' Http://www.google.cn/search?"
hl=zh-cn&q=link%3a "&wd&" ' target= ' _blank ' title= ' data acquisition error, please requery later
! ' ><font color= #999999 ><b>x</b></font></a> '); "
Else
Response.Write ("document.write" "<a href= ' Http://www.google.cn/search?"
hl=zh-cn&q=site%3a "&wd&" ' target= ' _blank ' title= ' data acquisition error, please requery later
! ' ><font color= #999999 ><b>x</b></font></a> '); "
End If
Else
If Request ("s") = "Googles" Then
Response.Write ("document.write" "<a href= ' Http://www.google.cn/search?"
hl=zh-cn&q=link%3a "&wd&" ' target= ' _blank '
Title= ' "&GoogleWebSite&" & #10; " &wd& "' Rel=nofollow
Class=ln> "&GoogleWebSite&" </a> "");
Else
Response.Write ("document.write" "<a href= ' Http://www.google.cn/search?"
hl=zh-cn&q=site%3a "&wd&" ' target= ' _blank '
Title= ' "&GoogleWebSite&" & #10; " &wd& "' Rel=nofollow
Class=ln> "&GoogleWebSite&" </a> "");
End If
End If
Function Gethttppage (Path)
t = GetBody (Path)
Gethttppage=bytestobstr (T, "Utf-8")
End Function
Function getbody (URL)
On Error Resume Next
& nbsp; 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 ' 1-binary, 2-text data type
objstream. mode = 3 ' n read, 2-write, 3-read/write read/write mode
objstream. Open
objstream. Write body
objstream. Position = 0
objstream. Type = 2
objstream. Charset = Cset
bytestobstr = objstream. ReadText
objstream. Close
Set objstream = no
end Function
%>