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

前端之家收集整理的这篇文章主要介绍了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
运行程序

猜你在找的VB相关文章