geted2klink.vbs 代码如下,你也可以直接下载 :
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,欢迎向我反映!!
如对本文有疑问, 点击进行留言回复!!
网友评论