一小偷类!!有兴趣的可以看看
作者：
一小偷类!!有兴趣的可以看看
类代码 (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
%>
<%
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
%>