copyright 1999 - 2014 by heinz prelle - hannover  - lenbachstraße 42 - www.visual-basic5.de | impressum
'Beispiel: VB .Net - Urls aus einer Webseite extrahieren - 3
'
Option Explicit On
Option Strict On

Imports System.Net
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions

Public Class Form1

    Public Sub New()
        InitializeComponent()
        Dim Items() As String = _
            { _
                "http://www.visual-basic5.de/links.htm", _
                "http://www.visual-basic5.de/index.htm", _
                "http://www.visual-basic5.de/rechts.php" _
            }
        Me.ComboBox1.Items.AddRange(Items.ToArray())
        If Me.ComboBox1.Items.Count > 0 Then Me.ComboBox1.SelectedIndex = 0
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _
            Handles MyBase.Load
        With Me
            .Text = "Urls aus einer Webseite extrahieren - 3"
            .Button1.Text = "Extrahieren"
            .CenterToScreen()
        End With
    End Sub

    Private Function GetWebsiteContent(ByVal url As String) As String
        If url.Length = 0 Then Return String.Empty
        Dim Content As String = String.Empty

        Try
            Dim wr As WebRequest = WebRequest.Create(New Uri(url))
            Using [Stream] As Stream = wr.GetResponse.GetResponseStream
                Using sr As StreamReader = New StreamReader([Stream], Encoding.UTF8)
                    Content = sr.ReadToEnd()
                End Using
            End Using
        Catch ex As Exception
            MessageBox.Show(ex.Message(), "Info")
        End Try
        Return Content
    End Function

    Private ReadOnly Property Pattern() As String
        Get
            Return "<a [^>]*href=\" & """" & "*([^\" & """" & ">]*)\" & """" & "*[^>]*>"
        End Get
    End Property

    Private Function GetUrls(ByVal Content As String) As List(Of String)
        Dim List As New List(Of String)

        Try
            For Each m As Match In New Regex(Pattern, RegexOptions.IgnoreCase).Matches(Content)
                List.Add(m.Groups(1).ToString())
            Next
        Catch ex As Exception
            MessageBox.Show(ex.Message(), "Info")
        End Try
        Return List
    End Function

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
            Handles Button1.Click
        With Me
            If .ListBox1.Items.Count > 0 Then .ListBox1.Items.Clear()
            Dim Content As String = GetWebsiteContent(Me.ComboBox1.Text)
            If Content Is String.Empty Then
                Return
            Else
                Try
                    Dim List As New List(Of String)(.GetUrls(Content))
                    If List IsNot Nothing Then
                        For Each Items As String In List
                            .ListBox1.Items.Add(Items)
                        Next
                    Else
                        MessageBox.Show("Keine Ergebnisse vorhanden...", "Info")
                    End If

                Catch ex As Exception
                    MessageBox.Show(ex.Message(), "Info")
                End Try
            End If
            .Text = .ListBox1.Items.Count.ToString()
        End With
    End Sub

End Class
Sourcecode Visual Basic