源码网,源码论坛,源码之家,商业源码,游戏源码下载,discuz插件,棋牌源码下载,精品源码论坛

 找回密码
 立即注册
查看: 448|回复: 19

[ASP编程] 百度小偷

[复制链接]

7万

主题

861

回帖

32万

积分

论坛元老

Rank: 8Rank: 8

积分
329525
发表于 2006-6-25 00:00:00 | 显示全部楼层 |阅读模式

<%
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>

回复

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2022-8-8 09:08:03 | 显示全部楼层
先把创新班才能下班才能下班
回复 支持 反对

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2022-8-11 00:13:23 | 显示全部楼层
啦啦啦啦啦德玛西亚
回复 支持 反对

使用道具 举报

6

主题

2万

回帖

247

积分

中级会员

Rank: 3Rank: 3

积分
247
发表于 2022-9-29 12:03:31 | 显示全部楼层
谢谢小Y分享
回复 支持 反对

使用道具 举报

8

主题

2万

回帖

52

积分

注册会员

Rank: 2

积分
52
发表于 2022-11-23 20:49:30 | 显示全部楼层
哦哦哦哦哦哦哦哦哦
回复 支持 反对

使用道具 举报

3

主题

2万

回帖

301

积分

中级会员

Rank: 3Rank: 3

积分
301
发表于 2023-3-7 13:59:08 | 显示全部楼层
谢谢下载来看看
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

55

积分

注册会员

Rank: 2

积分
55
发表于 2023-5-3 04:31:42 | 显示全部楼层
hi哦和烦恼农家女
回复 支持 反对

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2023-6-24 00:21:51 | 显示全部楼层
抽根烟,下来看看再说
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

120

积分

注册会员

Rank: 2

积分
120
发表于 2023-8-24 13:02:38 | 显示全部楼层
灌灌灌灌水
回复 支持 反对

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2023-10-24 05:27:44 | 显示全部楼层
有什么好的服务器
回复 支持 反对

使用道具 举报

高级模式
B Color Image Link Quote Code Smilies

本版积分规则

手机版|小黑屋|网站地图|源码论坛 ( 海外版 )

GMT+8, 2024-11-23 15:37 , Processed in 0.075215 second(s), 26 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表