vbs模擬登陸、遍歷，然後批量，調用迅雷下載某電影網站的資源

對 [url]www.cool8.tv[/url] 的短篇資源愛不釋手，所以寫了個腳本把全部下載到本地了。

保存下列代碼爲 GetCool9.vbs，雙擊運行即可，可能會產生很多臨時文件

On Error Resume Next

'交互登陸
sUserName = InputBox("Cool8 user name:",sTitle,"netunion")
If sUserName ="" then WScript.Quit
sUserPwd = InputBox("Cool8 user password:",sTitle,"netunion")
If sUserPwd ="" Then WScript.Quit
sUploadPath =InputBox("Where to save the download?:",sTitle,"I:\Upload\Cool8短片\")
If sUploadPath ="" Then WScript.Quit


sCool8Entry ="http://www.cool8.tv/humor/index.do?method=showPage&CHANNEL_ID=268" '登陸入口
sCool8Login ="CHANNEL_ID=268&actionURL=http%3A%2F%2Fwww.cool8.tv%2Fhumor%2Findex.do&operator.loginname="& sUserName&"&operator.passwd="& sUserPwd &"&cookieTimes=0" '登錄提交內容
sCoo8Pager1 ="cookieTimes=0&CHANNEL_ID=268&operator.loginname="& sUserName &"&actionURL=http%3A%2F%2Fwww.cool8.tv%2Fhumor%2Findex.do&operator.passwd="& sUserPwd &"&currPageNum=" '逐頁瀏覽
sCoo8Pager2 ="&goPageNum="
sReferUrl ="http://www.cool8.tv/humor/index.do?method=login" '下載引用頁

'得到當前目錄sCurrDir
Set fso=CreateObject("scripting.filesystemobject")
set ofile =fso.GetFile(WScript.ScriptFullName)
sCurrDir= ofile.ParentFolder
Set fso=Nothing

'全局的HTTP操作對象
Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
Set XunLei =CreateObject("ThunderAgent.Agent")

'獲得 cool8 的入口
xmlHttp.open "GET",sCool8Entry,False
xmlHttp.send
wscript.Echo xmlHttp.getAllResponseHeaders

'登錄(其實不用登錄的)
SimplePost "http://www.cool8.tv/humor/index.do?method=login",sCool8Login
SaveToFile xmlHttp.responseBody,"loginResult.htm"


For pi = 21 To 38 '後面那個是頁數
    
'逐頁打開
SimplePost "http://www.cool8.tv/humor/index.do?method=login",sCoo8Pager1 & pi & sCoo8Pager2
SaveToFile xmlHttp.responseBody,"list" & pi & ".htm"
    
'獲得當前頁面的視頻頁面鏈接列表
Set oDOM=GetObject(sCurrDir & "\list" & pi & ".htm","htmlfile")
WScript.Sleep 1000
Set ListForm = oDOM.getElementsByTagName("table")(34) '列表所在的<table>位於html的第34位
    
For ti = 2 To ListForm.rows.length -3 '那個 2 是我一個小時調試的心血啊～～
    Set ThisCell=ListForm.rows(ti).cells(1)
    sFilmTitle=ThisCell.innerText
    sFilmLink="http://www.cool8.tv/" & mid(CStr(ThisCell.all(1).getAttribute("href")),18)
    
    '獲得真實地址
    xmlHttp.open "GET",sFilmLink,False
    xmlHttp.send
    SaveToFile xmlHttp.responseBody,"detail"&(pi-1)*39+ti&".htm"
    sVideoUrl=GetVideoUrl(sCurrDir & "\detail"&(pi-1)*39+ti&".htm")
    
    '調用迅雷下載
    XunLei.AddTask sVideoUrl,sFilmTitle &".wma",sUploadPath,"",sReferUrl
    
Next    
    
'完成一頁的分析後批量下載
XunLei.CommitTasks
Next

'程序完


'---------------公用函數-----------------

'讀取真實視頻地址
GetVideoUrl() GetVideoUrl(sHtmlFilePath)
Set tmpDOM=GetObject(sHtmlFilePath,"htmlfile")
WScript.Sleep 1000
GetVideoUrl =CStr(    tmpDOM.getElementsByTagName("param")(14).getAttribute("value"))
End Function


'同意設置一般性HTTP請求頭(cool8備用)
Sub SetNormalHeaders
xmlhttp.setRequestHeader "Accept", " image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*"
xmlhttp.setRequestHeader "Accept-Language", " zh-cn"
xmlhttp.setRequestHeader "Accept-Encoding", " gzip, deflate"
xmlhttp.setRequestHeader "User-Agent", " Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; Maxthon; .NET CLR 1.1.4322; .NET CLR 2.0.50727)"
xmlhttp.setRequestHeader "Host", " [url]www.cool8.tv[/url]"
xmlhttp.setRequestHeader "Connection", " Keep-Alive"
End Sub

'保存xmlHttp返回爲文件，隨便解碼
SaveToFile() SaveToFile(oResponseBody, sFileName)
Set oStream = CreateObject("ADODB.Stream")    
oStream.Mode = 3    
oStream.Type = 1    
oStream.Open()    
oStream.Write(oResponseBody)    
oStream.SaveToFile sFileName,2    
Set oStream =Nothing
End Function

'簡單POST提交
SimplePost() SimplePost(sActionUrl,sSend)
xmlHttp.open "POST",sActionUrl,False
xmlHttp.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
xmlHttp.setRequestHeader "Content-Length",Len(sSend)
xmlHttp.send(sSend)
End Function

'中文的UTF-8編碼
URLEncoding() URLEncoding(vstrIn)
        strReturn = ""
        For iv = 1 To Len(vstrIn)
                ThisChr = Mid(vStrIn,iv,1)
                If Abs(Asc(ThisChr)) < &HFF Then
                 Select Case ThisChr                    
                 Case ":" strReturn = strReturn & "%3A"
                 Case "/" strReturn = strReturn & "%2F"
                 Case ";" strReturn = strReturn & "%3B"
                 Case "?" strReturn = strReturn & "%3F"
                        Case Else strReturn = strReturn & ThisChr
                        End Select
                Else
                        innerCode = Asc(ThisChr)
                        If innerCode < 0 Then
                                innerCode = innerCode + &H10000
                        End If
                        Hight8 = (innerCode    And &HFF00)\ &HFF
                        Low8 = innerCode And &HFF
                        strReturn = strReturn & "%" & Hex(Hight8) &    "%" & Hex(Low8)
                End If
        Next
        URLEncoding = strReturn
End Function