小偷类

<%
'===============================================================================================
' 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 _fcksavedurl="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="&#22312&#22788&#29702&#25968&#25454&#26102&#25130&#21462&#30340&#21442&#25968&#19981&#27491&#30830&#25110&#32773&#25152&#25552&#21462&#30340&#39029&#38754&#19981&#23384&#22312&#65281"
  ErrStr2="&#27809&#26377&#32593&#32476&#25968&#25454&#25110&#32773&#20320&#27809&#26377&#36830&#25509&#32593&#32476&#65281"
  ErrStr3="&#26410&#30693&#38169&#35823&#65292&#35831&#32852&#31995&#20316&#32773&#65292&#20316&#32773&#65306&#87&#121&#100&#49&#53&#50&#48&#40&#26412&#183&#25289&#28783&#41&#32&#81&#81&#65306&#52&#55&#56&#51&#51&#56&#55&#51&#32&#69&#45&#109&#97&#105&#108&#58&#119&#121&#100&#49&#53&#50&#48&#64&#49&#54&#51&#46&#99&#111&#109"
  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
%>