網易手機圖片自由下載器（hta）

2020-01-25 19:40:53

字體：大中小

來源：轉載

供稿：網友

代碼如下:

<TITLE>網易文件攝取</TITLE>

<meta http-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"

/>

<style type="text/css">



</style>

  <div class="separator">

    <hr>

  </div>

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

  <tr>

    <td colspan="2" align="center" valign="middle" id=menubar onselectstart="return false"><span class="TT1" id="consume">網易圖片文件一覽表</span> </td>

  </tr>

</table>

  <div class="separator">

    <hr>

  </div>

<table width="100%" height="415" border="1">

  <tr>

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

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

      <p> </p>

    </div>

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

  </tr>

  <tr>

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

      <p>本程序可以自由下載網易圖片..</p>

      <p> </p>

    </div></td>

  </tr>

   <tr>

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

  </tr>

  <tr>

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

      <option value="jpg">彩圖</option>

      <option value="gif">動畫</option>

                        </select></td>

    <td height="33" align="center" valign="middle" bgcolor="#FFFFFF" style="border-style: solid; border-color: #000080"><select name="imagetype" id="imagetype">

      <option selected="selected">圖片類型</option>

      <option>全部</option>

      <option value="90">絕色風光</option>

      <option value="91">四季花語 </option>

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

      <option value="34">絕色美女 </option>

      <option value="198">都市麗人</option>

      <option value="200">手繪美女</option>

    </select></td>

  </tr>

  <tr>

    <td height="33" colspan="2" align="center" valign="middle" bgcolor="#FFFFFF" style="border-style: solid; border-color: #000080"><input name="del2" type="submit" class="s_button" id="del2" onclick="downloadfile()" value="下載選定項" /></td>

  </tr>

  <tr>

    <td height="33" colspan="2" align="center" valign="middle" bgcolor="#FFFFFF" style="border-style: solid; border-color: #000080"><input name="del" type="submit" class="s_button" id="del" onclick="tb_del()" value="刪除選定項" /></td>

  </tr>

  <tr>

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

    <td width="14%" bgcolor="#FFFFFF" valign="middle" align="center" style="border-style: solid; border-color: #000080"><a title="在此處輸入起始頁數"><input name="start1" type="text" id="start1" value="1" size="10" />

    </a></td>

  </tr>

  <tr>

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

    <td height="26" align="center" valign="middle" bgcolor="#FFFFFF" style="border-style: solid; border-color: #000080"><a title="在此處輸入結束頁數"><input name="start2" type="text" id="start2" size="10" value="1"/>

    </a></td>

  </tr>

</table>

<script language="vbscript">

public fileext

str1="<tr><td><span class='grid1'><input type=checkbox id='sall' onclick='selectall()'>全都選</span></td>"

str1str1=str1& "<td><span class='grid1'>預覽</span></td>"

str1str1=str1 & "<td><span class='grid1'>文件路徑</span></td>"

str1str1=str1 & "<td><span class='grid1'>文件名稱</span></td></tr>"

Sub Window_onLoad

     window.resizeTo 750,515

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

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

  window.moveTo ileft,itop

end sub

function connect(num)

dim imageinfo,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="

set http=createobject("Microsoft.XMLHTTP")

http.open "GET",url,False

http.send

vIn=http.ResponseBody

strReturn = ""

For i = 1 To LenB(vIn)

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

If ThisCharCode < &H80 Then

strReturnstrReturn = strReturn & Chr(ThisCharCode)

Else

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

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

ii = i + 1

End If

Next

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

do

pos=instr(strReturn,"showPic")

pos1=instr(strReturn,"128x128")

if pos>0 then

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)

    strHTMLstrHTML=strHTML & "<tr><td><span class='grid2'><input id=addme type=checkbox>選定</span></td>"

    strHTMLstrHTML=strHTML &"<td><span class='grid3'><a onMousemove='view()' onmouseout='hideview()' href=#><img onClick='addpro()' src='"&imageurl&imagepath&"' width=30 height=20></a></span></td>"

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

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

strReturn=mid(strReturn,namepos1+20)

else

exit do

end if

loop

connect=strHTML

end function

function writeinner()

for i=start1.value to start2.value

strHTMLstrHTML=strHTML & connect(i)

next

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

list.innerHTML=strHTML

infotextinfotext.innertext=infotext.innertext & "連接成功。"

infotextinfotext.innertext=infotext.innertext & vbcrlf &vbcrlf & "從第" & start1.value & "頁到第" & start2.value & "頁的gif圖片文件信息!"

end function

function show()

if not (isnumeric(start2.value)) or not (isnumeric(start2.value)) then

infotextinfotext.innertext=infotext.innertext & vbcrlf & "配置錯誤..."

else

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

window.settimeout "writeinner()",200

end if

end function

sub view()

strHTML1="<img src='" &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

end sub

sub hideview()

preview.style.visibility="hidden"

end sub

sub addpro()

set obj=window.event.srcElement.parentelement.parentelement.parentelement.parentelement

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

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

else

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

end if

end sub

sub tb_del()

set obj=document.all.namedItem("mytable")

if obj.rows.length>2 then

Set tagID = document.all.namedItem("addme")   '獲取對象ID:delcheck'

for each otag in tagID

if otag.checked then

objrow=otag.parentelement.parentelement.parentelement.rowindex       '獲取對象的行序數;'

obj.deleteRow(objrow)  '刪除該項；'

end if

next

else

msgbox "才一項你都刪，哪有這樣的?!",0,"刪除提醒"

exit sub

end if

end sub

sub selectall()

set obj=document.all.namedItem("mytable")

set objcheck=document.all.namedItem("sall")

Set tagID = document.all.namedItem("addme")   '獲取對象ID:addme'

for each otag in tagID

otag.checked=objcheck.checked

next

end sub

sub download()

Set fso = CreateObject("Scripting.FileSystemObject")

If not (fso.FolderExists("★網易下載圖片★")) Then

fso.createfolder("★網易下載圖片★")

end if

set http=createobject("Microsoft.XMLHTTP")

set obj=document.all.namedItem("mytable")

Set tagID = document.all.namedItem("addme")   '獲取對象ID:delcheck'

for each otag in tagID

if otag.checked then

set objrow=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

set aso=createobject("ADODB.Stream")

aso.type=1

aso.open

aso.write http.ResponseBody

aso.savetofile "★網易下載圖片★/" & filename & "."&fileext,2

aso.close

end if

next

infotextinfotext.innertext=infotext.innertext & vbcrlf & "文件下載成功。"

infotextinfotext.innertext=infotext.innertext & vbcrlf & "文件保存在:" & vbcrlf &"“★網易下載圖片★”下"

end sub

sub downloadfile()

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

window.settimeout "download()",200

end sub

sub changevalue()

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

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

if Atype.selectedindex=0 then

for i=0 to 5

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

next

else

for i=0 to 5

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

next

end if

end sub

</script>