url extractor

Iniciado por elrecar, 6 Octubre 2007, 05:11 AM

0 Miembros y 1 Visitante están viendo este tema.

Imprimir
Ir Abajo Páginas1
Acciones del Usuario

elrecar

6 Octubre 2007, 05:11 AM
he encontrado el siguiente codigo para extraer urls de donde sea.. textbox, archivo etc..

Código [Seleccionar]
Private Function ExtractURL(strHTML As String) As String()
    Dim URLs() As String
    Dim search As String
    Dim i, x, m As Long
    Dim z As Integer
   
    i = 1
    x = 1
    m = 0
   
    Do
        search = " "
        z = 5
        i = InStr(i, strHTML, "href=", vbTextCompare)
        DoEvents
        If (i) Then
            If Mid$(strHTML, i + 5, 1) = Chr(34) Then
                search = Chr(34)
                z = 6
            End If
            x = InStr(i + z, strHTML, search, vbTextCompare)
            If (x = 0 And search = " ") Then x = InStr(i + z, strHTML, ">", vbTextCompare)
            ReDim Preserve URLs(m)
            URLs(m) = URLDecode(Mid$(strHTML, i + z, x - (i + z)))
        End If
        i = i + 1
        m = m + 1
    Loop Until i = 1
    ExtractURL = URLs()
End Function

por ejemplo lo invoco de la siguiente manera:

Código [Seleccionar]
'HTML = "<a href=" & Chr(34) & "http://google.com/?bef=123&amp;test=xx" & Chr(34) & ">lol</a>"

Dim mis() As String
mis() = ExtractURL(HTML)

bueno por lo visto el codigo extractea urls buscando la palabra href= pero si por ejemplo tengo el siguiente codigo HTML, no funciona:

Código [Seleccionar]
HTTP/1.1 302 Found
Date: Sat, 06 Oct 2007 03:09:46 GMT
Server: Apache
Vary: *
Expires: Mon, 26 Jul 1997 05:00:00 GMT
Last-Modified: Sat, 06 Oct 2007 03:09:46 GMT
Cache-Control: no-store, no-cache, must-revalidate
Cache-Control: post-check=0, pre-check=0
Pragma: no-cache
Location: http://wawawawawawawa.com/pagead/iclk?sa=l&ai=B4poLbfwGR4WyK5j6oQOFjYiEDsyKqx_I69zeAcCNtwHgmBcQAhgCIOaRkQYoCjgAUKb63LD-_____wFg2wagAZKTvv8DsgEPdXJ1c29mdHdhcmUuY29tyAEB2gEXaHR0cDovL3VydXNvZnR3YXJlLmNvbS-oAwHoA5EG6APSBfUDQgAAAA&num=2&adurl=http://www.cellsignal.com&client=ca-dp-sedo-11_xml
Connection: close
Transfer-Encoding: chunked
Content-Type: text/html

2cf
<html><head><meta http-equiv="refresh" content="0; URL=http://wawawawawawawa.com/pagead/iclk?sa=l&ai=B4poLbfwGR4WyK5j6oQOFjYiEDsyKqx_I69zeAcCNtwHgmBcQAhgCIOaRkQYoCjgAUKb63LD-_____wFg2wagAZKTvv8DsgEPdXJ1c29mdHdhcmUuY29tyAEB2gEXaHR0cDovL3VydXNvZnR3YXJlLmNvbS-oAwHoA5EG6APSBfUDQgAAAA&num=2&adurl=http://www.cellsignal.com&client=ca-dp-sedo-11_xml"></head><body><a href='http://wawawawawawawa/pagead/iclk?sa=l&ai=B4poLbfwGR4WyK5j6oQOFjYiEDsyKqx_I69zeAcCNtwHgmBcQAhgCIOaRkQYoCjgAUKb63LD-_____wFg2wagAZKTvv8DsgEPdXJ1c29mdHdhcmUuY29tyAEB2gEXaHR0cDovL3VydXNvZnR3YXJlLmNvbS-oAwHoA5EG6APSBfUDQgAAAA&num=2&adurl=http://www.cellsignal.com&client=ca-dp-sedo-11_xml'>Please click here ... </a></body></html>

0

alguna idea? help!
Imprimir
Ir Arriba Páginas1
Acciones del Usuario