Question

VB 如何提取网页源带码的所有url链接

在源码内搜索网址，搜到一个网址就动态加一个标签控件把网址输进去

Answer 1

　　VB6新建一个工程加入以下源码(不加任何控件)
　　Dim Label() As Object
　　Dim clsT() As New Class1
　　Function getHTTPPage(Url)
　　Dim Http
　　Set Http = CreateObject("MSXML2.XMLHTTP")
　　Http.Open "GET", Url, False
　　a = Http.send()
　　If Http.readystate <> 4 Then
　　Exit Function
　　End If
　　getHTTPPage = BytesToBstr(Http.responseBody, "GB2312")
　　Set Http = Nothing
　　If Err.Number <> 0 Then Err.Clear
　　End Function
　　Function BytesToBstr(body, Cset)
　　Dim objstream
　　Set objstream = CreateObject("adodb.stream")
　　objstream.Type = 1
　　objstream.Mode = 3
　　objstream.Open
　　objstream.Write body
　　objstream.Position = 0
　　objstream.Type = 2
　　objstream.Charset = Cset
　　BytesToBstr = objstream.ReadText
　　objstream.Close
　　Set objstream = Nothing
　　End Function

　　Private Sub Form_Load()
　　Dim Url, Html
　　Url = InputBox("请输入一个网址")
　　a = Split(getHTTPPage(Url), "href=")
　　Dim i As Integer
　　Dim nTop As Long
　　ReDim Label(UBound(a) - 1)
　　ReDim clsT(UBound(a) - 1)
　　For i = 1 To UBound(a) - 1
　　Set Label(i) = Controls.Add("VB.Label", "Label" & CStr(i))
　　Label(i).Height = 300
　　Label(i).Top = nTop
　　Label(i).Visible = True
　　TEMP = Split(a(i), ">")(0)
　　If Left(TEMP, 4) <> "http" Then TEMP = Url & TEMP
　　If InStr(TEMP, " ") Then TEMP = Split(TEMP, " ")(0)
　　Label(i).Caption = TEMP
　　Label(i).AutoSize = True
　　nTop = nTop + 30 * 8
　　clsT(i).Init Label(i)

　　Next i
　　End Sub

　　然后新建一个类模块加入以下代码:
　　Option Explicit
　　Dim WithEvents L As Label
　　Public Sub Init(tmp As Label)
　　Set L = tmp
　　End Sub
　　Private Sub L_Click()
　　Shell "C:\Program Files\Internet Explorer\iexplore.exe " & L.Caption
　　End Sub