VBS 提取狗狗影視中的ED2K連接的實現(xiàn)代碼

我找到一個 19.75GB 的:

點開它,出現(xiàn)如下圖的界面,可以看到正常下載地址已被屏蔽。我們復制地址欄中的網(wǎng)址,備用。

打開從本站下載的 VBS 腳本,復制該網(wǎng)址到輸入框,然后確定,稍過一會,會出現(xiàn)提示完成的消息框,這個時間的長短由你的網(wǎng)速決定!

最后,我們得到最終的 ED2K 連接地址,全部保存在當前目錄下的 ed2k.txt 文件中:

還等什么?打開你的下載工具,開始下載吧!^_^
GetEd2kLink.VBS 代碼如下,你也可以直接下載 GetED2KLink:
On Error Resume Next
SourceURL = inputbox( _
vbcrlf & "提取完成后您將收到一個提示。這個過程中" & vbcrlf & _
vbcrlf & "請耐心等待,文件結(jié)果保存在:ed2k.txt" & vbcrlf & _
vbcrlf & "請輸入鏈接地址:" & vbcrlf, "Get ED2K Link", "http://" _
)
IF SourceURL = "" or SourceURL = "http://" Then
MsgBox "鏈接地址不能為空!", 48, "Get ED2K Link"
Wscript.Quit(1)
End If
'獲取網(wǎng)頁源碼
Set ObjHttp = CreateObject("Microsoft.XMLHTTP")
ObjHttp.Open "Get", SourceURL, false
ObjHttp.Send
SourceCode = Split(CodeConver(ObjHttp.responsebody), chr(10))
'分析網(wǎng)頁源碼
For i = 0 To UBound(SourceCode)-LBound(SourceCode)
MatchLine = InStr(SourceCode(i), "ed2k://|file|")
If MatchLine <> 0 Then
ArrPub = Split(Replace(SourceCode(i), "},{", "}#{"), "#")
For K = 0 To UBound(ArrPub)-LBound(ArrPub)
Ed2KLink = Ed2KLink & Split(Split(ArrPub(K), ",")(5), """")(3) & vbcrlf
Next
End If
Next
'保存結(jié)果
If Ed2KLink = "" Then
MsgBox "該網(wǎng)頁中找不到任何 ed2k 連接!", 48, "Get ED2K Link"
Wscript.Quit(2)
Else
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
ObjFSO.OpenTextFile("ed2k.txt", 8,true).Write(Ed2KLink)
End If
MsgBox "已完成全部作業(yè)!", 64, "Get ED2K Link"
Wscript.Quit(0)
Function CodeConver(vIn)
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
CodeConver = strReturn
End Function
僅供測試,如發(fā)現(xiàn)任何 BUG,歡迎向我反映!!
相關(guān)文章
VBS基礎篇 - vbscript Dictionary對象
Dictionary是存儲數(shù)據(jù)鍵和項目對的對象,其主要屬性有Count、Item、Key,主要方法有Add、Exists、Items、Keys、Remove、RemoveAll2018-05-05用vbs實現(xiàn)的利用ADSL撥號變ip刷投票的代碼
朋友讓我?guī)退⑼镀保铱戳丝?,那個投票系統(tǒng)只是限制ip,考慮的不是很全面,可以刷。2010-03-03VBS教程:VBscript屬性-HelpContext 屬性
VBS教程:VBscript屬性-HelpContext 屬性...2006-11-11VBS教程:VBScript 基礎-VBScript編碼約定
VBS教程:VBScript 基礎-VBScript編碼約定...2006-11-11