ASP实现的小偷类

最新推荐文章于 2024-09-18 09:47:26 发布
最新推荐文章于 2024-09-18 09:47:26 发布
阅读量725 收藏
点赞数
分类专栏： ASP 文章标签： asp html function 正则表达式 url include
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/lg970044/article/details/1809647
版权

以前的一个项目为抓内容写的小偷类，感觉是一个不错的类，便拿出来分享一下。

< %
 ' ******************************************************************
' ClassName:    Pub_Thief
' Name:        通用小偷类
' Version:    2.0
' Author:    lg970044
' Date:        2006-2-16
' Note:        1.出错标记为"$False$"
'             2.分隔标记为"$|||$"
' ******************************************************************
Class Pub_Thief
     Private  PT_URL             ' 目标网址
     Public     PT_RegExp         ' 正则表达式对象
     Public      CharSet             ' 设置字符集(可设置,默认GB2312)
     Public     Str_Html         ' 获取的HTML代码，是加工操作的字符串
     Public     IgnoreCase         ' 设置是否区分大小写,True忽略大小写,False区分大小写(可设置,默认True)
     Public     RequestMethod     ' 设置网页请求方式(可设置,默认GET)
     Public     RequestForm         ' 设置Post请求方式的表单内容(格式为:表单项1=值1&表单项2=值2，当传递的表单值有特殊字符时,应用Server.URLEncode来转换)
     Public   Property   Get  Version
        Version = " 通用小偷类 V2.0 "
     End Property
    
     ' 类初始化
     Private   Sub  Class_Initialize()
        PT_URL = " $False$ "
        Str_Html = " $False$ "
         Set  PT_RegExp = New  RegExp
        PT_RegExp.IgnoreCase = True          ' 忽略大小写
        PT_RegExp.Global = True              ' 全程匹配。
        IgnoreCase = True
        CharSet = " GB2312 "
        RequestMethod = " GET "
        RequestForm = ""
     End Sub

     ' 注销类
     Private   Sub  Class_Terminate()
         Set  PT_RegExp = Nothing
     End Sub
    

     ' 连接网址，获取网页HTML源码(Get_Url为目标网址)
     Public   Sub  Open(Get_Url)
        PT_URL = Get_Url
        getHttpPage()
     End Sub

     ' 根据目标网页的HTML代码写入到Str_Html属性中
     Private   Sub  getHttpPage()
         If  PT_URL = ""   Or  PT_URL = " $False$ "   Then
            Str_Html = " $False$ "
             Exit   Sub
         End   If
         Dim  Http
         On   Error   Resume   Next
         Set  Http = Server.CreateObject( " MSXML2.XMLHTTP " )
        Http.Open RequestMethod,PT_URL, False
         If   UCase (RequestMethod) = " POST "   Then      ' 当RequestMethod属性为POST时传送表单
            Http.setRequestHeader  " Content-Type " ,  " application/x-www-form-urlencoded "
            Http.Send(RequestForm)
         Else
            Http.Send()
         End   If
         ' 过滤传输失败的情况
         If  Http.ReadyState <> 4   Then
             Set  Http = Nothing
            Str_Html = " $False$ "
             Exit   Sub
         End   If
         ' 过滤响应错误的情况
         If  Http.Status = 200   Then
            Str_Html = BytesToBstr(Http.ResponseBody)
         Else
            Str_Html = " $False$ "
         End   If
         Set  Http = Nothing
         If  Err.Number <> 0   Then
            Err.Clear
         End   if
     End Sub

     ' 编码转换
     Private   Function  BytesToBstr(Body)
         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  =  CharSet
        BytesToBstr  =  ObjStream.ReadText
        ObjStream.Close()
         Set  ObjStream  =   Nothing
     End Function

     ' 保存HTML源码到文件中
     Public   Sub  saveFile(Out_Path)
         Dim  ObjStream,Stream
         Set  ObjStream  =  Server.CreateObject( " AdoDB.Stream " )
        ObjStream.Type  =   2
        ObjStream.Charset  =  CharSet
        ObjStream.Open
        ObjStream.WriteText Str_Html
        ObjStream.SaveToFile Server.Mappath(Out_Path), 2
        ObjStream.Close()
         Set  ObjStream  =   Nothing
     End Sub


     ' 删除HTML中里面的换行、回车、换页
     Public   Sub  delNRF()
        PT_RegExp.Global = True              ' 设置全程匹配
        PT_RegExp.Pattern = " | | "
        Str_Html = PT_RegExp.Replace(Str_Html, "" )
     End Sub

     ' 替换HTML中里面字符串(Get_StrOld为被替换的字符串,Get_StrNew为替换字符串)
     Public   Sub  replaceText(Get_StrOld,Get_StrNew)
        Str_Html = Replace (Str_Html,Get_StrOld,Get_StrNew)
     End Sub

     ' 查找指定首尾字符串的第一个字符串,返回查找到的值(Get_StrS为指定首字符串,Get_StrNew为指定尾字符串,Get_Start为开始查找位置,Get_Include为是否包含首尾字符串)
     Public   Function  SelectTextFirst(Get_StrS,Get_StrE,Get_Start,Get_Include)
         If  Get_StrS = ""   Or  Get_StrE = ""   Then
            SelectTextFirst = ""
             Exit   Function
         End   If
         Dim  SN,EN,SL,EL,Total,Start,i,str,str_arr     ' 首字符串位置，尾字符串位置，首字符串长度，尾字符串长度，总长度，开始位置
        Start = Abs (Get_Start)
         If  Start = 0   Then  Start = 1
        Total = Len (Str_Html)
        SL = Len (Get_StrS)
        EL = Len (Get_StrE)
        SN = Instr (Start,Str_Html,Get_StrS)
        EN = Instr (Start,Str_Html,Get_StrE)
         If  SN > 0   and  EN > 0   Then
             If  Get_Include  Then
                i = Total - SN + 1
                str = Right (Str_Html,i)
                i = EN - SN + EL
                str = Left (str,i)
             Else
                i = Total - SN - SL + 1
                str = Right (Str_Html,i)
                i = EN - SN - SL
                str = Left (str,i)
             End   If
            SelectTextFirst = str
         Else
            SelectTextFirst = ""
         End   If
     End Function

     ' 查找指定首尾字符串的一组字符串,返回查找到的值的数组(Get_StrS为指定首字符串,Get_StrNew为指定尾字符串,Get_Start为开始查找位置,Get_Include为是否包含首尾字符串)
     Public   Function  SelectText(Get_StrS,Get_StrE,Get_Start,Get_Include)
         If  Get_StrS = ""   Or  Get_StrE = ""   Then
            SelectText = Null
             Exit   Function
         End   If
         Dim  SN,EN,SL,EL,Total,Start,i,str,str_arr     ' 首字符串位置，尾字符串位置，首字符串长度，尾字符串长度，总长度，开始位置
        Start = Abs (Get_Start)
         If  Start = 0   Then  Start = 1
        Total = Len (Str_Html)
        SL = Len (Get_StrS)
        EL = Len (Get_StrE)
        str_arr = ""
         Do   While  Start < Total
            SN = Instr (Start,Str_Html,Get_StrS)
            EN = Instr (Start,Str_Html,Get_StrE)
             If  SN < 1   and  EN < 1   Then   Exit   Do      ' 当找不到时退出循环
             If  Get_Include  Then
                i = Total - SN + 1
                str = Right (Str_Html,i)
                i = EN - SN + EL
                str = Left (str,i)
             Else
                i = Total - SN - SL + 1
                str = Right (Str_Html,i)
                i = EN - SN - SL
                str = Left (str,i)
             End   If
            Start = EN + Len (Get_StrE)
            str_arr = str_arr & str & " $|||$ "
         Loop
         If  str_arr = ""   Then
            SelectText = Null
         Else
            str_arr = Left (str_arr, Len (str_arr) - Len ( " $|||$ " ))         ' 去掉最后一个分隔符
            SelectText = Split (str_arr, " $|||$ " )         ' 输出数组
         End   If
     End Function

     ' 正则表达式替换字符串(Get_StrOld为要被替换的匹配模式,Get_StrNew为替换匹配模式)
     Public   Sub  RegExpRepl(Get_PatternOld,Get_PatternNew)
        PT_RegExp.Global = True              ' 设置全程匹配
        PT_RegExp.IgnoreCase = IgnoreCase
        PT_RegExp.Pattern = Get_PatternOld
        Str_Html = PT_RegExp.Replace(Str_Html,Get_PatternNew)
     End Sub

     ' 正则表达式匹配第一个字符串(Get_Pattern为匹配模式,Get_SubMatches为子匹配[0表示返回匹配,不为0返回相应子匹配])
     Public   Function  RegExpExecFirst(Get_Pattern,Get_SubMatches)
         Dim     Matches
        PT_RegExp.Global = False              ' 设置匹配第一个
        PT_RegExp.IgnoreCase = IgnoreCase
        PT_RegExp.Pattern = Get_Pattern
         Set  Matches  =  PT_RegExp.Execute(Str_Html)
         If  Matches.Count  =   0   Then
            RegExpExecFirst = ""
         Else
             If  Get_SubMatches = 0   Then
                RegExpExecFirst = Matches.Item( 0 ).Value
             Else
                RegExpExecFirst = Matches.Item( 0 ).SubMatches(Get_SubMatches - 1 )
             End   If
         End   If
        PT_RegExp.Global = True              ' 设置全程匹配
     End Function

     ' 正则表达式匹配字符串,返回数组(Get_Pattern为匹配模式,Get_SubMatches为子匹配[0表示返回匹配,不为0返回相应子匹配])
     Public   Function  RegExpExec(Get_Pattern,Get_SubMatches)
         Dim     Matches,Match,str_arr
        PT_RegExp.Global = True              ' 设置全程匹配
        PT_RegExp.IgnoreCase = IgnoreCase
        PT_RegExp.Pattern = Get_Pattern
         Set  Matches  =  PT_RegExp.Execute(Str_Html)
        str_arr = ""
         For   Each  Match in Matches         '  遍历 Matches 集合。
             If  Get_SubMatches = 0   Then
                str_arr = str_arr & Match.Value & " $|||$ "
             Else
                str_arr = str_arr & Match.SubMatches(Get_SubMatches - 1 ) & " $|||$ "
             End   If
         Next
         If  str_arr = ""   Then
            RegExpExec = Null
         Else
            str_arr = Left (str_arr, Len (str_arr) - Len ( " $|||$ " ))         ' 去掉最后一个分隔符
            RegExpExec = Split (str_arr, " $|||$ " )         ' 输出数组
         End   If
     End Function

     ' 正则表达式匹配检测,返回Boolean值指示是否找到(Get_Pattern为匹配模式)
     Public   Function  RegExpTest(Get_Pattern)
        PT_RegExp.Global = False
        PT_RegExp.Pattern = Get_Pattern
        RegExpTest = PT_RegExp.Test(Str_Html)
        PT_RegExp.Global = True              ' 设置全程匹配
     End Function

     ' 取得目标网址的二进制流
     Private   Function  getBinary (Get_Url)
         If  Get_Url = ""   Or  Get_Url = " $False$ "   Then
            getBinary = Null
             Exit   Function
         End   If
         Dim  Binary
         On   Error   Resume   Next
         Set  Binary = Server.CreateObject( " MSXML2.XMLHTTP " )
        Binary.Open  " GET " ,Get_Url, False
        Binary.Send()
         If  Binary.ReadyState <> 4   Then
             Set  Binary = Nothing
            getBinary = Null
             Exit   Function
         End   If
         ' 过滤响应错误的情况
         If  Binary.Status = 200   Then
            getBinary = Binary.ResponseBody
         Else
            getBinary = Null
         End   If
         Set  Binary = Nothing
         If  Err.Number <> 0   Then
            Err.Clear
         End   if
     End Function

     ' 根据目标网址保存二进制文件,返回保存的文件路径(Get_Url为要保存的远程文件[要求完整URL],Out_Path为保存的路径前缀[使用虚路径])
     Public   Function  saveBinaryFile(Get_Url,Out_Path)
         Dim  ObjStream,Stream,Matches
        Stream = getBinary(Get_Url)
         If   IsNull (Stream)  Then      ' 当无法获取二进制文件时退出函数，并返回远程文件URL
            saveBinaryFile = Get_Url
             Exit   Function
         End   If
         ' 从URL中取得文件名
        PT_RegExp.IgnoreCase = IgnoreCase
        PT_RegExp.Pattern = " ^http://.+?/(.+)$ "
         Set  Matches  =  PT_RegExp.Execute(Get_Url)
         If  Matches.Count  =   0   Then      ' 当取没有相匹配文件名时退出函数，并返回远程文件URL
            saveBinaryFile = Get_Url
             Exit   Function
         Else
            Out_Path = Out_Path & Replace (Matches.Item( 0 ).SubMatches( 0 ), " / " , " - " )
         End   If
         Set  ObjStream  =  Server.CreateObject( " AdoDB.Stream " )
        ObjStream.Type  =   1
        ObjStream.Open
        ObjStream.Write Stream
        ObjStream.SaveToFile Server.Mappath(Out_Path), 2
        ObjStream.Close()
         Set  ObjStream  =   Nothing
        saveBinaryFile = Out_Path         ' 返回本地保存的文件路径
     End Function
End  Class
% >
 
详细内容见： http://www.qlolo.com/?m=pc&a=page_fh_diary&target_c_diary_id=879
lg970044
关注
专栏目录
ASP网站小偷源码
01-09
ASP网站小偷源码
发一个采集(小偷)用的类，ASP+缓存实现
10-31
- **总结**：通过使用 ASP 结合缓存技术实现的 Web 数据采集系统，不仅可以高效地抓取所需信息，还能通过合理的缓存策略减少重复工作，提升整体性能。同时，该项目还提供了一个简单的示例应用，方便初学者理解和实践...
asp小偷转html,asp读取远程文件/ASP小偷写法
weixin_35097989的博客
06-29 206
抓取远程文件中的内容，可以用到。function DownloadFile(url,filename)Set xml = Server.CreateObject("Msxml2.XMLHTTP") '创建对象xml.Open "GET",url,Falsexml.Send '发送请求if Err.Number>0 thenResponse.Status="404"elseResponse.C...
asp正则表达式使用过程中踩的坑
Robin罗兵
11-12 363
以下代码是我调试过程中的代码，有以下问题： 1、matches(0).SubMatches(0)是匹配模式中有()的时候来获取结果。 2、如果匹配模式中无()则直接用Match.value获取匹配结果 3、将以下代码copy到test.asp的文件中时，在调试的时候浏览器有些时候看不到结果，是因为输出的结果中包涵了代码。采用源代码的模式是可以看到匹配的代码及文字。Match.value输出的...
做ASP小偷时.经常需要用到的函数.
SmartJavaer的专栏
10-12 882
 做ASP小偷时.经常需要用到的函数.采集页面:Function GetPage(url) dim SendData,Retrieval        Set Retrieval = CreateObject("Microsoft.XMLHTTP")         With Retrieval         .Open "post", url, False        .setReque
