多功能采集类

<%
'============================= 
' Script Written by LZ8.飞狼 
' Copyright (C) 2004 
' Oicq: 23481045 
' Email: [e-mail] 
' 如采用本类模块，请不要去掉这个说明，此处不会引响你的执行速度。 
' 作用:小偷通用类，利用此类可以截取网络上文字，图片，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 
%>