您现在的位置是：网站首页> 编程资料编程资料
用于提取网易文件的hta代码_vbs_
2023-05-25
265人已围观
简介 用于提取网易文件的hta代码_vbs_
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 & "
strHTML = strHTML & "
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 = "
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
