用于提取网易文件的hta代码_vbs教程-查字典教程网

摘要：网易文件摄取网易图片文件一览表信息公布本程序可以自由下载网易图片..彩图动画图片类型全部绝色风光四季花语海底世界绝色美女都市丽人手绘美女从到...

<TITLE>网易文件摄取</TITLE>

<metahttp-equiv="Content-Type"content="text/html;charset=gb2312">

<HTA:APPLICATION

ID="MyhyliApp"

APPLICATIONNAME="设置程序"

VERSION="1.0"

SCROLL="no"

INNERBORDER="no"

CONTEXTMENU="no"

CAPTION="yes"

SHOWINTASKBAR="yes"

SINGLEINSTANCE="yes"

SYSMENU="yes"

WINDOWSTATE="normal"

NAVIGABLE="yes"

<styletype="text/css">

</style>

<divclass="separator">

<hr>

</div>

<tablewidth="100%"height="4%"border="0"cellspacing="0"cellpadding="0">

<tr>

<tdcolspan="2"align="center"valign="middle"id=menubaronselectstart="returnfalse"><spanclass="TT1"id="consume">网易图片文件一览表</span></td>

</tr>

</table>

<divclass="separator">

<hr>

</div>

<tablewidth="100%"height="415"border="1">

<tr>

<tdwidth="81%"height="16"rowspan="8"valign="top"bgcolor="#FFFFFF"style="border-style:solid;border-color:#000080"><divclass="info"id=liststyle="width:100%;height:405;overflow-y:auto;border:solid1gray;"></div></td>

<tdheight="16"colspan="2"align="center"valign="middle"bordercolor="#FF0000"bgcolor="#000080"style="border-style:solid;border-color:#000080"><divclass="preview"id="preview">

<p></p>

</div>

<spanclass="STYLE2">信息公布</span></td>

</tr>

<tr>

<tdheight="182"colspan="2"align="left"valign="top"bgcolor="#FFFFFF"class="info"style="border-style:solid;border-color:#000080"><divclass="info"id="infotext"style="width:100%;height:177;overflow-y:auto">

<p>本程序可以自由下载网易图片..</p>

<p></p>

</div></td>

</tr>

<tr>

<tdheight="33"colspan="2"align="center"valign="middle"bgcolor="#FFFFFF"class="info"style="border-style:solid;border-color:#000080"><inputname="add"type="submit"class="s_button"id="add"onclick="show()"value="取文件信息"/></td>

</tr>

<tr>

<tdheight="33"align="center"valign="middle"bgcolor="#FFFFFF"style="border-style:solid;border-color:#000080"><selectname="Atype"id="Atype"onchange="changevalue()">

<optionvalue="jpg">彩图</option>

<optionvalue="gif">动画</option>

</select></td>

<tdheight="33"align="center"valign="middle"bgcolor="#FFFFFF"style="border-style:solid;border-color:#000080"><selectname="imagetype"id="imagetype">

<optionselected="selected">图片类型</option>

<optionvalue="90">绝色风光</option>

<optionvalue="91">四季花语</option>

<optionvalue="89">海底世界</option>

<optionvalue="34">绝色美女</option>

<optionvalue="198">都市丽人</option>

<optionvalue="200">手绘美女</option>

</select></td>

</tr>

<tr>

<tdheight="33"colspan="2"align="center"valign="middle"bgcolor="#FFFFFF"style="border-style:solid;border-color:#000080"><inputname="del2"type="submit"class="s_button"id="del2"onclick="downloadfile()"value="下载选定项"/></td>

</tr>

<tr>

<tdheight="33"colspan="2"align="center"valign="middle"bgcolor="#FFFFFF"style="border-style:solid;border-color:#000080"><inputname="del"type="submit"class="s_button"id="del"onclick="tb_del()"value="删除选定项"/></td>

</tr>

<tr>

<tdwidth="5%"height="25"align="center"valign="middle"bgcolor="#000080"class="STYLE2"style="border-style:solid;border-color:#000080">从</td>

<tdwidth="14%"bgcolor="#FFFFFF"valign="middle"align="center"style="border-style:solid;border-color:#000080"><atitle="在此处输入起始页数">

<inputname="start1"type="text"id="start1"value="1"size="10"/>

</a></td>

</tr>

<tr>

<tdheight="26"align="center"valign="middle"bgcolor="#000080"class="STYLE2"style="border-style:solid;border-color:#000080">到</td>

<tdheight="26"align="center"valign="middle"bgcolor="#FFFFFF"style="border-style:solid;border-color:#000080"><atitle="在此处输入结束页数">

<inputname="start2"type="text"id="start2"size="10"value="1"/>

</a></td>

</tr>

</table>

<scriptlanguage="vbscript">

Publicfileext

str1="<tr><td><spanclass='grid1'><inputtype=checkboxid='sall'onclick='selectall()'>全都选</span></td>"

str1=str1&"<td><spanclass='grid1'>预览</span></td>"

str1=str1&"<td><spanclass='grid1'>文件路径</span></td>"

str1=str1&"<td><spanclass='grid1'>文件名称</span></td></tr>"

SubWindow_onLoad

window.resizeTo750,515

ileft=(window.screen.Width-750)/2

itop=(window.screen.height-515)/2

window.moveToileft,itop

EndSub

Functionconnect(num)

Dimimageinfo,Length

fileext=Atype.options(Atype.selectedindex).Value

imgtype=imagetype.options(imagetype.selectedindex).Value

imgtypenum=Atype.selectedindex

url="http://mms.163.com/new_web/cm_lv2_pic.jsp?catID="&imgtype&"&ord=dDate&page="&num&"&type="&imgtypenum&"&key="

imageurl="http://mmsimg.163.com/new_web/loaditem.jsp/type="&imgtypenum&"/path="

Sethttp=CreateObject("Microsoft.XMLHTTP")

http.Open"GET",url,False

http.send

vIn=http.ResponseBody

strReturn=""

Fori=1ToLenB(vIn)

ThisCharCode=AscB(MidB(vIn,i,1))

IfThisCharCode<&H80Then

strReturn=strReturn&Chr(ThisCharCode)

Else

NextCharCode=AscB(MidB(vIn,i+1,1))

strReturn=strReturn&Chr(CLng(ThisCharCode)*&H100+CInt(NextCharCode))

i=i+1

EndIf

'------获取文件的地址------------'

pos=InStr(strReturn,"showPic")

pos1=InStr(strReturn,"128x128")

Ifpos>0Then

Length=pos1-pos

imageinfo=Mid(strReturn,pos,Length)

images=Split(imageinfo,",")

imagepath=Mid(images(2),2,Len(images(2))-1)&"128x128."&fileext

'----------获取文件的名字------------'

namepos=InStr(strReturn,"n名字:")

namepos1=InStr(strReturn,"n人气")

namelength=namepos1-namepos

imagename=Mid(Mid(strReturn,namepos,namelength),6)

strHTML=strHTML&"<tr><td><spanclass='grid2'><inputid=addmetype=checkbox>选定</span></td>"

strHTML=strHTML&"<td><spanclass='grid3'><aonMousemove='view()'onmouseout='hideview()'href=#><imgonClick='addpro()'src='"&imageurl&imagepath&"'width=30height=20></a></span></td>"

strHTML=strHTML&"<td><spanclass='grid2'>"&imagepath&"</span></td>"

strHTML=strHTML&"<td><spanclass='grid2'>"&imagename&"</span></td></tr>"

strReturn=Mid(strReturn,namepos1+20)

Else

ExitDo

EndIf

Loop

connect=strHTML

EndFunction

Functionwriteinner()

Fori=start1.ValueTostart2.Value

