Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: <[(x)]> en 2 Febrero 2009, 00:42 am


Título: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: <[(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
  1.  
  2. Public Sub ExtractText(ByVal strData As String, ByRef strArrayOut() As String)
  3.  
  4.  Dim strText() As String: ReDim strText(0) As String
  5.  Dim strBuf As String
  6.  Dim bol As Boolean: bol = False
  7.  
  8.  strBuf = strData
  9.  
  10.  Do While Not bol
  11.  
  12.  If InStr(LCase(strBuf), "<font") > 0 Then
  13.  
  14.   strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font"))
  15.  
  16.   If InStr(LCase(strBuf), ">") > 0 Then
  17.  
  18.    Dim inta As Integer: inta = InStr(LCase(strBuf), ">")
  19.  
  20.    If InStr(LCase(strBuf), "</font") > 0 Then
  21.  
  22.     Dim intb As Integer
  23.  
  24.     intb = InStr(LCase(strBuf), "</font") - inta
  25.     PlusArray strText, Mid(strBuf, inta + 1, intb - 1)
  26.  
  27.     strBuf = Mid(strBuf, inta)
  28.  
  29.    Else
  30.  
  31.     bol = True
  32.  
  33.    End If
  34.  
  35.   Else
  36.  
  37.    bol = True
  38.  
  39.   End If
  40.  
  41.  Else
  42.  
  43.   bol = True
  44.  
  45.  End If
  46.  
  47.  Loop
  48.  
  49.  ReDim strArrayOut(UBound(strText)) As String
  50.  
  51.  strArrayOut = strText
  52.  
  53. End Sub
  54.  
  55. Public Sub PlusArray(ByRef strArray() As String, ByVal strPlus As String)
  56.  
  57.  Dim lngP As Long
  58.  
  59.  lngP = UBound(strArray) + 1
  60.  
  61.  ReDim Preserve strArray(lngP)
  62.  
  63.  strArray(lngP) = strPlus
  64.  
  65. End Sub
  66.  
  67.  



Y para probarlo en un form:
Código
  1.  
  2. Private Sub Form_Load()
  3.  
  4.  Dim x As Integer
  5.  Dim strText As String
  6.  Dim strArrayText() As String
  7.  
  8.  strText = "<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font>  <font > un pedo </font>"
  9.  
  10.  ExtractText strText, strArrayText
  11.  
  12.  Me.Print "Prueba:"
  13.  Me.Print ""
  14.  Me.Print ""
  15.  
  16.  For x = 0 To UBound(strArrayText)
  17.  
  18.   Me.Print "    " & strarraytext(x)
  19.  
  20.  Next
  21.  
  22. End Sub
  23.  
  24.  

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

54¬U|)()5


Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: seba123neo en 2 Febrero 2009, 01:02 am
Hola, funciona bien, pero corregile la linea

Código
  1. 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.

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: <[(x)]> en 2 Febrero 2009, 02:01 am
holas

 Gracias por la corrección.

  y cual es la etiqueta que me decís?


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

oks gracias

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: seba123neo en 2 Febrero 2009, 02:12 am
cuando creas un post tenes al lado un combo que dice "Geshi" ahi elegis el lenguaje para el codigo...

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: el_c0c0 en 2 Febrero 2009, 03:25 am
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
  1.  
  2. Public Sub ExtractText(ByVal strData As String, ByRef strArrayOut() As String)
  3.  
  4.  Dim strText() As String: ReDim strText(0) As String
  5.  Dim strBuf As String
  6.  Dim bol As Boolean: bol = False
  7.  
  8.  strBuf = strData
  9.  
  10.  Do While Not bol
  11.  
  12.  If InStr(LCase(strBuf), "<font") > 0 Then
  13.  
  14.   strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font"))
  15.  
  16.   If InStr(LCase(strBuf), ">") > 0 Then
  17.  
  18.    Dim inta As Integer: inta = InStr(LCase(strBuf), ">")
  19.  
  20.    If InStr(LCase(strBuf), "</font") > 0 Then
  21.  
  22.     Dim intb As Integer
  23.  
  24.     intb = InStr(LCase(strBuf), "</font") - inta
  25.     PlusArray strText, Mid(strBuf, inta + 1, intb - 1)
  26.  
  27.     strBuf = Mid(strBuf, inta)
  28.  
  29.    Else
  30.  
  31.     bol = True
  32.  
  33.    End If
  34.  
  35.   Else
  36.  
  37.    bol = True
  38.  
  39.   End If
  40.  
  41.  Else
  42.  
  43.   bol = True
  44.  
  45.  End If
  46.  
  47.  Loop
  48.  
  49.  ReDim strArrayOut(UBound(strText)) As String
  50.  
  51.  strArrayOut = strText
  52.  
  53. End Sub
  54.  
  55. Public Sub PlusArray(ByRef strArray() As String, ByVal strPlus As String)
  56.  
  57.  Dim lngP As Long
  58.  
  59.  lngP = UBound(strArray) + 1
  60.  
  61.  ReDim Preserve strArray(lngP)
  62.  
  63.  strArray(lngP) = strPlus
  64.  
  65. End Sub
  66.  
  67.  



Y para probarlo en un form:
Código
  1.  
  2. Private Sub Form_Load()
  3.  
  4.  Dim x As Integer
  5.  Dim strText As String
  6.  Dim strArrayText() As String
  7.  
  8.  strText = "<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font>  <font > un pedo </font>"
  9.  
  10.  ExtractText strText, strArrayText
  11.  
  12.  Me.Print "Prueba:"
  13.  Me.Print ""
  14.  Me.Print ""
  15.  
  16.  For x = 0 To UBound(strArrayText)
  17.  
  18.   Me.Print "    " & strarraytext(x)
  19.  
  20.  Next
  21.  
  22. End Sub
  23.  
  24.  

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
  1. Public Function TextInBetwinE(ByVal sData As String, ByVal sStart As String, ByVal sEnd As String) As String
  2.     If InStr(sData, sStart) > 0 Then
  3.         sData = Mid(sData, InStr(sData, sStart) + Len(sStart))
  4.         TextInBetwinE = Mid(sData, 1, InStr(sData, sEnd) - 1)
  5.     End If
  6. 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
  1. 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

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: <[(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.

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: el_c0c0 en 3 Febrero 2009, 03:22 am
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
  1. TextInBetwinE(".... ", "<font ", "</font>")
y te quedaria
Citar
color="#DD6600">blablabla

saludos

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: <[(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.


Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: xkiz ™ en 3 Febrero 2009, 05:24 am
<[(X)]> mira este link, creo que ese ejemplo te puede servir para lo que queres hacer...

SimpleXMLParserSimpleXMLParser ( PSC )  (http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=64975&lngWId=1)

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: el_c0c0 en 3 Febrero 2009, 05:42 am
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
  1. Dim strRet As String
  2. strRet = TextInBetwinE("<font color=""#DD6600"">blablabla</font>", "<font ", "</font>")
  3.  
  4. If Left(strRet, 1) = ">" Then
  5.  strRet = Right(strRet, Len(strRet) -1)
  6. Else
  7.  strRet = Right(strRet, Len(strRet) - InStr(strRet, ">"))
  8. End If
  9.  
  10.  

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

saludos

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: <[(x)]> en 3 Febrero 2009, 05:58 am
holas

coco:
jej no es por nada pero el code que pusistes no se parece al que puse yo?


Código
  1.  ....
  2.  
  3.   If InStr(LCase(strBuf), "<font") > 0 Then
  4.  
  5.   strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font"))
  6.  
  7.   If InStr(LCase(strBuf), ">") > 0 Then
  8.  
  9.    Dim inta As Integer: inta = InStr(LCase(strBuf), ">")
  10.  
  11.    If InStr(LCase(strBuf), "</font") > 0 Then
  12.  
  13.     Dim intb As Integer
  14.  
  15.     intb = InStr(LCase(strBuf), "</font") - inta
  16.     PlusArray strText, Mid(strBuf, inta + 1, intb - 1)
  17.  
  18.       ...
  19.  

y lo qpusistes:
Código
  1. Public Function TextInBetwinE(ByVal sData As String, ByVal sStart As String, ByVal sEnd As String) As String
  2.     If InStr(sData, sStart) > 0 Then
  3.         sData = Mid(sData, InStr(sData, sStart) + Len(sStart))
  4.         TextInBetwinE = Mid(sData, 1, InStr(sData, sEnd) - 1)
  5.     End If
  6. End Function
  7.  

Código
  1. Dim strRet As String
  2. strRet = TextInBetwinE("<font color=""#DD6600"">blablabla</font>", "<font ", "</font>")
  3.  
  4. If Left(strRet, 1) = ">" Then
  5.  strRet = Right(strRet, Len(strRet) -1)
  6. Else
  7.  strRet = Right(strRet, Len(strRet) - InStr(strRet, ">"))
  8. End If
  9.  

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: el_c0c0 en 3 Febrero 2009, 06:07 am
Cita de: <[(x)]> en  3 Febrero 2009, 05:58 am
holas

coco:
jej no es por nada pero el code que pusistes no se parece al que puse yo?


Código
  1.  ....
  2.  
  3.   If InStr(LCase(strBuf), "<font") > 0 Then
  4.  
  5.   strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font"))
  6.  
  7.   If InStr(LCase(strBuf), ">") > 0 Then
  8.  
  9.    Dim inta As Integer: inta = InStr(LCase(strBuf), ">")
  10.  
  11.    If InStr(LCase(strBuf), "</font") > 0 Then
  12.  
  13.     Dim intb As Integer
  14.  
  15.     intb = InStr(LCase(strBuf), "</font") - inta
  16.     PlusArray strText, Mid(strBuf, inta + 1, intb - 1)
  17.  
  18.       ...
  19.  

y lo qpusistes:
Código
  1. Public Function TextInBetwinE(ByVal sData As String, ByVal sStart As String, ByVal sEnd As String) As String
  2.     If InStr(sData, sStart) > 0 Then
  3.         sData = Mid(sData, InStr(sData, sStart) + Len(sStart))
  4.         TextInBetwinE = Mid(sData, 1, InStr(sData, sEnd) - 1)
  5.     End If
  6. End Function
  7.  

Código
  1. Dim strRet As String
  2. strRet = TextInBetwinE("<font color=""#DD6600"">blablabla</font>", "<font ", "</font>")
  3.  
  4. If Left(strRet, 1) = ">" Then
  5.  strRet = Right(strRet, Len(strRet) -1)
  6. Else
  7.  strRet = Right(strRet, Len(strRet) - InStr(strRet, ">"))
  8. End If
  9.  

me puedo remitir a mi 1º comentario que decia que eran muchas lineas al dope. y nose si pensas que te copie, que este en todo tu derecho, pero yo se que no.


en fin, para estos casos, yo usaria el parser...

no solo porque busca cualquier tag, tipo fonto o div, lo q sea.. en si porque devuelve los parametros del tag, como en tu ejemplo el parametro "color" ademas del contenido del tag...

saludos

Título: Re: Extraer texto de la etiqueta <font></font> [SRC]
Publicado por: <[(x)]> en 3 Febrero 2009, 13:41 pm

oks

xkiz:

muy bueno el ej...




Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines