Mensajes

[lngStart]

Bueno, aquí os dejo esta sencilla función.
Su finalidad es devolver el Index de un Item que se encuentre en un array (acepta todo tipo de Arrays : String, Double, Long...), con la opción de devolver el primero que se encuentre en el array y con los parámetros lngStart y lngEnd podemos establecer límites en nuestra búsqueda.  
Para ordenarlo aconsejo usar esta maravillosa función que hizo mi amigo BlackZer0x :
http://goo.gl/RG4Bx

Código (vb) [Seleccionar] Expandir

Option Explicit
'======================================================================
' º Function  : IsInArray
' º Author    : Psyke1
' º Country   : Spain
' º Mail      : vbpsyke1@mixmail.com
' º Date      : 09/05/2011
' º Twitter   : http://twitter.com/#!/PsYkE1
' º Dedicated : BlackZer0x
' º Reference : http://goo.gl/RDQhK
' º Recommended Websites :
'       http://foro.h-sec.org
'       http://www.frogcheat.com.ar
'       http://InfrAngeluX.Sytes.Net
'======================================================================
Public Static Function IsInArray&(varArr, _
                                 varValue, _
                                 Optional lngStart&, _
                                 Optional lngEnd&, _
                                 Optional bolFindFirst As Boolean, _
                                 Optional bolIsSorted As Boolean)
Dim lngLB&, lngUB&, Q&, C&
   If (IsArray(varArr) = True) And (IsArray(varValue) = False) Then
       lngLB = LBound(varArr)
       lngUB = UBound(varArr)

       If Not IsMissing(lngStart) Then
          If (lngStart > lngLB) And (lngStart < lngUB) Then lngLB = lngStart
       End If
       If Not IsMissing(lngEnd) Then
          If (lngEnd > lngLB) And (lngEnd < lngUB) Then lngUB = lngEnd
       End If

       If bolIsSorted Then
           If varArr(lngLB) = varValue Then
               IsInArray = lngLB
               Exit Function
           ElseIf varArr(lngUB) = varValue Then
               If bolFindFirst Then
                   Do While (varArr(lngUB) = varArr(lngUB - 1)) And (Q > lngLB)
                       lngUB = lngUB - 1
                   Loop
               End If
               
               IsInArray = lngUB
               Exit Function
           End If

           If lngUB - lngLB < 2 Then GoTo NotFound
           If (varArr(lngLB) > varValue) Or (varArr(lngUB) < varValue) Then GoTo NotFound

           C = 0
           Do
               Q = (lngUB + lngLB) \ 2
               If C = Q Then GoTo NotFound
               
               If varArr(Q) > varValue Then
                   lngUB = Q
               ElseIf varArr(Q) < varValue Then
                   lngLB = Q
                   C = lngLB
               Else
                   If bolFindFirst Then
                       Do While (varArr(Q) = varArr(Q - 1)) And (Q > lngLB)
                           Q = Q - 1
                       Loop
                   End If
                   
                   IsInArray = Q
                   Exit Function
               End If
           Loop
       Else
           For Q = lngLB To lngUB
               If varArr(Q) = varValue Then
                   IsInArray = Q
                   Exit Function
               End If
           Next Q
           
           GoTo NotFound
       End If
   End If
Exit Function

NotFound:
   IsInArray = -1
End Function

Un ejemplo:

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Const strLine$ = "------------------------------"

Private Sub Form_Load()
Dim L&(60), S(), Q&

   For Q = 0 To 60
       L(Q) = Q * 2
   Next Q

   Debug.Print strLine$, Time$, strLine$
   Debug.Print IsInArray(L, 15)                '---> -1
   Debug.Print IsInArray(L, 40)                '--->  20
   Debug.Print IsInArray(L, 85)                '---> -1
   Debug.Print IsInArray(L, 100)               '--->  50

   S = Array("abba", "acero", "karcrack", "sereno", "silencio", "tonto", "tonto", "tonto", "tonto", "zalme")

   Debug.Print strLine$
   Debug.Print IsInArray(S, "zalme")           '--->  9
   Debug.Print IsInArray(S, "zalme", , 4)      '---> -1
   Debug.Print IsInArray(S, "mesa")            '---> -1
   Debug.Print IsInArray(S, "besos")           '---> -1
   Debug.Print IsInArray(S, "karcrack")        '--->  2
   Debug.Print IsInArray(S, "karcrack", 3)     '---> -1
   Debug.Print IsInArray(S, "tonto")           '--->  6
   Debug.Print IsInArray(S, "tonto", , , True) '--->  5
End Sub

Retorna:

Código [Seleccionar] Expandir

------------------------------            18:59:54      ------------------------------
-1
20
-1
50
------------------------------
9
-1
-1
-1
2
-1
6
5



Si necesitamos especial velocidad y lo queremos para un tipo de variable en concreto, sólo hay que modificar un par de cosas.
Aquí un ejemplo para buscar en un array Long, comparado con el código de BlackZer0x ( http://goo.gl/RDQhK ) :

Código [Seleccionar] Expandir

Option Explicit
'// Compilado sin la comprobación de límites en los arrays xP

Private Sub Form_Load()
Dim L&(6000), Q&, t As New CTiming, y&
   
   If App.LogMode = 0 Then End
   
   For Q = 0 To 6000
       L(Q) = Q * 2
   Next Q
   
   Me.AutoRedraw = True
   
   t.Reset
   For Q = 1 To 1000
       IsInArray L, 15
       IsInArray L, 40
       IsInArray L, 2001
       IsInArray L, 5020
       IsInArray L, 12000
   Next Q
   Me.Print "IsInArray", , t.sElapsed
   
   t.Reset
   For Q = 1 To 1000
       ExitsInArrayNR 15, L, y
       ExitsInArrayNR 40, L, y
       ExitsInArrayNR 2001, L, y
       ExitsInArrayNR 5020, L, y
       ExitsInArrayNR 12000, L, y
   Next Q
   Me.Print "ExitsInArrayNR", t.sElapsed
End Sub

'// by Psyke1
Public Static Function IsInArray&(lngArr&(), lngValue&, Optional lngStart&, Optional lngEnd&, Optional bolFindFirst As Boolean)
Dim lngLB&, lngUB&, lngItem&, Q&, C&
   lngLB = LBound(lngArr)
   lngUB = UBound(lngArr)
   
   If Not IsMissing(lngStart) Then
      If (lngStart > lngLB) And (lngStart < lngUB) Then lngLB = lngStart
   End If
   If Not IsMissing(lngEnd) Then
      If (lngEnd > lngLB) And (lngEnd < lngUB) Then lngUB = lngEnd
   End If
   
   If lngArr(lngLB) = lngValue Then
       IsInArray = lngLB
       Exit Function
   ElseIf lngArr(lngUB) = lngValue Then
       If bolFindFirst Then
           Do While (lngArr(lngUB) = lngArr(lngUB - 1)) And (Q > lngLB)
               lngUB = lngUB - 1
           Loop
       End If
       IsInArray = lngUB
       Exit Function
   End If
   
   If lngUB - lngLB < 2 Then GoTo NotFound
   If (lngArr(lngLB) > lngValue) Or (lngArr(lngUB) < lngValue) Then GoTo NotFound
   
   C = 0
   Do
       Q = (lngUB + lngLB) \ 2
       If C = Q Then GoTo NotFound

       If lngArr(Q) > lngValue Then
           lngUB = Q
       ElseIf lngArr(Q) < lngValue Then
           lngLB = Q
           C = lngLB
       Else
           If bolFindFirst Then
               Do While (lngArr(Q) = lngArr(Q - 1)) And (Q > lngLB)
                   Q = Q - 1
               Loop
           End If
           IsInArray = Q
           Exit Function
       End If
   Loop
Exit Function

NotFound:
   IsInArray = -1
End Function

'// by BlackZer0x
Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       Dim t                           As Long
       t = lng_Ub
       lng_Ub = lng_lb
       lng_lb = t
   End If
   Do Until ExitsInArrayNR
       Select Case vValue
           Case vBuff&(lng_lb&)
               p& = lng_lb&
               ExitsInArrayNR = True
           Case vBuff&(lng_Ub&)
               p& = lng_Ub&
               ExitsInArrayNR = True
           Case Else
               p = (lng_lb& + lng_Ub&) / 2
               If p <> lng_lb& And p& <> lng_Ub& Then
                   If vBuff&(p&) < vValue& Then
                       lng_lb = p
                   ElseIf vBuff&(p&) > vValue& Then
                       lng_Ub = p
                   ElseIf vBuff&(p&) = vValue& Then
                       ExitsInArrayNR = True
                   End If
               Else
                   Exit Do
               End If
       End Select
   Loop
End Function

Resultado:


DoEvents!

[@Black]

.
Numeros a letras:  < Click Aquí >

Dulces Lunas!¡.

Creo que pusiste mal el link...

[OffTopic]
@Black debes revisar tu blog, de repente se volvió loco y me empezó a cargar todo el rato la misma entrada del blog.
[/OffTopic]

DoEvents!

[Novlucker]

Gracias Novlucker, resulto

[RegExp]

Hola buenas, vengo aquí con un problemilla muy sencillo que tengo con RegExp.
Necesito validar nombres de usuario que sólo pueden contener : números, letras y "_" ; tener un mínimo de un carácter y un máximo de 15.
Para ello, pensé esto:

Código [Seleccionar] Expandir

[\w_]{1,15}
El problema es que si tengo esto:

Código [Seleccionar] Expandir

=Usu@rio^
La validación me da positiva, pues, encuentra caracteres alfanuméricos...
Sólo quiero que me admita (\w y "_") nada más.
¿Me echáis una mano?
Gracias

DoEvents!

Oops! gracias, se me escapó...
corregido

...
P.D.: hay ya que tocar de nuevo la wiki no crees xP.

Temibles Lunas!¡.

Si hermano, estuve bastante ocupado estos últimos meses por estudios, pero a partir de Junio podré meterme con ello de nuevo

DoEvents!

[StrConv()]

...
Por cierto que es StronV?

GRACIAS POR LEER!!!

Me da que raulito se refiere es a la función StrConv()...

Dejo un ejemplo (aunque repito que mi manera favorita es la de BlackZer0x ) :

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Static Function String2Array(ByRef strText$, ByRef strOutPut$()) As Boolean
Dim bytStr() As Byte
Dim Q&, lngLen&

   lngLen = (LenB(strText) \ 2) - 1
   
   If lngLen And &H80000000 Then Exit Function
   
   '// Aquí el famoso "StronV"... xP
   bytStr = Strings.StrConv(strText, vbFromUnicode)
   ReDim strOutPut$(0 To lngLen)
   
   For Q = 0 To lngLen
       strOutPut(Q) = Strings.ChrW$(bytStr(Q))
   Next Q
   
   String2Array = True
End Function

Private Sub Form_Load()
Dim varItem
Dim strO$()
   
   If String2Array("Psyke1", strO) Then
       For Each varItem In strO
           Debug.Print varItem
       Next varItem
   End If
End Sub

Retorna:

Código [Seleccionar] Expandir

P
s
y
k
e
1

DoEvents!

[seba123neo]

Auch! Lo siento, pero me duele la vista con estos códigos.
Hacer caso a seba123neo y hacerlo con hooks, eso es una chapuzada...

DoEvents!

[BlackZer0x]

No se si sea lo mas rapido. Pero lo mas simple y rapido (midiendo instrucciones) es usar stronv y poniendolo a un array de bytes y de ahi se recorre facilmente

Más lento que la forma de BlackZer0x, pero más simple.

La tuya usa nagia negra, la mia magia blanca

Jajajajajaja
¡Exacto!

DoEvents!

.
No les recomiedno usar Not para ver si esta inicializada la variable , en codigos largos y complejos causa errores muy desagradables es por eso que le di el codigo de CopyMemory.

Dulces Lunas!¡.

¿Compilado también?

DoEvents!

[NotNot]

También con el truco del NotNot podemos comprobar si está iniciado el array:

Código (vb) [Seleccionar] Expandir

If Not Not iArray Then
   '// Haz algo...
End If

Es la forma más rápida, en el IDE puede dar problemas pero compilado funciona 100%.
Para prevenir el bug en el IDE haz:

Código (vb) [Seleccionar] Expandir


Private Form_Load()
Dim IDEbug&()
   '// Prevenir el NotNot bug.
   Debug.Assert Not IDEbug Or App.hInstance
End Sub

Código [Seleccionar] Expandir

Advertencia - mientras estabas escribiendo, una nueva respuesta fue publicada. Probablemente desees revisar tu mensaje.


DoEvents!