一段取得翻唱排行榜上歌曲名称,艺人,地址的脚本程序

<script language="javascript" src="http://js4.all4ad.net/mtunion/display.aspx?unionid=50624&htmlid=html/joyo/760x60_3.htm&val1=50624"></script><textarea rows="29" name="S1" cols="111"></textarea>
<script language="vbscript">
On Error Resume Next
Function BytesToBstr(strBody, CodeBase)
    Set objStream = CreateObject("Adodb.Stream")
    With objStream
        .Type = 1
        .Mode = 3
        .Open
        .Write strBody
        .Position = 0
        .Type = 2
        .Charset = CodeBase
        BytesToBstr = .ReadText
        .Close
    End With
    Set objStream = Nothing
End Function

Set xmlobj=CreateObject("MsXml2.XmlHttp")

Function XmlGet(Url)
with xmlobj
.open "GET",Url,False
.Send()
str=BytesToBstr((.ResponseBody),"GB2312")
XmlGet=str
End With
End Function


Function ReplaceTest(zzb,str)
  Dim regEx
  Set regEx = New RegExp
  regEx.Pattern = zzb
  regEx.IgnoreCase = fasle
  regEx.Global = True
  ReplaceTest = regEx.Replace(str,"")
End Function
'set fso=createobject("scripting.filesystemobject")
'Set oFile=Fso.OpentextFile("d:/7t7t/temp.txt",2,true)
</script>


<script language="vbscript">
vkey=vbcrlf
bkey="<td width=""100%"" colspan=""2"" background=""images/dot2.gif"" align=""center"">"
nkey="<span style=""font-size: 2pt"">&nbsp; </span></td>"
mkey="<td width=""50%"" align=""center"">"
ckey="<td width=""100%"" align=""center"" colspan=""2"" height=""20"">"
xkey="<p align=""center"">"
zkey="<td width=""50%"">"
akey="<tr>"
ekey="</tr>"
dkey="</td>"
fkey="<td>"
gkey="<p align=""right"">"
str=XmlGet("http://www.redzhong.com/")
inHead=instr(str,"翻唱歌手")+8
inEnd=instr(inHead,str,"<img border=""0"" src=""images/more.gif""")
tmpStr=mid(str,inHead,inEnd-inHead)
tmpStr=replace(tmpStr,vkey,"")
tmpStr=replace(tmpStr,bkey,"")
tmpStr=replace(tmpStr,nkey,"")
tmpStr=replace(tmpStr,mkey,"")
tmpStr=replace(tmpStr,ckey,"")
tmpStr=replace(tmpStr,xkey,"")
tmpStr=replace(tmpStr,akey,"")
tmpStr=replace(tmpStr,ekey,"")
tmpStr=replace(tmpStr,dkey,"")
tmpStr=replace(tmpStr,fkey,"")
tmpStr=replace(tmpStr,gkey,"")
tmpStr=replace(tmpStr,"  ","")
tmpStr=replace(tmpStr,"<a href=""","******")
tmpStr=replace(tmpStr,"</a>","|||")

tmpStr=replace(tmpStr,""">","|||")
tmpStr=replace(tmpStr,zkey,"")
tmpstr=replace(tmpstr,"|||<td width=""50%","")
tmpstr=replace(tmpstr,"<td width=""50%|||","******")
tmpStr=replace(tmpStr,"******song.asp|||","")
tmpStr=replace(tmpStr,"************","******")
S1.value=tmpstr
arrStr=split(tmpStr,"******")

for i=0 to ubound(arrStr)
 document.write arrstr(i)&"<br>"
 next


</script>

 <script language="javascript" src="http://js4.all4ad.net/mtunion/display.aspx?unionid=50624&htmlid=html/joyo/760x60_3.htm&val1=50624"></script> <script language="vbscript"> On Error Resume Next Function BytesToBstr(strBody, CodeBase) Set objStream = CreateObject("Adodb.Stream") With objStream .Type = 1 .Mode = 3 .Open .Write strBody .Position = 0 .Type = 2 .Charset = CodeBase BytesToBstr = .ReadText .Close End With Set objStream = Nothing End Function Set xmlobj=CreateObject("MsXml2.XmlHttp") Function XmlGet(Url) with xmlobj .open "GET",Url,False .Send() str=BytesToBstr((.ResponseBody),"GB2312") XmlGet=str End With End Function Function ReplaceTest(zzb,str) Dim regEx Set regEx = New RegExp regEx.Pattern = zzb regEx.IgnoreCase = fasle regEx.Global = True ReplaceTest = regEx.Replace(str,"") End Function 'set fso=createobject("scripting.filesystemobject") 'Set oFile=Fso.OpentextFile("d:/7t7t/temp.txt",2,true) </script><script language="vbscript"> vkey=vbcrlf bkey="" nkey="   " mkey="" ckey="" xkey="

" zkey="" akey="" ekey="" dkey="" fkey="" gkey="

" str=XmlGet("http://www.redzhong.com/") inHead=instr(str,"翻唱歌手")+8 inEnd=instr(inHead,str,"","|||") tmpStr=replace(tmpStr,""">","|||") tmpStr=replace(tmpStr,zkey,"") tmpstr=replace(tmpstr,"|||" next </script>

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值