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

 

 


Tema destacado: Top 20 herramientas Hacking más populares de 2020


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [RETO] Reemplazo de Funcion IsNumeric
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 2 [3] 4 5 Ir Abajo Respuesta Imprimir
Autor Tema: [RETO] Reemplazo de Funcion IsNumeric  (Leído 13,091 veces)
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.144


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #20 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!¡.


« Última modificación: 13 Agosto 2011, 22:38 pm por BlackZeroX▓▓▒▒░░ » En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #21 en: 13 Agosto 2011, 19:32 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


En línea

BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.144


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #22 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)

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!¡.
« Última modificación: 14 Agosto 2011, 02:53 am por BlackZeroX▓▓▒▒░░ » En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.144


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #23 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
En ZIP

Temibles Lunas!¡.
« Última modificación: 14 Agosto 2011, 03:24 am por BlackZeroX▓▓▒▒░░ » En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
AlxSpy

Desconectado Desconectado

Mensajes: 137


Ver Perfil
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #24 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.
En línea

raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #25 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
En línea

BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.144


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #26 en: 14 Agosto 2011, 08:36 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!¡.
En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
x64core


Desconectado Desconectado

Mensajes: 1.908


Ver Perfil
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #27 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
En línea

raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #28 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
« Última modificación: 15 Agosto 2011, 02:42 am por raul338 » En línea

x64core


Desconectado Desconectado

Mensajes: 1.908


Ver Perfil
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #29 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
En línea

Páginas: 1 2 [3] 4 5 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
[RETO] Funcion iFactorize() - Factorizacion de numeros enteros « 1 2 »
Programación Visual Basic
Karcrack 15 8,154 Último mensaje 19 Julio 2010, 17:19 pm
por FFernandez
Reto: puedes descifrar esta pequeña funcion Php?? « 1 2 »
PHP
PanConMantequilla 12 4,667 Último mensaje 6 Agosto 2010, 04:03 am
por Castg!
[RETO] Reemplazo de Operadores Binarios.
Programación Visual Basic
79137913 3 2,327 Último mensaje 8 Abril 2011, 14:12 pm
por 79137913
[C]isNumeric (VB6 a C)
Programación C/C++
BlackZeroX (Astaroth) 8 3,410 Último mensaje 20 Agosto 2011, 03:21 am
por BlackZeroX (Astaroth)
[RETO] Funcion EntreTextos
Programación Visual Basic
79137913 1 861 Último mensaje 12 Junio 2012, 16:35 pm
por Psyke1
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines