Autor
|
Tema: [RETO] Reemplazo de Funcion IsNumeric (Leído 20,463 veces)
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
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!¡.
|
|
« Última modificación: 13 Agosto 2011, 22:38 pm por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
Sí, tiene un espacio hasta lo ultimo, IsNumeric lo toma como numero y tu función no.
Si, por eso puse el Trim y si me lo toma
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. Por fin la termine (creo que ya esta bien)... Link Pequeña explicacion de la variable lData (Estructura)Soporta numeros con formatos: ###e[+/-]###. ###d[+/-]###. Numeros en base 16. Numeros en base 10. 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!¡.
|
|
« Última modificación: 14 Agosto 2011, 02:53 am por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. 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 SueltosEn ZIPTemibles Lunas!¡.
|
|
« Última modificación: 14 Agosto 2011, 03:24 am por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
AlxSpy
Desconectado
Mensajes: 137
|
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.
|
|
|
En línea
|
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
BlackZeroX se lo tomo en serio jeje, tendré que hacer una versión aparte para hexadecimales n.n
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
BlackZeroX se lo tomo en serio 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!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
x64core
Desconectado
Mensajes: 1.908
|
buenas gente felicidades a todos parece que ya es tarde para que yo entre y ademas viendo tanto codigo raro me desanimo la vdd pero me gusto la idea espero que hagan mas retos mas seguido esta interesante esto y uno apriende tambien
|
|
|
En línea
|
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
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 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) Haber... seguro que no es tan rápida, pero es segura
|
|
« Última modificación: 15 Agosto 2011, 02:42 am por raul338 »
|
En línea
|
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
[RETO] Funcion iFactorize() - Factorizacion de numeros enteros
« 1 2 »
Programación Visual Basic
|
Karcrack
|
15
|
11,698
|
19 Julio 2010, 17:19 pm
por FFernandez
|
|
|
Reto: puedes descifrar esta pequeña funcion Php??
« 1 2 »
PHP
|
PanConMantequilla
|
12
|
6,625
|
6 Agosto 2010, 04:03 am
por Castg!
|
|
|
[RETO] Reemplazo de Operadores Binarios.
Programación Visual Basic
|
79137913
|
3
|
4,057
|
8 Abril 2011, 14:12 pm
por 79137913
|
|
|
[C]isNumeric (VB6 a C)
Programación C/C++
|
BlackZeroX
|
8
|
5,085
|
20 Agosto 2011, 03:21 am
por BlackZeroX
|
|
|
[RETO] Funcion EntreTextos
Programación Visual Basic
|
79137913
|
1
|
1,591
|
12 Junio 2012, 16:35 pm
por Psyke1
|
|