ASP多功能采集类 admin 发表于 2006-9-16 23:04:01

<% ============================= 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 %> 阅读全文 | 回复(2) | 引用通告 | 编辑

发表评论：