一小偷类!!有兴趣的可以看看 类代码 (cls.asp) <% Class clsThief Private strUrl ' 偷取地址 Private strValue ' 偷取的内容,所有内容 Private strResult ' 偷取结果,可以具体某一块内容 Private flag ' 是否已经偷过 '-------初始化类--------' Private Sub Class_Initialize() strUrl="" strValue="" strResult="" flag=false End Sub '------类结束-----------' Private Sub Class_Terminate() End Sub '------初始化url属性----' Public Property Let url(ByVal iurl) strUrl = iurl End Property '------返回输出内容----' public property get value value=strValue end property public property get result result=strResult end property '------------文字处理-----------' private Function BytesToBstr(body,Cset) dim objstream set objstream = Server.CreateObject("adodb.stream") objstream.Type = 1 objstream.Mode =3 objstream.Open objstream.Write body objstream.Position = 0 objstream.Type = 2 objstream.Charset = Cset BytesToBstr = objstream.ReadText objstream.Close set objstream = nothing End Function '-------文字处理-------' private Function Ichange(str) Dim finalStr Dim icharCode Dim inextCode For i = 1 To lenb(str) icharCode = ascb(midb(str,i,1)) If icharCode < &H80 Then finalStr = finalStr & chr(icharCode) Else inextCode = ascb(midb(str,i+1,1)) finalstr = finalstr & chr(clng(icharCode) * &H100 + cint(inextCode)) i = i + 1 End If Next Ichange = finalStr End Function '-------内容抓取--------' Public sub Seize() if strUrl<>"" then dim iconnect Set iconnect = CreateObject("Microsoft.XMLHTTP") iconnect.open "GET",strUrl,false iconnect.send() strValue = BytesToBSTR(iconnect.responseBody,"GB2312") flag=true set iconnect = nothing if err.number<>0 then err.Clear else response.write("请设置url的属性,即url地址") end if end sub '------内容分析------' Public sub Assay(head,headCusor,bot,botCusor) if flag = false then call Seize() if instr(strValue,head) and instr(strValue,bot) then dim inum inum = len(strValue)-instr(strValue,head)-len(head)-headCusor strValue=right(strValue,inum) inum = instr(strValue,bot)-1+botCusor strResult=left(strValue,inum) else strResult = "没有匹配到相关记录,请检查开始标记代码是否唯一" end if end sub '----替换空格及回车行----' public sub Shift() if flag= false then call Seize() strResult=replace(replace(strResult , vbCr,""),vbLf,"") end sub '------对内容自定义替换----' Public sub Change(oldStr,newStr) if flag=false then call Seize() strResult = replace(strResult,oldStr,newStr) end sub '--------自定义正则进行匹配---' public sub pickByReg(patrn) if isGet_= false then call Seize() dim tempReg,match,matches,content set tempReg=new RegExp tempReg.IgnoreCase=true tempReg.Global=true tempReg.Pattern=patrn set matches=tempReg.execute(value_) for each match in matches content=content&match.value&"" next strValue=content set matches=nothing set tempReg=nothing end sub '--------如果有首页文件则转入-----------' Public sub CheckFile(folderName,fileName) dim url Set fs=Server.CreateObject("Scripting.FileSystemObject") if fs.FolderExists(server.MapPath("./")&"\"&folderName&"\"&fileName) then set fs = nothing url = folderName&"/"&fileName response.write url 'response.redirect url end if end sub '------生成文件------' Public sub MakeFile(folderName,fileName) Set fs=Server.CreateObject("Scripting.FileSystemObject") if folderName<>"" then if not fs.FolderExists(server.MapPath("/"&folderName&"/")) then response.write "文件不存在" fs.CreateFolder(folderName) else response.write "文件存在" end if end if Set CrFi=fs.CreateTextFile(server.MapPath("./")&"\"&folderName&"\"&fileName) Crfi.Writeline(strResult) set CrFi=nothing set fs=nothing dim url url = folderName&"/"&fileName response.redirect url end sub '-------查看偷出的代码----' public sub look() dim tempstr tempstr="
" response.Write(tempstr) end sub end class %> 引用页(test.asp) <% dim myThief,value set myThief = new clsThief '实例化类 myThief.CheckFile "","index.html" '检测是否已经偷过并生成 myThief.url="http://www.sohu.com" '目标URL myThief.Seize '开始偷取 myThief.Assay "","-7","","7" '剪切标记 myThief.Change "择优","浪人" '进行替换 value = myThief.result '最后得到的内容 myThief.MakeFile "","index.html" '生成文件 set myThief = nothing 'response.write value %>
