📄 pr_action.asp
字号:
url="http://panda.www.net.cn/cgi-bin/Whois.cgi?domain="&str1(0)&"&"&domain&"=yes"
'我晕．万网不支持 asphttp
'If IsObjInstalled("AspHTTP.Conn")=true Then
'str= getaspHTTPPage(url)
'else
str= getHTTPPage(url)
'End if
if str="" then
Call Error(4)
else
set reg=new Regexp
reg.Multiline=True
reg.Global=False
reg.IgnoreCase=true
str_top="<!-- start -->"
str_bottom="<!-- end -->"
reg.Pattern=""&str_top&"((.|\n)*?)"&str_bottom&""
Set matches = reg.execute(str)
For Each match1 in matches
str=match1.Value
Next
Set matches = Nothing
Set reg = Nothing
response.write "<table width=95% border=0 align=center cellpadding=0 cellspacing=0><tr><td><BR>"
response.write str
response.write "</td></tr></table> "
response.write "<a href="&url&" target=_blank><font color=#cc0000>点击查看详细信息</font></a>"
end if
response.write "</body></html>"
End Sub
'// <summary>
'// 百度GG关键词排行
'// Url="http://www.yourdomain.com/"
'// Url="http://www.baidu.com/s?lm=0&si=&rn=100&ie=gb2312&ct=0&wd=关键词&pn=10&cl=3" 百度
'// Url="http://www.google.com/search?hl=zh-CN&inlang=zh-CN&ie=GB2312&oe=GB2312&newwindow=1&q="&arrKey(i)&"" Google
'// </summary>
Sub keys(str)
call print_do("key")
str_=str
url="http://www."&str
If IsObjInstalled("AspHTTP.Conn")=true Then
str= getaspHTTPPage(url)
else
str= getHTTPPage(url)
End if
if str="" then
Call Error(4)
else
'//得到关键词 网站必需 放置 <meta name="keywords" content="关键词1,关键词2">
set reg=new Regexp
reg.Multiline=True
reg.Global=False
reg.IgnoreCase=true
str_top="<meta name=""keywords"" content="""
str_bottom=""">"
reg.Pattern=""&str_top&"((.|\n)*?)"&str_bottom&""
Set matches = reg.execute(str)
For Each match1 in matches
str=match1.Value
Next
str = reg.Replace(str,"$1")
Set matches = Nothing
Set reg = Nothing
'//得到关键词之后
'//如果是禁止访问的，表示是地方网站，如某个市的地方电影站，禁止我这台服务器访问的话，就显示错误
'//下载之后，放在本市的服务器上就可以了。
if instr(str,"HTTP 错误 403.6")>0 then
response.write "<BR><ul><li>HTTP 错误 403.6 - 禁止访问：客户端的 IP 地址被拒绝</li></ul>"
response.write "</body></html>"
response.end()
end if
'//如果域名已经有了，但是没有放置具体的页面，提示错误
if instr(str,"Directory Listing Denied")>0 then
response.write "<BR><ul><li>Directory Listing Denied 没有选择默认页</li></ul>"
response.write "</body></html>"
response.end()
end if
'//需增加 [以下功能]
'// * 如果没有这个域名
'// * 如果页面没有找到 404错误
'//如果得不到关键词，则提示错误
if len(str)<3 then
Response.write "<BR> 你的网站关键词放置有误,下面是相关提示<ul><li>请不要放在 JS包函文件里，这样对搜索非常不利<li>属性之间用双引号隔开<li>关键词之间用 , 逗号分开，注意用英文符号<li>下面为正确语法：<meta name=""keywords"" content=""关键词1,关键词2""> </ul>"
response.write "</body></html>"
response.end()
end if
'//输出关键词，提示 百度跟GG的链接，增加锚点，使快速达到所去的地方
response.write "您的网站(www."&str_&")关键词为：<BR><font color=blue>"&str&"</font><BR><a href=#baidu>百度</a> <a href=#GG>Google</a><BR>"
'// 去除 、，\ 等不规范符号
'str=replace(replace(replace(str,"、",","),"，",","),"\",",")
str=replace(replace(replace(str,"、",","),"，",",")," ","")
'//得到关键词数组，得到关键词数量
arrKey=split(str,",")
num=ubound(arrKey)
str=""
'//得到正确的关键词字符串
for i=0 to num
str=str&"||"&arrKey(i)
next
'//百度收录开始
'//输出锚点 baidu
Response.write "<a name=baidu></a>"
for i=0 to num
'//每个关键词查询
Url="http://www.baidu.com/s?lm=0&si=&rn=100&ie=gb2312&ct=0&wd="&arrKey(i)&"&pn=0&cl=3"
str_2=getinfo_baidu(Url,str_,arrKey(i))
'//没有被收录
if str_2="" then
response.write "<font color=red>您网站所放的关键词: <a href=http://www.baidu.com/s?lm=0&si=&rn=100&ie=gb2312&ct=0&wd="&arrKey(i)&"&pn=0&cl=3 target=_blank><font color=blue>"&arrKey(i)&"</font></a> 在百度搜索前五页都没有找到，看来是失败的!</font><BR>"
else
'//收录则显示 出现的位置
str_2=left(str_2,len(str_2)-2)
str_2=replace(str_2,"||","<li>")
response.write "<ul>"&str_2&"</ul>"
end if
next
'//百度收录结束
Response.write "<BR>------------------------------Baidu End Google Start------------------------------<BR><BR>"
'//GG收录开始
'//输出锚点 GG
Response.write "<a name=GG></a>"
Str_2=""
for i=0 to num
url = "http://www.google.com/search?hl=zh-CN&inlang=zh-CN&ie=GB2312&oe=GB2312&newwindow=1&start=0&q="&arrKey(i)&""
Str_2 = getinfo_GG(Url,str_,arrKey(i))
'//没有被收录
if str_2="" then
response.write "<font color=red>您网站所放的关键词: <a href='http://www.google.com/search?hl=zh-CN&inlang=zh-CN&ie=GB2312&oe=GB2312&newwindow=1&q="&arrKey(i)&"' target=_blank><font color=blue>"&arrKey(i)&"</font></a> 在Google搜索前五页都没有找到，看来是失败的!</font><BR>"
else
'//收录则显示 出现的位置
str_2=left(str_2,len(str_2)-2)
str_2=replace(str_2,"||","<li>")
response.write "<ul>"&str_2&"</ul>"
end if
next
end if
response.write "</body></html>"
End Sub
'// <summary>
'// 去百度搜索关键词
'// </summary>
function getinfo_baidu(url,siteurl,sk)
If IsObjInstalled("AspHTTP.Conn")=true Then
str= getaspHTTPPage(url)
else
str= getHTTPPage(url)
End if
'//如果所查域名出现在查询结果时
if instr(str,siteurl)>0 then
set reg=new Regexp
reg.Multiline=True
reg.Global=True
reg.IgnoreCase=true
str_top="<p class=p1>"
str_bottom="上的更多结果"
reg.Pattern=""&str_top&"((.|\n)*?)"&str_bottom&""
Set matches = reg.execute(str)
str1=""
For Each match1 in matches
str1=str1&"||"&match1.Value
Next
'//得到 百度 搜索结果的 字符串,使用正则的好处
arrStr=split(str1,"||")
showlog="在百度搜索到关键词为 <a href=http://www.baidu.com/s?lm=0&si=&rn=100&ie=gb2312&ct=0&wd="&sk&"&pn=0&cl=3 target=_blank>["&sk&"]</a>,共找到 50条记录的"&ubound(arrStr)&"条记录||"
'// 把出现该网址的 记录下来
for y=0 to ubound(arrStr)
if instr(arrStr(y),siteurl)>0 then
showlog=showlog&"在第"&y&"条找到你的记录||"
end if
next
Set matches = Nothing
Set reg = Nothing
getinfo_baidu=showlog
else
'//如果没有出现，则空返回
exit function
end if
end function
'// <summary>
'// 去GooGle搜索关键词
'// </summary>
function getinfo_GG(url,siteurl,sk)
If IsObjInstalled("AspHTTP.Conn")=true Then
str= getaspHTTPPage(url)
else
str= getHTTPPage(url)
End if
'//如果有第二页
If instr(str,"&start=10")>0 Then 'A
If IsObjInstalled("AspHTTP.Conn")=true Then
str=str&getaspHTTPPage(Replace(url,"&start=0","&start=10"))
Else
str=str&getHTTPPage(Replace(url,"&start=0","&start=10"))
End if
'//如果有第三页
If instr(str,"&start=20")>0 Then 'B
If IsObjInstalled("AspHTTP.Conn")=true Then
str=str&getaspHTTPPage(Replace(url,"&start=10","&start=20"))
Else
str=str&getHTTPPage(Replace(url,"&start=10","&start=20"))
End if
'//如果有第四页
If instr(str,"&start=30")>0 Then 'C
If IsObjInstalled("AspHTTP.Conn")=true Then
str=str&getaspHTTPPage(Replace(url,"&start=20","&start=30"))
Else
str=str&getHTTPPage(Replace(url,"&start=20","&start=30"))
End if
'//如果有第五页
If instr(str,"&start=30")>0 Then 'D
If IsObjInstalled("AspHTTP.Conn")=true Then
str=str&getaspHTTPPage(Replace(url,"&start=20","&start=30"))
Else
str=str&getHTTPPage(Replace(url,"&start=20","&start=30"))
End if
End if 'D
End if 'C
End IF 'B
End If 'A
if instr(str,siteurl)>0 then
set reg=new Regexp
reg.Multiline=True
reg.Global=True
reg.IgnoreCase=true
str_top="<p class=g>"
str_bottom="类似网页"
reg.Pattern=""&str_top&"((.|\n)*?)"&str_bottom&""
Set matches = reg.execute(str)
str1=""
For Each match1 in matches
str1=str1&"||"&match1.Value
Next
arrStr=split(str1,"||")
showlog="在 Google 搜索到关键词为 ["&sk&"],共找到 100条记录的"&ubound(arrStr)&"条记录||"
for y=0 to ubound(arrStr)
if instr(arrStr(y),siteurl)>0 then
showlog=showlog&"在第"&y+1&"条找到你的记录||"
end if
next
Set matches = Nothing
Set reg = Nothing
getinfo_GG=showlog
else
exit function
end if
end function
'==================================================================
'// <summary>
'// 采用 显示已经输出完毕 组件采集数据
'// </summary>
Sub print_do(str)
response.write "<script>"
response.write "function HiddenLoad()"
response.write "{"
response.write "parent.do"&str&".style.display='none';"
response.write "}"
response.write "</script>"
response.write "<body leftmargin=0 topmargin=0 marginwidth=0 marginheight=0 bgcolor=#f2f2f2 onload=HiddenLoad()>"
end sub
'// <summary>
'// 采用 Microsoft.XMLHTTP 组件采集数据
'// </summary>
Function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number<>0 then err.Clear
End function
'// <summary>
'// 采用 ADODB.Stream 处理采集到的数据，把二进制的文件转成文本字符
'// </summary>
Function Bytes2bStr(vin)
Dim BytesStream,StringReturn
Set BytesStream = Server.CreateObject("ADODB.Stream")
BytesStream.Type = 2
BytesStream.Open
BytesStream.WriteText vin
BytesStream.Position = 0
BytesStream.Charset = "GB2312"
BytesStream.Position = 2
StringReturn =BytesStream.ReadText
BytesStream.close
Set BytesStream = Nothing
Bytes2bStr = StringReturn
End Function
'// <summary>
'// 采用 AspHTTP.Conn 组件采集数据
'// </summary>
Function getaspHTTPPage(url)
if url="" then
exit function
end if
Set HttpObj = Server.CreateObject("AspHTTP.Conn")
'设置代理服务器,通过代理上网的用户需要设置此选项
If ProxyIP=1 Then
HttpObj.Proxy="192.168.5.254:808"
end if
HTTPObj.TimeOut = 45
HttpObj.Url = url
HttpObj.RequestMethod = "GET"
getaspHTTPPage = HttpObj.GetURL
set HttpObj=nothing
End function
'//<summary>
'//检查组件,采用xmlhttp抓取网页还是AspHTTP
'//</summary>
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then
If AspHttpOpen=1 Then
IsObjInstalled = True
'Response.write "当前组件 ASPHTTP"
Else
IsObjInstalled = False
'Response.write "当前组件 XMLHTTP"
End If
Else
IsObjInstalled = False
'Response.write "当前组件 XMLHTTP"
End If
Set xTestObj = Nothing
Err = 0
End Function
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -