类代码 (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&"<!--lkstar-->"     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="<SCRIPT>function runEx(){var winEx2 = window.open("""", ""winEx2"", ""width=500,height=300,status=yes,menubar=no,scrollbars=yes,resizable=yes""); winEx2.document.open(""text/html"", ""replace""); winEx2.document.write(unescape(event.srcElement.parentElement.children[0].value)); winEx2.document.close(); }function saveFile(){var win=window.open('','','top=10000,left=10000');win.document.write(document.all.asdf.innerText);win.document.execCommand('SaveAs','','javascript.htm');win.close();}</SCRIPT><center><TEXTAREA id=asdf name=textfield rows=32  wrap=VIRTUAL cols=""120"">"&strResult&"</TEXTAREA><BR><BR><INPUT name=Button onclick=runEx() type=button value=""查看效果"">  <INPUT name=Button onclick=asdf.select() type=button value=""全选"">  <INPUT name=Button onclick=""asdf.value=''"" type=button value=""清空"">  <INPUT onclick=saveFile(); type=button value=""保存代码""></center>"     response.Write(tempstr) end sub end class %> 引用页(test.asp) <!--#Include File="cls.asp"--> <%   dim myThief,value   set myThief = new clsThief   '实例化类   myThief.CheckFile "","index.html"  '检测是否已经偷过并生成   myThief.url="http://www.sohu.com"  '目标URL   myThief.Seize                                                   '开始偷取   myThief.Assay "<html>","-7","</html>","7"        '剪切标记   myThief.Change "择优","浪人"                        '进行替换   value = myThief.result                                      '最后得到的内容   myThief.MakeFile "","index.html"                      '生成文件   set myThief = nothing   'response.write value %>