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，有兴趣的朋友可以试一下，然后给我一个答案，就感谢了。