ASP文章小偷程序

今天闲得没事，就写了一个小偷程序，呵呵，不要误会哦，本人生性光明。只是好久没有认真写程序了，热热身子。主要思路还是来源于http://blog.csdn.net/manyou/archive/2004/09/14/103617.aspx，在此表示感谢，我只不过是在他的思路下丰富了一下，使得该程序更容易使用而已，不是我的功劳。

关于原理方面的东西，我这里就不多讲了，网上讲原理的很多，感兴趣可以去baidu一下。

可以将取得的文章放入ACCESS或者是SQL数据库，在你的数据库中建立两个表，一个是GetContent，有四个字段，id（自增），title（文本200），content（TEXT），type（类型），另外一个类型表type，有两个字段，id（自增），typename（分类名）。

数据库连接文件conn.asp如下:

<%
on error resume next
public conn
DatabaseType=1'如果是1就将收取的内容放入ACCESS数据库,如果是其它就放入SQL数据库

if DatabaseType=1 then
connstr="DBQ="+server.mappath("data/data.mdb")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
set conn=server.createobject("ADODB.CONNECTION")
conn.open connstr
else
sub ConnLink
set conn=server.createobject("adodb.connection")
Conn.open "Provider=Sqloledb; User ID=sa; Password=123; Initial Catalog=data; Data Source=(local);"
If Err Then
Response.Write "数据库链接失败！"
Response.Write "<br>"&Err.description
Err.Clear
Conn.Close
Set Conn=Nothing
End If
end sub
sub ConnClose
conn.close
set conn=nothing
end sub
end if
%>

下面是主要程序文件：

<!--#include file=conn.asp-->
<%
on error resume next
Server.ScriptTimeOut=10000 '设定操作超时的时间（因为程序运行速度慢啊）

''''''''''''''''''''''''''''''''''''''''''把下面的几个参数改了就可以了
HeadURL="http://www.72598.com/article7.asp?article_id="'文章来源ID
URLstartID=1'开始ID号
URLendID=5'结束ID号
SeparateHead="<td class=""article_detaill"" id=""sizeSet"">"'文章内容的前面特殊符，要唯一
SeparateEnd="【<a href=""#top"">返回顶部</a>】"'文章内容的后面特殊符，要唯一
TitleSeparateHead="<font color=""#FF0000"" style=""font-size:24px"">"'文章标题的前面特殊符，要唯一
TitleSeparateEnd="</font>&nbsp;&nbsp;</td>"'文章标题的后面特殊符，要唯一
'''''''''''''''''''''''''''''''''''''''''在这里结束

call getRangeConent(URLstartID,URLendID,HeadURL,SeparateHead,SeparateEnd,TitleSeparateHead,TitleSeparateEnd)

dim rs,sql
Function getRangeConent(startID,endID,defaultURL,SHead,SEnd,TSeparateHead,TSeparateEnd)
call ConnLink
for i=startID to endID
currentURL=defaultURL&startID
'Response.write currentURL
call getContent(currentURL,SHead,SEnd,TSeparateHead,TSeparateEnd)
'Response.write "startID: "&startID&"<br>"
startID=startID+1
next
Call ConnClose
End Function
Function getContent(url,SHead,SEnd,TSeparateHead,TSeparateEnd)
wstr = getHTTPPage(url) '取得页面内容
if err.number=0 then '如果获取成功
'''''''''''''取得文章标题
start=newstring(wstr,TSeparateHead) '要获取的内容在网页中的开始位置（通过唯一的标志寻找）
over=newstring(wstr,TSeparateEnd) '要获取的内容在网页中结束位置（通过唯一的标志寻找）
title=mid(wstr,start+45,over-start-45) '获取想要的内容
'''''''''''''取得文章内容
start=newstring(wstr,SHead) '要获取的内容在网页中的开始位置（通过唯一的标志寻找）
over=newstring(wstr,SEnd) '要获取的内容在网页中结束位置（通过唯一的标志寻找）
wstr=mid(wstr,start+41,over-start-156) '获取想要的内容
content=replace(wstr,"/admin/editor/UploadFile","http://www.72598.com//admin/editor/UploadFile") '替换掉你不想要的内容
'response.write content
wstr=""'释放内存
call writeDatabase(title,content)
end if
End Function

Function writeDatabase(thisTitle,thisContent)
sql="insert into GetContent(title,content,type) values('"&thisTitle&"','"&thisContent&"',1)"
conn.execute(sql)
End Function

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

备注：这里有一个问题，就是我在采集文章的时候，最多只能够同时采集3篇文章，我仔细检察了一下，程序上没有问题，我的服务环境采用是netbox，我有点怀疑是问题出在这上面。因为本机上没有IIS，有兴趣的朋友可以试一下，然后给我一个答案，就感谢了。