Separar partes de un un html code

[extreme69]

A ver, tengo un archivo .html inmenso y necesito sacar cierta información dentro de unos tags.

Tengo que sacar del .html todo lo que esté entre medio de

<a href="

hasta

"><img class=

Esta sería parte del código:

<a href="xfire:add_friend?user=mrdogbertt"><img class=

Y esto lo que necesito obtener:

xfire:add_friend?user=mrdogbertt

Estoy usando este código:

Private Function ExtractInfo(ByVal strstring As String, ByVal starttag As String, ByVal endtag As String) As String
      ExtractInfo = Mid(strstring, Len(starttag) + 1, Len(strstring) - Len(endtag) - Len(starttag))
      End Function


      Private Sub Command1_Click()
      MsgBox ExtractInfo(Text1.Text, "<a href", "><img class")
      End Sub

Pero no me funciona en lo más mínimo, me corta partes del código que nada que ver, y aparte hay muchos de estos en el mismo html, y me obtendría sólo 1 o todos juntos, y yo necesito obtenerlos 1 por 1

Ideas? sugerencias? ejemplos? soluciones? ayuda? algo?

[Elemental Code]

Quiero que busques en este foro con muuucho cuidado, Mr.Frog tiene unos codigos para manipular codigo html.
Con uno lo obtenes y con otro lo limpia o algo asi.

Buscalo 

son las 01:11 de la matina, me voy a hacer noni

[ignorantev1.1]

Código (vb) [Seleccionar] Expandir


Function getXfire(ByVal tStr As String) As String
    Dim i As String
    Dim f As String
    tStr = LCase(tStr)
    i = InStr(tStr, "<a href=")
    f = InStr(tStr, "<img class")
    If i = 0 Or f = 0 Then getXfire = "No hay!": Exit Function
    getXfire = Mid(tStr, i + 9, f - i - 11)
End Function


checalo

[yalosabes]

ahmm ..spero q t sirva ste codigo

Código (vb) [Seleccionar] Expandir


Private Sub ListarUrl()

Dim i As Integer

      List1.Clear
       For i = 0 To wb1.Document.links.length - 1
         List1.AddItem wb1.Document.links.Item(i)
         List2.AddItem wb1.Document.All.tags("a").Item(i).innerText
      Next
End Sub

donde dice "a" puedes poner "td"  "img" "div" .. o lo que kieras...

en el ejemplo estoy sakando el texto con su respectiva url.. en los list distintos

[extreme69]

Bueno, funcionar funciona... con el código de ignorantev1.1... pero me toma únicamente la primera y me corta el resto del código donde se encuentran los otros links que quiero obtener.

Tengo el código html en un textbox, y estoy llamando a la función de esta manera:

call getXfire(Text1.Text)

Hay alguna manera de que no me corte el texto en Text1 sino que lo mande a otro textbox?


Agrego: Lo hice de una manera menos "elite", a puro sendkeys, tabs y enters, jajajaj, pero para mi sorpresa funciona y funciona excelente.

Gracias a todos por la ayuda!!! si alguien tiene el mismo objetivo que yo me dicen y les paso el source.

Saludos.-

[Psyke1]

Dios mio... SendKeys() para este tipo de cosas no por favor.
Te dejo aquí una funcion para sacar el texto entre dos palabras, para esto creo que te funcionará, sino otra opción será usar RegExp.

Código:

Código (vb) [Seleccionar] Expandir


'by Mr.Frog™
Public Function TextBetweenWords(ByRef strText$, ByRef strWord1$, ByRef strWord2$) As String
Dim lngPos1&, lngPos2&, lngStart&

    lngPos1 = InStr(strText, strWord1)
    If lngPos1 Then
        lngStart = lngPos1 + LenB(strWord1) \ 2
        lngPos2 = InStr(lngStart, strText, strWord2)
        If iPosition2 Then
            TextBetweenWords = Mid$(strText, lngStart, lngPos2 - lngStart)
        End If
    End If
End Function

Ejemplo:

Código (vb) [Seleccionar] Expandir


Private Sub Form_Load()
    Msgbox TextBetweenWords("<a href=""xfire:add_friend?user=mrdogbertt""><img class=", "<a href=""", """><img class=")
End Sub

Resultado:

Código [Seleccionar] Expandir

xfire:add_friend?user=mrdogbertt

No tengo el vb ahora, pero debería funcionar.

DoEvents!

[extreme69]

jajajajaja  

Si, ya sé soy un cochino... quedó un poco bugueado con sendkeys, tabs y enters, pero bueno, el 90% de los links los carga sin problemas. Incluso agregué botones para loguear y desloguear  

El problema es que tengo el código html cargado en un textbox, pero el resultado debería ir a otro textbox y como si fuese poco hay muchos links, no sólo 1, debería tomar 1x1, ir poniendolos en el otro textbox (el de la url) e ir visitando cada link extraído, y la verdad no se me ocurrió el como.

Para que tengas una idea de lo que hice...

http://www.xfire.com/communities/dignitas/roster/

Si estás logueado al entrar a ese link vas a ver que cada usuario debajo tiene un "+" para agregarlo como amigo.

[Psyke1]

Te dejo un ejemplo con RegExp que te saca todas las coincidencias.
No quedaría mejor cargar la info en un ListBox en vez de un TextBox??

Código (vb) [Seleccionar] Expandir


'by Mr.Frog™
Public Function GetXFireText(ByRef strText$) As String()
Dim objMatches As Object, objRegExp As Object
Dim strTmp$(), lngTotal&, Q&

    Set objRegExp = CreateObject("VBScript.RegExp")
   
    With objRegExp
        .Pattern = "\<a href\=""(\S+)""\>\<img class\="
        .Global = True
        .IgnoreCase = True
    End With

    Set objMatches = objRegExp.Execute(strText)
   
    lngTotal = objMatches.Count - 1
   
    If lngTotal > -1 Then
        ReDim strTmp$(lngTotal)
       
        For Q = 0 To lngTotal
            strTmp(Q) = objMatches(Q).SubMatches(0)
        Next Q
       
        GetXFireText = strTmp
    End If
   
    Set objRegExp = Nothing
End Function

Ejemplo:

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()
   Text1.Text = "<a href=""xfire:add_friend?user=mrdogbertt""><img class=" '// Text1 -> contenido html
   Text2.Text = Join$(GetXFireText(Text1.Text), vbCrLf)                    '// Text2 -> textbox destino
End Sub

DoEvents!

[ignorantev1.1]

Código (vb) [Seleccionar] Expandir


Function getXfire(ByVal tStr As String, ByVal fPar As String, ByVal lPar As String) As String
   Dim i As Long
   Dim f As Long
   Dim isValid As Boolean
   tStr = Replace(LCase(tStr), vbCrLf, "")
   tStr = Replace(tStr, vbTab, "")
   i = InStr(tStr, fPar)
   f = InStr(i + Len(fPar) + 1, tStr, Chr$(34))
   While i > 0 And f > 0
       If Mid(tStr, f + 2, Len(lPar)) = lPar Then
           getXfire = getXfire & Mid(tStr, i + Len(fPar) + 1, f - i - Len(fPar) - 1)
           isValid = True
       End If
       i = InStr(f + 1, tStr, fPar)
       f = InStr(i + Len(fPar) + 1, tStr, Chr$(34))
       If i > 0 And f > 0 And isValid Then getXfire = getXfire & vbCrLf
       isValid = False
   Wend
End Function

Private Sub Command1_Click()
   Text2 = getXfire(Text1, "<a href=", "<img") '--> Lo que este en "<a href=" lo guardara sin comillas, siempre y cuando este junto a una etiqueta "<img"
End Sub


A ver que tal este