当前位置: 首页 > 图文教程 > 网络编程 > ASP > 百度小偷

ASP
Adodb.Command 平时很少注意到的一个参数
Asp.Net控件加载错误的解决方法
远程连接access数据库的方法
创建具有JScript的HTML的XMLHTTP
在Asp中如何快速优化分页的技巧
用VB生成DLL封装ASP代码,连接数据库
RS.OPEN SQL,CONN,A,B 全接触
利用adodb.stream直接下载任何后缀的文件(防盗链)
用ASP编程控制在IIS建立Web站点的程序代码
使用VBScript操作Html复选框(CheckBox)控件
把文章内容中涉及到的图片自动保存到本地服务器
两个不同数据库表的分页显示解决方案
使用组件封装数据库操作(一)
使用组件封装数据库操作(二)
如何在pb中创建COM组件,并在asp中调用并返回结果集?
用ASP和Microsoft.XMLDOM分析远程XML文件
浅谈无刷新取得远程数据技术
将ASP纪录集输出成n列的的表格形式显示的方法
在ASP中通过oo4o连接Oracle数据库的例子
Server Application Error详细解决办法

ASP 中的 百度小偷


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-09-13   浏览: 219 ::
收藏到网摘: n/a

<%
Function bytes2BSTR(vIn)
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = ubb(strReturn)
End Function

Function dq(key)
dim XmlHttp
set XmlHttp = CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "GET","http://www.baidu.com/s?wd="&key&"&pn="&request("pn"), false
XmlHttp.setRequestHeader "Content-Type","text/XML"
XmlHttp.Send
dq = bytes2BSTR(XmlHttp.responseBody)
End Function

Function BR(Str)
Str = Replace(Str,"{br}","<br>")
Str = Replace(Str,vbcrlf,"<br>")
Str = Replace(Str,"<br> <br>","<br>")
Str = Replace(Str,"<br><br>","<br>")
Str = Replace(Str,"<br><br>","<br>")
BR = Str
End Function


function ubb(str)

if instr(str,"找到相关网页") = 0 then
ubb = "没有搜索到任何内容"
exit function
end if

str = Replace(str,vbcrlf,"{br}")
str = Replace(str,"<br>","{br}")
str = Replace(str,"</td>","</td>"&vbcrlf)
str = Replace(str,"<td",vbcrlf&"<td")

dim re,Match,Matches
set re = New RegExp
re.Global = True
re.IgnoreCase = True

re.Pattern=".*\<td class=f>(.*)\<\/td>"

Set Matches = re.Execute(str)

For Each Match in Matches
ubb=ubb&BR(Match.value)
next
re.Pattern="(\- \<a .[^\<]*>百度快照\<\/a>)"
ubb = re.replace(ubb,"")
re.Pattern="(\<a class=""m"".[^\<]*>.[^\<]*\<\/a>)"
ubb = re.replace(ubb,"")
re.Pattern="(\<font color=#008000>.[^\<]*\<\/font>)"
ubb = re.replace(ubb,"<hr>") '每一条信息的间隔
ubb = Replace(ubb,"<td class=f>","")
ubb = Replace(ubb,"</td>","")
ubb = BR(UBB)


re.Pattern="(找到相关网页.*秒)"
Set Matches = re.Execute(str)
set Match = Matches(0)
ubb = ubb & Match & "<br>"

str = Replace(str,"</div>","</div>"&vbcrlf)


re.Pattern="\<div class=""p"">(.*)\<\/div>"
Set Matches = re.Execute(str)
set Match = Matches(0)
Dim TheLink
TheLink = Match
re.Pattern="href=s?(.[^>]*)"
TheLink = re.replace(TheLink,"href=""$1""")

ubb = ubb & TheLink
end function

if len(request("wd")) > 0 then
response.write dq(request("wd"))
end if
%>
<form method=post action="?">
<input type="text" name="wd"> <input type="submit">
</form>