Extraer texto de la etiqueta <font></font> [SRC]

Iniciado por <[(x)]>, 2 Febrero 2009, 00:42 AM

0 Miembros y 2 Visitantes están viendo este tema.

<[(x)]>

holas aka les dejo este pequeño code. que lo empece haciendo para una pagina en otro idioma y se me ocurrió traducirlo. Lo que hace es extraer el texto que se encuentre entre '<font>' y '</font>.

En un modulo:
Código (vb) [Seleccionar]


Public Sub ExtractText(ByVal strData As String, ByRef strArrayOut() As String)

Dim strText() As String: ReDim strText(0) As String
Dim strBuf As String
Dim bol As Boolean: bol = False

strBuf = strData

Do While Not bol

If InStr(LCase(strBuf), "<font") > 0 Then
   
  strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font"))
   
  If InStr(LCase(strBuf), ">") > 0 Then
   
   Dim inta As Integer: inta = InStr(LCase(strBuf), ">")
   
   If InStr(LCase(strBuf), "</font") > 0 Then
   
    Dim intb As Integer
     
    intb = InStr(LCase(strBuf), "</font") - inta
    PlusArray strText, Mid(strBuf, inta + 1, intb - 1)
     
    strBuf = Mid(strBuf, inta)
   
   Else
   
    bol = True
   
   End If
   
  Else
   
   bol = True
   
  End If
   
Else
 
  bol = True
   
End If

Loop

ReDim strArrayOut(UBound(strText)) As String

strArrayOut = strText

End Sub

Public Sub PlusArray(ByRef strArray() As String, ByVal strPlus As String)

Dim lngP As Long

lngP = UBound(strArray) + 1

ReDim Preserve strArray(lngP)

strArray(lngP) = strPlus

End Sub





Y para probarlo en un form:
Código (vb) [Seleccionar]


Private Sub Form_Load()

Dim x As Integer
Dim strText As String
Dim strArrayText() As String

strText = "<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font>  <font > un pedo </font>"

ExtractText strText, strArrayText

Me.Print "Prueba:"
Me.Print ""
Me.Print ""

For x = 0 To UBound(strArrayText)
 
  Me.Print "    " & strarraytext(x)

Next

End Sub



Bue no se, se puede usar si quieres hacer una búsqueda en una web.

54¬U|)()5

<[(x)]>

seba123neo

Hola, funciona bien, pero corregile la linea

Código (vb) [Seleccionar]
Me.Print "    " & strArrayText(x)

te falto una "r"....

y usa la etiqueta de codigo de visual , asi queda mas lindo el codigo..creo que la funcion podria tener menos codigo, si puedo ahora lo veo...

saludos.
La característica extraordinaria de las leyes de la física es que se aplican en todos lados, sea que tú elijas o no creer en ellas. Lo bueno de las ciencias es que siempre tienen la verdad, quieras creerla o no.

Neil deGrasse Tyson

<[(x)]>

#2
holas

Gracias por la corrección.

  y cual es la etiqueta que me decís?


------------------------------------

oks gracias
<[(x)]>

seba123neo

cuando creas un post tenes al lado un combo que dice "Geshi" ahi elegis el lenguaje para el codigo...
La característica extraordinaria de las leyes de la física es que se aplican en todos lados, sea que tú elijas o no creer en ellas. Lo bueno de las ciencias es que siempre tienen la verdad, quieras creerla o no.

Neil deGrasse Tyson

el_c0c0

#4
Cita de: <[(x)]> en  2 Febrero 2009, 00:42 AM
holas aka les dejo este pequeño code. que lo empece haciendo para una pagina en otro idioma y se me ocurrió traducirlo. Lo que hace es extraer el texto que se encuentre entre '<font>' y '</font>.

En un modulo:
Código (vb) [Seleccionar]


Public Sub ExtractText(ByVal strData As String, ByRef strArrayOut() As String)

Dim strText() As String: ReDim strText(0) As String
Dim strBuf As String
Dim bol As Boolean: bol = False

strBuf = strData

Do While Not bol

If InStr(LCase(strBuf), "<font") > 0 Then
   
  strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font"))
   
  If InStr(LCase(strBuf), ">") > 0 Then
   
   Dim inta As Integer: inta = InStr(LCase(strBuf), ">")
   
   If InStr(LCase(strBuf), "</font") > 0 Then
   
    Dim intb As Integer
     
    intb = InStr(LCase(strBuf), "</font") - inta
    PlusArray strText, Mid(strBuf, inta + 1, intb - 1)
     
    strBuf = Mid(strBuf, inta)
   
   Else
   
    bol = True
   
   End If
   
  Else
   
   bol = True
   
  End If
   
