https://www.google.es/url?sa=t&rct=j&q=&esrc=s&source=web&cd=1&cad=rja&uact=8&ved=0ahUKEwiK3Ii9zr7KAhXD0RQKHekoC9kQFggcMAA&url=http%3A%2F%2Fwww.recursosvisualbasic.com.ar%2Fhtm%2Fvb-net%2F54-obtener-links-de-una-pagina-web.htm&usg=AFQjCNGMpwVIQ7z-vWEq6Urag9Vf_UAKGg&bvm=bv.112454388,d.d24

http://www.recursosvisualbasic.com.ar/htm/vb-net/54-obtener-links-de-una-pagina-web.htm

#Region "Normalizar URL"
    Public Function ResolverURL(ByVal strUrl As String) As String
        Dim RedirectUrl As String = Nothing
         strUrl = DecodeUrl(strUrl)
        Try
            Dim WebRequest As System.Net.HttpWebRequest = DirectCast(System.Net.HttpWebRequest.Create(strUrl), System.Net.HttpWebRequest)
            With WebRequest
                .UserAgent = "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/535.1 (KHTML, like Gecko) Chrome/13.0.782.112 Safari/535.1"
                'WebRequest.MaximumAutomaticRedirections = 1
                .AllowAutoRedirect = True  '<==importante
                '.ProtocolVersion = System.Net.HttpVersion.Version11
                 .Method = "GET"
                '.Timeout = 1000
            End With
 
            Using webResponse As System.Net.HttpWebResponse = DirectCast(WebRequest.GetResponse, Net.HttpWebResponse)
                RedirectUrl = webResponse.ResponseUri.AbsoluteUri
                webResponse.Close() '<===importante
            End Using
        Catch ex As System.Net.WebException
            If ex.Status = Net.WebExceptionStatus.NameResolutionFailure Then
                MessageBox.Show("El Sitio no existe", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End If
        End Try
        Return RedirectUrl
    End Function
   Public Function DecodeUrl(ByVal strUrl As String) As String
        Dim HexCaracter As String()
        HexCaracter = strUrl.Split(CChar("%"))
        For I As Integer = 1 To HexCaracter.Length - 1
            Dim Cr As String = HexCaracter(I).Substring(0, 2)
            Dim newCr As String = Convert.ToChar(Convert.ToInt32(Cr, 16))
            strUrl = strUrl.Replace("%" & Cr, newCr)
        Next
        Return strUrl
    End Function
#End Region
 

Public Class Form1
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        TextBox1.Text = ResolverURL(URL)
    End Sub
 

 
   Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim strUrl as String = "https://www.google.es/url?sa=t&rct=j&q=&esrc=s&source=web&cd=1&cad=rja&uact=8&ved=0ahUKEwidgYbs98HKAhUJLhoKHRwBBzYQFggcMAA&url=https%3A%2F%2Fes.wikipedia.org%2Fwiki%2FAlbert_Einstein&usg=AFQjCNEpx7ZvmsTJayPwnY-RF0W1AbWLGw&bvm=bv.112454388,d.d2s"
 
         strUrl = DecodeUrl(strUrl)
 
        Dim uri As New Uri(strUrl)
        Dim dirs As String = uri.GetComponents(UriComponents.AbsoluteUri, UriFormat.UriEscaped)
 
        Try
            Dim dirArray As String() = dirs.Split(CChar("="))
            For I As Integer = 1 To dirArray.Length - 1
                If dirArray(I).Length > 4 Then
                    If dirArray(I).Substring(0, 4) = "http" Then
                        strUrl = dirArray(I).Replace("&usg", "")
                        Exit For
                    End If
                End If
            Next
        Catch ex As Exception
        End Try
 
        TextBox1.Text = strUrl
 
End Sub
    Public Function DecodeUrl(ByVal strUrl As String) As String
        Dim HexCaracter As String()
        HexCaracter = strUrl.Split(CChar("%"))
        For I As Integer = 1 To HexCaracter.Length - 1
            Dim Cr As String = HexCaracter(I).Substring(0, 2)
            Dim newCr As String = Convert.ToChar(Convert.ToInt32(Cr, 16))
            strUrl = strUrl.Replace("%" & Cr, newCr)
        Next
        Return strUrl
    End Function
 

#Region "Normalizar URL"
    Public Function NormalizarUrl(ByVal strUrl As String) As String
        strUrl = DecodeUrl(strUrl)
        Task.Factory.StartNew(Sub()
                                  If strUrl.Contains("www.google.es/url?") = True Then
                                      '//Obtiene la Url a la que redirecciona 
                                      strUrl = ResolverUrlGoogle(strUrl)
                                  Else
                                      '//Si el Url redireciona a otra Url obtiene la Url a la que redirecciona
                                      strUrl = ResolverURL(strUrl)
                                  End If
                                  ComboBox1.Invoke(DirectCast(Sub() ComboBox1.Text = strUrl, MethodInvoker))
                              End Sub)
 
 
        Return strUrl
    End Function
    Public Function DecodeUrl(ByVal strUrl As String) As String
        Dim HexCaracter As String()
        HexCaracter = strUrl.Split(CChar("%"))
        For I As Integer = 1 To HexCaracter.Length - 1
            Dim Cr As String = HexCaracter(I).Substring(0, 2)
            Dim newCr As String = Convert.ToChar(Convert.ToInt32(Cr, 16))
            strUrl = strUrl.Replace("%" & Cr, newCr)
        Next
        Return strUrl
    End Function
    Public Function ResolverUrlGoogle(ByVal strUrl As String) As String
 
        Dim uri As New Uri(strUrl)
        Dim dirs As String = uri.GetComponents(UriComponents.AbsoluteUri, UriFormat.UriEscaped)
        Try
            Dim dirArray As String() = dirs.Split(CChar("="))
            For I As Integer = 1 To dirArray.Length - 1
                If dirArray(I).Length > 4 Then
                    If dirArray(I).Substring(0, 4) = "http" Then
                        strUrl = dirArray(I).Replace("&usg", "")
                        Exit For
                    End If
                End If
            Next
        Catch ex As Exception
        End Try
        Return strUrl
    End Function
    Public Function ResolverURL(ByVal strUrl As String) As String
        Dim RedirectUrl As String = Nothing
        strUrl = DecodeUrl(strUrl)
 
        Try
            Dim WebRequest As System.Net.HttpWebRequest = DirectCast(System.Net.HttpWebRequest.Create(strUrl), System.Net.HttpWebRequest)
            With WebRequest
                WebRequest.UserAgent = "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/535.1 (KHTML, like Gecko) Chrome/13.0.782.112 Safari/535.1"
                'WebRequest.MaximumAutomaticRedirections = 1
                WebRequest.AllowAutoRedirect = True  '<==importante
            End With
            Using webResponse As System.Net.HttpWebResponse = DirectCast(WebRequest.GetResponse, Net.HttpWebResponse)
                RedirectUrl = webResponse.ResponseUri.AbsoluteUri
                webResponse.Close() '<===importante
            End Using
        Catch ex As System.Net.WebException
            If ex.Status = Net.WebExceptionStatus.NameResolutionFailure Then
                MessageBox.Show("El Sitio no existe", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End If
        End Try
        Return RedirectUrl
    End Function
#End Region
 

 Public Function DecodeUrl(ByVal strUrl As String) As String
        Dim HexCaracter As String()
        HexCaracter = strUrl.Split(CChar("%"))
        For I As Integer = 1 To HexCaracter.Length - 1
            Dim Cr As String = HexCaracter(I).Substring(0, 2)
            Dim newCr As String = Convert.ToChar(Convert.ToInt32(Cr, 16))
            strUrl = strUrl.Replace("%" & Cr, newCr)
        Next
        Return strUrl
    End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Encodes a Url string.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <remarks>
''' For more info, see Percent-encoding rule specifications:
''' <para></para>
''' In English: <see href="http://en.wikipedia.org/wiki/Percent-encoding"/>
''' <para></para>
''' In Spanish: <see href="http://es.wikipedia.org/wiki/C%C3%B3digo_porciento"/>
''' </remarks>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim encoded As String = UrlEncode("http://www.website.com/page.asp?id=5&amp;test=Hello World")
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="url">
''' The Url to encode.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting encoded Url.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function UrlEncode(ByVal url As String) As String
 
    ' HttpUtility.UrlEncode() writes the percent-code in lower-case,
    ' this is a custom method to write the percent-code in upper-case.
 
    Const Excluded As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.!()*"
 
    Dim sb As New StringBuilder()
    For Each c As Char In url
 
        Select Case c
 
            Case " "c
                sb.Append("+"c)
 
            Case Else
                If (Excluded.Contains(c, EqualityComparer(Of Char).Default)) Then
                    sb.Append(c)
 
                Else
                    For Each value As Byte In Encoding.UTF8.GetBytes(c)
                        sb.AppendFormat("%{0:X2}", value)
                    Next value
 
                End If
 
        End Select
 
    Next c
 
    Return sb.ToString()
 
End Function