VBS 提取狗狗影視中的ED2K連接的實現代碼

打開狗狗影視，搜索自己需要的資源，資源類型選：電驢，如下圖：



我找到一個 19.75GB 的：



點開它，出現如下圖的界面，可以看到正常下載地址已被屏蔽。我們復制地址欄中的網址，備用。



打開從本站下載的 VBS 腳本，復制該網址到輸入框，然後確定，稍過一會，會出現提示完成的消息框，這個時間的長短由你的網速決定！



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



還等什麼？打開你的下載工具，開始下載吧！^_^

GetEd2kLink.VBS 代碼如下，你也可以直接下載 GetED2KLink：

SourceURL = inputbox( _
 vbcrlf & "提取完成後您將收到一個提示。這個過程中" & vbcrlf & _
 vbcrlf & "請耐心等待，文件結果保存在：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

'獲取網頁源碼
Set ObjHttp = CreateObject("Microsoft.XMLHTTP")
ObjHttp.Open "Get", SourceURL, false
ObjHttp.Send
SourceCode = Split(CodeConver(ObjHttp.responsebody), chr(10))

'分析網頁源碼
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

'保存結果
If Ed2KLink = "" Then
 MsgBox "該網頁中找不到任何 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 "已完成全部作業!", 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

僅供測試，如發現任何 BUG，歡迎向我反映！！