多功能采集类

上一篇：关于企业竞争的名人名言下一篇：剥离自pjblog新版本的防XSS注入函数

2009年05月16号 | 14:44分类：asp技术 | 212 views

采集小偷，虽然不光彩，却也为广大垃圾站长所青睐。其实，普通的踏踏实实做站的朋友，也在不断的用小偷，比如天气预报小偷，就是很人性化的一种做法。
好，我们来看多功能采集类。

下载: caiji.asp

< %
'=============================
' Script Written by LZ8.飞狼
' Copyright (C) 2004
' Oicq: 23481045
' Email: pzflcom@163.com
' 如采用本类模块，请不要去掉这个说明，此处不会引响你的执行速度。
' 作用:小偷通用类，利用此类可以截取网络上文字，图片，Flash，音乐等
' 原理：这里所说的;小偷”指的是在ASP中运用XML中的XMLHTTP组件提供的强大功能，
' 把远程网站上的数据(图片，网页及其他文件)抓取到本地，经过各种处理
' 后存储在本地机上或显示到页面上或者存储进数据库的一类程序。
'=============================
Class BizsuCut
private MHttp,Fso,objStream,localaddr,localdir,strReturn,objRegExp,strMatchTemp,DSaved,strBodyTemp
private strFile,blnErr,strErr(4),strFileExt
Public Version,ReExt,ReName,DefExt
'*********************************************
'Version:版本信息
'ReExt:是否要更改文件存储格式。
'ReName：是否要更改文件名。如将文件名;dog.gif”改为;当时时刻_随机数产生的文件名+扩展名”(20041107182512_12354.gif)的形式
'DefExt：默认文件格式
'*********************************************
'类的方法
'Down(strStart,strEnd,strLocalPath)主调用程序
'CreateDIR(strLocalPath)建立目录，如果有多级目录，则一级一级的创建，如可创建C:\WWWROOT\Bizsu\Bizsu\Bizsu\...文件夹
'strNewName(strFile,ReName)获得新的文件名
'getFileName(strFile)由路径获得文件名.如getFileName("C:\WWWROOT\Bizsu\Bizsu\bizsu.swf")得到"bizsu.swf"
'ReFileExt(strNewName,strFileExt,ReExt)更改文件存储格式.如原文件为;dog.gif”可改为;dog.jpg”
'FormatPath(strPath)将路径中的"\"改为 "/"
'CutStr(strStart,strEnd)按指定首尾字符串对偷取的内容进行裁减，参数分别是首字符串,尾字符串
'如要截取〈title〉************〈/title〉中"*"中的内容，则strStart="〈title〉" strEnd="〈/title〉"
'BytesToBstr(strBody)二进制转成字符
'getFile(url,blnIsWhole)获取文件流
'SaveFile(strFrom,strTo)存储文件
'GetfileExt(filename)获得文件扩展名
'setAutoFileName(strFile)根据当时时间和随机数自动生成文件名
'***************************************
Private Sub Class_Initialize()'程序初始化，创建各实例
Server.ScriptTimeOut=9999999
set MHttp=Server.createobject("Msxml2.XMLHTTP")
Set objstream = Server.CreateObject("Adodb.Stream")
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
Version="BizsuCut Version 1.0"
Set objRegExp = New Regexp
strBodyTemp=""
strFile=""
strErr(0)=""
strErr(1)="字符串切割错误"
strErr(2)="保存文件时发生错误"
strErr(3)="创建目录失败,请检查目录权限"
End Sub
Private Sub Class_Terminate()
Set MHttp = nothing
Set objstream = nothing
Set Fso = nothing
Set objRegExp = nothing
End Sub
Public Function CreateDIR(LocalPath)'建立目录，如果有多级目录，则一级一级的创建，如可创建C:\WWWROOT\Bizsu\Bizsu\Bizsu\...文件夹
On Error Resume Next
LocalPath = FormatPath(LocalPath)
arrPath= Split(LocalPath, "/")
intPathLevel= UBound(arrPath)
For I = 0 To intPathLevel
If I = 0 Then:arrPathTemp = arrPath(0) & "/":Else: arrPathTemp = arrPathTemp & arrPath(I) & "/"
strNowPath = Left(arrPathTemp, Len(arrPathTemp) - 1)
If Not Fso.FolderExists(strNowPath) Then Fso.CreateFolder strNowPath
Next
putErr(3)
End Function
Public Function CreateSysFile(LocalPath,sysFileExt)
pathTemp=LocalPath&"\"&GetRndStr(90000,100000)&"."&sysFileExt
Set fsoFile=fso.createTextFile(pathTemp,1)
End Function
Public Function GetFile(RemotePath)
'On error resume next
MHttp.open "GET",RemotePath,false
MHttp.send()
if MHttp.readystate〈〉4 then exit function
GetFile=MHttp.responseBody
putErr(3)
End Function
Public Function BytesToBstr(strBody)
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write strBody
objstream.Position = 0
objstream.Type = 2
objstream.Charset = "GB2312"
BytesToBstr = objstream.ReadText
objstream.CLOSE
End Function
Public Function CutStr(strBody,strStart,strEnd)
On Error Resume Next
intStart=Instr(strBody,strStart)
intEnd=Instr(intStart+1,strBody,strEnd)
TmpStr=Mid(strBody,intStart+Len(strStart),intEnd-intStart-Len(strStart))
CutStr=tmpstr
putErr(3)
End Function
private Function GetRndStr(strMin,strMax)
Randomize
ranNum = Int(strMin * Rnd) + strMax
TNow=Now()
strDate=Year(TNow)&Month(TNow)&Day(TNow)&Hour(TNow)&Minute(TNow)&Second(TNow)&"_"&ranNum
GetRndStr=strDate
End Function
Public Function putErr(errNum)
If Err Then
MSG strErr(errNum)
Err.Clear
End If
End Function
Public Function MSG(strMSG)
Response.Write strMSG
END Function
Private Function Formatstr(strBody,strOld,strNew)
Formatstr=Replace(strPath,strOld,strNew)
End function
End class
%>