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 = Nothing
End 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.Clear
End 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 i
End Sub

然后新建一个类模块class1加入以下代码:
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

运行程序

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!