'-------初始化類--------' 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 %>
