'-------初始化类--------' 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=contentmatch.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=""查看效果"">nbsp;nbsp;INPUT name=Button onclick=asdf.select() type=button value=""全选"">nbsp;nbsp;INPUT name=Button onclick=""asdf.value=''"" type=button value=""清空"">nbsp;nbsp;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 %>
