首页 / ASP / 自己做采集程序

自己做采集程序

内容导读

互联网集市收集整理的这篇技术教程文章主要介绍了自己做采集程序，小编现在分享给大家，供广大互联网技能从业者学习和参考。文章包含12211字，纯文字阅读大概需要18分钟。

内容图文

现在网上的采集程序很多，但是有时候你发现一个好的网站，想自己做个采集工具采集一些信息，就需要自己去写程序了，其实这样的采集程序并不难写，主要是去分析源网站的网页结构。
首先去下载个XMLHTTP的类文件：
<%
Class xhttp
private cset,sUrl,sError
Private Sub Class_Initialize()
'cset="UTF-8"
cset="GB2312"
sError=""
end sub

Private Sub Class_Terminate()
End Sub

Public Property LET URL(theurl)
sUrl=theurl
end property
public property GET BasePath()
BasePath=mid(sUrl,1,InStrRev(sUrl,"/")-1)
end property
public property GET FileName()
FileName=mid(sUrl,InStrRev(sUrl,"/")+1)
end property
public property GET Html()
Html=BytesToBstr(getBody(sUrl))
end property

public property GET xhttpError()
xhttpError=sError
end property

private Function BytesToBstr(body)
on error resume next
'Cset:GB2312 UTF-8
dim objstream
set objstream = Server.CreateObject("adodb.stream")
with objstream
.Type = 1 '
.Mode = 3 '
.Open
.Write body '
.Position = 0 '
.Type = 2 '
.Charset = Cset '
BytesToBstr = .ReadText '
.Close
end with
set objstream = nothing
End Function

private function getBody(surl)
on error resume next
dim xmlHttp
'Set xmlHttp=server.createobject("Msxml2.XMLHTTP.4.0")
'set xmlHttp=server.createobject("Microsoft.XMLHTTP")
set xmlHttp=server.createobject("MSXML2.ServerXMLHTTP")
xmlHttp.setTimeouts 10000,10000,10000,30000
xmlHttp.open "GET",surl,false
xmlHttp.send
if xmlHttp.readystate=4 then
'if xmlHttp.status=200 then
getBody=xmlhttp.responsebody
'end if
else
getBody=""
end if

if Err.Number<>0 then
sError=Err.Number
Err.clear
else
sError=""
end if
set xmlHttp=nothing
end function

Public function saveimage(tofile,isoverwrite)
on error resume next
dim objStream,objFSO,imgs

if Not isoverwrite Then
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(Server.MapPath(tofile)) Then
Exit Function
End If
Set objFSO = Nothing
End IF

imgs=getBody(sUrl)
Set objStream = Server.CreateObject("ADODB.Stream")
with objStream
.Type =1
.Open
.write imgs
.SaveToFile server.mappath(tofile),2
.Close()
end with
set objstream=nothing
end function

end class

%>
用了这个类文件，做起事情来就方便多了。
然后就可以分析采集网站的网页结构，写采集程序了。
下面给个例子：



<%
server.ScriptTimeout = 1000
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>BT采集器</title>
</head>
<body>
<form name="form1" method="post" action="get81bt.asp">
分类ID：
  <input type="text" name="cid" value="<%=request("cid")%>"><br>
开始ID：
  <input type="text" name="startid" value="<%=request("startid")%>">
  <br>
  结束ID：
  <input type="text" name="overid" value="<%=request("overid")%>">
  <br>
  分类名称：<input type="text" name="classname" value="<%=request("classname")%>">为空自动获取
  <br>
  <input name="action" type="hidden" id="action" value="getdata">
  <input type="submit" name="Submit" value="采集">
</form>
当前ID：<%=request("id")%> <br>
<%
dim action

action = Request("action")
if action = "getdata" then
cid = Request("cid")
startid = Request("startid")
overid = Request("overid")
id = Request("id")
if id = "" then id = startid

set objxhttp = new xhttp

objxhttp.URL = "http://www.gxlsystem.com/Class/"&cid&"_"&id&".htm"
content = objxhttp.Html

if InStr(content,"网站维护中") then
call NextID
response.End()
end if

list = GetContent(content,"","",0)

Dim regEx, Match, Matches,patrn
Set regEx = New RegExp
patrn = "<a href=""../BtHtml/(.+?)"">"
regEx.Pattern = patrn
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(list)
on error resume next
For Each Match in Matches

'response.write Match.Value & "<br>"
weburl = "http://www.gxlsystem.com/BtHtml/" & regEx.Replace(Match.Value,"$1")
response.write weburl & "<br>"
response.Flush()

objxhttp.URL = weburl
cpage = objxhttp.Html
cpage = GetContent(cpage,"","",0)

title = GetContent(cpage,"BT资源名称：<strong>","</strong>",0)
title = stripHTML(title)

IF Request("classname") <> "" then
classname = Request("classname")
Else
if InStr(title,"喜剧") then
classname = "喜剧"
Elseif InStr(title,"动作") then
classname = "动作"
Elseif InStr(title,"惊悚") then
classname = "惊悚"
Elseif InStr(title,"犯罪") then
classname = "犯罪"
Elseif InStr(title,"恐怖") then
classname = "恐怖"
Elseif InStr(title,"爱情") then
classname = "爱情"
Elseif InStr(title,"冒险") then
classname = "冒险"
Elseif InStr(title,"科幻") then
classname = "科幻"
Elseif InStr(title,"悬念") then
classname = "悬念"
Elseif InStr(title,"奇幻") then
classname = "奇幻"
Elseif InStr(title,"战争") then
classname = "战争"
Elseif InStr(title,"连续剧") then
classname = "连续剧"
Elseif InStr(title,"综艺") then
classname = "综艺"
Elseif InStr(title,"灾难") then
classname = "灾难"
Elseif InStr(title,"伦理") then
classname = "伦理"
Elseif InStr(title,"动漫") or InStr(title,"动画") then
classname = "动漫"
Elseif InStr(title,"国语") or InStr(title,"集") then
classname = "其他影视"
Else
classname = "其他"
End if
End IF

intro = GetContent(cpage,"<tr><td width=770 bgcolor=#FFFFFF><div style=""margin:10px;line-height:150%"">","</div>",0)
intro = Replace(intro,"<br />","[br]")
intro = Replace(intro,"<BR />","[br]")
intro = Replace(intro,"<BR>","[br]")
intro = Replace(intro,"<br>","[br]")
intro = Replace(intro,"<p>","[p]")
intro = Replace(intro,"<P>","[p]")
intro = Replace(intro,"</p>","[/p]")
intro = Replace(intro,"</P>","[p]")
intro = Replace(intro,"<img","[img")
intro = Replace(intro,"<IMG","[img")
intro = stripHTML(intro)
intro = Replace(intro,"[br]","<br>")
intro = Replace(intro,"[p]","<p>")
intro = Replace(intro,"[/p]","</p>")
intro = Replace(intro,"[img","<img")
intro = Replace(intro,"[img]","<img src=")
intro = Replace(intro,"[/img]",">")
intro = Replace(intro,"[IMG]","<img src=")
intro = Replace(intro,"[/IMG]",">")
'response.write t
'response.End()

addtime = Trim(GetContent(cpage,"发布时间："," ",0))
if Not IsDate(addtime) then addtime = now()

username = "bt"

filesize = GetContent(content,"BT文件大小："," ",0)

title2 = title

downurl = GetContent(cpage,"<a style=""color:red"" href=""","""",0)

p = CDate(addtime)
Dim sRnd
Randomize
sRnd = Int(900 * Rnd) + 100
sFileName = year(p) & month(p) & day(p) & hour(now) & minute(now) & second(now) & sRnd & ".torrent"

url = "torrent/" & year(p) & "-" & month(p) & "-" & day(p) & "/" & sFileName
Call CreateF(url)

'Text
Response.Write classname & "<br>"
Response.write title & "<br>"
'response.Write intro & "<br>"
'response.Write addtime & "<br>"
'response.Write username & "<br>"
'response.Write filesize & "<br>"
response.Write downurl & "<br>"
response.Write url & "<br>"
response.Flush()

'response.End()
'database

if err.number = 0 then
if (Not IsNull(title)) and title <> "" and downurl <> "" then
set rs = server.CreateObject("adodb.recordset")
sql = "select * from bt_class where classname = '" & classname & "'"
rs.open sql,conn,1,3
if rs.eof then
rs.addnew
rs("classname") = classname
rs.update
end if
classid = rs("classid")
rs.close
set rs = nothing

set rs = server.CreateObject("adodb.recordset")
sql = "select * from bt_movie where title in ('" & title & "')"
rs.open sql,conn,1,3
if rs.eof then
response.Write "<div><font color=blue>写入数据库...</font></div>"
response.Flush()
rs.addnew
rs("classid") = classid
rs("title") = title
rs("title2") = title2
rs("intro") = intro
rs("username") = username
rs("filesize") = filesize
rs("url") = url
rs("serverid") = 1
rs("addtime") = addtime
rs("ismake") = 0
rs.update

objxhttp.URL = downurl
objxhttp.saveimage url,False
else
response.Write "<div><font color=red>已经存在！</font></div>"
end if
rs.close
set rs = nothing

'objxhttp.URL = downurl
'objxhttp.saveimage url,False
End IF

Else
err.clear
End IF
response.Write "-------------------------------------------<br>"
Next
set regEx = nothing

response.Write "下一页<br>"
response.Flush()

Call NextID()

end if

Sub NextID
conn.close
set conn = nothing

if cint(startid) < cint(overid) and cint(id) < cint(overid) then
response.Write "<script>location.href='get81bt.asp?action=getdata&classname=" & Request("classname") & "&cid=" & cid & "&startid=" & startid & "&overid=" & overid & "&id="& id + 1 &"'</script>"
Elseif cint(startid) > cint(overid) and cint(id) > cint(overid) then
response.Write "<script>location.href='get81bt.asp?action=getdata&classname=" & Request("classname") & "&cid=" & cid & "&startid=" & startid & "&overid=" & overid & "&id="& id - 1 &"'</script>"
Else
Response.Write "采集完成！<br>"
response.End()
End if
End Sub

%>

</body>
</html>

内容总结

以上是互联网集市为您收集整理的自己做采集程序全部内容，希望文章能够帮你解决自己做采集程序所遇到的程序开发问题。如果觉得互联网集市技术教程内容还不错，欢迎将互联网集市网站推荐给程序员好友。

内容备注

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容，请发送邮件至 gblab@vip.qq.com 举报，一经查实，本站将立刻删除。

内容手机端

扫描二维码推送至手机访问。

本文链接：https://qyyshop.com/info/385389.html

来源：【匿名】

【上一篇】ASP智能搜索的实现【下一篇】ASP知识讲座四

更多 ►

【自己做采集程序】教程文章相关的互联网学习教程文章

信息收集【采集点OWASP CHINA】网址http://www.owasp.org.cn/

以下部分源于安全家 http://www.anquanjia.net.cn/newsinfo/729480.html 资源虽多，优质却少。不要被信息海迷惑的心智，新人要想入门，除了优质的系统教学资源，别无他法。请从以下所有信息海，找到知识的来源，找教学。不好意思，新人必须做一个伸手党：你不伸手要来源，去搜文章看的话，思维是无法汇聚的，文章也看得云里雾里。作为专家，也请多把自己的学习经历，接触了什么优质教学资源分享出来。不要掌握了，就随便写写文章，...

发一个采集(小偷)用的类，ASP+缓存实现【图】

简单采集类1.0测试版------------------------------Cls_Ajax.asp 负责采集网页Cls_Filter.asp 负责过滤数据Cls_Thief.asp 前2个类的整合，并负责数据处理和缓存演示和使用已在index.asp给出这里的抓取多已百度为主，原因是页面简洁，容易写正则其实很多地方，抓rss效果和效率会更好，本人只是在上次看到一个ajax留言本后，用此练习下，类的功能很简单，仅用于练习正则写的不好，望高手指点演示地址：http://home.goofar.com/robin...

创力采集程序用到的函数推荐第1/3页

代码如下:<% '================================================== '过程名：Admin_ShowChannel_Name '作用：显示频道名称 '参数：ChannelID ------频道ID '================================================== Sub Admin_ShowChannel_Name(ChannelID) Dim Sqlc,Rsc,TempStr ChannelID=Clng(ChannelID) Sqlc ="select top 1 ChannelName from Cl_Channel Where ChannelID=" & ChannelID Set Rsc=server.Creat...

利用MSXML2.XmlHttp和Adodb.Stream采集图片

利用MSXML2.XmlHttp和Adodb.Stream 代码如下:<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.gxlsystem.com/logos.gif",Server.MapPath("google.gif")) %> </body> </html>

phpcurl采集含__EVENTVALIDATION的asp网页【图】

phpcurl 正在用php的curl抓取页面信息时，遭遇asp的__VIEWSTATE和__EVENTVALIDATION有搜到博客提供的方法，但有一个关键问题（也可能是白痴的问题)：action是空的， CURLOPT_URL 怎么写？写表单所在页面不行，空的不行，有个博客这样写http://???/default.aspx，也不行，真心求解

asp只采集网站可见文本的正则

我写的是这样: Function ClearHTMLCode(originCode) Dim reg set reg = new RegExp reg.IgnoreCase = True reg.Global = True reg.Pattern = "(<s+cript(.+?)<\/s+cript>)" originCode= reg.Replace(originCode, "") reg.Pattern = "(<s+tyle(.+?)<\/s+tyle>)" originCode= reg.Replace(originCode, "") reg.Pattern = "<[^>]*>" originCode= reg.Replace(originCode, "") ClearHTMLCode = originCode End Function 不过有一些过滤...

asp采集HTML内容常用代码,详讲正则采集

先说一下采集原理：采集程序的主要步骤如下：一、获取被采集的页面的内容二、从获取代码中提取所有用的数据一、获取被采集的页面的内容我目前所掌握的ASP常用获取被采集的页面的内容方法： 1、用serverXMLHTTP组件获取数据代码如下:Function GetBody(weburl) 创建对象 Dim ObjXMLHTTP Set ObjXMLHTTP=Server.CreateObject("MSXML2.serverXMLHTTP") 请求文件,以异步形式 ObjXMLHTTP.Open "GET",weburl,False ObjXMLHTTP.send...

ASP 自动采集实现代码

其主要的优点便是无需再手工添加大量的信息了，可以指定对某一个站信息的截取进行批量录入，达到省时省力的目的。与其单纯的ASP小偷程序不同的是:它已经不再依赖其目标网站。参考代码：代码如下:<% 声明取得目标信息的函数,通过XML组件进行实现。 Function Geturl(/blog/url) Set Retrieval = CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "GET", url, False .Send GetURL = bytes2bstr(.responsebody) 对取得信息进...

ASP读取XML实例优酷专辑采集程序雷锋版

代码如下:<title>雷锋|优酷-专辑采集程序</title></head> <form name="form1" method="post" action="?action=add"> <table width="95%" border="0" align="center" cellpadding="0" cellspacing="1" class="tableBorder"> <tr><th colspan="2" align="center" class="tableHeaderText"><<<< <font color=red>雷锋|优酷-专辑采集程序</font> >>>></td></tr> <tr><td align="center"><a href="http://www.gxlsystem.com/playlist/...

asp动态页面防采集的新方法

昨天在网上看到一个防采集软件，说采集只访问当前网页，不会访问网页的图片、JS等，今天突然想到，通过动态程序和Js访问分别记录访问者的IP，然后进行IP判断，由于采集过程不会访问JS，采集的时候只会查到用动态程序记录的IP，而不会有通过JS记录的IP，从而实现网页程序的防采集。防采集的原理非常简单，首先放一段动态语句，把访问者的IP加入到数据库的一个表里，然后在页面底部加入一个JS，JS直接访问动态页面，将访问者的IP加入...

asp 采集程序常用函数分析

原理采集程序实际上是通过了XML中的XMLHTTP组件调用其它网站上的网页。比如新闻采集程序，很多都是调用了sina的新闻网页，并且对其中的html进行了一些替换，同时对广告也进行了过滤。用采集程序的优点有：无须维护网站，因为采集程序中的数据来自其他网站，它将随着该网站的更新而更新；可以节省服务器资源，一般采集程序就几个文件，所有网页内容都是来自其他网站。缺点有：不稳定，如果目标网站出错，程序也会出错，而且，如果目...

ASP实现防止网站被采集代码

代码如下:<% Dim AppealNum,AppealCount AppealNum=10 '同一IP60秒内请求限制10次 AppealCount=Request.Cookies("AppealCount") If AppealCount="" Then Response.Cookies("AppealCount")=1 AppealCount=1 Response.Cookies("AppealCount").Expires=DateAdd("s",60,Now()) Else Response.Cookies("AppealCount")=AppealCount+1 Response.Cookies("AppealCount").Expires=DateAdd("s",60,Now()) End If If Int(AppealCount)>Int(App...

asp 小偷采集程序原理与常用函数方法

用采集程序的优点有：无须维护网站，因为采集程序中的数据来自其他网站，它将随着该网站的更新而更新；可以节省服务器资源，一般采集程序就几个文件，所有网页内容都是来自其他网站。缺点有：不稳定，如果目标网站出错，程序也会出错，而且，如果目标网站进行升级维护，那么采集程序也要进行相应修改；速度，因为是远程调用，速度和在本地服务器上读取数据比起来，肯定要慢一些。一、事例下面就XMLHTTP在ASP中的应用做个简单说明 ...

防止网站被采集的理论分析以及十条方法对策第1/2页

相同点： a. 两者都需要直接抓取到网页源码才能有效工作， b. 两者单位时间内会多次大量抓取被访问的网站内容; c. 宏观上来讲两者IP都会变动; d. 两者多没耐心的去破解你对网页的一些加密(验证)，比如网页内容通过js文件加密，比如需要输入验证码才能浏览内容，比如需要登录才能访问内容等。不同点：搜索引擎爬虫先忽略整个网页源码脚本和样式以及html标签代码，然后对剩下的文字部分进行切词语法句法分析等一系列的复杂处...

一个带采集远程文章内容,保存图片,生成文件等完整的采集功能

代码如下:'================================================== '函数名：GetHttpPage '作用：获取网页源码 '参数：HttpUrl ------网页地址 '================================================== Function GetHttpPage(HttpUrl) If IsNull(HttpUrl)=True Or Len(HttpUrl)<18 Or HttpUrl="$False$" Then GetHttpPage="$False$" Exit Function End If Dim Http Set Http=server.createobject("MSX" & "ML2.XM" & "LHT" & "TP") H...

首页 / ASP / 自己做采集程序

自己做采集程序

内容导读

内容图文

内容总结

内容备注

内容手机端

【自己做采集程序】教程文章相关的互联网学习教程文章

信息收集【采集点OWASP CHINA】网址http://www.owasp.org.cn/

发一个采集(小偷)用的类，ASP+缓存实现【图】

创力采集程序用到的函数推荐第1/3页

利用MSXML2.XmlHttp和Adodb.Stream采集图片

phpcurl采集含__EVENTVALIDATION的asp网页【图】

asp只采集网站可见文本的正则

asp采集HTML内容常用代码,详讲正则采集

ASP 自动采集实现代码

ASP读取XML实例优酷专辑采集程序雷锋版

asp动态页面防采集的新方法

asp 采集程序常用函数分析

ASP实现防止网站被采集代码

asp 小偷采集程序原理与常用函数方法

防止网站被采集的理论分析以及十条方法对策第1/2页

一个带采集远程文章内容,保存图片,生成文件等完整的采集功能

采集 - 相关标签

程序 - 相关标签

ASP - 技术教程分类

ASP - 最新教程

ASP - 最热教程