VB利用正则表达式获取网页全部链接的源码

'API函数声明

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _

    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _

    lParam As Any) As Long

Const LB_SETHORIZONTALEXTENT = &H194

Private Sub Form_Load()

    Text1.Text = "www.tugaga.com"   '设置默认网址

     WebBrowser1.Visible = False

End Sub

Private Sub Command1_Click()

 WebBrowser1.Visible = True

 WebBrowser1.Navigate (Text1.Text) '打开指定网页

End Sub

Private Sub Command2_Click() '获取当前网页所有的超链接

Dim TagName, str As String

    Dim count, i, k As Integer

    Dim cols

    List1.Clear

    Set cols = WebBrowser1.Document.All

    count = cols.length

    k = 0

    While i < count

        TagName = cols.Item(i).TagName

        If TagName = "A" Or TagName = "IMG" Then  '查找超链接和图形

            str = k & "  " & TagName & "... " & cols.Item(i).href '显示内容

            List1.AddItem (str)       '添加超链接表项

            SendMessage List1.hwnd, LB_SETHORIZONTALEXTENT, Me.TextWidth(str), ByVal 0&  '为列表框添加水平滚动条

            k = k + 1 '计数