悠悠博客 关注Ajax技术与web开发

网络数据载取系统(WebCutpurse)
系统版本：Version 1.0
版权所有: 夕雨情
Copyright 2004www.loveling.net - All Rights Reserved.

开发者文档说明
网名: 本·拉灯
论坛ID: wyd1520
Oicq: 47833873
Email: wyd1520@163.com
Web: http://www.loveling.net

使用说明
作用:截取网络数据通用类，利用此类可以截取网络上文字，图片，Flash，音乐等

===================
类的属性
===================
URL属性:载取的网址
FileURL属性：网络上文件（如图片，Flash等）地址
SaveFilePath属性：保存到本地的路径
BStr属性：处理提取字符串的起始点
EStr属性：处理提取字符串的结束点
Char属性：提取汉字拼音时所用的字符串
WebFolderPath：网络上的子目录(如Http://www.Loveling.net/bbs/js 那么 bbs/js就是网络子目录)
RegStr属生：是按正则表达式所提取的内容
Pattern属性：正则表达式
===================
类的方法
===================
SaveFile方法：提取网络上的文件到本机用的，其对应的属性 FileURL,FilePath
DeHttpdata方法：正则提取内容，其对应的属性 RegStr,Pattern
GetWebBody方法：提取网页内容，其对应的属性 URL
GetPyChar方法：提取汉字的第一个拼音，其对应的属性 Char （注：此属性只能是一个汉字，两个或两个以上会出错）
GetStr(Wyd_Body)方法：从左边提取字符串函数，参数为要提取的对应内容，其对应属性 BStr,EStr
GetRstr(Wyd_Body)方法：从右边提取字符串函数，参数为要提取的对应内容，其对应属性 BStr,EStr
MakeNewFolder方法：建立文件夹，其对应的属性 WebFolderPath （注：生成的目录是要当前目录下）
IsErr方法：处理错误
ShowErrMsg方法：显视错误原因

版本说明：
 1.商业版 拥有以上所有的功能,及以后的升级
 2.免费版 没有提取网络上的文件到本机、没有提取汉字的第一个拼音、没有建立文件夹等功能的所有功能

<%
''===============================================================================================
'' File: Wyd_Class.asp                                                                          
'' Version:1.0 (免费版)
'' Date: 2004-9-2
'' Script Written by Wyd1520(本·拉灯)
'' Copyright (C) 2004 loveling.net. All rights reserved.
''===============================================================================================
'' 开发者文档说明
'' 网名:       本·拉灯
'' 论坛ID: wyd1520
'' Oicq:       47833873
'' Email: wyd1520@163.com
'' Web:       http://www.loveling.net
''================================================================================================
''                         使用说明
'' 如采用本类模块，请不要去掉这个说明，此处不会引响你的执行速度。
'' 作用:截取网络数据通用类，利用此类可以截取网络上文字，图片，Flash，音乐等
''================================================================================================
''类的属性
''===================
''  URL属性:载取的网址
''  FileURL属性：网络上文件（如图片，Flash等）地址
''  SaveFilePath属性：保存到本地的路径
''  BStr属性：处理提取字符串的起始点
''  EStr属性：处理提取字符串的结束点
''  Char属性：提取汉字拼音时所用的字符串
''  WebFolderPath：网络上的子目录(如Http://www.Loveling.net/bbs/js 那么 bbs/js就是网络子目录)
''  RegStr属生：是按正则表达式所提取的内容
''  Pattern属性：正则表达式
''===================
''类的方法
''===================
''  SaveFile方法：提取网络上的文件到本机用的，其对应的属性 FileURL,FilePath
''  DeHttpdata方法：正则提取内容，其对应的属性 RegStr,Pattern
''  GetWebBody方法：提取网页内容，其对应的属性 URL
''  GetPyChar方法：提取汉字的第一个拼音，其对应的属性 Char （注：此属性只能是一个汉字，两个或两个以上会出错）
''  GetStr(Wyd_Body)方法：从左边提取字符串函数，参数为要提取的对应内容，其对应属性 BStr,EStr
''  GetRstr(Wyd_Body)方法：从右边提取字符串函数，参数为要提取的对应内容，其对应属性 BStr,EStr
''  MakeNewFolder方法：建立文件夹，其对应的属性 WebFolderPath （注：生成的目录是要当前目录下）
''  IsErr方法：处理错误
''  ShowErrMsg方法：显视错误原因
''================================================================================================
Class Wyd_WebCutpurse
 Private XMLHttp,ADS,RegEx,Fso
 Private FoundErr,ErrNo
 Private Wyd_URL,Wyd_FileUrl,Wyd_FilePath,Wyd_BStr,Wyd_EStr,ErrStr1,ErrStr2,ErrStr3
 Private TmpStr,TmpBStr,TmpEStr,TmpBody
 Private Wyd_WebFolderPath,Wyd_Char,Wyd_Pattern,Wyd_RegStr
 Public Body
 Public Property Get Version
          Version="<A HREF=http://www.loveling.net>WebCutpurse Version 1.0 [免费版]</A>"
 End Property
 Public Property Let URL(TmpURL)
    Wyd_URL=TmpURL
 End Property

 Public Property Let BStr(T_BStr)
    Wyd_BStr=T_BStr
 End Property
 Public Property Let EStr(T_EStr)
    Wyd_EStr=T_EStr
 End Property
 Public Property Let Char(T_Char)
    Wyd_Char=T_Char
 End Property

 Public Property Let RegStr(T_RegStr)
    Wyd_RegStr=T_RegStr
 End Property
 Public Property Let Pattern(T_Patt)
    Wyd_Pattern=T_Patt
 End Property
 
 Private Sub Class_Initialize()
    Set XMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")
     Set ADS = Server.CreateObject("Adodb.Stream")
    Set Fso = Server.CreateObject("Scripting.FileSystemObject")
     Set RegEx = New RegExp
    FoundErr=False
    ErrNo=-1
     ErrStr1="在处理数据时截取的参数不正确或者所提取的页面不存在！"
     ErrStr2="没有网络数据或者你没有连接网络！"
     ErrStr3="未知错误，请联系作者，作者：Wyd1520(本·拉灯) QQ：47833873 E-mail:wyd1520@163.com"
 End Sub
 Private Sub Class_Terminate()
     Set XMLHTTP = nothing
     Set ADS = nothing
     Set Fso = nothing
     Set RegEx = nothing
 End Sub
''二进制转成字符
 Private Function BytesToBstr(Tbody)
   ADS.Type = 1
   ADS.Mode =3
   ADS.Open
   ADS.Write Tbody
   ADS.Position = 0
   ADS.Type = 2
   ADS.Charset = "GB2312"
   BytesToBstr = ADS.ReadText
   ADS.Close
 End Function
 Public Function DeHttpdata()
   Dim RetStr, Match '' 建立变量。
   RegEx.IgnoreCase = False   '' 设置是否区分字母的大小写。
   RegEx.Global = True   '' 设置全程性质。
   RegEx.Pattern = Wyd_Pattern  '' 设置模式。
   Set Matches = RegEx.Execute(Wyd_RegStr)
   For Each Match In Matches   '' 遍历 Matches 集合
      RetStr = RetStr & Replace(Match.Value, """", "") & "|"
   Next
   DeHttpdata = Left(RetStr, Len(RetStr) - 1)
 End Function
 ''得到网页数据
 Public Function GetWebBody()
   Dim GetBody
   XMLHTTP.Open "Get", Wyd_Url, False
   XMLHTTP.Send
    On Error Resume Next
   GetBody = XMLHTTP.ResponseBody
   Body = BytesToBstr(GetBody)
    If Err Then
       FoundErr=True
       ErrNo=2
       Exit Function
    End if
    GetWebBody=Body
 End Function


 ''从左开始取得字符串
 Public Function GetStr(Wyd_Body)
   On Error Resume Next
    TmpBody=Wyd_Body
   TmpBStr=Instr(TmpBody,Wyd_BStr)
   TmpEStr=Instr(TmpBStr+1,TmpBody,Wyd_EStr)
   TmpStr=Mid(TmpBody,TmpBStr+Len(Wyd_BStr),TmpEStr-TmpBStr-Len(Wyd_BStr))
    If Err Then
       FoundErr=True
       ErrNo=1
       Exit Function
    End If
   GetStr=TmpStr
 End Function
 ''从右开始取得字符串
 Public Function GetRStr(Wyd_Body)
   TmpBody=Wyd_Body
    On Error Resume Next
   TmpBStr=InstrRev(TmpBody,Wyd_BStr)
   TmpEStr=Instr(TmpBStr+1,TmpBody,Wyd_EStr)
   TmpStr=Mid(TmpBody,TmpBStr+Len(Wyd_BStr),TmpEStr-TmpBStr-Len(Wyd_BStr))
    If Err Then
       FoundErr=True
       ErrNo=1
       Exit Function
    End If
   GetRStr=TmpStr
 End Function
 Public Function IsErr()
   If FoundErr Then
       IsErr=True
    Else
       IsErr=False
    End If
 End Function
 Public Sub ShowErrMsg()
    Select Case ErrNo
        Case 1
              Response.write ErrStr1
                Response.end
          Case 2
              Response.Write ErrStr2
                Response.end
          Case Else
              Response.write ErrStr3
                Response.end
     End Select
 End Sub
 Public Sub Head()
    Response.write "<HTML>"
    Response.write "<HEAD>"
    Response.write "<TITLE>网络数据载取系统1.0</TITLE>"
    Response.write "<META HTTP-EQUIV=""Content-Type"" CONTENT=""text/html; charset=gb2312"">"
    Response.write "<meta name=""generator"" content=""网络数据载取系统-WebCutpurse"">"
    Response.write "<meta name=""keywords"" content=""LoveLing.net,LoveLing,LVBBS,LDBBS,Music,Flash,Article,网络截取系统,小偷系统,Net Happer,音乐,动画,文章，论坛,组件,文章教程,网络大盗,WebCutpurse"">"
    Response.write "<meta name=""description"" content=""夕雨情-www.loveling.net是拉灯的个人网站,其中里面积成了Flash动网系统,Article文章教程, Music音乐,自行开发的LDBBS1.0论坛 LvBBs2.0论坛及网络数据载取系统1.0,联系QQ:47833873 Email:wyd1520@163.com 论坛ID:wyd1520"">"
    Response.write "<STYLE type=text/css>"
    Response.write "BODY {FONT-FAMILY: Arial, Helvetica, sans-serif; FONT-SIZE: 12px}"
    Response.write "TD {FONT-FAMILY: Arial, Helvetica, sans-serif; FONT-SIZE: 12px}"
    Response.write "TH {FONT-FAMILY: Arial, Helvetica, sans-serif; FONT-SIZE: 12px}"
    Response.write "A {COLOR: #000000; TEXT-DECORATION: none}"
    Response.write "</STYLE></HEAD>"
 End Sub
End Class
%>

网络数据载取系统　使用说明

<!--#include file="Wyd_Class.asp"-->
<%
Set Wyd=New Wyd_WebCutpurse
''========================================
''提取网页内容 sql.htm内容并显示出来
''========================================
Wyd.URL="Http://127.0.0.1/Pro/sql.html";
Body=Wyd.GetWebBody()
Response.write Body

''========================================
''从左边开始取字符串
''从上面提取出字符串如下
'' <TABLE>
''<TR id=1>
'' <TD  id=1>要提取的内容11111</TD>
''</TR>
''<TR>
'' <TD  id=1>要提取的内容22222</TD>
''</TR>
''</TABLE>
''========================================
Wyd.BStr="<TD  id=1>" ''提取开始位置
Wyd.EStr="</TD>"　''提取的结束位置
Response.write Wyd.GetStr(Wyd.Body) &"<br>"
''得出　要提取的内容11111

''========================================
''从右边开始取字符串
'' <TABLE>
''<TR id=1>
'' <TD  id=1>要提取的内容11111</TD>
''</TR>
''<TR>
'' <TD  id=1>要提取的内容22222</TD>
''</TR>
''</TABLE>
''由于有两个<TD  id=1>　而你要提取的<TD  id=1>要提取的内容2</TD> 这个，刚才<TD  id=1>要提取的内容2</TD>又在最后一个所以
''========================================
Wyd.BStr="<TD  id=1>"
Wyd.EStr="</TD>"
Response.write Wyd.GetRStr(Wyd.Body) &"<br>"
''得出　要提取的内容22222

''========================================
''提汉字的第一个字母
''========================================
''Wyd.Char="王"
''Response.write Wyd.GetPyChar() &"<br>"
''得出 W


''========================================
''正则提取匹配的数据
'' 比如有如下
'' <TABLE>
''<TR id=1>
'' <TD  id=1>要提取的内容11111</TD>
''</TR>
''<TR>
'' <TD  id=1>要提取的内容22222</TD>
''</TR>
''</TABLE>
''========================================
''Wyd.RegStr=Body
''Wyd.Pattern="<.*?>"
''Response.write Wyd.DeHttpData() &"<br>"
''得出 <TABLE>|<TR id=1>|<TD  id=1>|</TD>|</TR>|<TR>|<TD  id=1>|</TD>|</TABLE>


''========================================
''建立文件夹
''========================================
''Wyd.WebFolderPath="BBs/Make/Fu/mes"
''Wyd.MakeNewFolder
''在当前文件夹下建立　BBS/Make/Fu/Mes文件夹　


''========================================
''保存文件
''=======================================================
''Wyd.FileURL="http://127.0.0.1/pro/20045171663919.jpg";
''Wyd.SaveFilePath="fude/sdfsdf/apefa/a"
''Wyd.SaveFile
''先在当前文件夹下建立　fude/sdfsdf/apefa/a文件夹　
''后下载http://127.0.0.1/pro/20045171663919.jpg文件到fude/sdfsdf/apefa/a文件夹下

''下面是报错信息
If Wyd.IsErr Then
  Wyd.ShowErrMsg()
End if
%>

页面没找到，我那个就会报错

还有，在修改DownArticle.asp时，

你要先分析　源文件　

IE -->查看-->源文件

然后看里面，你要提取哪些内容，位置在哪，

比如有这个


<HTML>
 <HEAD>
   <title>CSDN技术中心 使用组件来保护你的ASP代码
   </title>
 
   <link rel="stylesheet" href="/Skins/default/csdn.css" type="text/css">
 </HEAD》

你要提取<title>    </title> 之间的字

CSDN技术中心 使用组件来保护你的ASP代码  这一行字

你就先

Wyd.URL="http://dev.csdn.net/article/36/500.shtm";
Body=Wyd.GetWebBody()
后

''分析出 CSDN技术中心 使用组件来保护你的ASP代码 这一行字在<title> </title>

Wyd.BStr="<title>"
Wyd.EStr="</title>"

Response.write Wyd.GetStr(Wyd.Body)

就得出 CSDN技术中心 使用组件来保护你的ASP代码 字了

不错的类，可以根据该思想开发出完整版本来。