程序|小偷程序小偷程序原理和简单示例
现在网上流行的小偷程序比较多，有新闻类小偷，音乐小偷，下载小偷，那么它们是如何做的呢，
下面我来做个简单介绍，希望对各位站长有所帮助。
（一）原理
小偷程序实际上是通过了XML中的XMLHTTP组件调用其它网站上的网页。
比如新闻小偷程序，很多都是调用了sina的新闻网页，并且对其中的html进行了一些替换，
同时对广告也进行了过滤。用小偷程序的优点有：无须维护网站，因为小偷程序中的数据来自其他网站，它将随着该网站的更新而更新；可以节省服务器资源，一般小偷程序就几个文件，所有网页内容都是来自其他网站。
缺点有：不稳定，如果目标网站出错，程序也会出错，而且，如果目标网站进行升级维护，那么小偷程序也要进行相应修改；
速度，因为是远程调用，速度和在本地服务器上读取数据比起来，肯定要慢一些。
（二）事例
下面就XMLHTTP在ASP中的应用做个简单说明
<%
'常用函数
'1、输入url目标网页地址，返回值getHTTPPage是目标网页的html代码
function getHTTPPage(url)
dim Http
set Http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=nothing
if err.number<>0 then err.Clear
end function
'2、转换乱玛，直接用xmlhttp调用有中文字符的网页得到的将是乱玛，可以通过adodb.stream组件进行转换
Function BytesToBstr(body,Cset)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
'下面试着调用http://www.3doing.com/earticle/的html内容
Dim Url,Html
Url="http://www.3doing.com/earticle/";
Html = getHTTPPage(Url)
Response.write Html
%>
如何写ASP入库小偷程序
作者：allen
转载请注明出自玛雅论坛
最近大家都对小偷程序感兴趣，尤其是入库类的，在这里我简单的介绍一下。希望大家对这个能有所了解，如果您还不知道什么叫小偷，请参考我写的另外一片文章（小偷程序原理和简单示例
）：http://www.cnmaya.org/viewthread.php?tid=68&fpage=1
个人认为小偷只是一个很通俗的说法，也给很多人带来了误解，认为小偷是什么不好的东西，
其实不然，用数据采集程序来形容应该更准确些。
这里是我昨天刚完成的新浪娱乐入库小偷程序：：http://www.saynew.com/news/Class/popjb/popjb02.html
在这里我根据该程序的制作简单介绍一下：
入库小偷的原理也很简单：就是用XMLHTTP远程读取网页的内容，然后根据需要，对读到的内容进行加工（过滤，替换，分类），最后得到自己需要的数据，加入到数据库中。
首先：我们先用XMLHTTP读取远程网页（我的另一片文章中有介绍）。
其次：对内容进行过滤，这个是比较关键的步骤，比如说，我要从远程网页上提取出所有url连接，我应该怎么做呢？
‘这里用的是正则式
Set objRegExp = New Regexp '建立对象
objRegExp.IgnoreCase = True '大小写忽略
objRegExp.Global = True '全局为真
objRegExp.Pattern = "http://.+?"; '匹配字段
set mm=objRegExp.Execute(str) '执行查找，str为输入参数
For Each Match in mm '进入循环
Response.write(Match.Value） '输出url地址
next
然后，我们需要根据需要做一些替换功能，把不必要的数据替换掉，这个比较简单，用Replace函数即可。
最后，进行数据库操作，这个我想大家应该都会，就不做介绍了。
ASP小偷入门教程。。。附QQ天气小偷源代码
要做一名好的小偷有点难度:P灵活运用XMLHTTP组件你也可以做“小偷”
这里所说的“小偷”指的是在ASP中运用XML中的XMLHTTP组件提供的强大功能，
把远程网站上的数据（图片，网页及其他文件）抓取到本地，经过各种处理后显示到页面上或者存储进数据库的一类程序。
你可以通过这种小偷程序，完成过去一些似乎完全不可能实现的任务，比如说把某个站的页面偷梁换柱后变成自己的页面，或者把某个站的一些数据（文章，图片）保存到本地数据库中加以利用。
“小偷”的优点有：无须维护网站，因为小偷程序中的数据来自其他网站，它将随着该网站的更新而更新；
可以节省大量的服务器资源，一般小偷程序就几个文件，所有网页内容都是来自其他网站。
缺点在于：不稳定，如果目标网站出错，程序也会出错，而且，如果目标网站进行升级维护，那么小偷程序也要进行相应修改；
速度，因为是远程调用，速度和在本地服务器上读取数据比起来，肯定要慢一些。
怎么样，听起来很神奇吧？我们现在就开始来学习一些“小偷”程序的入门知识吧！
我们拿个简单点的东西来研究一下吧，QQ网站上的天气预报程序
程序演示地址：http://www.gtocn.com/tianqi.asp
源码下载：http://www.gtocn.com/tianqi.txt
代码如下：
<%
On Error Resume Next
Server.ScriptTimeOut=9999999
Function getHTTPPage(Path)
t = GetBody(Path)
getHTTPPage=BytesToBstr(t,"GB2312")
End function
'首先，进行小偷程序的一些初始化设置，以上代码的作用分别是忽略掉所有非致命性错误，把小偷程序的运行超时时间设置得很长（这样不会出现运行超时的错误），转换原来默认的UTF-8编码转换成GB2312编码，否则直接用XMLHTTP组件调用有中文字符的网页得到的将是乱码。
Function GetBody(url)
on error resume next
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False, "", ""
.Send
GetBody = .ResponseBody
End With
Set Retrieval = Nothing
End Function
'然后调用XMLHTTP组件创建一个对象并进行初始化设置。
Function BytesToBstr(body,Cset)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
Function Newstring(wstr,strng)
Newstring=Instr(lcase(wstr),lcase(strng))
if Newstring<=0 then Newstring=Len(wstr)
End Function
'处理抓取回来的数据需要调用adodb.stream组件并进行初始化设置。%>
'以下即为页面显示部分
<%
Dim wstr,str,url,start,over,city
'定义一些需要使用到的变量
city = Request.QueryString("id")
'程序传回的ID变量（即用户选择的城市）赋给id
url="http://appnews.qq.com/cgi-bin/news_qq_search?city=";&city&""
'这里设置需要抓取的页面地址，当然你也可以直接指定某个地址而不使用变量
wstr=getHTTPPage(url)
'获取指定页面的全部数据
start=Newstring(wstr," <html>")
'这里设置需要处理的数据的头部，这个变量应视不同情况而设置，具体内容可以通过查看需要抓取的页面的源代码来确定。
因为在这个程序里我们需要抓取整个页面,所以设置为页面全部抓取。注意，设置的内容必须是页面内容唯一的，不可以重复。
over=Newstring(wstr," </HTML>")
'和start相对应的就是需要处理的数据的尾部，同样的，设置的内容必须是页面中唯一的。
body=mid(wstr,start,over-start)
'设置显示页面的范围
'下面就是动用乾坤挪移大法的时候了，通过replace可以用一些字符替换掉数据中指定的字符。
body = replace(body,"skin1","天气预报 - 斯克网络")
body = replace(body,"http://appnews.qq.com/cgi-bin/news_qq_search?city";,"tianqi.asp?id")
'本程序中已经完成了替换的工作，如果有其他需要的话可以继续进行类似的替换操作。
response.write body
%>
替换完需要修改的内容后，就可以把修改的内容显示在页面上了。至此程序结束
程序使用方法及结果：把上述代码去掉说明部分后保存为tianqi.asp，上传到支持ASP和XML的空间下，在浏览器中运行即可。
你可以在在这个程序的基础上进行进一步的界面美化或者程序优化。
以上只是一些关于XMLHTTP组件的初级应用，实际上它还能实现的功能还有很多，比如说保存远程图片到本地服务器上，配合adodb.stream组件可以把获取来的数据保存进数据库。小偷的作用和使用范围都很广。但是不可以拿来做违法的事哦！
也许还有人要问了，这种“小偷”程序难道只是ASP的专利吗？非也，PHP通过fopen函数一样可以实现同样的效果，由于PHP本身的各种特点，写出来的小偷程序和ASP相比，在体积和执行效率上都有者明显的优势，但限于篇幅，这里就不一一说明了。
神鹰V霸主
献给学习小偷程序的朋友
很久没写过东西了，今天看了chinahuman 的《用asp自动解析网页中的图片地址，并将其保存到本地服务器》，于是优化了这个程序，并且将所有的功能都函数化了，希望对学习 XMLHTTP 的朋友有所帮助。
程序实现功能：自动将远程页面的文件中的图片下载到本地。
<%
'将本文保存为 save2local.asp
'测试：save2local.asp?url=http://ent.sina.com.cn/s/m/2003-11-11/1411231388.html
'本文根据 chinahuman 的《用asp自动解析网页中的图片地址，并将其保存到本地服务器》改编和优化
'自动创建目录，自动将原文件名更名，文件格式的限制以及其他功能的一些优化
'自动保存网页文件中 http://.... 格式的图片到本地
'转载请注明出处：http://www.jaron.cn http://www.csdn.net/develop
'参数设置开始
url = request("url")
localaddr = server.MapPath("images_remote/") '保存到本地的目录
localdir = "images_remote/" 'http 访问的相对路径
AllowFileExt = "jpg|bmp|png|gif" '支持的文件名格式
'参数设置完毕
if createdir(localaddr) = false then
response.Write "创建目录失败，请检查目录权限"
response.End
end if
response.Write Convert2LocalAddr(url,localaddr,localdir)
function Convert2LocalAddr(url,localaddr,localdir)
'参数说明
'url 页面地址
'localaddr 保存本地的物理地址
'localdir 相对路径
strContent = getHTTPPage(url)
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<img.+?>"
Set Matches =objRegExp.Execute(strContent)
For Each Match in Matches
RetStr = RetStr & GetRemoteImages(Match.Value)
Next
ImagesArray=split(RetStr,"||")
RemoteImage=""
LocalImage=""
for i=1 to ubound(ImagesArray)
if ImagesArray(i)<>"" and instr(RemoteImage,ImagesArray(i))<1 then
fname=baseurl&cstr(i&mid(ImagesArray(i),instrrev(ImagesArray(i),".")))
ImagesFileName = ImagesArray(i)
AllowFileExtArray = split(AllowFileExt,"|")
isGetFile = false
for tmp = 0 to ubound(AllowFileExtArray)
if lcase(GetFileExt(ImagesFileName)) = ALlowFileExtArray(tmp) then
isGetFile=True
end if
next
if isGetFile = true then
newfilename = GenerateRandomFileName(fname)
call Save2Local(ImagesFileName,localaddr & "/" & newfilename)
RemoteImage=RemoteImage&"||"& ImagesFileName
LocalImage=LocalImage&"||" & localdir & newfilename
end if
end if
next
arrnew=split(LocalImage,"||")
arrall=split(RemoteImage,"||")
for i=1 to ubound(arrnew)
strContent=replace(strContent,arrall(i),arrnew(i))
next
Convert2LocalAddr = strContent
end function
function GetRemoteImages(str)
Set objRegExp1 = New Regexp
objRegExp1.IgnoreCase = True
objRegExp1.Global = True
objRegExp1.Pattern = "http://.+? "
set mm=objRegExp1.Execute(str)
For Each Match1 in mm
tmpaddr = left(Match1.Value,len(Match1.Value)-1)
GetRemoteImages=GetRemoteImages&"||" & replace(replace(tmpaddr,"""",""),"'","")
next
end function
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
function getHTTPimg(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
getHTTPimg=Http.responseBody
set http=nothing
if err.number<>0 then err.Clear
end function
function Save2Local(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=gethttpimg(geturl)
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write imgs
objstream.SaveToFile tofile,2
objstream.Close()
set objstream=nothing
end function
function geturlencodel(byval url)'中文文件名转换
Dim i,code
geturlencodel=""
if trim(Url)="" then exit function
for i=1 to len(Url)
code=Asc(mid(Url,i,1))
if code<0 Then code = code + 65536
If code>255 Then
geturlencodel=geturlencodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2)
else
geturlencodel=geturlencodel&mid(Url,i,1)
end if
next
end function
Function GenerateRandomFileName(ByVal szFilename) '根据原文件名，自动以日期YYYY-MM-DD-RANDOM格式生成新文件名
Randomize
ranNum = Int(90000 * Rnd) + 10000
If Month(Now) < 10 Then c_month = "0" & Month(Now) Else c_month = Month(Now)
If Day(Now) < 10 Then c_day = "0" & Day(Now) Else c_day = Day(Now)
If Hour(Now) < 10 Then c_hour = "0" & Hour(Now) Else c_hour = Hour(Now)
If Minute(Now) < 10 Then c_minute = "0" & Minute(Now) Else c_minute = Minute(Now)
If Second(Now) < 10 Then c_second = "0" & Second(Now) Else c_second = Minute(Now)
fileExt_a = Split(szFilename, ".")
FileExt = LCase(fileExt_a(UBound(fileExt_a)))
GenerateRandomFileName = Year(Now) & c_month & c_day & c_hour & c_minute & c_second & "_" & ranNum & "." & FileExt
End Function
Function CreateDIR(ByVal LocalPath) '建立目录的程序，如果有多级目录，则一级一级的创建
On Error Resume Next
LocalPath = Replace(LocalPath, "\", "/")
Set FileObject = server.CreateObject("Scripting.FileSystemObject")
patharr = Split(LocalPath, "/")
path_level = UBound(patharr)
For I = 0 To path_level
If I = 0 Then pathtmp = patharr(0) & "/" Else pathtmp = pathtmp & patharr(I) & "/"
cpath = Left(pathtmp, Len(pathtmp) - 1)
If Not FileObject.FolderExists(cpath) Then FileObject.CreateFolder cpath
Next
Set FileObject = Nothing
If Err.Number <> 0 Then
CreateDIR = False
Err.Clear
Else
CreateDIR = True
End If
End Function
function GetfileExt(byval filename)
fileExt_a=split(filename,".")
GetfileExt=lcase(fileExt_a(ubound(fileExt_a)))
end function
%>
有一点要注意的是，这里只是分析了以 http开头的图片的地址。否则不下载图片，可以转换一下地址就行了，再提供几个小函数，分析地址用的：
Function findurl(thisurl)
if thisurl <> "" Then
findurl=""
strlen=InStr(8,thisurl,"/")
If strlen=0 Then strlen =1
findurl=Mid(thisurl,strlen,28)
end if
end Function
function findurlpath(thisurl)
thisurl = replace(thisurl,"//","")
ary_tmp = split(thisurl,"/")
for tmp = 0 to ubound(ary_tmp)
if tmp < ubound(ary_tmp) then
urltmp = urltmp & "/" & ary_tmp(tmp)
end if
next
urltmp = right(urltmp,len(urltmp)-1)
findurlpath = replace(urltmp,"","//") & "/"
end function
function findurlhost(thisurl)
thisurl = replace(thisurl,"//","")
ary_tmp = split(thisurl,"/")
urltmp = ary_tmp(0)
findurlhost = replace(urltmp,"","//") & "/"
findurlhost = left(findurlhost,len(findurlhost)-1)
end function
先选中一个你想 “偷” 的网页程序。。。
我这里看中了它。。呵呵 。。。很多妹妹图片。。。口水中。。
http://www.linkmm.com/photo/ads2.html
然后建立个ASP网页，先把以下代码复制进去
<%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 = strReturn
End Function
Url = "http://www.linkmm.com/photo/ads2.html";;;
set oSend=createobject("Microsoft.XMLHTTP")
SourceCode = oSend.open ("GET",url,false)
oSend.send()
if err.number<>0 then
Response.write err.description
Response.End()
end if
SourceCode = bytes2BSTR(oSend.responseBody)%>
其中Url = "http://www.linkmm.com/photo/ads2.html";;;就是你想要 偷 的网页，换成你需要的就可以了。。
这个时候response.write 一下。。是不是很多图片看不见啊。。不急，我们有replace呢。。把你现在的网页查看下原文件
把原来的网页查看下愿文件对比下就知道怎么让这些无法显示的显示出来。。。比起那些一个个replace替换图片的方法
用这个方法好多了就是在有src的地方在他前面直接替换网址多方便呵呵。。
在写这段代码。。程序就完了呵呵
<%baseurl1="http://www.linkmm.com/photo";;;
SourceCode =replace(sourcecode,"src=""img/","src=""http://www.linkmm.com/photo/img/";;;)
SourceCode =replace(sourcecode,"new.gif",baseurl1&"/new.gif")
SourceCode =replace(sourcecode,"href=""photo888","href=""http://www.linkmm.com/photo/photo888";;;)
SourceCode =replace(sourcecode,"site.css","http://www.linkmm.com/photo/site.css";;;)
response.write SourceCode%>
是不是很简单啊。不懂的联系我52596464
完整代码如下：
<html>
<head>
<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta http-equiv="refresh" content="3600">
<title></title>
</head>
<body>
<%
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 = strReturn
End Function
Url = "http://www.linkmm.com/photo/ads2.html";;;
set oSend=createobject("Microsoft.XMLHTTP")
SourceCode = oSend.open ("GET",url,false)
oSend.send()
if err.number<>0 then
Response.write err.description
Response.End()
end if
SourceCode = bytes2BSTR(oSend.responseBody)
baseurl1="http://www.linkmm.com/photo";;;
SourceCode =replace(sourcecode,"src=""img/","src=""http://www.linkmm.com/photo/img/";;;)
SourceCode =replace(sourcecode,"new.gif",baseurl1&"/new.gif")
SourceCode =replace(sourcecode,"href=""photo888","href=""http://www.linkmm.com/photo/photo888";;;)
SourceCode =replace(sourcecode,"site.css","http://www.linkmm.com/photo/site.css";;;)
response.write SourceCode
%>
</body>
</html>
小偷程序原理
80酷酷网 80kuku.com
