%
'轉(zhuǎn)發(fā)時(shí)請(qǐng)保留此聲明信息,這段聲明不并會(huì)影響你的速度!
'**************************   【先鋒海盜類】Ver2005  最終版********************************
'作者:孫立宇、apollosun、ezhonghua
'改進(jìn)者：arllic
'【消除所有的BUG，去掉了一些不易使用，容易使人誤解的功能，優(yōu)化了執(zhí)行效率，此為最終版】
'官方網(wǎng)站:http://www.lkstar.com   技術(shù)支持論壇：http://bbs.lkstar.com
'電子郵件:kickball@netease.com    在線QQ:94294089
'版權(quán)聲明:版權(quán)沒有,盜版不究,源碼公開,各種用途均可免費(fèi)使用,歡迎你到技術(shù)論壇來尋求支持。
'——小偷程序的原理是通過XHTML和ASP技術(shù)相結(jié)合,定向集中采集遠(yuǎn)程網(wǎng)頁內(nèi)容加工后轉(zhuǎn)為本地虛擬網(wǎng)頁。
'——此技術(shù)自誕生以來由于它的信息覆蓋面、廣同步更新和免維護(hù)的特性一直受到各編程愛好者的關(guān)注和追捧。
'——目前國內(nèi)比較流行的實(shí)時(shí)新聞、閃客動(dòng)漫、流行歌曲、軟件下載、天氣預(yù)報(bào)、股票查詢等優(yōu)秀作品。
'——然而由于制作小偷程序的過程過于復(fù)雜和繁瑣,還由于遠(yuǎn)程網(wǎng)頁代碼的變更而經(jīng)常失效,這使小偷網(wǎng)頁的
'維護(hù)成為一個(gè)噩夢(mèng)!所以到目前為止,目前此類佳作不多,技術(shù)也集中在小部分人手中。
'——先鋒海盜類的誕生將使小偷程序的制作和維護(hù)變得容易起來。先鋒海盜類提供的12種類方法將使你對(duì)采集
'內(nèi)容的編輯掌控能力變得空前強(qiáng)大,另有貼心的類排錯(cuò)debug方法可以使你隨時(shí)觀察自己在各步驟獲得的代碼和
'頁面顯示效果,徹底掌握這些類方法將使你為所欲為地采集編輯各種遠(yuǎn)程頁面,而且維護(hù)也相當(dāng)方便！
'——總而言之,使用先鋒海盜類將使你的"小偷"程序晉升為"海盜"程序！
'詳細(xì)使用說明或范例請(qǐng)見下載附件或到本人官方站點(diǎn)下載！
'-------------------------------------------------------------------------------------
Class clsThief
'____________________
Private value_    '竊取到的內(nèi)容
Private src_      '要偷的目標(biāo)URL地址
Private isGet_    '判斷是否已經(jīng)偷過

public property let src(str) '賦值—要偷的目標(biāo)URL地址/屬性
src_=str
end property

public property get value '返回值—最終竊取并應(yīng)用類方法加工過的內(nèi)容/屬性
value=value_
end property

Public Property get Version
 Version="先鋒海盜類 Version 2005"
End Property

private sub class_initialize()
value_=""
src_=""
isGet_= false
end sub

private sub class_terminate()
end sub

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

public sub steal() '竊取目標(biāo)URL地址的HTML代碼/方法
if src_>"" then
 dim Http
 set Http=server.createobject("MSXML2.XMLHTTP")
 Http.open "GET",src_ ,false
 Http.send()
 if Http.readystate>4 then
  exit sub
 end if
 value_=BytesToBSTR(Http.responseBody,"GB2312")
 isGet_= True
 set http=nothing
 if err.number>0 then err.Clear
else
 response.Write("script>alert(""請(qǐng)先設(shè)置src屬性！"")/script>")
end if
end sub

'刪除偷到的內(nèi)容中里面的換行、回車符以便進(jìn)一步加工/方法
public sub noReturn()
if isGet_= false then call steal()
value_=replace(replace(value_ , vbCr,""),vbLf,"")
end sub

'對(duì)偷到的內(nèi)容中的個(gè)別字符串用新值更換/方法
public sub change(oldStr,str) '參數(shù)分別是舊字符串,新字符串
if isGet_= false then call steal()
value_=replace(value_ , oldStr,str)
end sub

'按指定首尾字符串對(duì)偷取的內(nèi)容進(jìn)行裁減（不包括首尾字符串）/方法
public sub cut(head,bot) '參數(shù)分別是首字符串,尾字符串
if isGet_= false then call steal()
  if instr(value_ , head)>0 and instr(value_ , bot)>0 then
   value_=mid(value_ ,instr(value_ ,head)+len(head),instr(value_ ,bot)-instr(value_ ,head)-len(head))
  else
   value_= "p align=""center"">函數(shù)cut指定裁減內(nèi)容不存在,請(qǐng)重新定義"
  end if
end sub

'按指定首尾字符串對(duì)偷取的內(nèi)容進(jìn)行裁減（包括首尾字符串）/方法
public sub cutX(head,bot) '參數(shù)分別是首字符串,尾字符串
if isGet_= false then call steal()
  if instr(value_,head)>0 and instr(value_,bot)>0 then
   value_=mid(value_ ,instr(value_ ,head),instr(value_ ,bot)-instr(value_ ,head)+len(bot))
  else
   value_= "p align=""center"">函數(shù)cutX指定裁減的內(nèi)容不存在"
  end if
end sub

'按指定首尾字符串位置偏移指針對(duì)偷取的內(nèi)容進(jìn)行裁減/方法
public sub cutBy(head,headCusor,bot,botCusor)
'參數(shù)分別是首字符串,首偏移值,尾字符串,尾偏移值,左偏移用負(fù)值,偏移指針單位為字符數(shù)
if isGet_= false then call steal()
  if instr(value_,head)>0 and instr(value_,bot)>0 then
   value_=mid(value_ ,instr(value_ ,head)+len(head)+headCusor,instr(value_ ,bot)-1+botCusor-instr(value_ ,head)-len(head)-headcusor)
  else
   value_= "p align=""center"">函數(shù)cutBy指定裁減內(nèi)容不存在"
  end if
end sub

'按指定首尾字符串對(duì)偷取的內(nèi)容用新值進(jìn)行替換（不包括首尾字符串）/方法
public sub filt(head,bot,str) '參數(shù)分別是首字符串,尾字符串,新值,新值位空則為過濾
if isGet_= false then call steal()
  if instr(value_,head)>0 and instr(value_,bot)>0 then
   value_=replace(value_,mid(value_ ,instr(value_ ,head)+len(head) , instr(value_ ,bot)-instr(value_ ,head)-len(head)),str)
  else
   value_= "p align=""center"">函數(shù)filt指定替換的內(nèi)容不存在"
  end if
end sub

'按指定首尾字符串對(duì)偷取的內(nèi)容用新值進(jìn)行替換（包括首尾字符串）/方法
public sub filtX(head,bot,str) '參數(shù)分別是首字符串,尾字符串,新值,新值為空則為過濾
if isGet_= false then call steal()
  if instr(value_,head)>0 and instr(value_,bot)>0 then
        value_=replace(value_,mid(value_ ,instr(value_ ,head),instr(value_ ,bot)-instr(value_ ,head)+len(bot)),str)
  else
   value_= "p align=""center"">函數(shù)filtX指定替換的內(nèi)容不存在"
  end if
end sub

'按指定首尾字符串位置偏移指針對(duì)偷取的內(nèi)容新值進(jìn)行替換/方法
public sub filtBy(head,headCusor,bot,botCusor,str)
'參數(shù)分別是首字符串,首偏移值,尾字符串,尾偏移值,新值,左偏移用負(fù)值,偏移指針單位為字符數(shù),新值為空則為過濾
if isGet_= false then call steal()
  if instr(value_,head)>0 and instr(value_,bot)>0 then
   value_=replace(value_ ,mid(value_ ,instr(value_ ,head)+len(head)+headCusor,instr(value_ ,bot)-1+botCusor-instr(value_ ,head)-len(head)-headcusor),str)
  else
   value_= "p align=""center"">函數(shù)filtBy指定替換的內(nèi)容不存在"
  end if
end sub

'對(duì)符合條件的內(nèi)容進(jìn)行分塊采集并組合,最終內(nèi)容為以!--lkstar-->隔斷的大文本/方法
'通過屬性value得到此內(nèi)容后你可以用split(value,"!--lkstar-->")得到你需要的數(shù)組
public sub rebuild(str) '參數(shù)是你目標(biāo)頁面反復(fù)出現(xiàn)的特征字符
if isGet_= false then call steal()
value_= replace(value_,str,vbcrlf"!--lkstar-->"vbcrlf)
end sub

'類排錯(cuò)模式——在類釋放之前應(yīng)用此方法可以隨時(shí)查看你截獲的內(nèi)容HTML代碼和頁面顯示效果/方法
public sub debug()
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"">"value_"/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
%>