[求助]请高手指点,想快速批量提取网页中的超链接

kld_map

请高手指点,想快速批量提取网页中的超链接.本人是小白一个..
非常感谢.


卡饭有个高人给我的写的提取网页源码中ed2k链接的代码，我想下面这段代码修改一下，应该能实现，但我不知道怎么修改。。

1. Set ObjHttp = CreateObject("Microsoft.XMLHTTP")
   
2. 
   
3. SourceURL = inputbox(vbcrlf & "提取完成后您将收到一个提示。这个过程中" & vbcrlf & _
   
4.         vbcrlf & "请耐心等待，文件结果保存在：ed2k.txt" & vbcrlf & _
   
5.         vbcrlf & "请输入链接地址:" & vbcrlf, "Get ED2K Link", "http://" )
   
6. 
   
7. IF SourceURL = "" Then wscript.quit(1)
   
8. 
   
9. ObjHttp.Open "Get", SourceURL, false
   
10. ObjHttp.Send
    
11. SourceCode = Conver(ObjHttp.responsebody)
    
12. 
    
13. Set ObjFSO = CreateObject("Scripting.FileSystemObject")
    
14. ObjFSO.OpenTextFile("s.txt", 8, true).Write SourceCode
    
15. 
    
16. Set ReadFile = ObjFSO.OpenTextFile("s.txt", 1, True)
    
17. 
    
18. Do While Not ReadFile.AtEndOfStream
    
19.         EveryLine = ReadFile.ReadLine
    
20.         
    
21.     If Left(EveryLine, 14) = "var g_filelist" Then
    
22.                 Arr = Split(Split(EveryLine, "=[")(1), ",")
    
23.                 For K = 0 To UBound(Arr)-LBound(Arr)
    
24.                         K = K + 1
    
25.                         If Left(replace(mid(Arr(K), 9), """}", ""), 4) = "ed2k" Then
    
26.                                 ObjFSO.OpenTextFile("ed2k.txt", 8, true).Write(replace(mid(Arr(K), 9), """}", "") & vbcrlf)
    
27.                         End If
    
28.                 Next
    
29.                 Exit Do
    
30.         End If
    
31. Loop
    
32. ReadFile.Close
    
33. ObjFSO.DeleteFile ".\s.txt"
    
34. 
    
35. MsgBox "已完成全部作业!", 64, "Get ED2K Link"
    
36. 
    
37. 
    
38. Function Conver(vIn)
    
39.     strReturn = ""
    
40.     For i = 1 To LenB(vIn)
    
41.         ThisCharCode = AscB(MidB(vIn,i,1))
    
42.         If ThisCharCode < &H80 Then
    
43.             strReturn = strReturn & Chr(ThisCharCode)
    
44.         Else
    
45.             NextCharCode = AscB(MidB(vIn,i+1,1))
    
46.             strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
    
47.             i = i + 1
    
48.         End If
    
49.     Next
    
50.     Conver = strReturn
    
51. End Function

复制代码

青色烟雨夜朦胧

看看用火车头，texthealper可不可以提取

kld_map

青色烟雨夜朦胧 发表于 2012-6-22 12:24
看看用火车头，texthealth可不可以提取

这是个软件吗??

青色烟雨夜朦胧

kld_map 发表于 2012-6-22 12:25
这是个软件吗??

这是两个软件，分别试试

kld_map

青色烟雨夜朦胧 发表于 2012-6-22 12:25
这是两个软件，分别试试

好的。非常感谢。我试试