一小偷类!!有兴趣的可以看看(2)
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
'--------如果有首页文件则转入-----------'
内容版权声明:除非注明,否则皆为本站原创文章。