Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: 79137913 en 10 Agosto 2011, 16:37 pm


Título: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: 79137913 en 10 Agosto 2011, 16:37 pm
HOLA!!!

Viendo como ha decaido la actividad y nivel en el foro, me propongo aunque sea a que las nuevas mentes que hay aqui hagan un pequeño reto que les propongo...

El Reto es hacer una funcion que remplace efectivamente a la funcion IsNumeric que viene de fabrica en vb...

Deberan usar para nombrar la funcion un metodo como este:
Código
  1. Private Function IsNumeric_SuNickReducido(str As String) As Boolean
  2. 'Ejemplos:
  3. 'Raul338:
  4. Private Function IsNumeric_r338(str As String) As Boolean
  5. '79137913:
  6. Private Function IsNumeric_7913(str As String) As Boolean

Ejemplos de lo que devuelve la funcion original:
Código:
IsNumeric("asdf") ->False
IsNumeric("a12f") ->False
IsNumeric("12,12") ->True
IsNumeric("12.12") ->True
IsNumeric("12,23,34") ->False
IsNumeric("133.23.330") ->True
IsNumeric("36.658,30") ->True
IsNumeric("81,838.59") ->True

Espero que hayan entendido, TODOS pueden participar...

Es un reto dentro de todo simple...

Cuando esten todas las funciones se competira para encontrar al que hizo el codigo mas rapido(se mide con ctiming), luego se tomara de referencia la funcion original para ver si alguien la supera.

Notas:
·Las funciones y variables booleanas se inicializan en False.
·Se recomienda usar APIs.
·Se recomienda usar InStr.
·Se recomienda utilizar arrays de bytes.
·Se vale usar BadTypeConvert // EvilTypeConvert
·Recuerden que el tipo numerico mas rapido en vb es el Entero Largo (Long).


GRACIAS POR LEER!!!

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 10 Agosto 2011, 17:53 pm
Código
  1. Public Function Is_NumberT(ByRef Str As String) As Boolean
  2. On Error GoTo err
  3.         Str = Str + 0
  4.         Is_NumberT = True
  5.         Exit Function
  6. err:
  7. End Function
  8.  
  9.  

Salu2  :-*

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: 79137913 en 10 Agosto 2011, 18:24 pm
HOLA!!!

No crei que a nadie se le ocurriera eso XD mi forma es Casi igual, justo estaba hablando con Raul338 y me dijo que era Magia Negra eso XD Pero me gusta asi...

En fin... Mi codigo:

Código
  1. Private Function IsNumeric_7913(str As String) As Boolean
  2. Dim x As Double
  3. On Error GoTo Nonum
  4.     x = str
  5.     IsNumeric_7913 = True
  6. Nonum:
  7. End Function

GRACIAS POR LEER!!!

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: AlxSpy en 10 Agosto 2011, 18:44 pm
Código
  1. Option Explicit
  2.  
  3.  
  4. Private Sub Command1_Click()
  5.     Dim Dato As String
  6.     Dato = Text1.Text
  7.     MsgBox IsNumeric_Alx(Dato)
  8. End Sub
  9.  
  10. Public Function IsNumeric_Alx(byval Dato As Variant) As Boolean
  11.     Dim Temporal As String, X As Long
  12.     Temporal = Dato
  13.     For X = 0 To 9
  14.         Temporal = Replace(Temporal, X, "")
  15.     Next X
  16.     If Len(Temporal) = 0 Then IsNumeric_Alx = True
  17. End Function
  18.  

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: raul338 en 10 Agosto 2011, 19:23 pm
Código
  1. Option Explicit
  2. Private Const leTest As String = "asdf|a12f|12,12|12.12|12,23,34|133.23.330|36.658,30|81,838.59|11111111111111111111|1..3"
  3. Private Const leSep As String = "|"
  4.  
  5. Private Sub Form_Load()
  6.     Dim sTest() As String, i As Integer
  7.     sTest = Split(leTest, leSep)
  8.     For i = LBound(sTest) To UBound(sTest)
  9.         Debug.Print sTest(i), IsNumeric_r338(sTest(i))
  10.     Next
  11. End Sub
  12.  
  13. ' ==================================
  14.  
  15. Private Function IsNumeric_r338(str As String) As Boolean
  16.     Dim cReg As Object
  17.     Set cReg = CreateObject("VBScript.RegExp")
  18.     With cReg
  19.         ' Testeamos con . como separador de miles y , como separador de decimales
  20.         ' Personalmente seria para mi "^-?(?:\d{1,3}(?:\.\d{3})*|\d+)(?:\,\d+)?$"
  21.         ' ya que 133.23.330 no es un numero aunque IsNumeric diga que si ¬¬
  22.         .Pattern = "^-?(?:\d{1,3}(?:\.\d{1,3})*|\d+)(?:\,\d+)?$"
  23.         .Global = True
  24.         .IgnoreCase = True
  25.     End With
  26.     IsNumeric_r338 = cReg.Test(str)
  27.     If Not IsNumeric_r338 Then
  28.         ' Testeamos con , como separador de miles y . como separador de decimales
  29.         cReg.Pattern = "^(?:\d{1,3}(?:\,\d{3})*|\d+)(?:\.\d+)?$"
  30.         IsNumeric_r338 = cReg.Test(str)
  31.     End If
  32.     Set cReg = Nothing
  33. End Function
  34.  

Soporta tantas cifras como caracteres que soporta string. Y números negativos :D

Código:
asdf          False
a12f          False
12,12         True
12.12         True
12,23,34      False
133.23.330    True
36.658,30     True
81,838.59     True
11111111111111111111        True
1..3          False

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: TGa. en 10 Agosto 2011, 20:14 pm
hola ;D aca esta mi funcion

Código
  1. Private Function IsNumeric_TGa(str As String) As Boolean
  2.     Dim sAux As String
  3.     Dim lPos As Long, lCont As Long, lAsc As Long
  4.     lPos = 1
  5.  
  6.     Do While lPos <= Len(str)
  7.         IsNumeric_TGa = True
  8.         sAux = Mid$(str, lPos, 1)
  9.         lAsc = Asc(sAux)
  10.         If (lAsc >= 48 And lAsc <= 57) Or (lAsc >= 43 And lAsc <= 46) Then
  11.             If lAsc = 44 Then
  12.                 lCont = lCont + 1
  13.                 If lCont > 1 Then
  14.                     IsNumeric_TGa = False
  15.                     Exit Function
  16.                 End If
  17.             End If
  18.         Else
  19.             IsNumeric_TGa = False
  20.             Exit Function
  21.         End If
  22.         lPos = lPos + 1
  23.     Loop
  24. End Function
  25.  

Modificado: Espero que ahora funcione

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 11 Agosto 2011, 01:36 am
No usar esta funcion para el test, usar la 2.1

http://foro.elhacker.net/programacion_visual_basic/reto_reemplazo_de_funcion_isnumeric-t336067.0.html;msg1651317#new

Hace mucho que no participo en retos aqui dejo mi codigo.

Es mucho codigo pero trabaja rapido e identico que isNumeric de VB.

Código:

Public Function isNumeric_Black(ByRef sString As String) As Boolean
'   //  Version 1.0
Dim lChar   As Long
Dim lPos    As Long
Dim lLn     As Long
Dim lSwich  As Long     '   //  Switcher

Const PUNTO_DECIMAL As Long = &H1
Const SIGNO_SUMA    As Long = &H2
Const SIGNO_RESTA   As Long = &H4
Const ENTER_BEGIN   As Long = &H8
'Const ENTER_END     As Long = &H10 '   //  Sin uso...

    lLn = Len(sString)
    If (lLn = 0) Then Exit Function
    For lPos = 1 To lLn
        lChar = Asc(Mid$(sString, lPos, 1))      ' // <--- Esta linea es seguro que redusca la velocidad del algoritmo...
        Select Case lChar
            Case Is >= 48 And cChar <= 57
                isNumeric_Black = True
                
            Case 32
                If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
                
            Case 46            '   //  "."  Solo 1
                If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
                lSwich = (lSwich Or PUNTO_DECIMAL)
                
            Case 43            '   //  "+" Solo 1
                If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
                If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
                If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
                lSwich = (lSwich Or SIGNO_SUMA)
                
            Case 45            '   //  "-"  Solo 1
                If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
                If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
                If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
                lSwich = (lSwich Or SIGNO_RESTA)
                
            Case 9              '   //  vbTab       Se permite la cantidad que sea.
                If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
                
            Case 13
                If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then Exit Function
                lSwich = (lSwich Or ENTER_BEGIN)
                
            Case 10
                If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN) Else Exit For
            
            Case Else
                Exit For
        End Select
    Next
End Function


Codigo completo de mi test:

Código:

Private Sub Form_Load()

    Debug.Print isNumeric_Black("+.0"),
    Debug.Print isNumeric("+.0")
    
    Debug.Print isNumeric_Black("+."),
    Debug.Print isNumeric("+.")
    
    Debug.Print isNumeric_Black("+"),
    Debug.Print isNumeric("+")
    
    Debug.Print isNumeric_Black("-"),
    Debug.Print isNumeric("-")
    
    Debug.Print isNumeric_Black("."),
    Debug.Print isNumeric(".")
    
    Debug.Print isNumeric_Black(vbTab & " .+0"),
    Debug.Print isNumeric(vbTab & " .+0")
    
    Debug.Print isNumeric_Black(".0"),
    Debug.Print isNumeric(".0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0")
    
    Debug.Print isNumeric_Black(vbTab & Space(10) & vbNewLine & " +-+-.+.0"),
    Debug.Print isNumeric(vbTab & Space(10) & vbNewLine & " +-+-.+.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0")

End Sub


OutPut:

Código:

Verdadero     Verdadero
Falso         Falso
Falso         Falso
Falso         Falso
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero


Temibles Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 11 Agosto 2011, 01:59 am
No usar esta funcion para el test, usar la 2.1

http://foro.elhacker.net/programacion_visual_basic/reto_reemplazo_de_funcion_isnumeric-t336067.0.html;msg1651317#new


Actualizo el codigo a una version 1.1...

Código:


Public Function isNumeric_Black(ByRef sString As String) As Boolean
'   //  Version 1.1 (Fixed)
Dim lChar   As Long
Dim lPos    As Long
Dim lLn     As Long
Dim lSwich  As Long     '   //  Switcher

Const PUNTO_DECIMAL As Long = &H1
Const SIGNO_SUMA    As Long = &H2
Const SIGNO_RESTA   As Long = &H4

    lLn = Len(sString)
    If (lLn = 0) Then Exit Function
    For lPos = 1 To lLn
        lChar = Asc(Mid$(sString, lPos, 1))     '   //  <--Esta linea puede reducir la velocidad del algoritmo..
        If (lChar >= 48 And lChar <= 57) Then
            isNumeric_Black = True
        Else
            Select Case lChar
                Case 46            '   //  "."  Solo 1
                    If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                    lSwich = (lSwich Or PUNTO_DECIMAL)
                    
                Case 43            '   //  "+" Solo 1
                    If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
                    If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
                    If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                    lSwich = (lSwich Or SIGNO_SUMA)
                    
                Case 45            '   //  "-"  Solo 1
                    If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
                    If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
                    If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                    lSwich = (lSwich Or SIGNO_RESTA)
                    
                '   //  Espacio, Tabulador, (13 + 10) = vbNewLine
                Case 32, 9, 13, 10, 11, 12, 36, 38, 160   '   //   Despues del 10 son otros Espacios en Blanco
                    If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                    
                Case Else
                    Exit For
                    
            End Select
        End If
    Next
End Function


Nuevo Codigo de test...

Código:

Private Sub Form_Load()
Dim i As Integer

    Debug.Print isNumeric_Black("0"),
    Debug.Print isNumeric("0")
    
    For i = 0 To 255
        If (isNumeric_Black(Chr(i) & "0") <> isNumeric(Chr(i) & "0")) Then
            Debug.Print isNumeric_Black(Chr(i) & "0"); isNumeric(Chr(i) & "0")
            Debug.Print Chr(i); i
        End If
    Next i
    
    Debug.Print isNumeric_Black("+0."),
    Debug.Print isNumeric("+0.")
    
    Debug.Print isNumeric_Black("+.  0"),
    Debug.Print isNumeric("+.  0")
    
    Debug.Print isNumeric_Black("+"),
    Debug.Print isNumeric("+")
    
    Debug.Print isNumeric_Black("+  0"),
    Debug.Print isNumeric("+  0")
    
    Debug.Print isNumeric_Black(Chr(10) & "-0"),
    Debug.Print isNumeric(Chr(10) & "-0")
    
    Debug.Print isNumeric_Black("."),
    Debug.Print isNumeric(".")
    
    Debug.Print isNumeric_Black(vbTab & " .+0"),
    Debug.Print isNumeric(vbTab & " .+0")
    
    Debug.Print isNumeric_Black(".0"),
    Debug.Print isNumeric(".0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0")
    
    Debug.Print isNumeric_Black(vbTab & Space(10) & vbNewLine & " +-+-.+.0"),
    Debug.Print isNumeric(vbTab & Space(10) & vbNewLine & " +-+-.+.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0"),
    Debug.Print isNumeric(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0")

End Sub


Output:

Código:

Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero


Temibles Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 11 Agosto 2011, 02:20 am
Cita de: 79137913 en 10 Agosto 2011, 18:24 pm
HOLA!!!

No crei que a nadie se le ocurriera eso XD mi forma es Casi igual, justo estaba hablando con Raul338 y me dijo que era Magia Negra eso XD Pero me gusta asi...

En fin... Mi codigo:

Código
  1. Private Function IsNumeric_7913(str As String) As Boolean
  2. Dim x As Double
  3. On Error GoTo Nonum
  4.     x = str
  5.     IsNumeric_7913 = True
  6. Nonum:
  7. End Function

GRACIAS POR LEER!!!

 :xD , y se me habia ocurrido sumarle 0, pero no se me ocurrio que al sumarle "0" es como si no hubiera pasado nada matematicamente y lo pudiera eliminar dejandolo igual que tu code  :laugh:

habria que testear la velocidad... un saludo!.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: LeandroA en 11 Agosto 2011, 04:48 am
Hola, esta solo implementa una forma de comprobar el tipo de variable, pero al final utiliza el error para comprovar
Código:
Private Function IsNumeric_LeandroA(Expression) As Boolean
    Select Case VarType(Expression)
        Case vbBoolean, vbByte, vbInteger, vbLong, vbCurrency, vbDecimal, vbDouble, vbNull, vbEmpty, vbError
            IsNumeric_LeandroA = True
        Case vbArray, vbDataObject, vbDate, vbObject, vbUserDefinedType
            IsNumeric_LeandroA = False
        Case vbString
            If Val(Expression) <> 0 Then
                IsNumeric_LeandroA = True
            Else
                On Error Resume Next
                IsNumeric_LeandroA = Abs(Expression) + 1
            End If
    End Select
End Function

lo unico que gana en velocidad es si el parametro no fue definido como string.

Código:
 IsNumeric_LeandroA(85.54778)
 IsNumeric_LeandroA(-85.54778)
 IsNumeric_LeandroA(8554778)
 IsNumeric_LeandroA(me)

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: 79137913 en 11 Agosto 2011, 17:43 pm
HOLA!!!

Antes de hacer la competencia les muestro donde sus funciones no funcionan igual que IsNumeric... Por favor corrijan y luego testeamos:

REVISEN EL SIGUIENTE POST

GRACIAS POR LEER!!!

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 11 Agosto 2011, 19:42 pm
.

usa la ultima funcion que postee (1.1 la que esta en geshi) la 1ra no sirve del todo bien.

Código
  1.  
  2. Private Sub Form_Load()
  3.     MsgBox isNumeric_Black("12,23,34")
  4.     MsgBox IsNumeric("12,23,34")
  5. End Sub
  6.  
  7.  

OutPut

Código
  1.  
  2. Verdadero     Verdadero
  3.  
  4.  

Deberias usar tambien Strins con con Spacios en Blanco.

Temibles Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 13 Agosto 2011, 16:15 pm
Actualización

Código
  1. Public Function Is_NumberT(ByRef Str As String) As Boolean
  2. On Error GoTo err
  3.         Str = Str + 0
  4.         Is_NumberT = True
  5.         Exit Function
  6. err:
  7. End Function

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: raul338 en 13 Agosto 2011, 16:38 pm
Código
  1. Private Function IsNumeric_r338v2(ByVal str As String) As Boolean
  2.     Dim cReg As Object
  3.     Set cReg = CreateObject("VBScript.RegExp")
  4.     str = Trim$(str)
  5.     With cReg
  6.         ' Testeamos con . como separador de miles y , como separador de decimales
  7.         ' Personalmente seria para mi "^-?(?:\d{1,3}(?:\.\d{3})*|\d+)(?:\,\d+)?$"
  8.         ' ya que 133.23.330 no es un numero aunque IsNumeric diga que si ¬¬
  9.         .Pattern = "^[+\-]?(?:\d{1,3}(?:\.\d{1,3})*|\d*)\,?\d*?$"
  10.         .Global = True
  11.         .IgnoreCase = True
  12.     End With
  13.     IsNumeric_r338v2 = cReg.Test(str)
  14.     If Not IsNumeric_r338v2 Then
  15.         While InStr(str, "..")
  16.             str = Replace$(str, "..", vbNullString)
  17.         Wend
  18.         ' Testeamos con , como separador de miles y . como separador de decimales
  19.         cReg.Pattern = "^[+\-]?(?:\d{1,3}(?:\,\d{3})*|\d+)\.?\d*$"
  20.         IsNumeric_r338v2 = cReg.Test(str)
  21.     End If
  22.     Set cReg = Nothing
  23. End Function
  24.  

Obviamente ya no es la mas rápida, lo arregle para los caprichos de IsNumeric (desde cuando 1..2..3 es un numero?!!!)

Código:
sTest                  IsNumeric_r338   IsNumeric  CDbl(sTest)
1..3                   Verdadero        Verdadero       13
+33.2                  Verdadero        Verdadero       332
11111111111111111111   Verdadero        Verdadero       1,11111111111111E+19
12,12                  Verdadero        Verdadero       12,12
12.12                  Verdadero        Verdadero       1212
133.23.330             Verdadero        Verdadero       13323330
36.658,30              Verdadero        Verdadero       36658,3
81,838.59              Verdadero        Verdadero       81,83859
-65,1                  Verdadero        Verdadero       -65,1
12,23,34               Falso            Falso       
asdf                   Falso            Falso       
a12f                   Falso            Falso       
1..1                   Verdadero        Verdadero       11
1,,1                   Falso            Falso       
1..2..3                Verdadero        Verdadero       123

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 13 Agosto 2011, 17:17 pm
Observaciones

Código:
'LeandroA falla en "1. .2..3 "
'r338v2 falla en "1..2..3 "
'TGa falla en "1..2..3 "
'Alx falla en "1..2..3 "
'Black falla en "1. .2..3"

Salu2

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: raul338 en 13 Agosto 2011, 17:31 pm
Tenient101: Fixed :D

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 13 Agosto 2011, 17:45 pm
Cita de: raul338 en 13 Agosto 2011, 17:31 pm
Tenient101: Fixed :D

Código:
Dim A As String
A = "1..2..3 "
MsgBox IsNumeric(A)  ' = Verdadero
MsgBox IsNumeric_r338v2(A) ' = Falso

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: raul338 en 13 Agosto 2011, 17:55 pm
Citar
Última modificación: Hoy a las 12:54 por raul338 »
Incluiste la modificacion?

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: jaunx en 13 Agosto 2011, 18:05 pm
buenas, felicitaros a todos por los códigos,
no pongo mi code para no quedar último  :xD,
pero creo que para las pruebas tambien tendríais que usar cadenas como "&HFAA" ó "3e-3".... ;D

mi apuesta es por la de 79137913  ;-) ;-) ;-)

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 13 Agosto 2011, 18:10 pm
Cita de: raul338 en 13 Agosto 2011, 17:55 pm
Incluiste la modificacion?

Sí, tiene un espacio hasta lo ultimo, IsNumeric lo toma como numero y tu función no.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 13 Agosto 2011, 19:28 pm
No usar esta funcion para el test, usar la 2.1

http://foro.elhacker.net/programacion_visual_basic/reto_reemplazo_de_funcion_isnumeric-t336067.0.html;msg1651317#new

Código:

Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)

Public Function isNumeric_Black(ByRef sString As String) As Boolean
'   //  Version 1.2
Dim iChar   As Integer
Dim lPos    As Long
Dim lLn     As Long
Dim lSwich  As Long     '   //  Switcher

Const PUNTO_DECIMAL As Long = &H1
Const SIGNO_SUMA    As Long = &H2
Const SIGNO_RESTA   As Long = &H4
Const NUMBER_OK     As Long = &H10
'Const NUMBER_FINISH As Long = &H20 '   //  Sin uso.
 
    lLn = Len(sString)
    If (lLn = 0) Then Exit Function
    lLn = (lLn - 1)
    
    For lPos = 0 To lLn Step 1
        
        RtlMoveMemory VarPtr(iChar), StrPtr(sString) + (lPos + lPos), &H2
        
        If (iChar >= 48) And (iChar <= 57) Then
            lSwich = (lSwich Or NUMBER_OK)
            If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit For
            
        Else
            Select Case iChar
                Case 46            '   //  "."  Solo 1
                    If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                    lSwich = (lSwich Or PUNTO_DECIMAL)
                    
                Case 43            '   //  "+" Solo 1
                    If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
                    If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
                    If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                    lSwich = (lSwich Or SIGNO_SUMA)
                    
                Case 45            '   //  "-"  Solo 1
                    If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
                    If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
                    If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                    lSwich = (lSwich Or SIGNO_RESTA)
                    
                '   //  Espacio, Tabulador, (13 + 10) = vbNewLine
                Case 32, 9, 13, 10, 11, 12, 36, 38, 160   '   //   Despues del 10 son otros Espacios en Blanco
                    If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                    
                Case Else
                    Exit Function
 
            End Select
        End If
    Next
    
    If ((lSwich And NUMBER_OK) = NUMBER_OK) Then isNumeric_Black = True    '   // Finalizacion.
    
End Function


Codigo Test:

Código:

Private Sub Form_Load()
Dim i As Integer

    Debug.Print isNumeric_Black("+1. .2"),  ' // Nuevo
    Debug.Print IsNumeric("+1. .2")  ' // Nuevo
    
    Debug.Print isNumeric_Black("0"),
    Debug.Print IsNumeric("0")
    
    For i = 0 To 255
        If (isNumeric_Black(Chr(i) & "0") <> IsNumeric(Chr(i) & "0")) Then
            Debug.Print isNumeric_Black(Chr(i) & "0"); IsNumeric(Chr(i) & "0")
            Debug.Print Chr(i); i
        End If
    Next i
    
    Debug.Print isNumeric_Black("+0."),
    Debug.Print IsNumeric("+0.")
    
    Debug.Print isNumeric_Black("+.  0"),
    Debug.Print IsNumeric("+.  0")
    
    Debug.Print isNumeric_Black("+"),
    Debug.Print IsNumeric("+")
    
    Debug.Print isNumeric_Black("+  0"),
    Debug.Print IsNumeric("+  0")
    
    Debug.Print isNumeric_Black(Chr(10) & "-0"),
    Debug.Print IsNumeric(Chr(10) & "-0")
    
    Debug.Print isNumeric_Black("."),
    Debug.Print IsNumeric(".")
    
    Debug.Print isNumeric_Black(vbTab & " .+0"),
    Debug.Print IsNumeric(vbTab & " .+0")
    
    Debug.Print isNumeric_Black(".0"),
    Debug.Print IsNumeric(".0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0"),
    Debug.Print IsNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0"),
    Debug.Print IsNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0"),
    Debug.Print IsNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0"),
    Debug.Print IsNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0")
    
    Debug.Print isNumeric_Black(vbTab & Space(10) & vbNewLine & " +-+-.+.0"),
    Debug.Print IsNumeric(vbTab & Space(10) & vbNewLine & " +-+-.+.0")
    
    Debug.Print isNumeric_Black(vbTab & " +.0"),
    Debug.Print IsNumeric(vbTab & " +.0")

End Sub


Output:

Código:

Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero


Temibles Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: raul338 en 13 Agosto 2011, 19:32 pm
Cita de: Tenient101 en 13 Agosto 2011, 18:10 pm
Sí, tiene un espacio hasta lo ultimo, IsNumeric lo toma como numero y tu función no.
Si, por eso puse el Trim :P y si me lo toma :P

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 13 Agosto 2011, 20:40 pm
.
Por fin la termine (creo que ya esta bien)...

Link Pequeña explicacion de la variable lData (Estructura) (http://foro.elhacker.net/programacion_visual_basic/recopilacion_de_funciones_con_operaciones_binarias-t329680.0.html;msg1651478#msg1651478)

Soporta numeros con formatos:
###e[+/-]###.
###d[+/-]###.
Numeros en base 16.
Numeros en base 10.

Código
  1.  
  2. Public Function isNumeric_Black(ByRef sString As String) As Boolean
  3. '   //  Version 3.0
  4. Dim lPos    As Long     '   //  For Next
  5. Dim lLn     As Long     '   //  Longitud de sString
  6. Dim lData   As Long     '   //  Caracter, Switcher, Contador (QWord)
  7.  
  8. Const PUNTO_DECIMAL As Long = &H10000
  9. Const SIGNO_SRC     As Long = &H20000
  10. Const NUMBER_HEX    As Long = &H40000
  11. Const NUMBER_OK     As Long = &H80000
  12. Const NUMBER_POW    As Long = &H100000
  13. Const NUMBER_POWF   As Long = &H200000
  14. Const NUMBER_POWC   As Long = &H300000
  15. Const NUMBER_FINISH As Long = &H400000
  16.  
  17.     lLn = Len(sString)
  18.     If (lLn = &H0) Then Exit Function
  19.     lLn = ((lLn + lLn) - &H1)
  20.  
  21.     For lPos = &H0 To lLn Step &H2
  22.  
  23.         RtlMoveMemory VarPtr(lData) + &H3, StrPtr(sString) + lPos, &H1
  24.  
  25.         If ((lData And NUMBER_HEX) = NUMBER_HEX) Then
  26.             If (((lData And &HFF000000) >= &H30000000) And ((lData And &HFF000000) <= &H39000000)) Or _
  27.                (((lData And &HFF000000) >= &H61000000) And ((lData And &HFF000000) <= &H66000000)) Or _
  28.                (((lData And &HFF000000) >= &H41000000) And ((lData And &HFF000000) <= &H46000000)) Then   '   //  Numeros Hexadecimales
  29.                 lData = (lData Or NUMBER_OK)
  30.                 If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
  31.                 lData = (lData + &H1)
  32.                 If ((lData And &HFF) > &H10) Then Exit Function   '   //  QWord (Max Double)
  33.  
  34.             Else
  35.                 Select Case (lData And &HFF000000)
  36.                     Case &H9000000, &HA000000, &HB000000, &HC000000, &HD000000, &H24000000, &H20000000, &HA0000000 '   //   Espacios en Blanco
  37.                        If ((lData And NUMBER_OK) = NUMBER_OK) Then lData = (lData Or NUMBER_FINISH)
  38.                     Case Else
  39.                         If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
  40.                 End Select
  41.             End If
  42.         Else
  43.             If ((lData And &HFF000000) >= &H30000000) And ((lData And &HFF000000) <= &H39000000) Then
  44.                 lData = (lData Or NUMBER_OK)
  45.                 If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
  46.                 If ((lData And NUMBER_POWC) = NUMBER_POW) Then lData = (lData Or NUMBER_POWF)
  47.  
  48.             Else
  49.                 Select Case (lData And &HFF000000)
  50.                     Case &H0 '   //  NULL Indica que se termina la cadena.
  51.                         If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
  52.                         Exit For
  53.  
  54.                     Case &H2E000000 '   //  "."  Solo 1
  55.                         If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
  56.                          If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
  57.                          If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  58.                          lData = (lData Or PUNTO_DECIMAL)
  59.  
  60.                     Case &H2B000000, &H2D000000 '   //  "+|-" Solo 1
  61.                         If ((lData And NUMBER_POWC) = NUMBER_POW) Then
  62.                             lData = (lData Or NUMBER_POWF)
  63.                         Else
  64.                             If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
  65.                             If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  66.                             If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
  67.                         End If
  68.                         If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
  69.                         lData = (lData Or SIGNO_SRC)
  70.  
  71.                     Case &H2C000000
  72.                         If Not ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
  73.                         If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
  74.  
  75.                     Case &H9000000, &HA000000, &HB000000, &HC000000, &HD000000, &H24000000   '   //  Solo se permiten al inicio de un Numero (Espacios en Blanco).
  76.                         If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  77.                         If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
  78.                         If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
  79.                         If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
  80.  
  81.                     Case &HA0000000, &H20000000 '   //  Se permiten al Inicio/final de un numero.
  82.                         If ((lData And NUMBER_OK) = NUMBER_OK) Then
  83.                             lData = (lData Or NUMBER_FINISH)
  84.                         Else
  85.                             If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  86.                             If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
  87.                         End If
  88.  
  89.                     Case &H26000000 '   //  Es un Numero Hexadecimal
  90.                         If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
  91.                         If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
  92.                         If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
  93.                         If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  94.                         If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
  95.  
  96.                         RtlMoveMemory VarPtr(lData) + &H3, StrPtr(sString) + (lPos + &H2), &H1
  97.                         If ((lData And &HFF000000) = &H48000000) Or ((lData And &HFF000000) = &H68000000) Then lData = (lData Or NUMBER_HEX): lPos = lPos + &H2
  98.  
  99.                     Case &H44000000, &H45000000, &H64000000, &H65000000 ' //  Numeros en Formato ###e-###, ###e+###
  100.                         If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
  101.                         If ((lData And NUMBER_POW) = NUMBER_POW) Then Exit Function
  102.                         If ((lData And NUMBER_OK) = NUMBER_OK) Then
  103.                             lData = (lData Or NUMBER_POW)
  104.                             If ((lData And SIGNO_SRC) = SIGNO_SRC) Then lData = (lData Xor SIGNO_SRC)    '   //  Permitimos nuevamente los signos "+" y "-".
  105.                         Else
  106.                             Exit Function
  107.                         End If
  108.  
  109.                     Case Else
  110.                         Exit Function
  111.  
  112.                 End Select
  113.             End If
  114.         End If
  115.     Next
  116.     If ((lData And NUMBER_OK) = NUMBER_OK) Then isNumeric_Black = True    '   // Finalizacion.
  117. End Function
  118.  
  119.  

Codigo de pruebas:

Código:

Private Sub Form_Load()
Dim i As Integer
    
    Debug.Print isNumeric_Black(" 0. 0"), IsNumeric(" 0. 0")
    Debug.Print isNumeric_Black("3" & Chr(10) & "0"), IsNumeric("3" & Chr(10) & "0")

    Debug.Print isNumeric_Black("3000" & Chr(10) & "0"), IsNumeric("3000" & Chr(10) & "0")

    For i = 0 To 255
        If (isNumeric_Black("3000" & Chr(i) & "0") <> IsNumeric("3000" & Chr(i) & "0")) Then
            Debug.Print isNumeric_Black("3000" & Chr(i) & "0"), IsNumeric("3000" & Chr(i) & "0")
            Debug.Print Chr(i); i
        End If
    Next i

    '   //  Test Base 16
    Debug.Print isNumeric_Black("    &H1000000000"),
    Debug.Print IsNumeric("    &H1000000000")
    
    Debug.Print isNumeric_Black("  s  &H1000000000"),
    Debug.Print IsNumeric("  s  &H1000000000")
    
    Debug.Print isNumeric_Black("  +.  &H1000000000"),
    Debug.Print IsNumeric("  +.  &H1000000000")
    
    Debug.Print isNumeric_Black("  +. &H1000000000"),
    Debug.Print IsNumeric("  +. &H1000000000")
    
    Debug.Print isNumeric_Black("  +.a &H1000000000"),
    Debug.Print IsNumeric("  +.a &H1000000000")
    
    Debug.Print isNumeric_Black("  +.a &H100000000v"),
    Debug.Print IsNumeric("  +.a &H100000000v")
    
    Debug.Print isNumeric_Black("  +.a &H1000000  00v"),
    Debug.Print IsNumeric("  +.a &H1000000  00v")
    
    Debug.Print isNumeric_Black("&H1000000  00v"),
    Debug.Print IsNumeric("&H1000000  00v")
    
    Debug.Print isNumeric_Black("&H1000000  00"),
    Debug.Print IsNumeric("&H1000000  00")

    '   //  Test de Numeros en formato ###e-###, ###e+###
    Debug.Print isNumeric_Black("+1.0e45"),
    Debug.Print IsNumeric("+1.0e45")
    
    Debug.Print isNumeric_Black("+e1. .2"),
    Debug.Print IsNumeric("+e1. .2")
    
    Debug.Print isNumeric_Black("+0e+11"),
    Debug.Print IsNumeric("+0e+11")
    
    Debug.Print isNumeric_Black(".+0e+11"),
    Debug.Print IsNumeric(".+0e+11")
    
    '   //  Test de Numeros en formato ###d-###, ###d+###
    Debug.Print isNumeric_Black("+1.0d45"),
    Debug.Print IsNumeric("+1.0d45")
    
    Debug.Print isNumeric_Black("+d1. .2"),
    Debug.Print IsNumeric("+d1. .2")
    
    Debug.Print isNumeric_Black("+0d+11"),
    Debug.Print IsNumeric("+0d+11")
    
    Debug.Print isNumeric_Black(".+0d+11"),
    Debug.Print IsNumeric(".+0d+11")
    
    '   //  Test Base 10
    Debug.Print isNumeric_Black("+1. .2"),
    Debug.Print IsNumeric("+1. .2")
    
    Debug.Print isNumeric_Black("0"),
    Debug.Print IsNumeric("0")
    
    For i = 0 To 255
        If (isNumeric_Black(Chr(i) & "0") <> IsNumeric(Chr(i) & "0")) Then
            Debug.Print isNumeric_Black(Chr(i) & "0"); IsNumeric(Chr(i) & "0")
            Debug.Print Chr(i); i
        End If
    Next i
    
    Debug.Print isNumeric_Black("+0."),
    Debug.Print IsNumeric("+0.")
    
    Debug.Print isNumeric_Black("+.  0"),
    Debug.Print IsNumeric("+.  0")
    
    Debug.Print isNumeric_Black("+"),
    Debug.Print IsNumeric("+")
    
    Debug.Print isNumeric_Black("+  0"),
    Debug.Print IsNumeric("+  0")
    
    Debug.Print isNumeric_Black(Chr(10) & "-0"),
    Debug.Print IsNumeric(Chr(10) & "-0")
    
    Debug.Print isNumeric_Black("."),
    Debug.Print IsNumeric(".")
    
    Debug.Print isNumeric_Black(vbTab & " .+0"),
    Debug.Print IsNumeric(vbTab & " .+0")
    
    Debug.Print isNumeric_Black(".0"),
    Debug.Print IsNumeric(".0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0"),
    Debug.Print IsNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0"),
    Debug.Print IsNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0"),
    Debug.Print IsNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0")
    
    Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0"),
    Debug.Print IsNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0")
    
    Debug.Print isNumeric_Black(vbTab & Space(10) & vbNewLine & " +-+-.+.0"),
    Debug.Print IsNumeric(vbTab & Space(10) & vbNewLine & " +-+-.+.0")
    
    Debug.Print isNumeric_Black(vbTab & " +.0"),
    Debug.Print IsNumeric(vbTab & " +.0")

End Sub


OutPut:

Código:

Falso         Falso
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Falso         Falso
Falso         Falso
Falso         Falso
Falso         Falso
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero


Temibles Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 14 Agosto 2011, 00:58 am
.
Como no me puedo esperar ademas no hay todavía un test de fiabilidad... aqui se los dejo, este test ESPRIME LA FUNCION ISNUMERIC() con las nuestras en todos los aspectos...

Codigo en un Form (Despues ejecutarlo y darle click al Form).

Código:

Option Explicit
 
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
Private Declare Function WaitMessage Lib "user32" () As Long
  
Enum eTime
     Horas = 3600
     Minutos = 60
     Segundos = 1
End Enum
  
Public Sub Wait(ByVal vToWait&, Optional ByVal ThisWait As eTime = Segundos, Optional ByVal UseAllProc As Boolean = False)
Dim vDateE      As Date
     vDateE = DateAdd("s", vToWait& * (ThisWait + 0), Time)
     Do While vDateE > Time
         Call WaitMessage
         If Not UseAllProc Then DoEvents
     Loop
End Sub

Private Sub Form_Click()
Dim laux0               As Long
Dim i                   As Long
Dim bRes                As Boolean
Dim spli()              As String
Dim ctmr                As CTiming

    Show
    Call Wait(1, Segundos, False)
    Set ctmr = New CTiming
    
    '   //  Test Fiabilidad.
    spli = Split("&H221231321| &H2212313215646546546546516516512|9999999999999999999999999999999999999999999999999999| 0. 0|3" & Chr(10) & "0|3000" & Chr(10) & "0|    &H1000000000|  s  &H1000000000" & _
                "|  +.  &H1000000000|  +. &H1000000000|  +.a &H1000000000|  +.a &H100000000v|  +.a &H1000000  00v" & _
                "|&H1000000  00v|&H1000000  00|+1.0e45|+e1. .2|+0e+11|.+0e+11|+1.0d45|+d1. .2|+0d+11|.+0d+11|" & _
                "|+1. .2|0|+0.|+.  0|+|+  0|" & Chr(10) & "-0|." & vbTab & " .+0|.0" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0" & _
                "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0 " & _
                "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0 " & _
                "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0 " & _
                "|" & vbTab & Space(10) & vbNewLine & " +-+-.+.0|" & vbTab & " +.0", "|")
    
    '   //  Test de tiempos...
    For i = 0 To UBound(spli)
        bRes = IsNumeric(spli(i))
        If Not (bRes = isNumeric_Black(spli(i))) Then
            Debug.Print "Error: isNumeric_Black (""" & spli(i) & """)"
        End If
        If Not (bRes = Is_NumberT(spli(i))) Then
            Debug.Print "Error: Is_NumberT (""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_TGa(spli(i))) Then
            Debug.Print "Error: IsNumeric_TGa (""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_r338v2(spli(1))) Then
            Debug.Print "Error: IsNumeric_r338v2(""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_LeandroA(spli(1))) Then
            Debug.Print "Error: IsNumeric_LeandroA(""" & spli(i) & """)"
        End If
        
        If Not (bRes = IsNumeric_7913(spli(1))) Then
            Debug.Print "Error: IsNumeric_7913(""" & spli(i) & """)"
        End If
    Next
    
    Me.AutoRedraw = True
    '   //  Test entre usuarios.
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            IsNumeric spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            isNumeric_Black spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric_Black()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            Is_NumberT spli(i)
        Next
    Next laux0
    Me.Print "Is_NumberT()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            IsNumeric_TGa spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric_TGa()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            IsNumeric_7913 spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric_7913()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            IsNumeric_r338v2 spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric_r338v2()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    
    Me.Print "Finalizado"
    Set ctmr = Nothing
    Show
    SetFocus
End Sub

Public Function isNumeric_Black(ByRef sString As String) As Boolean
'   //  Version 3.0
Dim lPos    As Long     '   //  For Next
Dim lLn     As Long     '   //  Longitud de sString
Dim lData   As Long     '   //  Caracter, Switcher, Contador (QWord)

Const PUNTO_DECIMAL As Long = &H10000
Const SIGNO_SRC     As Long = &H20000
Const NUMBER_HEX    As Long = &H40000
Const NUMBER_OK     As Long = &H80000
Const NUMBER_POW    As Long = &H100000
Const NUMBER_POWF   As Long = &H200000
Const NUMBER_POWC   As Long = &H300000
Const NUMBER_FINISH As Long = &H400000
 
    lLn = Len(sString)
    If (lLn = &H0) Then Exit Function
    lLn = ((lLn + lLn) - &H1)
 
    For lPos = &H0 To lLn Step &H2
 
        RtlMoveMemory VarPtr(lData) + &H3, StrPtr(sString) + lPos, &H1
 
        If ((lData And NUMBER_HEX) = NUMBER_HEX) Then
            If (((lData And &HFF000000) >= &H30000000) And ((lData And &HFF000000) <= &H39000000)) Or _
               (((lData And &HFF000000) >= &H61000000) And ((lData And &HFF000000) <= &H66000000)) Or _
               (((lData And &HFF000000) >= &H41000000) And ((lData And &HFF000000) <= &H46000000)) Then   '   //  Numeros Hexadecimales
                lData = (lData Or NUMBER_OK)
                If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                lData = (lData + &H1)
                If ((lData And &HFF) > &H10) Then Exit Function   '   //  QWord (Max Double)
                
            Else
                Select Case (lData And &HFF000000)
                    Case &H9000000, &HA000000, &HB000000, &HC000000, &HD000000, &H24000000, &H20000000, &HA0000000 '   //   Espacios en Blanco
                       If ((lData And NUMBER_OK) = NUMBER_OK) Then lData = (lData Or NUMBER_FINISH)
                    Case Else
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                End Select
            End If
        Else
            If ((lData And &HFF000000) >= &H30000000) And ((lData And &HFF000000) <= &H39000000) Then
                lData = (lData Or NUMBER_OK)
                If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                If ((lData And NUMBER_POWC) = NUMBER_POW) Then lData = (lData Or NUMBER_POWF)
 
            Else
                Select Case (lData And &HFF000000)
                    Case &H0 '   //  NULL Indica que se termina la cadena.
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
                        Exit For
 
                    Case &H2E000000 '   //  "."  Solo 1
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
                         If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                         If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                         lData = (lData Or PUNTO_DECIMAL)
 
                    Case &H2B000000, &H2D000000 '   //  "+|-" Solo 1
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then
                            lData = (lData Or NUMBER_POWF)
                        Else
                            If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                            If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                            If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
                        End If
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        lData = (lData Or SIGNO_SRC)
 
                    Case &H2C000000
                        If Not ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
 
                    Case &H9000000, &HA000000, &HB000000, &HC000000, &HD000000, &H24000000   '   //  Solo se permiten al inicio de un Numero (Espacios en Blanco).
                        If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
 
                    Case &HA0000000, &H20000000 '   //  Se permiten al Inicio/final de un numero.
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then
                            lData = (lData Or NUMBER_FINISH)
                        Else
                            If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                            If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
                        End If
 
                    Case &H26000000 '   //  Es un Numero Hexadecimal
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                        If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
                        If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
 
                        RtlMoveMemory VarPtr(lData) + &H3, StrPtr(sString) + (lPos + &H2), &H1
                        If ((lData And &HFF000000) = &H48000000) Or ((lData And &HFF000000) = &H68000000) Then lData = (lData Or NUMBER_HEX): lPos = lPos + &H2
 
                    Case &H44000000, &H45000000, &H64000000, &H65000000 ' //  Numeros en Formato ###e-###, ###e+###
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        If ((lData And NUMBER_POW) = NUMBER_POW) Then Exit Function
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then
                            lData = (lData Or NUMBER_POW)
                            If ((lData And SIGNO_SRC) = SIGNO_SRC) Then lData = (lData Xor SIGNO_SRC)    '   //  Permitimos nuevamente los signos "+" y "-".
                        Else
                            Exit Function
                        End If
 
                    Case Else
                        Exit Function
 
                End Select
            End If
        End If
    Next
    If ((lData And NUMBER_OK) = NUMBER_OK) Then isNumeric_Black = True    '   // Finalizacion.
End Function

Public Function Is_NumberT(ByVal str As String) As Boolean
On Error GoTo err
Dim L As Long
L = str + 1
Is_NumberT = True
Exit Function
err:
End Function

Private Function IsNumeric_TGa(str As String) As Boolean
    Dim sAux As String
    Dim lPos As Long, lCont As Long, lAsc As Long
    lPos = 1
 
    Do While lPos <= Len(str)
        IsNumeric_TGa = True
        sAux = Mid$(str, lPos, 1)
        lAsc = Asc(sAux)
        If (lAsc >= 48 And lAsc <= 57) Or (lAsc >= 43 And lAsc <= 46) Then
            If lAsc = 44 Then
                lCont = lCont + 1
                If lCont > 1 Then
                    IsNumeric_TGa = False
                    Exit Function
                End If
            End If
        Else
            IsNumeric_TGa = False
            Exit Function
        End If
        lPos = lPos + 1
    Loop
End Function

Private Function IsNumeric_r338v2(ByVal str As String) As Boolean
    Dim cReg As Object
    Set cReg = CreateObject("VBScript.RegExp")
    str = Trim$(str)
    With cReg
        ' Testeamos con . como separador de miles y , como separador de decimales
        ' Personalmente seria para mi "^-?(?:\d{1,3}(?:\.\d{3})*|\d+)(?:\,\d+)?$"
        ' ya que 133.23.330 no es un numero aunque IsNumeric diga que si ¬¬
        .Pattern = "^[+\-]?(?:\d{1,3}(?:\.\d{1,3})*|\d*)\,?\d*?$"
        .Global = True
        .IgnoreCase = True
    End With
    IsNumeric_r338v2 = cReg.Test(str)
    If Not IsNumeric_r338v2 Then
        While InStr(str, "..")
            str = Replace$(str, "..", vbNullString)
        Wend
        ' Testeamos con , como separador de miles y . como separador de decimales
        cReg.Pattern = "^[+\-]?(?:\d{1,3}(?:\,\d{3})*|\d+)\.?\d*$"
        IsNumeric_r338v2 = cReg.Test(str)
    End If
    Set cReg = Nothing
End Function

Private Function IsNumeric_LeandroA(expression) As Boolean
    Select Case VarType(expression)
        Case vbBoolean, vbByte, vbInteger, vbLong, vbCurrency, vbDecimal, vbDouble, vbNull, vbEmpty, vbError
            IsNumeric_LeandroA = True
        Case vbArray, vbDataObject, vbDate, vbObject, vbUserDefinedType
            IsNumeric_LeandroA = False
        Case vbString
            If Val(expression) <> 0 Then
                IsNumeric_LeandroA = True
            Else
                On Error Resume Next
                IsNumeric_LeandroA = Abs(expression) + 1
            End If
    End Select
End Function

Private Function IsNumeric_7913(str As String) As Boolean
Dim x As Double
On Error GoTo Nonum
    x = str
    IsNumeric_7913 = True
Nonum:
End Function


Output:

Código:

Error: Is_NumberT ("&H221231321")
Error: IsNumeric_TGa ("&H221231321")
Error: IsNumeric_r338v2("&H221231321")
Error: IsNumeric_LeandroA("&H221231321")
Error: IsNumeric_7913("&H221231321")
Error: Is_NumberT ("9999999999999999999999999999999999999999999999999999")
Error: IsNumeric_r338v2("9999999999999999999999999999999999999999999999999999")
Error: IsNumeric_LeandroA("9999999999999999999999999999999999999999999999999999")
Error: IsNumeric_7913("9999999999999999999999999999999999999999999999999999")
Error: Is_NumberT ("    &H1000000000")
Error: IsNumeric_TGa ("    &H1000000000")
Error: IsNumeric_r338v2("    &H1000000000")
Error: IsNumeric_LeandroA("    &H1000000000")
Error: IsNumeric_7913("    &H1000000000")
Error: Is_NumberT ("+1.0e45")
Error: IsNumeric_TGa ("+1.0e45")
Error: IsNumeric_r338v2("+1.0e45")
Error: IsNumeric_LeandroA("+1.0e45")
Error: IsNumeric_7913("+1.0e45")
Error: IsNumeric_TGa ("+0e+11")
Error: IsNumeric_r338v2("+0e+11")
Error: IsNumeric_LeandroA("+0e+11")
Error: IsNumeric_7913("+0e+11")
Error: Is_NumberT ("+1.0d45")
Error: IsNumeric_TGa ("+1.0d45")
Error: IsNumeric_r338v2("+1.0d45")
Error: IsNumeric_LeandroA("+1.0d45")
Error: IsNumeric_7913("+1.0d45")
Error: IsNumeric_TGa ("+0d+11")
Error: IsNumeric_r338v2("+0d+11")
Error: IsNumeric_LeandroA("+0d+11")
Error: IsNumeric_7913("+0d+11")
Error: IsNumeric_r338v2("0")
Error: IsNumeric_LeandroA("0")
Error: IsNumeric_7913("0")
Error: IsNumeric_r338v2("+0.")
Error: IsNumeric_LeandroA("+0.")
Error: IsNumeric_7913("+0.")
Error: IsNumeric_TGa ("+")
Error: IsNumeric_TGa ("+  0")
Error: IsNumeric_r338v2("+  0")
Error: IsNumeric_LeandroA("+  0")
Error: IsNumeric_7913("+  0")
Error: IsNumeric_TGa ("
-0")
Error: IsNumeric_r338v2("
-0")
Error: IsNumeric_LeandroA("
-0")
Error: IsNumeric_7913("
-0")
Error: IsNumeric_TGa (" 
    
    
 +.0 ")
Error: IsNumeric_r338v2("   
    
    
 +.0 ")
Error: IsNumeric_LeandroA(" 
    
    
 +.0 ")
Error: IsNumeric_7913(" 
    
    
 +.0 ")
Error: IsNumeric_TGa (" 
    
    
 +00.0 ")
Error: IsNumeric_r338v2("   
    
    
 +00.0 ")
Error: IsNumeric_LeandroA(" 
    
    
 +00.0 ")
Error: IsNumeric_7913(" 
    
    
 +00.0 ")
Error: IsNumeric_TGa ("  +.0")
Error: IsNumeric_r338v2("    +.0")
Error: IsNumeric_LeandroA("  +.0")
Error: IsNumeric_7913("  +.0")


Archivos de la prueba:

Archivos Sueltos (http://infrangelux.sytes.net/filex/?dir=/BlackZeroX/Programacion/vb6/Retos/isnumeric)
En ZIP (http://infrangelux.sytes.net/filex/?file=Comprimido.zip&dir=/BlackZeroX/Programacion/vb6/Retos/isnumeric)

Temibles Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: AlxSpy en 14 Agosto 2011, 05:59 am
mi codigo tiene mas  fallas que la ... , ya quede ultimo  T_T   ,felicitaciones a quienes ya lograron hacer un codigo eficiente y sin fallas, el lunes veremos quien sale ganador de este reto.
saludos.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: raul338 en 14 Agosto 2011, 06:06 am
BlackZeroX se lo tomo en serio :xD

jeje, tendré que hacer una versión aparte para hexadecimales n.n

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 14 Agosto 2011, 08:36 am
Cita de: raul338 en 14 Agosto 2011, 06:06 am
BlackZeroX se lo tomo en serio :xD

Estaba aburrido y me intento quitar un vicio que me genero un juego del facebook... por eso no estaba ya tanto en el foro maldito facebook.

Dulces Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: x64core en 14 Agosto 2011, 09:01 am
buenas gente felicidades a todos :xD parece que ya es tarde para que yo entre :xD y ademas viendo tanto codigo raro me desanimo la vdd :xD pero me gusto la idea ;D espero que hagan mas retos mas seguido ;D esta interesante esto y uno apriende tambien ;D

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: raul338 en 15 Agosto 2011, 01:05 am
Y por si alguno pensó que los caprichos de BlackZeroX es imposible de otra forma de la que lo hizo él. Acá le cierro la boca :xD

Código
  1. Private Function IsNumeric_r338v3(ByVal str As String) As Boolean
  2.     Const vbSpace As String = " "
  3.     Dim cReg As Object
  4.     Set cReg = CreateObject("VBScript.RegExp")
  5.     str = Replace$(str, vbCr, vbSpace)
  6.     str = Replace$(str, vbLf, vbSpace)
  7.     str = Replace$(str, vbTab, vbNullString)
  8.     str = Trim$(str)
  9.     If str = vbNullString Or str = "+" Or str = "-" Then Exit Function
  10.     With cReg
  11.         ' Hexadecimal y Notacion cientifica
  12.         .Pattern = "^(?:&H[\dA-F]{1,16}|[+\-]?\d(?:\.\d+)?[de][+\-]?\d+)$"
  13.         .Global = True
  14.         .IgnoreCase = True
  15.     End With
  16.     IsNumeric_r338v3 = cReg.Test(str)
  17.     If Not IsNumeric_r338v3 Then
  18.         ' Testeamos con . como separador de miles y , como separador de decimales
  19.         ' Personalmente seria para mi "^[+\-]?(?:\d{1,3}(?:\.\d{3})*|\d*)\,?\d*$"
  20.         ' ya que 133.23.330 no es un numero aunque IsNumeric diga que si ¬¬
  21.         cReg.Pattern = "^[+\-]?\s*(?:\d{1,3}(?:\.\d{1,3})*|\d*)\,?\d*$"
  22.         IsNumeric_r338v3 = cReg.Test(str)
  23.         If Not IsNumeric_r338v3 Then
  24.             str = Replace$(str, "..", vbNullString)
  25.             ' Testeamos con , como separador de miles y . como separador de decimales
  26.             cReg.Pattern = "^[+\-]?\s*(?:\d{1,3}(?:\,\d{3})*|\d+)\.?\d*$"
  27.             IsNumeric_r338v3 = cReg.Test(str)
  28.         End If
  29.     End If
  30.     Set cReg = Nothing
  31. End Function
  32.  

Tiene soporte Hexadecimal y un poco de notación científica (la verdad, le falta mas creo, es que nunca vi ese tipo de notación)
:D :D Haber... seguro que no es tan rápida, pero es segura :xD

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: x64core en 15 Agosto 2011, 01:14 am
vale panas y como se sabe que funcion es mas veloz que otra es obvio que por probar la ejecucion de la funcion no verdad :xD me imagino que con un programa o noce :P

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: raul338 en 15 Agosto 2011, 01:50 am
Estuve probando el testeo, y si lo hago asi

Código
  1. Private Sub Form_Load()
  2.     Dim bRes As Boolean, iRes As Boolean
  3.     Dim leTest As String
  4.     leTest = "1..3|+33.2|11111111111111111111|12,12|12.12|133.23.330|36.658,30|81,838.59|-65,1|12,23,34|asdf|a12f|1..1|1,,1|1..2..3|&HAF|" & _
  5.                 "&H221231321| &H2212313215646546546546516516512|9999999999999999999999999999999999999999999999999999| 0. 0|3" & Chr(10) & "0|3000" & Chr(10) & "0|    &H1000000000|  s  &H1000000000" & _
  6.                 "|  +.  &H1000000000|  +. &H1000000000|  +.a &H1000000000|  +.a &H100000000v|  +.a &H1000000  00v" & _
  7.                 "|&H1000000  00v|&H1000000  00|+1.0e45|+e1. .2|+0e+11|.+0e+11|+1.0d45|+d1. .2|+0d+11|.+0d+11|" & _
  8.                 "|+1. .2|0|+0.|+.  0|+|+  0|" & Chr(10) & "-0|." & vbTab & " .+0|.0" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0" & _
  9.                 "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0 " & _
  10.                 "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0 " & _
  11.                 "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0 " & _
  12.                 "|" & vbTab & Space(10) & vbNewLine & " +-+-.+.0|" & vbTab & " +.0"
  13.     Dim sTest() As String, i As Integer
  14.     sTest = Split(leTest, "|")
  15.     For i = LBound(sTest) To UBound(sTest)
  16.         bRes = IsNumeric(sTest(i))
  17.         iRes = IsNumeric_r338v3(sTest(i))
  18.         Debug.Print bRes, iRes, IIf(bRes <> iRes, "ERROR", "")
  19.     Next
  20.     Call Unload(Me)
  21. End Sub
  22.  

No tira error ...

En cambio si cambio en el for pongo esto como hace en su Test BlackZeroX

Código
  1. If Not (IsNumeric_r338v3(sTest(i))) Then Debug.Print "ERROR", i Else Debug.Print i
  2.  

Devuelve "errores" al azar :-/ así que no quiere decir que sea realmente un error

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 15 Agosto 2011, 01:58 am
@raul338: tengo unas dudas con tu code
"vbNewLine" y "vbCr" no es lo mismo... ?
y en esta parte del bucle

Código
  1. While InStr(str, "..")
  2. str = Replace$(str, "..", vbNullString)
  3. Wend

solamente ocurrira una vez, ya que reemplaze todos los ".." no volvera a haber mas, es decir no es necesario el bucle, bueno eso pienso o me equivoco, un saludo !.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: raul338 en 15 Agosto 2011, 02:40 am
vbNewLine = vbCrLf = vbCr & vbLf = Chr$(10) & Chr(13) :P
Misteriosamente no me a funcionado reemplazar vbCr con vbLf y sigue quedando vbNewLine :xD

Sobre el bucle, cierto, lo que pasa es que experiencias anteriores me dijeron hacer directamente eso :xD

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 15 Agosto 2011, 06:16 am
.
El ASC 10 = Saldo de linea. = vbCr
El ASC 13 = Retorno de carro.
-------------------
vbNewLine

Es decir en Windows asi, en linux si no mal recuerdo solo basta con el ASC 10.

Por otro lado:

@Raul100

En mi antiguo post (Donde esta el test de fiabilidad en la hoja anterior hay ligas de decarga de archivos, hay esta el codigo para probar la velocidad de las funciones... puedes estudiarlo).

Ando estresado y me limitare un poco...

Cita de: raul338 en 15 Agosto 2011, 01:05 am
Y por si alguno pensó que los caprichos de BlackZeroX es imposible de otra forma de la que lo hizo él. Acá le cierro la boca :xD

El capricho es de IsNumeric() no mio; aun asi sigue mal tu funcion...

Cita de: raul338 en 15 Agosto 2011, 01:50 am
Estuve probando el testeo, y si lo hago asi
....
Devuelve "errores" al azar :-/ así que no quiere decir que sea realmente un error

 * Revisa bien la forma en la que probe la fiabilidad...

Código
  1.     '...
  2.         bRes = IsNumeric(spli(i))
  3.         If Not (bRes = isNumeric_Black(spli(i))) Then
  4.             Debug.Print "Error: isNumeric_Black (""" & spli(i) & """)"
  5.         End If
  6.         '...
  7.         If Not (bRes = IsNumeric_r338v2(spli(i))) Then
  8.             Debug.Print "Error: IsNumeric_r338v2(""" & spli(i) & """)"
  9.         End If
  10.     '...
  11.  

Nota: no es nesesario usar lBound() despues de hacer un Split()... SIEMPRE es 0...
Código
  1. Private Sub Form_Load()
  2.     MsgBox LBound(Split("", "accc"))
  3.     MsgBox LBound(Split("aaa", "accc"))
  4.     MsgBox LBound(Split("aaaaa", "accc"))
  5.     MsgBox LBound(Split("accccaccccc", "accc"))
  6. End Sub
  7.  

------> Edito:

la version 3 sigue dando errores...

Test rapido...

Código
  1.  
  2. Private Sub Form_Load()
  3.     MsgBox IsNumeric_r338v3("1..3") & vbNewLine & IsNumeric("1..3")
  4. End Sub
  5.  
  6.  

Código:

Error: IsNumeric_r338v3("1..3")
Error: IsNumeric_r338v3("133.23.330")
Error: IsNumeric_r338v3("asdf")
Error: IsNumeric_r338v3("a12f")
Error: IsNumeric_r338v3("1..1")
Error: IsNumeric_r338v3("1..2..3")
Error: IsNumeric_r338v3(" &H2212313215646546546546516516512")
Error: IsNumeric_r338v3(" 0. 0")
Error: IsNumeric_r338v3("3
0")
Error: IsNumeric_r338v3("3000
0")
Error: IsNumeric_r338v3("  s  &H1000000000")
Error: IsNumeric_r338v3("  +.  &H1000000000")
Error: IsNumeric_r338v3("  +. &H1000000000")
Error: IsNumeric_r338v3("  +.a &H1000000000")
Error: IsNumeric_r338v3("  +.a &H100000000v")
Error: IsNumeric_r338v3("  +.a &H1000000  00v")
Error: IsNumeric_r338v3("&H1000000  00v")
Error: IsNumeric_r338v3("&H1000000  00")
Error: IsNumeric_r338v3("+e1. .2")
Error: IsNumeric_r338v3(".+0e+11")
Error: IsNumeric_r338v3("+d1. .2")
Error: IsNumeric_r338v3(".+0d+11")
Error: IsNumeric_r338v3("")
Error: IsNumeric_r338v3("+1. .2")
Error: IsNumeric_r338v3("+.  0")
Error: IsNumeric_r338v3("+")
Error: IsNumeric_r338v3(".   .+0")
Error: IsNumeric_r338v3(".0 
    
    
 .+0")
Error: IsNumeric_r338v3("   
    
    
 --.0 ")
Error: IsNumeric_r338v3("             
 +-+-.+.0")


Dulces Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 15 Agosto 2011, 07:22 am
Cita de: BlackZeroX▓▓▒▒░░ en 15 Agosto 2011, 06:16 am
.
El ASC 10 = Saldo de linea. = vbCr
El ASC 13 = Retorno de carro.


Visual Basic lo toma igual o estara mal algo..
Código
  1. MsgBox Asc(vbCr) ' => 13
  2. MsgBox Asc(vbNewLine) ' => 13

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: 79137913 en 15 Agosto 2011, 14:03 pm
HOLA!!!

Bueno gente, yo no podia entender como mi funcion no andaba asi que me puse a debuggear y vi un error en el test de BlackZero...

    '   //  Test de tiempos...
    For i = 0 To UBound(spli)
        bRes = IsNumeric(spli(i))
        If Not (bRes = isNumeric_Black(spli(i))) Then
            Debug.Print "Error: isNumeric_Black (""" & spli(i) & """)"
        End If
        If Not (bRes = Is_NumberT(spli(i))) Then
            Debug.Print "Error: Is_NumberT (""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_TGa(spli(i))) Then
            Debug.Print "Error: IsNumeric_TGa (""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_r338v2(spli(1))) Then
            Debug.Print "Error: IsNumeric_r338v2(""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_LeandroA(spli(1))) Then
            Debug.Print "Error: IsNumeric_LeandroA(""" & spli(i) & """)"
        End If
        
        If Not (bRes = IsNumeric_7913(spli(1))) Then
            Debug.Print "Error: IsNumeric_7913(""" & spli(i) & """)"
        End If
    Next

P.D: Mi Funcion no tira ni 1 solo error :D

PLAZO HASTA MAÑANA PARA QUE MODIFIQUEN LOS CODIGOS A SU GUSTO POR LAS NUEVAS REGLAS :P

NUEVAS TABLAS DE ERRORES CORREGIDAS:
Código:
Error: IsNumeric_TGa ("1E+52")
Error: IsNumeric_LeandroA("3
0")
Error: IsNumeric_LeandroA("3000
0")
Error: IsNumeric_TGa ("1E+46")
Error: IsNumeric_TGa ("1E+46")
Error: IsNumeric_LeandroA("+1. .2")
Error: IsNumeric_TGa ("+")
Error: isNumeric_Black ("   
    
    
 +.0 ")
Error: isNumeric_Black ("    +.0")

GRACIAS POR LEER!!!

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 15 Agosto 2011, 18:07 pm
@79137913
mi función actualizada tampoco da errores!!, han hecho pruebas con la primera que hize... mas abajo deje la otra, voy a editar la primera por si acaso.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 15 Agosto 2011, 20:29 pm
@Tenient101

Anteriormente si daba errores... nunca proble la actualizada hasta ahora ya que no la habia visto.

Código
  1.  
  2. msgbox isnumeric("&H221231321") & vbnewline & Is_NumberT("") & vbnewline & Is_NumberT2("&H221231321")
  3. msgbox isnumeric("99999999999999999999999999999999999999") & vbnewline & Is_NumberT("99999999999999999999999999999999999999") & vbnewline & Is_NumberT2("99999999999999999999999999999999999999")
  4.  
  5. Public Function Is_NumberT(ByVal str As String) As Boolean
  6. On Error GoTo err
  7. Dim L As Long
  8. L = str + 1
  9. Is_NumberT = True
  10. Exit Function
  11. err:
  12. End Function
  13.  
  14. Public Function Is_NumberT2(ByRef Str As String) As Boolean
  15. On Error GoTo err
  16.         Str = Str + 0
  17.         Is_NumberT2 = True
  18.         Exit Function
  19. err:
  20. End Function
  21.  
  22.  



Carajo error mio con la correcion que hiciste errores asi... aun que creo que usaste una funcion mia anterior a la 3.0, ya que la ultima no da errores.

Aumente la tabla de strings a probar.

Código:

Error: IsNumeric_LeandroA("10.45e.10")
Error: IsNumeric_TGa ("1.112.45")
Error: IsNumeric_r338v3("1.112.45")
Error: IsNumeric_LeandroA("1.112.45")
Error: IsNumeric_LeandroA("1.224e+-10.12")
Error: IsNumeric_LeandroA("45.01anonymouse")
Error: IsNumeric_TGa ("1..3")
Error: IsNumeric_r338v3("1..3")
Error: IsNumeric_LeandroA("1..3")
Error: IsNumeric_TGa ("1E+52")
Error: IsNumeric_LeandroA("3
0")
Error: IsNumeric_LeandroA("3000
0")
Error: IsNumeric_TGa ("1E+45")
Error: IsNumeric_TGa ("1E+45")
Error: IsNumeric_LeandroA("+1. .2")
Error: IsNumeric_TGa ("+")


Aqui dejo el codigo que utilice quizas algo se me paso.

Código:

Option Explicit
 
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
Private Declare Function WaitMessage Lib "user32" () As Long
  
Enum eTime
     Horas = 3600
     Minutos = 60
     Segundos = 1
End Enum
  
Public Sub Wait(ByVal vToWait&, Optional ByVal ThisWait As eTime = Segundos, Optional ByVal UseAllProc As Boolean = False)
Dim vDateE      As Date
     vDateE = DateAdd("s", vToWait& * (ThisWait + 0), Time)
     Do While vDateE > Time
         Call WaitMessage
         If Not UseAllProc Then DoEvents
     Loop
End Sub

Private Sub Form_Click()

Dim i                   As Long
Dim bRes                As Boolean
Dim spli()              As String
    Show
    '   //  Test Fiabilidad.
    spli = Split("44,0,4,3|44,.0144,0|44.,0,0,0,0,0,0,0,1|1d-12|10.45e.10|1.112.45|1.224e+-10.12" & _
                "||45.01anonymouse|usuarios elhacker 45.1| 45.01 " & Chr(0) & "anonymouse" & _
                "|1..3|" & Chr(0) & Chr(0) & Chr(0) & "0.0" & _
                "|&H221231321| &H2212313215646546546546516516512|9999999999999999999999999999999999999999999999999999| 0. 0|3" & Chr(10) & "0|3000" & Chr(10) & "0|    &H1000000000|  s  &H1000000000" & _
                "|  +.  &H1000000000|  +. &H1000000000|  +.a &H1000000000|  +.a &H100000000v|  +.a &H1000000  00v" & _
                "|&H1000000  00v|&H1000000  00|+1.0e45|+e1. .2|+0e+11|.+0e+11|+1.0d45|+d1. .2|+0d+11|.+0d+11|" & _
                "|+1. .2|0|+0.|+.  0|+|+  0|" & Chr(10) & "-0|." & vbTab & " .+0|.0" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0" & _
                "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0 " & _
                "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0 " & _
                "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0 " & _
                "|" & vbTab & Space(10) & vbNewLine & " +-+-.+.0|" & vbTab & " +.0", "|")
    
    '   //  Test de tiempos...
    For i = 0 To UBound(spli)
        bRes = IsNumeric(spli(i))
        If Not (bRes = isNumeric_Black(spli(i))) Then
            Debug.Print "Error: isNumeric_Black (""" & spli(i) & """)"
        End If
        If Not (bRes = Is_NumberT(spli(i))) Then
            Debug.Print "Error: Is_NumberT (""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_TGa(spli(i))) Then
            Debug.Print "Error: IsNumeric_TGa (""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_r338v3(spli(i))) Then
            Debug.Print "Error: IsNumeric_r338v3(""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_LeandroA(spli(i))) Then
            Debug.Print "Error: IsNumeric_LeandroA(""" & spli(i) & """)"
        End If
        
        If Not (bRes = IsNumeric_7913(spli(i))) Then
            Debug.Print "Error: IsNumeric_7913(""" & spli(i) & """)"
        End If
    Next
    SetFocus
End Sub

Public Function isNumeric_Black(ByRef sString As String) As Boolean
'   //  Version 3.0
Dim lPos    As Long     '   //  For Next
Dim lLn     As Long     '   //  Longitud de sString
Dim lData   As Long     '   //  Caracter, Switcher, Contador (QWord)

Const PUNTO_DECIMAL As Long = &H10000
Const SIGNO_SRC     As Long = &H20000
Const NUMBER_HEX    As Long = &H40000
Const NUMBER_OK     As Long = &H80000
Const NUMBER_POW    As Long = &H100000
Const NUMBER_POWF   As Long = &H200000
Const NUMBER_POWC   As Long = &H300000
Const NUMBER_FINISH As Long = &H400000
 
    lLn = Len(sString)
    If (lLn = &H0) Then Exit Function
    lLn = ((lLn + lLn) - &H1)
 
    For lPos = &H0 To lLn Step &H2
 
        RtlMoveMemory VarPtr(lData) + &H3, StrPtr(sString) + lPos, &H1
 
        If ((lData And NUMBER_HEX) = NUMBER_HEX) Then
            If (((lData And &HFF000000) >= &H30000000) And ((lData And &HFF000000) <= &H39000000)) Or _
               (((lData And &HFF000000) >= &H61000000) And ((lData And &HFF000000) <= &H66000000)) Or _
               (((lData And &HFF000000) >= &H41000000) And ((lData And &HFF000000) <= &H46000000)) Then   '   //  Numeros Hexadecimales
                lData = (lData Or NUMBER_OK)
                If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                lData = (lData + &H1)
                If ((lData And &HFF) > &H10) Then Exit Function   '   //  QWord (Max Double)
                
            Else
                Select Case (lData And &HFF000000)
                    Case &H9000000, &HA000000, &HB000000, &HC000000, &HD000000, &H24000000, &H20000000, &HA0000000 '   //   Espacios en Blanco
                       If ((lData And NUMBER_OK) = NUMBER_OK) Then lData = (lData Or NUMBER_FINISH)
                    Case Else
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                End Select
            End If
        Else
            If ((lData And &HFF000000) >= &H30000000) And ((lData And &HFF000000) <= &H39000000) Then
                lData = (lData Or NUMBER_OK)
                If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                If ((lData And NUMBER_POWC) = NUMBER_POW) Then lData = (lData Or NUMBER_POWF)
 
            Else
                Select Case (lData And &HFF000000)
                    Case &H0 '   //  NULL Indica que se termina la cadena.
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
                        Exit For
 
                    Case &H2E000000 '   //  "."  Solo 1
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
                         If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                         If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                         lData = (lData Or PUNTO_DECIMAL)
 
                    Case &H2B000000, &H2D000000 '   //  "+|-" Solo 1
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then
                            lData = (lData Or NUMBER_POWF)
                        Else
                            If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                            If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                            If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
                        End If
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        lData = (lData Or SIGNO_SRC)
 
                    Case &H2C000000
                        If Not ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
 
                    Case &H9000000, &HA000000, &HB000000, &HC000000, &HD000000, &H24000000   '   //  Solo se permiten al inicio de un Numero (Espacios en Blanco).
                        If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
 
                    Case &HA0000000, &H20000000 '   //  Se permiten al Inicio/final de un numero.
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then
                            lData = (lData Or NUMBER_FINISH)
                        Else
                            If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                            If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
                        End If
 
                    Case &H26000000 '   //  Es un Numero Hexadecimal
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                        If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
                        If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
 
                        RtlMoveMemory VarPtr(lData) + &H3, StrPtr(sString) + (lPos + &H2), &H1
                        If ((lData And &HFF000000) = &H48000000) Or ((lData And &HFF000000) = &H68000000) Then lData = (lData Or NUMBER_HEX): lPos = lPos + &H2
 
                    Case &H44000000, &H45000000, &H64000000, &H65000000 ' //  Numeros en Formato ###e-###, ###e+###
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        If ((lData And NUMBER_POW) = NUMBER_POW) Then Exit Function
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then
                            lData = (lData Or NUMBER_POW)
                            If ((lData And SIGNO_SRC) = SIGNO_SRC) Then lData = (lData Xor SIGNO_SRC)    '   //  Permitimos nuevamente los signos "+" y "-".
                        Else
                            Exit Function
                        End If
 
                    Case Else
                        Exit Function
 
                End Select
            End If
        End If
    Next
    If ((lData And NUMBER_OK) = NUMBER_OK) Then isNumeric_Black = True    '   // Finalizacion.
End Function

Public Function Is_NumberT(ByRef str As String) As Boolean
On Error GoTo err
    str = str + 0
    Is_NumberT = True
    Exit Function
err:
End Function

Private Function IsNumeric_TGa(str As String) As Boolean
    Dim sAux As String
    Dim lPos As Long, lCont As Long, lAsc As Long
    lPos = 1
 
    Do While lPos <= Len(str)
        IsNumeric_TGa = True
        sAux = Mid$(str, lPos, 1)
        lAsc = Asc(sAux)
        If (lAsc >= 48 And lAsc <= 57) Or (lAsc >= 43 And lAsc <= 46) Then
            If lAsc = 44 Then
                lCont = lCont + 1
                If lCont > 1 Then
                    IsNumeric_TGa = False
                    Exit Function
                End If
            End If
        Else
            IsNumeric_TGa = False
            Exit Function
        End If
        lPos = lPos + 1
    Loop
End Function

Private Function IsNumeric_r338v3(ByVal str As String) As Boolean
    Const vbSpace As String = " "
    Dim cReg As Object
    Set cReg = CreateObject("VBScript.RegExp")
    str = Replace$(str, vbCr, vbSpace)
    str = Replace$(str, vbLf, vbSpace)
    str = Replace$(str, vbTab, vbNullString)
    str = Trim$(str)
    If str = vbNullString Or str = "+" Or str = "-" Then Exit Function
    With cReg
        ' Hexadecimal y Notacion cientifica
        .Pattern = "^(?:&H[\dA-F]{1,16}|[+\-]?\d(?:\.\d+)?[de][+\-]?\d+)$"
        .Global = True
        .IgnoreCase = True
    End With
    IsNumeric_r338v3 = cReg.Test(str)
    If Not IsNumeric_r338v3 Then
        ' Testeamos con . como separador de miles y , como separador de decimales
        ' Personalmente seria para mi "^[+\-]?(?:\d{1,3}(?:\.\d{3})*|\d*)\,?\d*$"
        ' ya que 133.23.330 no es un numero aunque IsNumeric diga que si ¬¬
        cReg.Pattern = "^[+\-]?\s*(?:\d{1,3}(?:\.\d{1,3})*|\d*)\,?\d*$"
        IsNumeric_r338v3 = cReg.Test(str)
        If Not IsNumeric_r338v3 Then
            str = Replace$(str, "..", vbNullString)
            ' Testeamos con , como separador de miles y . como separador de decimales
            cReg.Pattern = "^[+\-]?\s*(?:\d{1,3}(?:\,\d{3})*|\d+)\.?\d*$"
            IsNumeric_r338v3 = cReg.Test(str)
        End If
    End If
    Set cReg = Nothing
End Function

Private Function IsNumeric_LeandroA(expression) As Boolean
    Select Case VarType(expression)
        Case vbBoolean, vbByte, vbInteger, vbLong, vbCurrency, vbDecimal, vbDouble, vbNull, vbEmpty, vbError
            IsNumeric_LeandroA = True
        Case vbArray, vbDataObject, vbDate, vbObject, vbUserDefinedType
            IsNumeric_LeandroA = False
        Case vbString
            If Val(expression) <> 0 Then
                IsNumeric_LeandroA = True
            Else
                On Error Resume Next
                IsNumeric_LeandroA = Abs(expression) + 1
            End If
    End Select
End Function

Private Function IsNumeric_7913(str As String) As Boolean
Dim x As Double
On Error GoTo Nonum
    x = str
    IsNumeric_7913 = True
Nonum:
End Function


Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 15 Agosto 2011, 21:53 pm
.
Dejo la version 4.0...

Codigo Obsoleto...

Código:

Option Explicit

Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)

Public Function isNumeric_Black(ByRef sString As String) As Boolean
'   //  Version 4.0
Dim lPos    As Long     '   //  For Next.
Dim lLn     As Long     '   //  Longitud de sString.
Dim lData   As Long     '   //  Xor, Switcher, Contador (QWord).
Dim lChar   As Long     '   //  2 Caracteres.

Dim pChar   As Long     '   //  Puntero a lChar
Dim pString As Long     '   //  Puntero al parametro de funcion {sString}

Const PUNTO_DECIMAL As Long = &H10000
Const SIGNO_SRC     As Long = &H20000
Const NUMBER_HEX    As Long = &H40000
Const NUMBER_OK     As Long = &H80000
Const NUMBER_POW    As Long = &H100000
Const NUMBER_POWF   As Long = &H200000
Const NUMBER_POWC   As Long = &H300000
Const NUMBER_FINISH As Long = &H400000
 
    lLn = Len(sString)
    If (lLn = &H0) Then Exit Function
    lLn = ((lLn + lLn) - &H1)
    pChar = VarPtr(lChar)
    pString = StrPtr(sString)
    
    For lPos = &H0 To lLn Step &H2
 
        If ((lData And &HFF000000) = &HFF000000) Then
            lChar = ((lChar And &HFF0000) \ &H10000)    '   lchar = ((lchar & 0xff0000) >> 0x10000); // Lastima con la divicion se alentisa la funcion...
        Else
            RtlMoveMemory pChar, pString, &H4  ' // alentisa la funcion....
            pString = (pString + &H4)
        End If
        
        lData = (lData Xor &HFF000000)
 
        If ((lData And NUMBER_HEX) = NUMBER_HEX) Then
            If (((lChar And &HFF) >= &H30) And ((lChar And &HFF) <= &H39)) Or _
               (((lChar And &HFF) >= &H61) And ((lChar And &HFF) <= &H66)) Or _
               (((lChar And &HFF) >= &H41) And ((lChar And &HFF) <= &H46)) Then   '   //  Numeros Hexadecimales
                lData = (lData Or NUMBER_OK)
                If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                lData = (lData + &H1)
                If ((lData And &HFF) = &H11) Then Exit Function   '   //  QWord (Max Double)
                
            Else
                Select Case (lChar And &HFF)
                    Case &H9, &HA, &HB, &HC, &HD, &H24, &H20, &HA0 '   //   Espacios en Blanco
                       If ((lData And NUMBER_OK) = NUMBER_OK) Then lData = (lData Or NUMBER_FINISH)
                    Case Else
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                End Select
            End If
        Else
            If ((lChar And &HFF) >= &H30) And ((lChar And &HFF) <= &H39) Then
                lData = (lData Or NUMBER_OK)
                If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                If ((lData And NUMBER_POWC) = NUMBER_POW) Then lData = (lData Or NUMBER_POWF)
                
            Else
                Select Case (lChar And &HFF)
                    Case &H0 '   //  NULL Indica que se termina la cadena.
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
                        Exit For
 
                    Case &H2E '   //  "."  Solo 1
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
                         If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                         If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                         lData = (lData Or PUNTO_DECIMAL)
 
                    Case &H2B, &H2D '   //  "+|-" Solo 1
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then
                            lData = (lData Or NUMBER_POWF)
                        Else
                            If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                            If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                            If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
                        End If
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        lData = (lData Or SIGNO_SRC)
 
                    Case &H2C
                        If Not ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
 
                    Case &H9, &HA, &HB, &HC, &HD, &H24   '   //  Solo se permiten al inicio de un Numero (Espacios en Blanco).
                        If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
 
                    Case &HA0, &H20 '   //  Se permiten al Inicio/final de un numero.
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then
                            lData = (lData Or NUMBER_FINISH)
                        Else
                            If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                            If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
                        End If
 
                    Case &H26 '   //  Es un Numero Hexadecimal
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then Exit Function
                        If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
                        If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                        If ((lData And NUMBER_POWC) = NUMBER_POW) Then Exit Function
 
                        
                        If ((lData And &HFF000000) = &HFF000000) Then
                            lChar = (lChar And &HFF0000) \ &H10000
                        Else
                            RtlMoveMemory pChar, (pString + &H4), &H4   ' // alentisa la funcion....
                        End If
                        
                        If ((lChar And &HFF) = &H48) Or ((lChar And &HFF) = &H68) Then
                            lData = (lData Or NUMBER_HEX)
                            lPos = (lPos + &H2)
                            pString = (pString + &H4)
                            lData = (lData Xor &HFF000000)
                        End If
 
                    Case &H44, &H45, &H64, &H65 ' //  Numeros en Formato ###e-###, ###e+###
                        If ((lData And NUMBER_FINISH) = NUMBER_FINISH) Then Exit Function
                        If ((lData And NUMBER_POW) = NUMBER_POW) Then Exit Function
                        If ((lData And NUMBER_OK) = NUMBER_OK) Then
                            lData = (lData Or NUMBER_POW)
                            If ((lData And SIGNO_SRC) = SIGNO_SRC) Then lData = (lData Xor SIGNO_SRC)    '   //  Permitimos nuevamente los signos "+" y "-".
                        Else
                            Exit Function
                        End If
 
                    Case Else
                        Exit Function
 
                End Select
            End If
        End If
    Next
    If ((lData And NUMBER_OK) = NUMBER_OK) Then isNumeric_Black = True    '   // Finalizacion.
End Function


Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 15 Agosto 2011, 23:12 pm
Citar
Error: isNumeric_Black("5,6,.6 ")
Error: LeandroA("5,6,.6 ")
Error: isNumeric_Black(" ,7.88")
Error: IsNumeric_r338v3(" ,7.88")
Error: isNumeric_Black(" .56788")
Error: LeandroA(" .56788")


Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 15 Agosto 2011, 23:33 pm
@Tenient101
Podrias dejar tus Test aqui pegados (Codigos de prueba), a mi en esos strings no me marca errores (3.0 en adelante).

Edito:
Verison en C
http://foro.elhacker.net/programacion_cc/cisnumeric_vb6_a_c-t336564.0.html

Pongo la version 4.1
 Fix para el numero Hexadecimal &H00000000000000000000000000000000000000000000000000000000000000000000000 y similares.

Código
  1.  
  2. Option Explicit
  3.  
  4. Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
  5.  
  6. Public Function isNumeric_Black(ByRef sString As String) As Boolean
  7. '   //  Version 4.1
  8. Dim lPos    As Long     '   //  For Next.
  9. Dim lLn     As Long     '   //  Longitud de sString.
  10. Dim lData   As Long     '   //  Xor, Switcher, Contador (QWord).
  11. Dim lChar   As Long     '   //  2 Caracteres.
  12.  
  13. Dim pChar   As Long     '   //  Puntero a lChar
  14. Dim pString As Long     '   //  Puntero al parametro de funcion {sString}
  15.  
  16. Const PUNTO_DECIMAL     As Long = &H10000
  17. Const SIGNO_SRC         As Long = &H20000
  18. Const NUMBER_HEX        As Long = &H40000
  19. Const NUMBER_HEX_ZERO   As Long = &H80000
  20. Const NUMBER_HEX_FLAGS  As Long = NUMBER_HEX Or NUMBER_HEX_ZERO
  21. Const NUMBER_POW        As Long = &H100000
  22. Const NUMBER_POW_FINISH As Long = &H200000
  23. Const NUMBER_POW_FLAGS  As Long = NUMBER_POW Or NUMBER_POW_FINISH
  24. Const NUMBER_OF_OK      As Long = &H400000
  25. Const NUMBER_OF_FINISH  As Long = &H800000
  26. Const NUMBER_OF_FLAGS   As Long = NUMBER_OF_OK Or NUMBER_OF_FINISH
  27.  
  28.  
  29.     lLn = Len(sString)
  30.     If (lLn = &H0) Then Exit Function
  31.     lLn = ((lLn + lLn) - &H1)
  32.     pChar = VarPtr(lChar)
  33.     pString = StrPtr(sString)
  34.  
  35.     For lPos = &H0 To lLn Step &H2
  36.  
  37.         If ((lData And &HFF000000) = &HFF000000) Then
  38.             lChar = ((lChar And &HFF0000) \ &H10000)    '   lchar = ((lchar & 0xff0000) >> 0x10000); // Lastima con la divicion se alentisa la funcion...
  39.         Else
  40.             RtlMoveMemory pChar, pString, &H4  ' // alentisa la funcion....
  41.             pString = (pString + &H4)
  42.         End If
  43.  
  44.         lData = (lData Xor &HFF000000)
  45.  
  46.  
  47.             '   //  Ceros a la izquierda
  48.         If ((lData And NUMBER_HEX) = NUMBER_HEX) Then
  49.             If (((lChar And &HFF) >= &H30) And ((lChar And &HFF) <= &H39)) Or _
  50.                (((lChar And &HFF) >= &H61) And ((lChar And &HFF) <= &H66)) Or _
  51.                (((lChar And &HFF) >= &H41) And ((lChar And &HFF) <= &H46)) Then   '   //  Numeros Hexadecimales
  52.                 If ((lData And NUMBER_OF_FLAGS) = &H0) Then
  53.                     If ((lChar And &HFF) = &H30) Then
  54.                         lData = (lData Or NUMBER_HEX_ZERO)
  55.                     Else
  56.                         lData = (lData Or NUMBER_OF_OK)
  57.                     End If
  58.                 End If
  59.                 Select Case (lData And NUMBER_OF_FLAGS)
  60.                     Case NUMBER_OF_OK
  61.                         lData = (lData + &H1)
  62.                         If ((lData And &HFF) = &H11) Then Exit Function   '   //  QWord (Max Double)
  63.                         lData = (lData Or NUMBER_OF_OK)
  64.                         If ((lData Or NUMBER_HEX_FLAGS) = NUMBER_HEX_FLAGS) Then lData = (lData Xor NUMBER_HEX_ZERO)
  65.                     Case NUMBER_OF_FINISH, NUMBER_OF_FLAGS
  66.                         Exit Function
  67.                 End Select
  68.             Else
  69.                 Select Case (lChar And &HFF)
  70.                     Case &H9, &HA, &HB, &HC, &HD, &H24, &H20, &HA0 '   //   Espacios en Blanco
  71.                         If ((lData Or NUMBER_HEX_FLAGS) = NUMBER_HEX_FLAGS) Then lData = ((lData Xor NUMBER_HEX_ZERO) Or NUMBER_OF_OK)
  72.                         If ((lData And NUMBER_OF_FLAGS) = NUMBER_OF_OK) Then lData = (lData Or NUMBER_OF_FINISH)
  73.  
  74.                     Case &H0 '   //  NULL Indica que se termina la cadena.
  75.                         If ((lData And NUMBER_OF_FLAGS) = NUMBER_OF_FINISH) Then Exit Function
  76.                         Exit For
  77.  
  78.                     Case Else
  79.                         Exit Function
  80.  
  81.                 End Select
  82.             End If
  83.         Else
  84.             If ((lChar And &HFF) >= &H30) And ((lChar And &HFF) <= &H39) Then
  85.                 lData = (lData Or NUMBER_OF_OK)
  86.                 If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
  87.                 If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then lData = (lData Or NUMBER_POW_FINISH)
  88.  
  89.             Else
  90.                 Select Case (lChar And &HFF)
  91.                     Case &H0 '   //  NULL Indica que se termina la cadena.
  92.                         If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
  93.                         Exit For
  94.  
  95.                     Case &H2E '   //  "."  Solo 1
  96.                         If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
  97.                          If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
  98.                          If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  99.                          lData = (lData Or PUNTO_DECIMAL)
  100.  
  101.                     Case &H2B, &H2D '   //  "+|-" Solo 1
  102.                         If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then
  103.                             lData = (lData Or NUMBER_POW_FINISH)
  104.                         Else
  105.                             If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then Exit Function
  106.                             If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  107.                             If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
  108.                         End If
  109.                         If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
  110.                         lData = (lData Or SIGNO_SRC)
  111.  
  112.                     Case &H2C
  113.                         If Not ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then Exit Function
  114.                         If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
  115.  
  116.                     Case &H9, &HA, &HB, &HC, &HD, &H24   '   //  Solo se permiten al inicio de un Numero (Espacios en Blanco).
  117.                         If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  118.                         If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
  119.                         If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then Exit Function
  120.                         If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
  121.  
  122.                     Case &HA0, &H20 '   //  Se permiten al Inicio/final de un numero.
  123.                         If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then
  124.                             lData = (lData Or NUMBER_OF_FINISH)
  125.                         Else
  126.                             If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  127.                             If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
  128.                         End If
  129.  
  130.                     Case &H26 '   //  Es un Numero Hexadecimal
  131.                         If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
  132.                         If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then Exit Function
  133.                         If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
  134.                         If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
  135.                         If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
  136.  
  137.  
  138.                         If ((lData And &HFF000000) = &HFF000000) Then
  139.                             lChar = (lChar And &HFF0000) \ &H10000
  140.                         Else
  141.                             RtlMoveMemory pChar, (pString + &H4), &H4   ' // alentisa la funcion....
  142.                         End If
  143.  
  144.                         If ((lChar And &HFF) = &H48) Or ((lChar And &HFF) = &H68) Then
  145.                             lData = (lData Or NUMBER_HEX)
  146.                             lPos = (lPos + &H2)
  147.                             'pString = (pString + &H4)
  148.                             lData = (lData Xor &HFF000000)
  149.                         End If
  150.  
  151.                     Case &H44, &H45, &H64, &H65 ' //  Numeros en Formato ###e-###, ###e+###
  152.                         If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
  153.                         If ((lData And NUMBER_POW) = NUMBER_POW) Then Exit Function
  154.                         If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then
  155.                             lData = (lData Or NUMBER_POW)
  156.                             If ((lData And SIGNO_SRC) = SIGNO_SRC) Then lData = (lData Xor SIGNO_SRC)    '   //  Permitimos nuevamente los signos "+" y "-".
  157.                         Else
  158.                             Exit Function
  159.                         End If
  160.  
  161.                     Case Else
  162.                         Exit Function
  163.  
  164.                 End Select
  165.             End If
  166.         End If
  167.     Next
  168.     Select Case (lData And NUMBER_OF_FLAGS)
  169.         Case NUMBER_OF_OK, NUMBER_OF_FLAGS: isNumeric_Black = True
  170.         Case Else
  171.             Select Case (lData And NUMBER_HEX_FLAGS)
  172.                 Case NUMBER_HEX_FLAGS: isNumeric_Black = True
  173.             End Select
  174.     End Select
  175. End Function
  176.  
  177.  

String con las que se probo:

Código:

Option Explicit
 
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
Private Declare Function WaitMessage Lib "user32" () As Long
  
Enum eTime
     Horas = 3600
     Minutos = 60
     Segundos = 1
End Enum
  
Public Sub Wait(ByVal vToWait&, Optional ByVal ThisWait As eTime = Segundos, Optional ByVal UseAllProc As Boolean = False)
Dim vDateE      As Date
     vDateE = DateAdd("s", vToWait& * (ThisWait + 0), Time)
     Do While vDateE > Time
         Call WaitMessage
         If Not UseAllProc Then DoEvents
     Loop
End Sub

Private Sub Form_Click()
Dim laux0               As Long
Dim i                   As Long
Dim bRes                As Boolean
Dim spli()              As String
Dim ctmr                As CTiming

    Show
    Call Wait(1, Segundos, False)
    Set ctmr = New CTiming

   '   //  Test Fiabilidad.
    spli = Split("&H999999999999999999" & Chr(0) & "999999999999999999999999999|&H00000000000000000000" & Chr(0) & "000000000000000000000000000000000000" & _
                "|5,6,.6 |,7.88| .56788|&H9999999999999999999999999999999999999999999999999|&H00000000000000000000000000000000000000000000000000000000000" & _
                "|45,0,4,3|44,.0144,0|44.,0,0,0,0,0,0,0,1|1d-12|10.45e.10|1.112.45|1.224e+-10.12" & _
                "||45.01anonymouse|usuarios elhacker 45.1| 45.01 " & Chr(0) & "anonymouse" & _
                "|1..3|" & Chr(0) & Chr(0) & Chr(0) & "0.0" & _
                "|&H221231321| &H2212313215646546546546516516512|9999999999999999999999999999999999999999999999999999| 0. 0|3" & Chr(10) & "0|3000" & Chr(10) & "0|    &H1000000000|  s  &H1000000000" & _
                "|  +.  &H1000000000|  +. &H1000000000|  +.a &H1000000000|  +.a &H100000000v|  +.a &H1000000  00v" & _
                "|&H1000000  00v|&H1000000  00|+1.0e45|+e1. .2|+0e+11|.+0e+11|+1.0d45|+d1. .2|+0d+11|.+0d+11|" & _
                "|+1. .2|0|+0.|+.  0|+|+  0|" & Chr(10) & "-0|." & vbTab & " .+0|.0" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0" & _
                "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0 " & _
                "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0 " & _
                "|" & vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0 " & _
                "|" & vbTab & Space(10) & vbNewLine & " +-+-.+.0|" & vbTab & " +.0", "|")
    
    '   //  Test de Fiabilidad...
    For i = 0 To UBound(spli)
        bRes = IsNumeric(spli(i))
        If Not (bRes = isNumeric_Black(spli(i))) Then
            Debug.Print "Error: isNumeric_Black (""" & spli(i) & """)"
        End If
        If Not (bRes = Is_NumberT(spli(i))) Then
            Debug.Print "Error: Is_NumberT (""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_TGa(spli(i))) Then
            Debug.Print "Error: IsNumeric_TGa (""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_r338v3(spli(i))) Then
            Debug.Print "Error: IsNumeric_r338v3(""" & spli(i) & """)"
        End If
        If Not (bRes = IsNumeric_LeandroA(spli(i))) Then
            Debug.Print "Error: IsNumeric_LeandroA(""" & spli(i) & """)"
        End If
        
        If Not (bRes = IsNumeric_7913(spli(i))) Then
            Debug.Print "Error: IsNumeric_7913(""" & spli(i) & """)"
        End If
    Next
    Me.AutoRedraw = True
    
    '   //  Test de tiempos entre usuarios junto con isNumeric().
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            IsNumeric spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            Is_NumberT spli(i)
        Next
    Next laux0
    Me.Print "Is_NumberT()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            isNumeric_Black spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric_Black()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            IsNumeric_TGa spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric_TGa()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To 1000
        For i = 0 To UBound(spli)
            IsNumeric_7913 spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric_7913()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    ctmr.Reset
    For laux0 = 1 To (1000 / 10) '   // Divio entre 10 por que es mas lenta...
        For i = 0 To UBound(spli)
            IsNumeric_r338v3 spli(i)
        Next
    Next laux0
    Me.Print "IsNumeric_r338v3()", ctmr.sElapsed
    Call Wait(1, Segundos, False)
    
    
    Me.Print "Finalizado"
    Set ctmr = Nothing
    Show
    SetFocus
    
End Sub

Public Function isNumeric_Black(ByRef sString As String) As Boolean
'   //  Version 5.0
Dim lPos    As Long     '   //  For Next.
Dim lLn     As Long     '   //  Longitud de sString.
Dim lData   As Long     '   //  Xor, Switcher, Contador (QWord).
Dim lChar   As Long     '   //  2 Caracteres.

Dim pChar   As Long     '   //  Puntero a lChar
Dim pString As Long     '   //  Puntero al parametro de funcion {sString}

Const PUNTO_DECIMAL     As Long = &H10000
Const SIGNO_SRC         As Long = &H20000
Const NUMBER_HEX        As Long = &H40000
Const NUMBER_HEX_ZERO   As Long = &H80000
Const NUMBER_HEX_FLAGS  As Long = NUMBER_HEX Or NUMBER_HEX_ZERO
Const NUMBER_POW        As Long = &H100000
Const NUMBER_POW_FINISH As Long = &H200000
Const NUMBER_POW_FLAGS  As Long = NUMBER_POW Or NUMBER_POW_FINISH
Const NUMBER_OF_OK      As Long = &H400000
Const NUMBER_OF_FINISH  As Long = &H800000
Const NUMBER_OF_FLAGS   As Long = NUMBER_OF_OK Or NUMBER_OF_FINISH

 
    lLn = Len(sString)
    If (lLn = &H0) Then Exit Function
    lLn = ((lLn + lLn) - &H1)
    pChar = VarPtr(lChar)
    pString = StrPtr(sString)
 
    For lPos = &H0 To lLn Step &H2
 
        If ((lData And &HFF000000) = &HFF000000) Then
            lChar = ((lChar And &HFF0000) \ &H10000)    '   lchar = ((lchar & 0xff0000) >> 0x10000); // Lastima con la divicion se alentisa la funcion...
        Else
            RtlMoveMemory pChar, pString, &H4  ' // alentisa la funcion....
            pString = (pString + &H4)
        End If
 
        lData = (lData Xor &HFF000000)
 
        
            '   //  Ceros a la izquierda
        If ((lData And NUMBER_HEX) = NUMBER_HEX) Then
            If (((lChar And &HFF) >= &H30) And ((lChar And &HFF) <= &H39)) Or _
               (((lChar And &HFF) >= &H61) And ((lChar And &HFF) <= &H66)) Or _
               (((lChar And &HFF) >= &H41) And ((lChar And &HFF) <= &H46)) Then   '   //  Numeros Hexadecimales
                If ((lData And NUMBER_OF_FLAGS) = &H0) Then
                    If ((lChar And &HFF) = &H30) Then
                        lData = (lData Or NUMBER_HEX_ZERO)
                    Else
                        lData = (lData Or NUMBER_OF_OK)
                    End If
                End If
                Select Case (lData And NUMBER_OF_FLAGS)
                    Case NUMBER_OF_OK
                        lData = (lData + &H1)
                        If ((lData And &HFF) = &H11) Then Exit Function   '   //  QWord (Max Double)
                        lData = (lData Or NUMBER_OF_OK)
                        If ((lData Or NUMBER_HEX_FLAGS) = NUMBER_HEX_FLAGS) Then lData = (lData Xor NUMBER_HEX_ZERO)
                    Case NUMBER_OF_FINISH, NUMBER_OF_FLAGS
                        Exit Function
                End Select
            Else
                Select Case (lChar And &HFF)
                    Case &H9, &HA, &HB, &HC, &HD, &H24, &H20, &HA0 '   //   Espacios en Blanco
                        If ((lData Or NUMBER_HEX_FLAGS) = NUMBER_HEX_FLAGS) Then lData = ((lData Xor NUMBER_HEX_ZERO) Or NUMBER_OF_OK)
                        If ((lData And NUMBER_OF_FLAGS) = NUMBER_OF_OK) Then lData = (lData Or NUMBER_OF_FINISH)
                        
                    Case &H0 '   //  NULL Indica que se termina la cadena.
                        If ((lData And NUMBER_OF_FLAGS) = NUMBER_OF_FINISH) Then Exit Function
                        Exit For
                        
                    Case Else
                        Exit Function
                        
                End Select
            End If
        Else
            If ((lChar And &HFF) >= &H30) And ((lChar And &HFF) <= &H39) Then
                lData = (lData Or NUMBER_OF_OK)
                If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
                If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then lData = (lData Or NUMBER_POW_FINISH)
 
            Else
                Select Case (lChar And &HFF)
                    Case &H0 '   //  NULL Indica que se termina la cadena.
                        If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
                        Exit For
 
                    Case &H2E '   //  "."  Solo 1
                        If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
                         If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
                         If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                         lData = (lData Or PUNTO_DECIMAL)
 
                    Case &H2B, &H2D '   //  "+|-" Solo 1
                        If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then
                            lData = (lData Or NUMBER_POW_FINISH)
                        Else
                            If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then Exit Function
                            If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                            If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
                        End If
                        If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
                        lData = (lData Or SIGNO_SRC)
 
                    Case &H2C
                        If Not ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then Exit Function
                        If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
 
                    Case &H9, &HA, &HB, &HC, &HD, &H24   '   //  Solo se permiten al inicio de un Numero (Espacios en Blanco).
                        If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                        If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
                        If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then Exit Function
                        If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
 
                    Case &HA0, &H20 '   //  Se permiten al Inicio/final de un numero.
                        If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then
                            lData = (lData Or NUMBER_OF_FINISH)
                        Else
                            If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                            If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
                        End If
 
                    Case &H26 '   //  Es un Numero Hexadecimal
                        If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
                        If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then Exit Function
                        If ((lData And SIGNO_SRC) = SIGNO_SRC) Then Exit Function
                        If ((lData And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                        If ((lData And NUMBER_POW_FLAGS) = NUMBER_POW) Then Exit Function
 
 
                        If ((lData And &HFF000000) = &HFF000000) Then
                            lChar = (lChar And &HFF0000) \ &H10000
                        Else
                            RtlMoveMemory pChar, (pString + &H4), &H4   ' // alentisa la funcion....
                        End If
 
                        If ((lChar And &HFF) = &H48) Or ((lChar And &HFF) = &H68) Then
                            lData = (lData Or NUMBER_HEX)
                            lPos = (lPos + &H2)
                            'pString = (pString + &H4)
                            lData = (lData Xor &HFF000000)
                        End If
 
                    Case &H44, &H45, &H64, &H65 ' //  Numeros en Formato ###e-###, ###e+###
                        If ((lData And NUMBER_OF_FINISH) = NUMBER_OF_FINISH) Then Exit Function
                        If ((lData And NUMBER_POW) = NUMBER_POW) Then Exit Function
                        If ((lData And NUMBER_OF_OK) = NUMBER_OF_OK) Then
                            lData = (lData Or NUMBER_POW)
                            If ((lData And SIGNO_SRC) = SIGNO_SRC) Then lData = (lData Xor SIGNO_SRC)    '   //  Permitimos nuevamente los signos "+" y "-".
                        Else
                            Exit Function
                        End If
 
                    Case Else
                        Exit Function
 
                End Select
            End If
        End If
    Next
    Select Case (lData And NUMBER_OF_FLAGS)
        Case NUMBER_OF_OK, NUMBER_OF_FLAGS: isNumeric_Black = True
        Case Else
            Select Case (lData And NUMBER_HEX_FLAGS)
                Case NUMBER_HEX_FLAGS: isNumeric_Black = True
            End Select
    End Select
End Function

Public Function Is_NumberT(ByRef str As String) As Boolean
On Error GoTo err
    str = str + 0
    Is_NumberT = True
    Exit Function
err:
End Function

Private Function IsNumeric_TGa(str As String) As Boolean
    Dim sAux As String
    Dim lPos As Long, lCont As Long, lAsc As Long
    lPos = 1
 
    Do While lPos <= Len(str)
        IsNumeric_TGa = True
        sAux = Mid$(str, lPos, 1)
        lAsc = Asc(sAux)
        If (lAsc >= 48 And lAsc <= 57) Or (lAsc >= 43 And lAsc <= 46) Then
            If lAsc = 44 Then
                lCont = lCont + 1
                If lCont > 1 Then
                    IsNumeric_TGa = False
                    Exit Function
                End If
            End If
        Else
            IsNumeric_TGa = False
            Exit Function
        End If
        lPos = lPos + 1
    Loop
End Function

Private Function IsNumeric_r338v3(ByVal str As String) As Boolean
    Const vbSpace As String = " "
    Dim cReg As Object
    Set cReg = CreateObject("VBScript.RegExp")
    str = Replace$(str, vbCr, vbSpace)
    str = Replace$(str, vbLf, vbSpace)
    str = Replace$(str, vbTab, vbNullString)
    str = Trim$(str)
    If str = vbNullString Or str = "+" Or str = "-" Then Exit Function
    With cReg
        ' Hexadecimal y Notacion cientifica
        .Pattern = "^(?:&H[\dA-F]{1,16}|[+\-]?\d(?:\.\d+)?[de][+\-]?\d+)$"
        .Global = True
        .IgnoreCase = True
    End With
    IsNumeric_r338v3 = cReg.Test(str)
    If Not IsNumeric_r338v3 Then
        ' Testeamos con . como separador de miles y , como separador de decimales
        ' Personalmente seria para mi "^[+\-]?(?:\d{1,3}(?:\.\d{3})*|\d*)\,?\d*$"
        ' ya que 133.23.330 no es un numero aunque IsNumeric diga que si ¬¬
        cReg.Pattern = "^[+\-]?\s*(?:\d{1,3}(?:\.\d{1,3})*|\d*)\,?\d*$"
        IsNumeric_r338v3 = cReg.Test(str)
        If Not IsNumeric_r338v3 Then
            str = Replace$(str, "..", vbNullString)
            ' Testeamos con , como separador de miles y . como separador de decimales
            cReg.Pattern = "^[+\-]?\s*(?:\d{1,3}(?:\,\d{3})*|\d+)\.?\d*$"
            IsNumeric_r338v3 = cReg.Test(str)
        End If
    End If
    Set cReg = Nothing
End Function

Private Function IsNumeric_LeandroA(expression) As Boolean
    Select Case VarType(expression)
        Case vbBoolean, vbByte, vbInteger, vbLong, vbCurrency, vbDecimal, vbDouble, vbNull, vbEmpty, vbError
            IsNumeric_LeandroA = True
        Case vbArray, vbDataObject, vbDate, vbObject, vbUserDefinedType
            IsNumeric_LeandroA = False
        Case vbString
            If Val(expression) <> 0 Then
                IsNumeric_LeandroA = True
            Else
                On Error Resume Next
                IsNumeric_LeandroA = Abs(expression) + 1
            End If
    End Select
End Function

Private Function IsNumeric_7913(str As String) As Boolean
Dim x As Double
On Error GoTo Nonum
    x = str
    IsNumeric_7913 = True
Nonum:
End Function


OutPut:

Código:

Error: IsNumeric_TGa (",7.88")
Error: IsNumeric_LeandroA("10.45e.10")
Error: IsNumeric_TGa ("1.112.45")
Error: IsNumeric_r338v3("1.112.45")
Error: IsNumeric_LeandroA("1.112.45")
Error: IsNumeric_LeandroA("1.224e+-10.12")
Error: IsNumeric_LeandroA("45.01anonymouse")
Error: IsNumeric_TGa ("1..3")
Error: IsNumeric_r338v3("1..3")
Error: IsNumeric_LeandroA("1..3")
Error: IsNumeric_TGa ("1E+52")
Error: IsNumeric_LeandroA("3
0")
Error: IsNumeric_LeandroA("3000
0")
Error: IsNumeric_TGa ("1E+45")
Error: IsNumeric_TGa ("1E+45")
Error: IsNumeric_LeandroA("+1. .2")
Error: IsNumeric_TGa ("+")


Nota: La funcion IsNumeric_LeandroA Sufre Desbodamiento con la string &H999999999999999999" & Chr(0) & "999999999999999999999999999

Temibles Lunas!¡.
.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 15 Agosto 2011, 23:48 pm
Cita de: BlackZeroX▓▓▒▒░░ en 15 Agosto 2011, 23:33 pm
@Tenient101
Podrias dejar tus Test aqui pegados (Codigos de prueba), a mi en esos strings no me marca errores (3.0 en adelante).


Copie y pegue exactamente el codigo que dejaste, y me tira esto

Citar
Error: isNumeric_Black ("5,6,.6 ")
Error: IsNumeric_LeandroA("5,6,.6 ")
Error: isNumeric_Black (",7.88")
Error: isNumeric_Black (" .56788")
Error: IsNumeric_LeandroA(" .56788")
Error: isNumeric_Black ("45,0,4,3")
Error: IsNumeric_LeandroA("45,0,4,3")
Error: isNumeric_Black ("44,.0144,0")
Error: IsNumeric_LeandroA("44,.0144,0")
Error: isNumeric_Black ("44.,0,0,0,0,0,0,0,1")
Error: IsNumeric_LeandroA("44.,0,0,0,0,0,0,0,1")
Error: IsNumeric_LeandroA("10.45e.10")
Error: isNumeric_Black ("1.112.45")
Error: IsNumeric_LeandroA("1.224e+-10.12")
Error: IsNumeric_LeandroA("45.01anonymouse")
Error: isNumeric_Black ("1..3")
Error: IsNumeric_TGa ("1E+52")
Error: IsNumeric_LeandroA("3
0")
Error: IsNumeric_LeandroA("3000
0")
Error: IsNumeric_TGa ("1E+46")
Error: IsNumeric_TGa ("1E+46")
Error: IsNumeric_LeandroA("+1. .2")
Error: IsNumeric_TGa ("+")
Error: isNumeric_Black ("   
   
   
 +.0 ")
Error: isNumeric_Black ("    +.0")

repito... Exactamente como lo acabaste de dejar  :silbar:

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 16 Agosto 2011, 00:10 am
.
Madre... si es eso cierto entonces mi PC esta drogada...

Tienes TeamViwer (http://www.teamviewer.com/es/download/index.aspx) quiero ver O.O!.

Dulces Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: Sanlegas en 16 Agosto 2011, 03:58 am
Cita de: BlackZeroX▓▓▒▒░░ en 16 Agosto 2011, 00:10 am
.
Madre... si es eso cierto entonces mi PC esta drogada...

Tienes TeamViwer (http://www.teamviewer.com/es/download/index.aspx) quiero ver O.O!.

Dulces Lunas!¡.

Abrá que ver si a alguien le sucede lo mismo..., si no entonces es mi pc  :P

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 16 Agosto 2011, 23:47 pm

Les dejo mi funcion en C para quien la quiera.

http://foro.elhacker.net/programacion_cc/cisnumeric_vb6_a_c-t336564.0.html

Dulces Lunas!¡.

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: 79137913 en 17 Agosto 2011, 13:44 pm
HOLA!!!

Si alguien quiere hacer los tests no hay problema, pero gano Black.

GRACIAS POR LEER!!!

Título: Re: [RETO] Reemplazo de Funcion IsNumeric
Publicado por: BlackZeroX en 20 Agosto 2011, 03:29 am
Archivos Fuente, y Compilados (http://infrangelux.sytes.net/filex/index.php?dir=/BlackZeroX/Programacion/vb6/Retos/isnumeric)

(http://infrangelux.sytes.net/filex/view.php?InfraFile=/BlackZeroX/Programacion/vb6/Retos/isnumeric/Resultados.png)

La funciones isNumericA e isNumeriW con mis versiones en C...

Temibles Lunas!¡.


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