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

 

 


Tema destacado: Introducción a la Factorización De Semiprimos (RSA)


+  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 20,565 veces)
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 #30 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


En línea

Sanlegas

Desconectado Desconectado

Mensajes: 131


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


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


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 #32 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
En línea

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


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

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...

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!¡.
« Última modificación: 15 Agosto 2011, 20:37 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 #34 en: 15 Agosto 2011, 07:22 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
En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] Reemplazo de Funcion IsNumeric
« Respuesta #35 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!!!
« Última modificación: 15 Agosto 2011, 18:18 pm por 79137913 » 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*
Sanlegas

Desconectado Desconectado

Mensajes: 131


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


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

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


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

« Última modificación: 15 Agosto 2011, 20:59 pm por BlackZeroX▓▓▒▒░░ » En línea

The Dark Shadow is my passion.
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


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

« Última modificación: 15 Agosto 2011, 23:36 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 #39 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")

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