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

 

 


Tema destacado: Trabajando con las ramas de git (tercera parte)


+  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,449 veces)
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.148


I'Love...!¡.


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


« Última modificación: 16 Agosto 2011, 23:48 pm por BlackZeroX▓▓▒▒░░ » En línea

The Dark Shadow is my passion.
Sanlegas

Desconectado Desconectado

Mensajes: 131


https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-


Ver Perfil
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #41 en: 15 Agosto 2011, 23:48 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:


En línea

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.148


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #42 en: 16 Agosto 2011, 00:10 am »

.
Madre... si es eso cierto entonces mi PC esta drogada...

Tienes TeamViwer quiero ver O.O!.

Dulces Lunas!¡.
En línea

The Dark Shadow is my passion.
Sanlegas

Desconectado Desconectado

Mensajes: 131


https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-


Ver Perfil
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #43 en: 16 Agosto 2011, 03:58 am »

.
Madre... si es eso cierto entonces mi PC esta drogada...

Tienes TeamViwer quiero ver O.O!.

Dulces Lunas!¡.

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

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.148


I'Love...!¡.


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

The Dark Shadow is my passion.
79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #45 en: 17 Agosto 2011, 13:44 pm »

HOLA!!!

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

GRACIAS POR LEER!!!
En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.148


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #46 en: 20 Agosto 2011, 03:29 am »

Archivos Fuente, y Compilados



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

Temibles Lunas!¡.
En línea

The Dark Shadow is my passion.
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,319 Último mensaje 19 Julio 2010, 17:19 pm
por FFernandez
Reto: puedes descifrar esta pequeña funcion Php?? « 1 2 »
PHP
PanConMantequilla 12 4,762 Último mensaje 6 Agosto 2010, 04:03 am
por Castg!
[RETO] Reemplazo de Operadores Binarios.
Programación Visual Basic
79137913 3 2,440 Último mensaje 8 Abril 2011, 14:12 pm
por 79137913
[C]isNumeric (VB6 a C)
Programación C/C++
BlackZeroX 8 3,546 Último mensaje 20 Agosto 2011, 03:21 am
por BlackZeroX
[RETO] Funcion EntreTextos
Programación Visual Basic
79137913 1 886 Último mensaje 12 Junio 2012, 16:35 pm
por Psyke1
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines