打开狗狗影视，搜索自己需要的资源，资源类型选：电驴，如下图：
我找到一个 19.75GB 的：
点开它，出现如下图的界面，可以看到正常下载地址已被屏蔽。我们复制地址栏中的网址，备用。 打开从本站下载的 VBS 脚本，复制该网址到输入框，然后确定，稍过一会，会出现提示完成的消息框，这个时间的长短由你的网速决定！ 最后，我们得到最终的 ED2K 连接地址，全部保存在当前目录下的 ed2k.txt 文件中： 还等什么？打开你的下载工具，开始下载吧！^_^ GetEd2kLink.VBS 代码如下，你也可以直接下载 GetED2KLink：
复制代码 代码如下:
On Error Resume Next
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，欢迎向我反映！！
您可能感兴趣的文章:
- Linux下进行MYSQL编程时插入中文乱码的解决方案
- Linux命令行和shell脚本编程宝典 Richard Blum
- linux c多线程编程实例代码
- Linux shell脚本编程if语句的使用方法(条件判断)
- linux多线程编程详解教程(线程通过信号量实现通信代码)
- Linux网络编程之socket文件传输示例
- Linux网络编程之UDP Socket程序示例
- Linux编程实现制作文件的ed2k链
本文由 华域联盟 原创撰写：华域联盟 » VBS 提取狗狗影视中的ED2K连接的实现代码
转载请保留出处和原文链接：https://www.cnhackhy.com/16552.htm
