elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Rompecabezas de Bitcoin, Medio millón USD en premios


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] 2 3 Ir Abajo Respuesta Imprimir
Autor Tema: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]  (Leído 6,713 veces)
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
[SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« en: 31 Mayo 2010, 21:58 pm »

ATENCION: SRC CORREGIDO

Hola, aqui os dejo esta funcin que acabo de hacer, no es gran cosa, pero bueno...  :P

Código
  1. ' ////////////////////////////////////////////////////////////////
  2. ' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
  3. ' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
  4. ' // respete la autoria y se me comuniquen esos cambios.        //
  5. ' // *Agradecimientos a BlackZeroX & Cobein                     //
  6. ' // *Visita http://foro.rthacker.net                           //
  7. ' ////////////////////////////////////////////////////////////////
  8. Option Explicit
  9. Public Function Text_Between_Words(ByVal sTextToAnalyze As String, ByVal sStartWord As String, ByVal sEndWord As String) As String
  10.    Dim iPosition1             As Integer
  11.    Dim iPosition2             As Integer
  12.    Dim iStart                 As Integer
  13.  
  14.    iPosition1 = InStr(sTextToAnalyze, sStartWord)
  15.    If iPosition1 <> 0 Then
  16.        iStart = iPosition1 + Len(sStartWord)
  17.        iPosition2 = InStr(iStart, sTextToAnalyze, sEndWord)
  18.    Else
  19.        Exit Function
  20.    End If
  21.    If iPosition2 <> 0 Then
  22.        Text_Between_Words = Mid$(sTextToAnalyze, iStart, iPosition2 - iStart)
  23.    End If
  24. End Function
Un ejemplo seria asi:
Código:
El contexto es el ámbito de referencia de un texto. ¿Qué entiendo por ámbito de referencia?.

Código
  1.    Debug.Print Text_Between_Words(Text1.Text, "referencia", "entiendo")

El resultado seria:
Citar
de un texto. ¿Qué

Y si pongo esto:

Código
  1.    Debug.Print Text_Between_Words(Text1.Text, "referencia", "referencia")

Me sale esto:
Citar
de un texto. ¿Qué entiendo por ámbito de

Espero que os haya gustado(mas aun  :xD)... ;)

Salu2!


« Última modificación: 6 Julio 2010, 19:40 pm por *PsYkE1* » En línea

ssccaann43 ©


Desconectado Desconectado

Mensajes: 792


¬¬


Ver Perfil
Re: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« Respuesta #1 en: 31 Mayo 2010, 22:15 pm »

Muy bueno *PsYkE1*, me gustó...! ;D


En línea

- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"
Elemental Code


Desconectado Desconectado

Mensajes: 622


Im beyond the system


Ver Perfil
Re: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« Respuesta #2 en: 31 Mayo 2010, 22:19 pm »

me costo entender como andaba asi que voy a explicarlo otra vez.  :xD

Si en la caja de texto escribo

Código:
No entendi el codigo y por eso hago esto

y llamo a la funcion como

Código
  1. MsgBox Text_Between_Words(Text1.Text, "Codigo", "Esto")

me responde:

Código:
 y por eso hago 

Esta bueno pero si lo hiciste vos porque esta en ingles el mensaje de error :S...

Ademas. Para que sirve??

Muy bueno para aprender como usar el instr que no sabia que existia y para practicar pero no entendi del todo para que sirve  ;D ;D

Toda la onda :D
En línea

I CODE FOR $$$
Programo por $$$
Hago tareas, trabajos para la facultad, lo que sea en VB6.0

Mis programas
ssccaann43 ©


Desconectado Desconectado

Mensajes: 792


¬¬


Ver Perfil
Re: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« Respuesta #3 en: 31 Mayo 2010, 22:21 pm »

 :-\ Me intrigo eso de que el mensaje esta en ingles...!

*PsYkE1*, no lo tomes a mal, pero detesto a los Copy&Paste...! Espero que esa funcion sea 100% tuya... Sino, tomate este momento para colocar su autor...!  :¬¬
En línea

- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"
ssccaann43 ©


Desconectado Desconectado

Mensajes: 792


¬¬


Ver Perfil
Re: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« Respuesta #4 en: 31 Mayo 2010, 22:23 pm »

me costo entender como andaba asi que voy a explicarlo otra vez.  :xD

Si en la caja de texto escribo

Código:
No entendi el codigo y por eso hago esto

y llamo a la funcion como

Código
  1. MsgBox Text_Between_Words(Text1.Text, "Codigo", "Esto")

me responde:

Código:
 y por eso hago 

Esta bueno pero si lo hiciste vos porque esta en ingles el mensaje de error :S...

Ademas. Para que sirve??

Muy bueno para aprender como usar el instr que no sabia que existia y para practicar pero no entendi del todo para que sirve  ;D ;D

