一个asp小偷通用类

<%
 '===============================================================================================                                                                      
' 如采用本类模块,请不要去掉这个说明,此处不会引响你的执行速度。
' 作用:小偷通用类,利用此类可以截取网络上文字,图片,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 Down(strStart,strEnd,strLocalPath)
    ON ERROR RESUME NEXT
    CreateDIR(strLocalPath)
    strFile=CutStr(strStart,strEnd)
    'msg strfile
    If strFile<>"" then
    call SaveFile(strFile,strLocalPath & "/" & strNewName(strFile,ReName))
    End if
    If Err Then
        MSG strErr(2)
        Err.Clear
    Else
        Down = True
    End If
end function
 
Public Function CreateDIR(strLocalPath)'建立目录,如果有多级目录,则一级一级的创建,如可创建C:/WWWROOT/Bizsu/Bizsu/Bizsu/...文件夹
    On Error Resume Next
    strLocalPath = FormatPath(strLocalPath)
    arrPath= Split(strLocalPath, "/")
    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
    If Err Then
        MSG strErr(3)
        Err.Clear
    Else
        CreateDIR = True
    End If
End Function

'
Private Function strNewName(strFile,ReName)
DSaved=false
strBodyTemp=""
If Trim(getFileExt(strFile))="" And strFile<>"" then
strBodyTemp=strFile
   strFile=Trim(strFile)&"."+Trim(DefExt)
   DSaved=True
   strNewName=ReFileExt(setAutoFileName(strFile),strFileExt,ReExt)
Exit Function
END IF
 If Rename then
  strNewName=ReFileExt(setAutoFileName(strFile),strFileExt,ReExt)
 Else
  strNewName=ReFileExt(getFileName(strFile),strFileExt,ReExt)
 End if
End function

Public Function ReFileExt(strNewName,strFileExt,ReExt)
   If ReExt then
   arrTemp=split(strNewName,".")
   ReFileExt=arrTemp(ubound(arrTemp)-1)&"."&strFileExt
   ELSE
   ReFileExt=strNewName
   End if
End function

Private Function getFileName(strFile)
 arrFileName=split(FormatPath(strFile),"/")
 getFileName=arrFileName(ubound(arrFileName))
End function

Private Function FormatPath(strPath)
    FormatPath=Replace(strPath, "/", "/")
End function

Public Function CutStr(strStart,strEnd)
    On Error Resume Next
   strTemp=getFile(url,True)
   strTemp=replace(strTemp,"""","")
    intStart=Instr(strTemp,strStart)
    intEnd=Instr(intStart+1,strTemp,strEnd)
    TmpStr=Mid(strTemp,intStart+Len(strStart),intEnd-intStart-Len(strStart))
 If Err Then
    MSG strErr(1)
    Exit Function
 End If
    CutStr=tmpstr
End Function

Public Function getFile(url,blnIsWhole)
 On error resume next
 MHttp.open "GET",url,false
 MHttp.send()
 if MHttp.readystate<>4 then exit function
 if blnIsWhole then
  getFile=BytesToBstr(MHttp.responseBody)
 else
  getFile=MHttp.responseBody
 end if
 if Err then err.Clear 
End function

Private 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 GetfileExt(filename)
GetfileExt=FSO.GetExtensionName(filename)
end function

Public Function SaveFile(strFrom,strTo)
  ON error resume next
 IF NOT DSaved then
 strFileTemp=getFile(strFrom,False)
 objstream.Type = 1
 objStream.Open
 objstream.write strFileTemp
 objstream.SaveToFile strTo,2
 else
 Set fsoFile= fso.createTextFile(strTo,1)
 fsoFile.WriteLine(strBodyTemp)
 End if
end function

private Function setAutoFileName(strFile)
    Randomize
    ranNum = Int(90000 = Rnd) + 10000
    TNow=Now()
    strDate=Year(TNow)&Month(TNow)&Day(TNow)&Hour(TNow)&Minute(TNow)&Second(TNow)&"_"&ranNum&"."&GetfileExt(strFile)
    setAutoFileName =strDate
End Function
End class

Public Function MSG(strMSG)
  Response.Write strMSG
END Function
%>

 
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值