Autor
|
Tema: [RETO] Reemplazo de Funcion IsNumeric (Leído 20,720 veces)
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
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
|
|
|
En línea
|
|
|
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
@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 !.
|
|
|
En línea
|
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
vbNewLine = vbCrLf = vbCr & vbLf = Chr$(10) & Chr(13) Misteriosamente no me a funcionado reemplazar vbCr con vbLf y sigue quedando vbNewLine Sobre el bucle, cierto, lo que pasa es que experiencias anteriores me dijeron hacer directamente eso
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. El ASC 10 = Saldo de linea. = vbCr El ASC 13 = Retorno de carro. ------------------- vbNewLine Es decir en Windows asi, en linux si no mal recuerdo solo basta con el ASC 10. Por otro lado: @Raul100 En mi antiguo post (Donde esta el test de fiabilidad en la hoja anterior hay ligas de decarga de archivos, hay esta el codigo para probar la velocidad de las funciones... puedes estudiarlo). Ando estresado y me limitare un poco... Y por si alguno pensó que los caprichos de BlackZeroX es imposible de otra forma de la que lo hizo él. Acá le cierro la boca El capricho es de IsNumeric() no mio; aun asi sigue mal tu funcion... Estuve probando el testeo, y si lo hago asi .... Devuelve "errores" al azar :-/ así que no quiere decir que sea realmente un error
* Revisa bien la forma en la que probe la fiabilidad... '... 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!¡.
|
|
« Última modificación: 15 Agosto 2011, 20:37 pm por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
. 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
|
|
|
En línea
|
|
|
|
79137913
Desconectado
Mensajes: 1.169
4 Esquinas
|
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 PLAZO HASTA MAÑANA PARA QUE MODIFIQUEN LOS CODIGOS A SU GUSTO POR LAS NUEVAS REGLAS 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!!!
|
|
« Última modificación: 15 Agosto 2011, 18:18 pm por 79137913 »
|
En línea
|
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!" "La peor de las ignorancias es no saber corregirlas"
79137913 *Shadow Scouts Team*
|
|
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
@79137913 mi función actualizada tampoco da errores!!, han hecho pruebas con la primera que hize... mas abajo deje la otra, voy a editar la primera por si acaso.
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
@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
|
|
« Última modificación: 15 Agosto 2011, 20:59 pm por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. 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
|
|
« Última modificación: 15 Agosto 2011, 23:36 pm por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
Error: isNumeric_Black("5,6,.6 ") Error: LeandroA("5,6,.6 ") Error: isNumeric_Black(" ,7.88") Error: IsNumeric_r338v3(" ,7.88") Error: isNumeric_Black(" .56788") Error: LeandroA(" .56788")
|
|
|
En línea
|
|
|
|
|
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,821
|
19 Julio 2010, 17:19 pm
por FFernandez
|
|
|
Reto: puedes descifrar esta pequeña funcion Php??
« 1 2 »
PHP
|
PanConMantequilla
|
12
|
6,686
|
6 Agosto 2010, 04:03 am
por Castg!
|
|
|
[RETO] Reemplazo de Operadores Binarios.
Programación Visual Basic
|
79137913
|
3
|
4,128
|
8 Abril 2011, 14:12 pm
por 79137913
|
|
|
[C]isNumeric (VB6 a C)
Programación C/C++
|
BlackZeroX
|
8
|
5,129
|
20 Agosto 2011, 03:21 am
por BlackZeroX
|
|
|
[RETO] Funcion EntreTextos
Programación Visual Basic
|
79137913
|
1
|
1,605
|
12 Junio 2012, 16:35 pm
por Psyke1
|
|