Toda la onda :D

Por cierto asi es como funciona Elemental, te muestra el texto que contiene una frase entre 2 palabras...!
En línea

- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« Respuesta #5 en: 31 Mayo 2010, 22:25 pm »

Muy bueno *PsYkE1*, me gustó...! ;D
:o
Gracias ssccaann43! ;)

me costo entender como andaba asi que voy a explicarlo otra vez.  :xD

Si en la caja de texto escribo

Código:
No entendi el codigo y por eso hago esto

y llamo a la funcion como

Código
  1. MsgBox Text_Between_Words(Text1.Text, "Codigo", "Esto")

me responde:

Código:
 y por eso hago 

Si, exacto, pero no te olvides de si la palabra lleva minusculas o MAYUSCULAS...

Código
  1. MsgBox Text_Between_Words(Text1.Text, "codigo", "esto")
Esta bueno pero si lo hiciste vos porque esta en ingles el mensaje de error :S...
Jajaja :laugh:
Pense que quedaria más internacional... :laugh:

Ademas. Para que sirve??
He posteado porque lo necesitaba para un proyecto que estoy haciendo, y pense que podia ser interesante... :silbar:

Salu2! ;)
« Última modificación: 1 Junio 2010, 02:51 am por *PsYkE1* » En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« Respuesta #6 en: 31 Mayo 2010, 22:28 pm »

:-\ Me intrigo eso de que el mensaje esta en ingles...!

