HOLA!!!
Viendo como ha decaido la actividad y nivel en el foro, me propongo aunque sea a que las nuevas mentes que hay aqui hagan un pequeño reto que les propongo...
El Reto es hacer una funcion que remplace efectivamente a la funcion IsNumeric que viene de fabrica en vb...
Deberan usar para nombrar la funcion un metodo como este:
Private Function IsNumeric_SuNickReducido(str As String) As Boolean
'Ejemplos:
'Raul338:
Private Function IsNumeric_r338(str As String) As Boolean
'79137913:
Private Function IsNumeric_7913(str As String) As Boolean
Ejemplos de lo que devuelve la funcion original:
IsNumeric("asdf") ->False
IsNumeric("a12f") ->False
IsNumeric("12,12") ->True
IsNumeric("12.12") ->True
IsNumeric("12,23,34") ->False
IsNumeric("133.23.330") ->True
IsNumeric("36.658,30") ->True
IsNumeric("81,838.59") ->True
Espero que hayan entendido, TODOS pueden participar...
Es un reto dentro de todo simple...
Cuando esten todas las funciones se competira para encontrar al que hizo el codigo mas rapido(se mide con ctiming), luego se tomara de referencia la funcion original para ver si alguien la supera.
Notas:
·Las funciones y variables booleanas se inicializan en False.
·Se recomienda usar APIs.
·Se recomienda usar InStr.
·Se recomienda utilizar arrays de bytes.
·Se vale usar BadTypeConvert // EvilTypeConvert
·Recuerden que el tipo numerico mas rapido en vb es el Entero Largo (Long).
GRACIAS POR LEER!!!
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
Salu2 :-*
HOLA!!!
No crei que a nadie se le ocurriera eso XD mi forma es Casi igual, justo estaba hablando con Raul338 y me dijo que era Magia Negra eso XD Pero me gusta asi...
En fin... Mi codigo:
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
GRACIAS POR LEER!!!
Option Explicit
Private Sub Command1_Click()
Dim Dato As String
Dato = Text1.Text
MsgBox IsNumeric_Alx(Dato)
End Sub
Public Function IsNumeric_Alx(byval Dato As Variant) As Boolean
Dim Temporal As String, X As Long
Temporal = Dato
For X = 0 To 9
Temporal = Replace(Temporal, X, "")
Next X
If Len(Temporal) = 0 Then IsNumeric_Alx = True
End Function
Option Explicit
Private Const leTest As String = "asdf|a12f|12,12|12.12|12,23,34|133.23.330|36.658,30|81,838.59|11111111111111111111|1..3"
Private Const leSep As String = "|"
Private Sub Form_Load()
Dim sTest() As String, i As Integer
sTest = Split(leTest, leSep)
For i = LBound(sTest) To UBound(sTest)
Debug.Print sTest(i), IsNumeric_r338(sTest(i))
Next
End Sub
' ==================================
Private Function IsNumeric_r338(str As String) As Boolean
Dim cReg As Object
Set cReg = CreateObject("VBScript.RegExp")
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_r338 = cReg.Test(str)
If Not IsNumeric_r338 Then
' Testeamos con , como separador de miles y . como separador de decimales
cReg.Pattern = "^(?:\d{1,3}(?:\,\d{3})*|\d+)(?:\.\d+)?$"
IsNumeric_r338 = cReg.Test(str)
End If
Set cReg = Nothing
End Function
Soporta tantas cifras como caracteres que soporta string. Y números negativos :D
asdf False
a12f False
12,12 True
12.12 True
12,23,34 False
133.23.330 True
36.658,30 True
81,838.59 True
11111111111111111111 True
1..3 False
hola ;D aca esta mi funcion
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
Modificado: Espero que ahora funcione
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
Hace mucho que no participo en retos aqui dejo mi codigo.
Es mucho codigo pero trabaja rapido e identico que isNumeric de VB.
Public Function isNumeric_Black(ByRef sString As String) As Boolean
' // Version 1.0
Dim lChar As Long
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 ENTER_BEGIN As Long = &H8
'Const ENTER_END As Long = &H10 ' // Sin uso...
lLn = Len(sString)
If (lLn = 0) Then Exit Function
For lPos = 1 To lLn
lChar = Asc(Mid$(sString, lPos, 1)) ' // <--- Esta linea es seguro que redusca la velocidad del algoritmo...
Select Case lChar
Case Is >= 48 And cChar <= 57
isNumeric_Black = True
Case 32
If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
Case 46 ' // "." Solo 1
If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
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
If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
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
If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
lSwich = (lSwich Or SIGNO_RESTA)
Case 9 ' // vbTab Se permite la cantidad que sea.
If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
Case 13
If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then Exit Function
lSwich = (lSwich Or ENTER_BEGIN)
Case 10
If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN) Else Exit For
Case Else
Exit For
End Select
Next
End Function
Codigo completo de mi test:
Private Sub Form_Load()
Debug.Print isNumeric_Black("+.0"),
Debug.Print isNumeric("+.0")
Debug.Print isNumeric_Black("+."),
Debug.Print isNumeric("+.")
Debug.Print isNumeric_Black("+"),
Debug.Print isNumeric("+")
Debug.Print isNumeric_Black("-"),
Debug.Print isNumeric("-")
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 & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0"),
Debug.Print isNumeric(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0")
End Sub
OutPut:
Verdadero Verdadero
Falso Falso
Falso Falso
Falso Falso
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
Actualizo el codigo a una version 1.1...
Public Function isNumeric_Black(ByRef sString As String) As Boolean
' // Version 1.1 (Fixed)
Dim lChar As Long
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
lLn = Len(sString)
If (lLn = 0) Then Exit Function
For lPos = 1 To lLn
lChar = Asc(Mid$(sString, lPos, 1)) ' // <--Esta linea puede reducir la velocidad del algoritmo..
If (lChar >= 48 And lChar <= 57) Then
isNumeric_Black = True
Else
Select Case lChar
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 For
End Select
End If
Next
End Function
Nuevo Codigo de test...
Private Sub Form_Load()
Dim i As Integer
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 & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0"),
Debug.Print isNumeric(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0")
End Sub
Output:
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!¡.
Cita de: 79137913 en 10 Agosto 2011, 18:24 PM
HOLA!!!
No crei que a nadie se le ocurriera eso XD mi forma es Casi igual, justo estaba hablando con Raul338 y me dijo que era Magia Negra eso XD Pero me gusta asi...
En fin... Mi codigo:
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
GRACIAS POR LEER!!!
:xD , y se me habia ocurrido sumarle 0, pero no se me ocurrio que al sumarle "0" es como si no hubiera pasado nada matematicamente y lo pudiera eliminar dejandolo igual que tu code :laugh:
habria que testear la velocidad... un saludo!.
Hola, esta solo implementa una forma de comprobar el tipo de variable, pero al final utiliza el error para comprovar
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
lo unico que gana en velocidad es si el parametro no fue definido como string.
IsNumeric_LeandroA(85.54778)
IsNumeric_LeandroA(-85.54778)
IsNumeric_LeandroA(8554778)
IsNumeric_LeandroA(me)
HOLA!!!
Antes de hacer la competencia les muestro donde sus funciones no funcionan igual que IsNumeric... Por favor corrijan y luego testeamos:
REVISEN EL SIGUIENTE POST
GRACIAS POR LEER!!!
.
usa la ultima funcion que postee (1.1 la que esta en geshi) la 1ra no sirve del todo bien.
Private Sub Form_Load()
MsgBox isNumeric_Black("12,23,34")
MsgBox IsNumeric("12,23,34")
End Sub
OutPut
Verdadero Verdadero
Deberias usar tambien Strins con con Spacios en Blanco.
Temibles Lunas!¡.
Actualización
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_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
Obviamente ya no es la mas rápida, lo arregle para los caprichos de IsNumeric (desde cuando 1..2..3 es un numero?!!!)
sTest IsNumeric_r338 IsNumeric CDbl(sTest)
1..3 Verdadero Verdadero 13
+33.2 Verdadero Verdadero 332
11111111111111111111 Verdadero Verdadero 1,11111111111111E+19
12,12 Verdadero Verdadero 12,12
12.12 Verdadero Verdadero 1212
133.23.330 Verdadero Verdadero 13323330
36.658,30 Verdadero Verdadero 36658,3
81,838.59 Verdadero Verdadero 81,83859
-65,1 Verdadero Verdadero -65,1
12,23,34 Falso Falso
asdf Falso Falso
a12f Falso Falso
1..1 Verdadero Verdadero 11
1,,1 Falso Falso
1..2..3 Verdadero Verdadero 123
Observaciones
'LeandroA falla en "1. .2..3 "
'r338v2 falla en "1..2..3 "
'TGa falla en "1..2..3 "
'Alx falla en "1..2..3 "
'Black falla en "1. .2..3"
Salu2
Tenient101: Fixed :D
Cita de: raul338 en 13 Agosto 2011, 17:31 PM
Tenient101: Fixed :D
Dim A As String
A = "1..2..3 "
MsgBox IsNumeric(A) ' = Verdadero
MsgBox IsNumeric_r338v2(A) ' = Falso
CitarÚltima modificación: Hoy a las 12:54 por raul338 »
Incluiste la modificacion?
buenas, felicitaros a todos por los códigos,
no pongo mi code para no quedar último :xD,
pero creo que para las pruebas tambien tendríais que usar cadenas como "&HFAA" ó "3e-3".... ;D
mi apuesta es por la de 79137913 ;-) ;-) ;-)
Cita de: raul338 en 13 Agosto 2011, 17:55 PM
Incluiste la modificacion?
Sí, tiene un espacio hasta lo ultimo, IsNumeric lo toma como numero y tu función no.
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
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:
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:
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!¡.
Cita de: Tenient101 en 13 Agosto 2011, 18:10 PM
Sí, tiene un espacio hasta lo ultimo, IsNumeric lo toma como numero y tu función no.
Si, por eso puse el Trim :P y si me lo toma :P
.
Por fin la termine (creo que ya esta bien)...
Link Pequeña explicacion de la variable lData (Estructura) (http://foro.elhacker.net/programacion_visual_basic/recopilacion_de_funciones_con_operaciones_binarias-t329680.0.html;msg1651478#msg1651478)
Soporta numeros con formatos:
###e[+/-]###.
###d[+/-]###.
Numeros en base 16.
Numeros en base 10.
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:
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:
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!¡.
.
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).
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:
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 (http://infrangelux.sytes.net/filex/?dir=/BlackZeroX/Programacion/vb6/Retos/isnumeric)
En ZIP (http://infrangelux.sytes.net/filex/?file=Comprimido.zip&dir=/BlackZeroX/Programacion/vb6/Retos/isnumeric)
Temibles Lunas!¡.
mi codigo tiene mas fallas que la ... , ya quede ultimo T_T ,felicitaciones a quienes ya lograron hacer un codigo eficiente y sin fallas, el lunes veremos quien sale ganador de este reto.
saludos.
BlackZeroX se lo tomo en serio :xD
jeje, tendré que hacer una versión aparte para hexadecimales n.n
Cita de: raul338 en 14 Agosto 2011, 06:06 AM
BlackZeroX se lo tomo en serio :xD
Estaba aburrido y me intento quitar un vicio que me genero un juego del facebook... por eso no estaba ya tanto en el foro maldito facebook.
Dulces Lunas!¡.
buenas gente felicidades a todos :xD parece que ya es tarde para que yo entre :xD y ademas viendo tanto codigo raro me desanimo la vdd :xD pero me gusto la idea ;D espero que hagan mas retos mas seguido ;D esta interesante esto y uno apriende tambien ;D
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
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
Tiene soporte Hexadecimal y un poco de notación científica (la verdad, le falta mas creo, es que nunca vi ese tipo de notación)
:D :D Haber... seguro que no es tan rápida, pero es segura :xD
vale panas y como se sabe que funcion es mas veloz que otra es obvio que por probar la ejecucion de la funcion no verdad :xD me imagino que con un programa o noce :P
Estuve probando el testeo, y si lo hago asi
Private Sub Form_Load()
Dim bRes As Boolean, iRes As Boolean
Dim leTest As String
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|" & _
"&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"
Dim sTest() As String, i As Integer
sTest = Split(leTest, "|")
For i = LBound(sTest) To UBound(sTest)
bRes = IsNumeric(sTest(i))
iRes = IsNumeric_r338v3(sTest(i))
Debug.Print bRes, iRes, IIf(bRes <> iRes, "ERROR", "")
Next
Call Unload(Me)
End Sub
No tira error ...
En cambio si cambio en el for pongo esto como hace en su Test BlackZeroX
If Not (IsNumeric_r338v3(sTest(i))) Then Debug.Print "ERROR", i Else Debug.Print i
Devuelve "errores" al azar :-/ así que no quiere decir que sea realmente un error
@raul338: tengo unas dudas con tu code
"vbNewLine" y "vbCr" no es lo mismo... ?
y en esta parte del bucle
While InStr(str, "..")
str = Replace$(str, "..", vbNullString)
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 !.
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
.
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...
Cita de: raul338 en 15 Agosto 2011, 01:05 AM
Y por si alguno pensó que los caprichos de BlackZeroX es imposible de otra forma de la que lo hizo él. Acá le cierro la boca :xD
El capricho es de IsNumeric() no mio; aun asi sigue mal tu funcion...
Cita de: raul338 en 15 Agosto 2011, 01:50 AM
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...
'...
bRes = IsNumeric(spli(i))
If Not (bRes = isNumeric_Black(spli(i))) Then
Debug.Print "Error: isNumeric_Black (""" & spli(i) & """)"
End If
'...
If Not (bRes = IsNumeric_r338v2(spli(i))) Then
Debug.Print "Error: IsNumeric_r338v2(""" & spli(i) & """)"
End If
'...
Nota: no es nesesario usar lBound() despues de hacer un Split()... SIEMPRE es 0...
Private Sub Form_Load()
MsgBox LBound(Split("", "accc"))
MsgBox LBound(Split("aaa", "accc"))
MsgBox LBound(Split("aaaaa", "accc"))
MsgBox LBound(Split("accccaccccc", "accc"))
End Sub
------> Edito:
la version 3 sigue dando errores...
Test rapido...
Private Sub Form_Load()
MsgBox IsNumeric_r338v3("1..3") & vbNewLine & IsNumeric("1..3")
End Sub
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!¡.
Cita de: BlackZeroX▓▓▒▒░░ en 15 Agosto 2011, 06:16 AM
.
El ASC 10 = Saldo de linea. = vbCr
El ASC 13 = Retorno de carro.
Visual Basic lo toma igual o estara mal algo..
MsgBox Asc(vbCr) ' => 13
MsgBox Asc(vbNewLine) ' => 13
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:
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!!!
@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.
@Tenient101
Anteriormente si daba errores... nunca proble la actualizada hasta ahora ya que no la habia visto.
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.
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.
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
.
Dejo la version 4.0...
Codigo Obsoleto...
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
CitarError: 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")
@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.
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:
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:
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!¡.
.
Cita de: BlackZeroX▓▓▒▒░░ en 15 Agosto 2011, 23:33 PM
@Tenient101
Podrias dejar tus Test aqui pegados (Codigos de prueba), a mi en esos strings no me marca errores (3.0 en adelante).
Copie y pegue exactamente el codigo que dejaste, y me tira esto
CitarError: isNumeric_Black ("5,6,.6 ")
Error: IsNumeric_LeandroA("5,6,.6 ")
Error: isNumeric_Black (",7.88")
Error: isNumeric_Black (" .56788")
Error: IsNumeric_LeandroA(" .56788")
Error: isNumeric_Black ("45,0,4,3")
Error: IsNumeric_LeandroA("45,0,4,3")
Error: isNumeric_Black ("44,.0144,0")
Error: IsNumeric_LeandroA("44,.0144,0")
Error: isNumeric_Black ("44.,0,0,0,0,0,0,0,1")
Error: IsNumeric_LeandroA("44.,0,0,0,0,0,0,0,1")
Error: IsNumeric_LeandroA("10.45e.10")
Error: isNumeric_Black ("1.112.45")
Error: IsNumeric_LeandroA("1.224e+-10.12")
Error: IsNumeric_LeandroA("45.01anonymouse")
Error: isNumeric_Black ("1..3")
Error: IsNumeric_TGa ("1E+52")
Error: IsNumeric_LeandroA("3
0")
Error: IsNumeric_LeandroA("3000
0")
Error: IsNumeric_TGa ("1E+46")
Error: IsNumeric_TGa ("1E+46")
Error: IsNumeric_LeandroA("+1. .2")
Error: IsNumeric_TGa ("+")
Error: isNumeric_Black ("
+.0 ")
Error: isNumeric_Black (" +.0")
repito... Exactamente como lo acabaste de dejar :silbar:
.
Madre... si es eso cierto entonces mi PC esta drogada...
Tienes TeamViwer (http://www.teamviewer.com/es/download/index.aspx) quiero ver O.O!.
Dulces Lunas!¡.
Cita de: BlackZeroX▓▓▒▒░░ en 16 Agosto 2011, 00:10 AM
.
Madre... si es eso cierto entonces mi PC esta drogada...
Tienes TeamViwer (http://www.teamviewer.com/es/download/index.aspx) quiero ver O.O!.
Dulces Lunas!¡.
Abrá que ver si a alguien le sucede lo mismo..., si no entonces es mi pc :P
Les dejo mi funcion en C para quien la quiera.
http://foro.elhacker.net/programacion_cc/cisnumeric_vb6_a_c-t336564.0.html
Dulces Lunas!¡.
HOLA!!!
Si alguien quiere hacer los tests no hay problema, pero gano Black.
GRACIAS POR LEER!!!
Archivos Fuente, y Compilados (http://infrangelux.sytes.net/filex/index.php?dir=/BlackZeroX/Programacion/vb6/Retos/isnumeric)
(http://infrangelux.sytes.net/filex/view.php?InfraFile=/BlackZeroX/Programacion/vb6/Retos/isnumeric/Resultados.png)
La funciones isNumericA e isNumeriW con mis versiones en C...
Temibles Lunas!¡.