VB 如何提取网页源带码中的url链接，动态添加控件实例

本人进行了简单修改，其提取链接的技术并不完美，无法处理复杂情况。着重学习其动态添加控件、为新控件添加事件处理的方法

新建一个工程，在Form1中添加如下代码

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 = NothingEnd Function

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.ClearEnd Function

Private Sub Form_Load()    Dim Url, tempStr As String    Dim a() As String    Dim Label() As Object    '标签控件对象数组    Dim clsT() As New Class1 '对象数组    Url = InputBox("请输入一个网址")        '输入对话框    a = Split(getHTTPPage(Url), "href=")    '获取页面源代码，并提取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))  '动态创建标签控件，CStr把i转换成字符串类型        Label(i).Height = 300        Label(i).Top = nTop        Label(i).Visible = True        tempStr = Split(a(i), ">")(0) '<a> 标签的结束        tempStr = Replace(tempStr, CStr(Chr(34)), "")   '去除两边双引号        If Left(tempStr, 4) <> "http" Then tempStr = Url & tempStr '左边没有http则可能是相对链接        If InStr(tempStr, " ") Then tempStr = Split(tempStr, " ")(0) '用空格分离URL        Label(i).Caption = tempStr        Label(i).AutoSize = True        nTop = nTop + 30 * 8        clsT(i).Init Label(i) '标签类    Next iEnd Sub

然后新建一个类模块class1加入以下代码: Option ExplicitDim WithEvents L As Label Public Sub Init(tmp As Label)    Set L = tmpEnd Sub Private Sub L_Click()    Shell "C:/Program Files/Internet Explorer/iexplore.exe " & L.CaptionEnd Sub 运行程序