[原创] sendkey大显神威送你n本奇幻小说

batman

前言：　　
　　最近论坛暗暗兴起了一股批处理下载热，jm还就此写出了关于curl下载的相关教程。我认为这确实是件好事，至少由此力证了批处理并不是花拳绣脚，而是有着广泛的实用性。要做到下载，就必须对网页源码进行分析和操作，相对于批处理而言，vbs对此更有着优越性，它针对于对象的操作让此变得很轻松，批处理却只能借助于第三方工具来实现。于是，本人在此之前鼓捣出了四大名著下载vbs版。。。
　　继四大名著下载后今日再推出批量下载代码。由于代码是采用的ie自带下载，所以采用了sendkey来模拟键盘操作。其实有很多人并不看好sendkey，认为这样的操作太不稳定，本人以前也是这样以为的。但是从下面这段代码，可以看出只要控制好sendkey，它还是大有可为的。。。
    代码从网页源码中获取小说名及下载地址，并用vbs调用cmd命令利用ie默认下载，同时对下载的temp.zip重命名并移动到当前目录下。
注：
　　由于是采用的ie（ie8可能不行）自带下载，所以在运行代码前请先关闭迅雷或其他下载软件的浏览器监视功能，最好关闭杀软的网络监控。同时将代码中的temp路径改为你的ie默认下载路径（本人的是桌面），并将输入法置于英文输入状态。在下载过程可能会因为有些地址无法连接而弹出错误窗口，对于此代码设置了超时等待（初始为30秒，自己可以根据网络情况修改），等待超时会自动进入下一个文件的下载。整个下载过程全是由程序自动完成的，你要做的就是静静坐在电脑前看着一本本小说（zip文件）被下载到电脑中。。。

Dim fso, vbstr, wssh, regstr, temp, XMLHTTP, AdoStrm
Set fso = CreateObject("scripting.filesystemobject")
Set wssh = CreateObject("wscript.shell")
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
set AdoStrm = CreateObject("ADODB.Stream")
XMLHTTP.Open "GET", "http://www.d9cn.org/modules/article/index.php?fullflag=1", False
Do Until XMLHTTP.readyState = 1:WScript.Sleep 200:Loop
XMLHTTP.Send()
AdoStrm.Mode = 3
AdoStrm.Type = 1
AdoStrm.Open()
AdoStrm.Write XMLHTTP.responseBody
AdoStrm.SaveToFile wssh.CurrentDirectory & "\temp.htm", 2
adostrm.Close
Set XMLHTTP = Nothing
set AdoStrm = Nothing
vbstr = fso.OpenTextFile(wssh.CurrentDirectory & "\temp.htm", 1, True).ReadAll()
fso.DeleteFile wssh.CurrentDirectory & "\temp.htm"
temp = "C:\Docume~1\Administrator\桌面\temp.zip"
regtest vbstr, "(<h3>).*?(\w+):\/\/([^/:]+)(/d9info)([^# ]*)?(htm)(.>)?(.*)?(</a>)"
Set fso = nothing
Set wssh = Nothing
MsgBox "ok"
 
Function regtest(str, pattern)
  Dim regex, matches, match, name, url, i
  Set regex = New RegExp
  regex.Pattern = pattern
  regex.Global = True
  regex.IgnoreCase = False
  Set matches = regex.Execute(str)
  For Each match In matches
    name = match.Submatches(7) & ".zip":i = 0
    url = "http://121.11.149.131:60889/d9cnzip" & match.Submatches(4) & "zip"
    wssh.Run "cmd /c start " & url, 0, True
    WScript.Sleep 500
    wssh.SendKeys "{delete}"
    WScript.Sleep 500
    wssh.SendKeys "{delete}"
    WScript.Sleep 500
    wssh.SendKeys "{delete}"
    WScript.Sleep 500
    wssh.SendKeys "s"
    WScript.Sleep 500
    wssh.SendKeys "temp"
    WScript.Sleep 500
    wssh.SendKeys "{tab}"
    WScript.Sleep 500
    wssh.SendKeys "{tab}"
    WScript.Sleep 500
    wssh.SendKeys "s"
    Do Until fso.FileExists(temp) Or i = 150
       i = i+1
       WScript.Sleep 200
    Loop
    wssh.SendKeys "{enter}"
    If fso.FileExists(temp) Then fso.MoveFile temp,  wssh.CurrentDirectory & "\" & name
    WScript.Sleep 500
  Next
End Function
复制代码