strHTML=strHTML&connect(i)

strHTML="<tableid='mytable'width=100%border=1bordercolor=green>"&str1&strHTML&"</table>"

list.innerHTML=strHTML

infotext.innertext=infotext.innertext&"连接成功。"

infotext.innertext=infotext.innertext&vbCrLf&vbCrLf&"从第"&start1.Value&"页到第"&start2.Value&"页的gif图片文件信息!"

EndFunction

Functionshow()

IfNot(IsNumeric(start2.Value))OrNot(IsNumeric(start2.Value))Then

infotext.innertext=infotext.innertext&vbCrLf&"配置错误..."

Else

infotext.innertext="正在连接..."

window.settimeout"writeinner()",200

EndIf

EndFunction

Subview()

strHTML1="<imgsrc='"&window.event.srcElement.src&"'width='140'height='140'>"

preview.runtimeStyle.pixelLeft=window.event.x+5

preview.runtimeStyle.pixelTop=window.event.y+5

preview.style.visibility="visible"

preview.innerHTML=strHTML1

EndSub

Subhideview()

preview.style.visibility="hidden"

EndSub

Subaddpro()

Setobj=window.event.srcElement.parentelement.parentelement.parentelement.parentelement

Ifobj.cells(0).children(0).children(0).checked=falseThen

obj.cells(0).children(0).children(0).checked=true

Else

obj.cells(0).children(0).children(0).checked=false

EndIf

EndSub

Subtb_del()

Setobj=document.all.namedItem("mytable")

Ifobj.rows.Length>2Then

SettagID=document.all.namedItem("addme")'获取对象ID:delcheck'

ForEachotagintagID

Ifotag.checkedThen

objrow=otag.parentelement.parentelement.parentelement.rowindex'获取对象的行序数;'

obj.deleteRow(objrow)'删除该项；'

EndIf

Else

MsgBox"才一项你都删，哪有这样的?!",0,"删除提醒"

ExitSub

EndIf

EndSub

Subselectall()

Setobj=document.all.namedItem("mytable")

Setobjcheck=document.all.namedItem("sall")

SettagID=document.all.namedItem("addme")'获取对象ID:addme'

ForEachotagintagID

otag.checked=objcheck.checked

EndSub

Subdownload()

Setfso=CreateObject("Scripting.FileSystemObject")

IfNot(fso.FolderExists("★网易下载图片★"))Then

fso.CreateFolder("★网易下载图片★")

EndIf

Sethttp=CreateObject("Microsoft.XMLHTTP")

Setobj=document.all.namedItem("mytable")

SettagID=document.all.namedItem("addme")'获取对象ID:delcheck'

ForEachotagintagID

Ifotag.checkedThen

Setobjrow=otag.parentelement.parentelement.parentelement'获取对象的行;'

downurl=objrow.cells(1).children(0).children(0).children(0).src

filename=objrow.cells(3).children(0).innertext

http.Open"GET",downurl,False

http.send

Setaso=CreateObject("ADODB.Stream")

aso.Type=1

aso.Open

aso.Writehttp.ResponseBody

aso.savetofile"★网易下载图片★"&filename&"."&fileext,2

aso.Close

EndIf

infotext.innertext=infotext.innertext&vbCrLf&"文件下载成功。"

infotext.innertext=infotext.innertext&vbCrLf&"文件保存在:"&vbCrLf&"“★网易下载图片★”下"

EndSub

Subdownloadfile()

infotext.innertext="正在下载文件...."'"

window.settimeout"download()",200

EndSub

Subchangevalue()

AID=Array("130","112","67","14","122","158")

PID=Array("90","91","89","34","198","200")

IfAtype.selectedindex=0Then

Fori=0To5

imagetype.options(i+2).Value=PID(i)

Else

Fori=0To5

imagetype.options(i+2).Value=AID(i)

EndIf

EndSub

</script>