怎样实现一个类似新闻小偷的程序？

ekeen 2003-12-19 09:04:45
假如www.demo.com是一个房产公司网站，上有一个搜索功能，可以找到本地一些房子的信息。我在自己网站做一个表单，当使用搜索的时候，使用www.demo.com网站的搜索功能，但让别人感觉是在我自己网站上搜索一样，要滤掉www.demo.com网站返回的一些信息。怎么做？谢谢！
...全文
25 13 打赏 收藏 转发到动态 举报
写回复
用AI写文章
13 条回复
切换为时间正序
请发表友善的回复…
发表回复
ekeen 2003-12-23
  • 打赏
  • 举报
 回复
找出了问题：
我用的是英文win2003操作系统。在中文操作系统下没有问题：）
全息宇宙 2003-12-22
  • 打赏
  • 举报
 回复
给你一个偷取搜索的例子看看：
www.cn-grease.com/zip/wyc/test.rar
全息宇宙 2003-12-22
  • 打赏
  • 举报
 回复
经测试，这句没问题啊！

strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
全息宇宙 2003-12-22
  • 打赏
  • 举报
 回复
改成这样试试：

strReturn = strReturn & ChrW(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
全息宇宙 2003-12-20
  • 打赏
  • 举报
 回复
http://expert.csdn.net/Expert/topic/2477/2477354.xml?temp=2.300662E-02
全息宇宙 2003-12-20
  • 打赏
  • 举报
 回复
典型的新闻小偷程序，呵呵

晕：http://www.demo.com 怎么进不去

上面的代码有很多垃圾，这才是主要的：
<%
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

Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
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 = strReturn
End Function

Function NewString(wstr,strng)
NewString=Instr(wstr,strng)
End Function
%>
ekeen 2003-12-20
  • 打赏
  • 举报
 回复
对中文的页面有这个问题，英文就没有！：（
对中文：strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))，
(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))这个值很大，有5000多，估计是要出错了！怎么回事？
看别人都用成功了！
郁闷！

ekeen 2003-12-20
  • 打赏
  • 举报
 回复
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
这句报错.
______________________________
Microsoft VBScript runtime error '800a0005'

Invalid procedure call or argument: 'Chr'

/test/test.asp, line 46
__________________________________
怎么回事？
<body leftmargin="0" topmargin="0">
<%
on error resume next
Server.ScriptTimeOut=120
url = "http://product.zol.com.cn/soft/" '新闻来源的页面

wstr = getHTTPPage(url) '取得页面内容
if err.number=0 then
start=newstring(wstr," <table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0""><!-- t {{{ -->")
over=newstring(wstr,"<!-- 第一表结束 }}} -->")
wstr=mid(wstr,start,over-start-61)
wstr=replace(wstr,"<img src=""images/mid.gif""","<img src=""http://product.zol.com.cn/soft/images/mid.gif""")
wstr=replace(wstr,"background=""images/bg.gif""","background=""http://product.zol.com.cn/soft/images/bg.gif""")
end if
response.write wstr
%>
<%
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

Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
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 = strReturn
End Function

Function newstring(wstr,strng)
newstring=Instr(wstr,strng)
End Function

Function LeftNews(strng,NewsLength,NeedTime)
If NeedTime<>True then
Left_0=Instr(strng,"</a>")+3
TheRed=Instr(strng,"<font color=#ff0000>")
If TheRed>0 then
Left_1=Instr(strng,"<font color=#ff0000>")+20
Left_2=Instr(strng,"</font>")
If Left_1+NewsLength>=Left_2 then
LeftNews=Left(strng,Left_0)
Else
LeftNews=Left(strng,Left_1+NewsLength)&Points&"</font></a>"
End if
Else
Left_1=Instr(strng,"_blank>")+7
Left_2=Instr(strng,"</a>")
If Left_1+NewsLength>=Left_2 then
LeftNews=Left(strng,Left_0)
Else
LeftNews=Left(strng,Left_1+NewsLength)&Points&"</a>"
End if
End if
Else
LeftNews=strng
End if
End Function

Function NewString(wstr,strng)
NewString=Instr(wstr,strng)
End Function

Function NumDate()
NumDate=Year(Date())&AddZero(Month(Date()),2)&AddZero(Day(Date()),2)
End Function

Function FormatDate(theDate,n)
FormatDate=Year(theDate)&n&AddZero(Month(theDate),2)&n&AddZero(Day(theDate),2)
End Function

Function AddZero(m,n) '添加0
If Len(m)<n then
AddZero=string(n-Len(m),"0")&m
Else
AddZero=m
End if
End function

Function LL(strng)
LL=Left(strng,Instr(strng,"</a>")+3)
End function

Erase ArrayNewsImg
Erase ArrayNewsTitle
%>

http://expert.csdn.net/Expert/topic/2477/2477354.xml?temp=2.300662E-02
by manyou(他山之石)


ekeen 2003-12-20
  • 打赏
  • 举报
 回复
怎么我的err.number是不等于0？
if err.number=0 then
start=newstring(wstr," <table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0""><!-- t {{{ -->")
over=newstring(wstr,"<!-- 第一表结束 }}} -->")
wstr=mid(wstr,start,over-start-61)
wstr=replace(wstr,"<img src=""images/mid.gif""","<img src=""http://product.zol.com.cn/soft/images/mid.gif""")
wstr=replace(wstr,"background=""images/bg.gif""","background=""http://product.zol.com.cn/soft/images/bg.gif""")
end if
if err.number<>0 then
Response.Write "this is a error"
end if
______________________________________________________________________
输出的是:
this is a error
我了上面的关键函数写的！：（
url也肯定是能访问到！
tianjy 2003-12-20
  • 打赏
  • 举报
 回复
up
talent303 2003-12-19
  • 打赏
  • 举报
 回复
ding
lsaturn 2003-12-19
  • 打赏
  • 举报
 回复
关注！
bzscs 2003-12-19
  • 打赏
  • 举报
 回复
搜索“httpxml”，关键函数：
function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Msxml2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then exit function
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number<>0 then err.Clear
end function

Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
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 = strReturn
End Function
小偷程序原理和简单示例
现在网上流行的小偷程序比较多，有新闻类...比如新闻小偷程序，很多都是调用了sina的新闻网页，并且对其中的html进行了一些替换，同时对广告也进行了过滤。用小偷程序的优点有：无须维护网站，因为小偷程序中的数据...
asp小偷程序原理
小偷程序原理和简单示例现在网上流行的小偷程序比较...比如新闻小偷程序，很多都是调用了sina的新闻网页，并且对其中的html进行了一些替换，同时对广告也进行了过滤。用小偷程序的优点有：无须维护网站，因为小偷程序中
php采集（php小偷）程序设计教程
... 采集范例程序 一些常用的函数 对一个目标网站的全面采集 <br />什么是php采集程序？  php采集程序，也叫php小偷，主要是用于自动搜集网络上w
《小偷程序：自动获取百度天气预报》
在做项目的过程中，需要用到一个类似天气预报的功能，以前不懂，以为那个是需要自己手工去更新的，在新闻小偷遍地的今天，越来越觉得以前自己的想法是错误的，简直是很幼稚。这里给出实现天气预报抓取功能的全部代码...
利用WebRequest登录网站，抓取信息
以前也做过类似于新闻小偷之类的东西，就是利用WebRequest从请求的URL获取信息后进行分析，然后显示。记得当时老板让做一个搜索时抓取程序，想把这边几个BBS的信息都能纳入搜索范围。因为有些BBS的搜索功能必须登录...
ASP

28,391

社区成员

357,060

社区内容

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages，是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章