网易手机图片自由下载器(hta)

复制代码 代码如下:

网易文件摄取

 ID="MyhyliApp" 
 APPLICATIONNAME="设置程序" 
 VERSION="1.0" 
 SCROLL="no" 
 INNERBORDER="no" 
 CONTEXTMENU="no" 
 CAPTION="yes" 
 SHOWINTASKBAR="yes" 
 SINGLEINSTANCE="yes" 
 SYSMENU="yes" 
 WINDOWSTATE="normal"
 NAVIGABLE="yes"
 />



  
    

  


  
    网易图片文件一览表 
  

  
    

  


  
    

    
      

 


    

       信息公布
  
  
    
      

本程序可以自由下载网易图片..


      

 


    

  
   
    
  

  
    
      彩图
      动画
                        
    
      图片类型
      
      绝色风光
      四季花语 
      海底世界 
      绝色美女 
      都市丽人
      手绘美女
    
  
  
    
  
  
    
  
  
    从    
    
    
  

  
    
    
    
  


public fileext
str1="全都选"
str1=str1& "预览"
str1=str1 & "文件路径"
str1=str1 & "文件名称"

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
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt (NextCharCode))
i = 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)
    strHTML=strHTML & "选定"
    strHTML=strHTML &""
 strHTML=strHTML & "" & imagepath & ""
 strHTML=strHTML & "" & imagename & ""
strReturn=mid(strReturn,namepos1+20)
else
exit do
end if
loop 
connect=strHTML
end function

function writeinner()
for i=start1.value to start2.value
strHTML=strHTML & connect(i)
next
strHTML="" &str1&strHTML& ""
list.innerHTML=strHTML
infotext.innertext=infotext.innertext & "连接成功。"
infotext.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 
infotext.innertext=infotext.innertext & vbcrlf & "配置错误..."
else
infotext.innertext="正在连接..."
window.settimeout "writeinner()",200
end if
end function
sub view()
strHTML1=""
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
infotext.innertext=infotext.innertext & vbcrlf & "文件下载成功。"
infotext.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



你可能感兴趣的:(网易手机图片自由下载器(hta))