用于提取网易文件的hta代码_VBS

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

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

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

str1 = 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

            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 & "<tr><td><span class='grid2'><input id=addme type=checkbox>选定</span></td>"

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

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

            strHTML = 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

        strHTML = strHTML & connect(i)

    Next

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

    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 = "<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

    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

</script>

用于提取网易文件的hta代码

相关文章

热门资讯