*PsYkE1*, no lo tomes a mal, pero detesto a los Copy&Paste...! Espero que esa funcion sea 100% tuya... Sino, tomate este momento para colocar su autor...!  :¬¬
Te puedo asegurar que no es C&P ssccaann43... :)
El mensaje lo puse en ingles con el Google traductor... :silbar:
Me desagrada que pienses eso... :-(
Prefiero subir una m**** de code (como ya he hecho en ocasiones) a hacer un C&P...

Salu2!
En línea

ssccaann43 ©


Desconectado Desconectado

Mensajes: 792


¬¬


Ver Perfil
Re: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« Respuesta #7 en: 31 Mayo 2010, 22:38 pm »

Bueno, te pedi que no te molestaras ni lo tomes a mal...!

Excelente entonces...! ;D Un saludo...!
En línea

- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« Respuesta #8 en: 31 Mayo 2010, 23:42 pm »

.
Dejen de decir C&P y opinen ("Eso diria si fuese el autor del hilo...")

Código
  1.  
  2. Dim pos1 as integer
  3.  
  4.  

Es pos1 o pos?

para que no te sucedan estas cosas feas usa al inicio

Código
  1.  
  2. option explicit
  3.  
  4.  

 * Lo peor que puedes hacer en una funcion es meterle un msgbox inputbox o X cosa SON ESTORBOS CREEME NO SON DINAMICOS.

Por otra parte...

Aqui esta mi funcion Entre Texto es "Anti-Error".

Código
  1.  
  2. '
  3. ' ////////////////////////////////////////////////////////////////
  4. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
  5. ' //                                                            //
  6. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  7. ' //                                                            //
  8. ' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
  9. ' // no se eliminen los creditos originales de este codigo      //
  10. ' // No importando que sea modificado/editado o engrandesido    //
  11. ' // o achicado, si es en base a este codigo                    //
  12. ' ////////////////////////////////////////////////////////////////
  13. Option Explicit
  14. Public Function Entre_Texto(ByRef StrIn As String, ByVal StrIni As String, ByVal StrFin As String, Optional ComparacionEstricta As Boolean) As String
  15. Dim Pos(1) As Long
  16. Dim IniPos As Long
  17. Dim OptionalCompare As VbCompareMethod
  18.  
  19.    If Len(StrIn) > 0 Then
  20.        If ComparacionEstricta Then
  21.            OptionalCompare = vbBinaryCompare
  22.        Else
  23.            OptionalCompare = vbTextCompare
  24.        End If
  25.        Pos(0) = InStr(1, StrIn, StrIni, OptionalCompare)
  26.        Pos(1) = InStr(1, StrIn, StrFin, OptionalCompare)
  27.        If CBool(Pos(0)) And CBool(Pos(1)) And Pos(0) < Pos(1) Then
  28.            IniPos = Pos(0) + Len(StrIni)
  29.            Entre_Texto = Mid$(StrIn, IniPos, Pos(1) - IniPos)
  30.        End If
  31.    End If
  32. End Function
  33.  
  34.  

Aqui dejo tres funciones que hacen esactamente lo mismo (Ojo esta igual viene incluida pero corregida por un servidor, incluyo la que yo cree y use desde hace mucho).

Código
  1.  
  2. Option Explicit
  3.  
  4. Private Function TextoEntreMedio(Texto As String, Palabra1 As String, Palabra2 As String)
  5.    TextoEntreMedio = Left$(Mid$(Texto, InStr(Texto, Palabra1) + Len(Palabra1)), InStr(Mid$(Texto, InStr(Texto, Palabra1) + Len(Palabra1)), Palabra2) - 1)
  6. End Function
  7.  
  8. Public Function Text_Between_Words(Text As String, String1 As String, String2 As String) As String
  9.    Dim Pos1              As Integer
  10.    Dim Pos2              As Integer
  11.    Dim Start             As Integer
  12.    Dim TotalLen          As Integer
  13.    Pos1 = InStr(Text, String1)
  14.    Pos2 = InStr(Text, String2)
  15.    If Pos1 = 0 Or Pos2 = 0 Then GoTo NoExists
  16.    Start = Pos1 + Len(String1)
  17.    TotalLen = Pos2 - Start
  18.    Text_Between_Words = Mid(Text, Start, TotalLen)
  19.    Exit Function
  20. NoExists:
  21.    MsgBox "Error, check that the two words are in the text, if so," & vbCrLf _
  22.    & " make sure you are entered correctly.", vbCritical
  23. End Function
  24.  
  25. '
  26. ' ////////////////////////////////////////////////////////////////
  27. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
  28. ' //                                                            //
  29. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  30. ' //                                                            //
  31. ' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
  32. ' // no se eliminen los creditos originales de este codigo      //
  33. ' // No importando que sea modificado/editado o engrandesido    //
  34. ' // o achicado, si es en base a este codigo                    //
  35. ' ////////////////////////////////////////////////////////////////
  36. Public Function Entre_Texto(ByRef StrIn As String, ByVal StrIni As String, ByVal StrFin As String, Optional ComparacionEstricta As Boolean) As String
  37. Dim Pos(1) As Long
  38. Dim IniPos As Long
  39. Dim OptionalCompare As VbCompareMethod
  40.  
  41.    If Len(StrIn) > 0 Then
  42.        If ComparacionEstricta Then
  43.            OptionalCompare = vbBinaryCompare
  44.        Else
  45.            OptionalCompare = vbTextCompare
  46.        End If
  47.        Pos(0) = InStr(1, StrIn, StrIni, OptionalCompare)
  48.        Pos(1) = InStr(1, StrIn, StrFin, OptionalCompare)
  49.        If CBool(Pos(0)) And CBool(Pos(1)) And Pos(0) < Pos(1) Then
  50.            IniPos = Pos(0) + Len(StrIni)
  51.            Entre_Texto = Mid$(StrIn, IniPos, Pos(1) - IniPos)
  52.        End If
  53.    End If
  54. End Function
  55.  
  56. Private Sub Form_Load()
  57. Const StrOri As String = "Miguel Angel Ortega Avila"
  58. Const StrIni As String = "an"
  59. Const StrFin As String = "vila"
  60.  
  61.    MsgBox Text_Between_Words(StrOri, StrIni, StrFin)
  62.    MsgBox TextoEntreMedio(StrOri, StrIni, StrFin)
  63.  
  64.    MsgBox Entre_Texto(StrOri, StrIni, StrFin, True)
  65.    MsgBox Entre_Texto(StrOri, StrIni, StrFin, False)
  66. End Sub
  67.  
  68.  

Dulce Infierno Lunar!¡.
En línea

The Dark Shadow is my passion.
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [SRC] + [Función] Text_Between_Words [by *PsYkE1*]
« Respuesta #9 en: 31 Mayo 2010, 23:46 pm »


se me olvido el formato REAL de InStr() es

Código:

Function InStr([Start], [String1], [String2], [Compare As VbCompareMethod = vbBinaryCompare])
    Miembro de VBA.Strings
    Devuelve la posición de la primera instancia de una cadena dentro de otra

Function InStrB([Start], [String1], [String2], [Compare As VbCompareMethod = vbBinaryCompare])
    Miembro de VBA.Strings
    Devuelve la posición del byte de la primera instancia de una cadena dentro de otra

Function InStrRev(StringCheck As String, StringMatch As String, [Start As Long = -1], [Compare As VbCompareMethod = vbBinaryCompare]) As Long
    Miembro de VBA.Strings
    Returns the position of the last occurrence of one string within another


Para quien no sepa que funciones existen en vb6 abran el IDE creen o abaran un nuevo proyecto y opriman la fecla [/b]F2

Tamabien se pueden acceder desde el Intelicense escribiendo

VBA.

como si fuese

Me.

Text1.

ETC...



Dulce Infierno Lunar!¡.
« Última modificación: 31 Mayo 2010, 23:48 pm por BlackZeroX▓▓▒▒░░ » En línea

The Dark Shadow is my passion.
Páginas: [1] 2 3 Ir Arriba Respuesta Imprimir 

Ir a:  
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines