Mensajes

@SONIC88
Ya conozco ese tutorial muchas gracias, pero no tengo intenciones de crear la dll desde vb6... ya que lo que ando buscando es velocidad con respecto a las strings de vb6, es decir en vb6 llamare a esta funcion de la dll, y en la dll creada en C/C++ la tratarare mas rapido que con copymemory en vb6...

Dulces Lunas!¡.

.
Solo tienes un error de sintasis mejor aprendete la sintaxis de vb6 antes de intentar nada.

Código (Vb) [Seleccionar] Expandir



    ...
    SavePicture Clipboard.GetData, ("c:\ScreenShot.bmp") ' ... nombre.Text& ...  deberia de ser ... nombre.Text & ...
    Clipboard.Clear
    ...



Temibles Lunas!¡.
.

["Dinamic Link Library"]

no hay problema el propio codeblocks tiene una platilla para eso uso la plantilla "Dinamic Link Library", todo correcto pero cuando intento acceder a una funcion de la dll sencillamente no encuentra en punto de entrada a dicha funcion... ya que alparecer me falta hacerla publica fuera de la dll... lei que me falta una archivo def... o algo asi, aun que tambien lei algo de __stdcall, los aplico pero nada ¬¬".

Estoy probando con la funcion de la plantilla... agregando lo que ya he dicho y nada sigue con el mismo error ¬¬".

Dulces Lunas!¡.

Como creo una DLL en codeblocks pero que pueda usar sus funciones en otro lenguaje por ejemplo VB6, vb .NET etc...

Dulces Lunas!¡.

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

Tienes TeamViwer quiero ver O.O!.

Dulces Lunas!¡.

[&H00000000000000000000000000000000000000000000000000000000000000000000000]

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



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



String con las que se probo:

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



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

.
Dejo la version 4.0...

Codigo Obsoleto...

Código [Seleccionar] Expandir



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



@Tenient101

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

Código (vb) [Seleccionar] Expandir



msgbox isnumeric("&H221231321") & vbnewline & Is_NumberT("") & vbnewline & Is_NumberT2("&H221231321")
msgbox isnumeric("99999999999999999999999999999999999999") & vbnewline & Is_NumberT("99999999999999999999999999999999999999") & vbnewline & Is_NumberT2("99999999999999999999999999999999999999")

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

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





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



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



De mi celular... en la puerta de mi casa xP, antes de cortarme la melena, aun que me la estoy dejando crecer de nuevo xD.

Dulces Lunas!¡.

.
@PiroskY

Ademas de que me has dado pena ajena de tu ignorancia, te informo que esa no es una consultoria de Software... leete y pasate por la pagina antes de opinar sobre algo, aun que tiene sentido lo que dices, en este caso no lo tiene... me parece que es una tipo consultoria de recursos humanos que actua como bolsa de trabajo temporal... donde ellos cobran digamos que el 50%-70% de tu trabajo... hay muchas de esas empresas, mientras ellos solo te envian y ya es esa su labor y punto es decir que seria dineo facil...

Por otro lado JAMAS se queda uno con el 100% del precio de venta del software ya que se tienen que pagar X cantidad por derechos de propiedad intelectual, licencias de software usado para su creacion, entre otras cosas... y eso para poder decir que es tuyo, como seria obvio claro esta.

---

Hay organisaciones donde te contratan supuestamente pero no te contratan realmente, es decir, te mandan a X lado a trabajar a ti o a X cantidad, PERO estos se quedan digamos con 50% por ejemplo y el otro 50% lo reparten o quisas menos a los que realizaron la labor esto en los mejores casos (Tomando en consideracion los gastos y todo esto de dicha oprganizacion), no solo como programadores ni nada por el estilo, puede ser X indole. no recuerdo como se les llama a estas organizaciones, algunas dicen ser consultorias o de X tipo, si te pasas por su web veras que onda,ya que seguro no le haz dado un ojo...

Por otro lado una Consultoria vende soluciones a Empresas, mas no envia a X personas a trabajar por X tiempo, aun que no tengo ni idea si es de esa manera en la que trabaja esta... es decir que actuen como "bolsa de trabajo" por decirlo de alguna manera pero de manera TEMPORAL.

Ojo no hablo de los Sindicatos... ya que no tiene nada que ver.

Lo mas habitual es que en las consultorias de software o similares asista el Sr o alguien con conocimientos razonables para ver la problematica que tiene su cliente, la mayoria de estas consultorias ponen publicidad en periodicos, revistas de tecnologia o en paginas web dedicadas a la "Bolsa de trabajo", mas no en foros... esto ultimo habla muy mal de la empresa, en mi criterio, ya que lo mas seguro es que no te respeten un salario aceptable y ni que se diga de lo que por ley mereces.

Quien quiera enviar el C.V. nadie le dice que NO; esto es aconsideracion de cada quien, y quien se sienta ofendido por una critica a una "empresa" que publica en foros pues... a ching.....

Dulces Lunas!¡.
.