ASP小偷代码(远程数据获取)程序入门教程
02-23 698
这里所说的“小偷”指的是在asp中运用xml中的xmlhttp组件提供的强大功能，把远程网站上的数据（图片，网页及其他文件）抓取到本地，经过各种处理后显示到页面上或者存储进数据库的一类程序。你可以通过这种小偷程序，完成过去一些似乎完全不可能实现的任务，比如说把某个站的页面偷梁换柱后变成自己的页面，或者把某个站的一些数据（文章，图片）保存到本地数据库中加以利用。“小偷”的优点有：无须维护网站，因为小
ASP文章小偷程序
冯立彬的博客
01-08 8109
    今天闲得没事，就写了一个小偷程序，呵呵，不要误会哦，本人生性光明。只是好久没有认真写程序了，热热身子。主要思路还是来源于http://blog.csdn.net/manyou/archive/2004/09/14/103617.aspx，在此表示感谢，我只不过是在他的思路下丰富了一下，使得该程序更容易使用而已，不是我的功劳。    关于原理方面的东西，我这里就不多讲了，网上讲原理的很多
ASP小偷(远程数据获取)程序的入门教程
ξσ Dicky's Blog σξ
05-28 1754
这里所说的“小偷”指的是在asp中运用xml中的xmlhttp组件提供的强大功能，把远程网站上的数据（图片，网页及其他文件）抓取到本地，经过各种处理后显示到页面上或者存储进数据库的一类程序。你可以通过这种小偷程序，完成过去一些似乎完全不可能实现的任务，比如说把某个站的页面偷梁换柱后变成自己的页面，或者把某个站的一些数据（文章，图片）保存到本地数据库中加以利用。“小偷”的优点有：无须维护网站，因为小
用正则和xmlHttp实现的asp小偷程序
10-31
本文档旨在解析一个具体的ASP脚本案例，该脚本通过使用正则表达式（Regular Expression）与XMLHttpRequest技术来实现网页内容抓取（俗称“小偷程序”）。此类程序能够自动从目标网站抓取数据，并将这些数据整合到...
A利用ASP小偷和Google实现在线翻译功能的代码
10-30
### A利用ASP小偷和Google实现在线翻译功能的代码 #### 概述 本文档将详细介绍如何使用ASP（Active Server Pages）与Google翻译API结合，为网页提供动态多语言翻译的功能。通过这种方式，用户可以在不离开当前页面...
利用ActiveX控件InetCtls.Inet在ASP中实现新闻小偷
10-31
### 使用ActiveX控件InetCtls.Inet在ASP中实现新闻抓取 #### 引言 在Web开发中，有时候需要从其他网站抓取数据，例如新闻文章、产品信息等，这一过程被称为“网络爬虫”或“数据抓取”。在早期的Web开发环境中，如...
[ASP]其实做小偷是很容易的
ggcall的专栏
10-20 1523
    其实做小偷是很容易的.......................          要做一名好的小偷有点难度:P          这是我投给电脑报的一篇稿子,很简单,写得很仓促,有很多不足的地方,高手们笑的时候麻烦指正一下,原文是拿ALEXA开刀,我在落伍发表的时候修改成了QQ天气预报小偷.          灵活运用XMLHTTP组件          你也可以做“小偷”     
ASP中实现小偷程序的原理和简单示例
晓夜璨丰
09-16 1401
早先网上流行的小偷程序比较多，有新闻类小偷，音乐小偷，下载小偷，那么它们是如何做的呢，下面我来做个简单介绍，希望对各位站长有所帮助。 （一）原理 小偷程序实际上是通过了XML中的XMLHTTP组件调用其它网站上的网页。比如新闻小偷程序，很多都是调用了sina的新闻网页，并且对
小偷程序(asp)
05-30 220
 这里所说的“小偷”指的是在ASP中运用XML中的XMLHTTP组件提供的强大功能，把远程网站上的数据（图片，网页及其他文件）抓取到本地，经过各种处理后显示到页面上或者存储进数据库的一类程序。你可以通过这种小偷程序，完成过去一些似乎完全不可能实现的任务，比如说把某个站的页面偷梁换柱后变成自己的页面，或者把某个站的一些数据（文章，图片）保存到本地数据库中加以利用。“小偷”的优点有：无须维护网站
做ASP小偷程序
wyhappy612的专栏
11-13 594
 (一)如何截取指定区域的HTML代码? 　　(对方网站的HTML代码在哪儿看？晕：IE浏览器>>查看>>源文件。不要告诉我你不知道IE是什么！)，例如我只想获取以下HTML代码中""和""之间的的文字部分： 网站爱好者__http://www.wwwfan.cn 网站爱好者__http://www.wwwfan.cn是个网页制作资源多多的站点…… …… Dim StrB
asp小偷程序原理
污鲱在制作网站
09-23 1621
小偷程序原理和简单示例现在网上流行的小偷程序比较多，有新闻类小偷，音乐小偷，下载小偷，那么它们是如何做的呢，下面我来做个简单介绍，希望对各位站长有所帮助。（一）原理小偷程序实际上是通过了XML中的XMLHTTP组件调用其它网站上的网页。比如新闻小偷程序，很多都是调用了sina的新闻网页，并且对其中的html进行了一些替换，同时对广告也进行了过滤。用小偷程序的优点有：无须维护网站，因为小偷程序中
html知识点框架
最新发布
爱敲代码的卡拉米的博客
09-18 550
一、HTML基础
ASP.NET 分页类实现及代码示例
"asp.net URL分页类代码是一个用于实现ASP.NET网页中数据分页功能的类，可以帮助开发者处理大量数据的展示，使用户能够通过点击不同的页码来浏览数据的不同部分。这个类提供了对分页参数的管理，包括页面地址、数据...
评论 1
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值