Else
 
  bol = True
   
End If

Loop

ReDim strArrayOut(UBound(strText)) As String

strArrayOut = strText

End Sub

Public Sub PlusArray(ByRef strArray() As String, ByVal strPlus As String)

Dim lngP As Long

lngP = UBound(strArray) + 1

ReDim Preserve strArray(lngP)

strArray(lngP) = strPlus

End Sub





Y para probarlo en un form:
Código (vb) [Seleccionar]


Private Sub Form_Load()

Dim x As Integer
Dim strText As String
Dim strArrayText() As String

strText = "<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font>  <font > un pedo </font>"

ExtractText strText, strArrayText

Me.Print "Prueba:"
Me.Print ""
Me.Print ""

For x = 0 To UBound(strArrayText)
 
  Me.Print "    " & strarraytext(x)

Next

End Sub



Bue no se, se puede usar si quieres hacer una búsqueda en una web.

54¬U|)()5




estas haciendo cagadas, mira cuantas lineas al dope.

asi vas a hacer errores (creeria que no) y/o tardar mucho

usa la funcion TEXTINBETWINE (de cobein, pero le pegue una modificacion yo)

Código (vb) [Seleccionar]
Public Function TextInBetwinE(ByVal sData As String, ByVal sStart As String, ByVal sEnd As String) As String
    If InStr(sData, sStart) > 0 Then
        sData = Mid(sData, InStr(sData, sStart) + Len(sStart))
        TextInBetwinE = Mid(sData, 1, InStr(sData, sEnd) - 1)
    End If
End Function


tene cuidado, si no existe el tag de cerrado, va a tirar error
la funcion trabaja asi:
encuentra la primer coincidencia, y hace que llegue hasta la primer coincidencia final
llama a la funcion asi
Código (vb) [Seleccionar]
TextInBetwinE("<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font>  <font > un pedo </font>", "<font >", "</font>")
eso te devuelve el primer tag..
para sacar el segundo tag, hace un replace a la cadena original, sacando el tag actual y hace asi hasta q no haya mas tags

saludos
'-     coco
"Te voy a romper el orto"- Las hemorroides

<[(x)]>



Bien coco.


Pensaste que la etiqueta podría ser <font color="#DD6600">blablabla</font>.

me parece que tu método no funcionaria ahi.
<[(x)]>

el_c0c0

Cita de: <[(x)]> en  2 Febrero 2009, 13:41 PM


Bien coco.


Pensaste que la etiqueta podría ser <font color="#DD6600">blablabla</font>.

me parece que tu método no funcionaria ahi.

para eso necesitas un parser, a lo xml o algo asi!

para hacer que funcione con ese ejemplo, modifica y pone asi:
Código (vb) [Seleccionar]
TextInBetwinE(".... ", "<font ", "</font>")
y te quedaria
Citarcolor="#DD6600">blablabla

saludos
'-     coco
"Te voy a romper el orto"- Las hemorroides

<[(x)]>

jej..holas

  Explicitame lo de ''un parser, a lo xml o algo asi!''

  y si no se optiene el mismo resultado,.. no me cirbe.

<[(x)]>

xkiz ™

<[(X)]> mira este link, creo que ese ejemplo te puede servir para lo que queres hacer...

SimpleXMLParserSimpleXMLParser ( PSC )

el_c0c0

Cita de: <[(x)]> en  3 Febrero 2009, 05:13 AM
jej..holas

  Explicitame lo de ''un parser, a lo xml o algo asi!''

  y si no se optiene el mismo resultado,.. no me cirbe.



yo te digo, usa el parser.. usa el que te paso xkiz.
parser es una herramienta que entiende un texto o lo que sea, segun lo que uno quiera sacar...
en este caso un parser xml. xml porque es mas o mismo que html, pero bueno.

si vos queres q te devuelva lo mismo, imaginatelas. No es dificil!!!!!
Código (vb) [Seleccionar]

Dim strRet As String
strRet = TextInBetwinE("<font color=""#DD6600"">blablabla</font>", "<font ", "</font>")

If Left(strRet, 1) = ">" Then
strRet = Right(strRet, Len(strRet) -1)
Else
strRet = Right(strRet, Len(strRet) - InStr(strRet, ">"))
End If



asi lo sacas. pero la proxima fijate vos eso.. que no es nada dificil

saludos
'-     coco
"Te voy a romper el orto"- Las hemorroides