Mensajes

Me toco una profesora si no mal recuerdo en 5to y 6 año de primaria que me dio = reglasos en las PUNTAS DE LOS DEDOS, no sabia que eso era ilegal pero ya despues me dijeron que si era ilegal... pero bueno.

Solo se que si a mi hijo (en un Futuro) le llegan a pegar o lo tocan ufff, entro directo a tirarle un rodillazo en la cara o sacandole el aire al hijo de p**a, obvio, entraria tranquilo y todo normal (doble cara) y en el saludo de manos... me entraria una rabia... de hecho al ver el video me genero una rabia, como de entrar al aula asi sin mas y surtirme al hijo de p**a con un rodillaso en la jeta.

Por otro lado, el trancaso que le da el profesor y tira al individuo con una silla, si es muy posible... mmm aun que el tipo sentado se impulsa... y no hay nadie en el aula...

Sangrientas Lunas!¡.

Estoy tan pero tan aburrido en casa que me puedo apuntar en su grupito.

Dulces Lunas!¡.

.
Te recomiendo mejor que estudies y practiques las structuras de flujo, bucles, declaracion de funciones procesos, tipos limites de los tipos de datos, etc... y como dije practicalos, por que si no estaras como yo con las expresiones regulares que no les entiendo casi nada xP, esto se debe a que no les tengo interes y no las practico... pero bueno.

Despues metete con las operaciones a nivel Bit no son dificiles (Wikipedia), estas operaciones son utiles en los IF then y select case, APIS, entre otros, = practicalos, implementalos y no los dejes atras, si es nesesario create hasta un POST en el foro, pero antes intentalo por ti mismo ya que la preseverancia y en especial cuando UNO lo resuelve por si solo se le queda grabado realmente, yo no te recomiendo ningun libro por que la vdd no conozco ninguno de VB, conozco codigos pero no libros,

A se me olvidaba lee codigos, intenta destriparlos, quita lineas, reemplazalas, etc, y fijate que sucede, ya que esta es la unica manera de aprender a programar sea cual sea el lenguaje.

P.D.: cuando creas que ya sabes programar migrate un rato a C/C++... solo para que veas como trabaja realmente un lenguaje, de esta manera expandes mas tus conocimientos y ves desde otra perspectiva un algoritmo X para implementarlo de una manera mas rapida y optima, despues si quieres te migra s a .NET, Java, Perl, PHP u otros... con una base soplida el translado de lenguaje solo sera aprenderte la sintaxis, e indagar en algunos apectos nuevos que no se ven o que estan mas ocultos que en otros, como la herencia, ( en vb6 se aplica de manera oculta y automatica... ).

Temibles Lunas!¡.

[Dim byData(3) as byte]

.
Recreacion de la funcion isNumeric(), empleando operaciones a nivel Bit
IsNumeric()

Variable lData..

Por que no usar Dim byData(3) as byte y quitar las mascaras de bytes?
R: Es mas lento, ¿por que?, me parece que es por que se involucra una multiplicacion aparentemente, o eso quiero creer, aun asi ya lo probe y si es mas leeeento.

Por que no usar otras 2 variables para que sea mas legible?
R: Es un ejemplo de como usar una variable tipo long para que la misma tenga distintos usos, no solo uno, ademas las mascaras son tan rapidas que no influyen en la velocidad.

Extructura de la variable lData

Para la explicacion veremos la variable de manera binaria:
0000 0000 0000 0000 0000 0000 0000 0000

0000 0000 => sección de 1 Byte donde se guarda el caracterleido con el API RtlMoveMemory().
0000 0000 => sección Flags de 1 Byte, se usa para guardar los Flags siguientes:

Código (Vb) [Seleccionar] Expandir



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



0000 0000 => sección 1 Byte (No tiene uso pero puede servir para continuar el conteo de la siguiente sección 0000 0000).

0000 0000 => sección 1 Byte, Se usa como contador sin signo con limite 2 potencia 8 es decir de 0 a 255 ( gracias a que el siguiente bloque 0000 0000 no se usa se puede expandir a 2 potencia 16 es decir 0 a 65535), se púso el contador en esta sección ya que la suma seria directa sin mascara alguna o algun tipo de dezplazamiento de bits y de esta manera NO MODIFICARIA los siguientes bloques de bytes.

Código (Vb) [Seleccionar] Expandir



lData = (lData + &H1)



Temibles Lunas!¡.

.
Que extraño a mi me siguen funcionando.

Dulces Lunas!¡.

[ESPRIME LA FUNCION ISNUMERIC()]

.
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 [Seleccionar] Expandir



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 [Seleccionar] Expandir



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

...
Espero te den duro!¡, mentira.

Dulces Lunas!¡.

.
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 (Vb) [Seleccionar] Expandir



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



Codigo de pruebas:

Código [Seleccionar] Expandir



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 [Seleccionar] Expandir



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

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 [Seleccionar] Expandir



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 [Seleccionar] Expandir



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 [Seleccionar] Expandir



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

[Stephen William Hawking]

.
Ammm me lei TODO vi todos los videos, etc, etc; y me fije algo curioso en la pagina SETI

http://www.seti.org/page.aspx?pid=1539

Mejor a criterio de cada uno por que a mi en parte me gustaria que fuera cierto pero me inclino mas a la idea de Stephen William Hawking con respecto al Darwinismo.

Temibles Lunas!¡.