elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Introducción a Git (Primera Parte)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [RETO] IsDate		0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 [2] 3 Ir Abajo Respuesta Imprimir
Autor Tema: [RETO] IsDate  (Leído 12,345 veces)
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #10 en: 29 Agosto 2011, 00:24 am »
.
Aquí les dejo mi codigo... esta bastante legible...

Código
  1.  
  2. Option Explicit
  3.  
  4. Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
  5.  
  6. '   //  Formato aceptado   DD/MM/YYYY, D/M/YYYY, D/MM/YYYY, DD/M/YYYY, D/M/Y, etc...
  7. Public Function isDate_BlackZX(ByRef sStr As String) As Boolean
  8. Dim lChar           As Long
  9. Dim lVal            As Long
  10. Dim lConvert(3)     As Long
  11.  
  12. Dim lDim            As Long
  13. Dim lMult           As Long
  14. Dim pStr            As Long
  15. Dim pChar           As Long
  16.  
  17.     pStr = LenB(sStr)
  18.     If (pStr < &H5) Then Exit Function
  19.  
  20.     pStr = StrPtr(sStr) + (pStr - &H4)
  21.     pChar = VarPtr(lChar)
  22.  
  23.     lDim = &H2
  24.     lMult = &H1
  25.     lConvert(lDim) = &H0
  26.  
  27.     Do Until StrPtr(sStr) > pStr
  28.         RtlMoveMemory pChar, pStr, &H4
  29.         lVal = (lChar And &HFF0000)
  30.         If (lVal = &H2F0000) Then
  31.             lDim = (lDim - &H1)
  32.             If ((lDim And &H80000000) = &H80000000) Then Exit Function
  33.             lMult = &H1
  34.         Else
  35.             If ((lVal > &H390000) Or (lVal < &H300000)) Then Exit Function
  36.             lConvert(lDim) = lConvert(lDim) + (((lVal / &H10000) - &H30) * lMult)
  37.             lMult = (lMult * &HA)
  38.         End If
  39.         lVal = (lChar And &HFF)
  40.         If (lVal = &H2F) Then
  41.             lDim = (lDim - &H1)
  42.             If ((lDim And &H80000000) = &H80000000) Then Exit Function
  43.             lMult = &H1
  44.         Else
  45.             If ((lVal > &H39) Or (lVal < &H30)) Then Exit Function
  46.             lConvert(lDim) = lConvert(lDim) + ((lVal - &H30) * lMult)
  47.             lMult = (lMult * &HA)
  48.         End If
  49.         pStr = (pStr - &H4)
  50.     Loop
  51.  
  52.     If ((lConvert(&H2) > &H270F) Or _
  53.         ((lConvert(&H2) And &H80000000) = &H80000000)) Or _
  54.     Not (lDim = &H0) Then Exit Function
  55.  
  56.     Select Case lConvert(&H1)
  57.         Case &H1, &H3, &H5, &H7, &H8, &HA, &HC
  58.             If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H20)) Then isDate_BlackZX = True
  59.         Case Is > &HC, Is <= &H0
  60.             Exit Function
  61.         Case Else
  62.             If (lConvert(&H1) = &H2) Then
  63.                 If ((lConvert(&H2) Mod &H4) = &H0) Then
  64.                     If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1E)) Then isDate_BlackZX = True
  65.                 ElseIf ((lConvert(&H2) Mod 400) = &H0) Then
  66.                     If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1E)) Then isDate_BlackZX = True
  67.                 ElseIf ((lConvert(&H2) Mod 100) = &H0) Then
  68.                     If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1E)) Then isDate_BlackZX = True
  69.                 Else
  70.                     If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1D)) Then isDate_BlackZX = True
  71.                 End If
  72.             Else
  73.                 If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1F)) Then isDate_BlackZX = True
  74.             End If
  75.     End Select
  76.  
  77. End Function
  78.  
  79.  

El siguiente codigo en lugar de leer 2 char ( 4 bytes ), solo lee 1 char ( 2 bytes ), PPuede o no ser mas rapido, pero eso a mi no me interesa.

Código
  1.  
  2. Public Function isDate_BlackZX(ByRef sStr As String) As Boolean
  3. Dim lChar           As Long
  4. Dim lVal            As Long
  5. Dim lConvert(3)     As Long
  6.  
  7. Dim lDim            As Long
  8. Dim lMult           As Long
  9. Dim pStr            As Long
  10. Dim pChar           As Long
  11.  
  12.     pStr = LenB(sStr)
  13.     If (pStr < &H5) Then Exit Function
  14.  
  15.     pStr = StrPtr(sStr) + (pStr - &H2)
  16.     pChar = VarPtr(lChar)
  17.  
  18.     lDim = &H2
  19.     lMult = &H1
  20.     lConvert(lDim) = &H0
  21.  
  22.     Do Until StrPtr(sStr) > pStr
  23.         RtlMoveMemory pChar, pStr, &H2  '   //  Dos bytes = char...
  24.         lVal = (lChar And &HFF)
  25.         If (lVal = &H2F) Then
  26.             lDim = (lDim - &H1)
  27.             If ((lDim And &H80000000) = &H80000000) Then Exit Function
  28.             lMult = &H1
  29.         Else
  30.             If ((lVal > &H39) Or (lVal < &H30)) Then Exit Function
  31.             lConvert(lDim) = lConvert(lDim) + ((lVal - &H30) * lMult)
  32.             lMult = (lMult * &HA)
  33.         End If
  34.         pStr = (pStr - &H2)
  35.     Loop
  36.  
  37.     If ((lConvert(&H2) > &H270F) Or _
  38.         ((lConvert(&H2) And &H80000000) = &H80000000)) Or _
  39.     Not (lDim = &H0) Then Exit Function
  40.  
  41.     Select Case lConvert(&H1)
  42.         Case &H1, &H3, &H5, &H7, &H8, &HA, &HC
  43.             If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H20)) Then isDate_BlackZX = True
  44.         Case Is > &HC, Is <= &H0
  45.             Exit Function
  46.         Case Else
  47.             If (lConvert(&H1) = &H2) Then
  48.                 If ((lConvert(&H2) Mod &H4) = &H0) Then
  49.                     If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1E)) Then isDate_BlackZX = True
  50.                 ElseIf ((lConvert(&H2) Mod 400) = &H0) Then
  51.                     If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1E)) Then isDate_BlackZX = True
  52.                 ElseIf ((lConvert(&H2) Mod 100) = &H0) Then
  53.                     If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1E)) Then isDate_BlackZX = True
  54.                 Else
  55.                     If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1D)) Then isDate_BlackZX = True
  56.                 End If
  57.             Else
  58.                 If ((lConvert(&H0) > &H0) And (lConvert(&H0) < &H1F)) Then isDate_BlackZX = True
  59.             End If
  60.     End Select
  61.  
  62. End Function
  63.  
  64.  

Temibles Lunas!¡.
« Última modificación: 3 Septiembre 2011, 09:22 am por BlackZeroX▓▓▒▒░░ » En línea
The Dark Shadow is my passion.
Sanlegas

Desconectado Desconectado

Mensajes: 131


https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-


Ver Perfil
Re: [RETO] IsDate
« Respuesta #11 en: 29 Agosto 2011, 02:38 am »
Código
  1. Public Function IsDate_T(ByRef Expresion As String) As Boolean
  2. On Error GoTo err
  3. Dim A           As Integer
  4. Dim B           As Integer
  5. Dim C           As Integer
  6. Dim P1          As Integer
  7. Dim P2          As Integer
  8. Dim F           As Boolean
  9.  
  10.             P1 = InStr(1, Expresion, "/")
  11.             If (Not CBool(P1)) Then Exit Function
  12.             P2 = InStr(P1 + 1, Expresion, "/")
  13.             If (Not CBool(P2)) Then Exit Function
  14.  
  15.             A = Mid(Expresion, 1, P1)
  16.             B = Mid(Expresion, P1 + 1, P2 - P1)
  17.             C = Mid(Expresion, P2 + 1, Len(Expresion))
  18.  
  19.             F = (((Not CBool((C Mod 4))) And CBool(C Mod 100)) Or (Not CBool(C Mod 400)))
  20.             IsDate_T = Not ((C < 0) Or (C > 9999) Or (A < 1) Or (B < 1) Or (B > 12) Or (F And (A > 29) And (B = 2)) Or (Not F And (A > 28) And (B = 2)))
  21. err:
  22. End Function

Me pude haber ahorrado variables... pero el codigo no quedaria bien explicado y tal vez seria mas lento, o bien usar el "truco" del vb con una variable de tipo Date  :xD
Salu2 !  :P
« Última modificación: 29 Agosto 2011, 20:09 pm por Tenient101 » En línea
79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #12 en: 30 Agosto 2011, 19:21 pm »
HOLA!!!

Alguien puede testear que es mas rapido (GoTo Fin o Exit Function)

GRACIAS POR LEER!!!
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*
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #13 en: 30 Agosto 2011, 19:28 pm »
Usa un poco la logica:

Exit function deberia de invocar
 * El Retorno.
 * Fin del proceso.
Goto deberia invocar.
 * Un guardado de posicion ( Insersion en una pila ).
 * Un salto de posicion.

En tu caso lo que haces es un goto al termino es decir
 * Un guardado de posicion  ( Insersion en una pila ).
 * Un salto de posicion.
 * El Retorno.
 * Fin del proceso.

Es mas lento...

Dulces Lunas!¡.
« Última modificación: 30 Agosto 2011, 19:34 pm por BlackZeroX▓▓▒▒░░ » En línea
The Dark Shadow is my passion.
79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #14 en: 30 Agosto 2011, 19:47 pm »
HOLA!!!

Mmm, si como lo planteas si pero pensando esto...

El exit function es un goto enfundado (para mi)

Acabe de testear y tardan casi lo mismo diferencia infima en un bucle de 600000000 vueltas.

Siempre a favor de Exit function, que debe ser ese tiempo donde guarda la posicion de la etiqueta (creo).

Pero yendo al tema donde la etiqueta la uso para el handle de errores, ese tiempo ya lo pierdo si o si... entonces debe tardar lo mismo.

tomando estas funciones:
Private Function a() As Boolean
GoTo Fin
Fin:
End Function
Private Function b() As Boolean
Exit Function
End Function

Osea para mi:
Citar
Exit function deberia de invocar
 * El Retorno.
* Un salto de posicion.
 * Fin del proceso.
Goto deberia invocar.
 * Un guardado de posicion ( Insersion en una pila ).(solo la primera vez)
 * Un salto de posicion.

En tu caso lo que haces es un goto al termino es decir
 * Un guardado de posicion  ( Insersion en una pila ).(solo una vez)
 * El Retorno.
 * Fin del proceso.
 * Un salto de posicion.

GRACIAS POR LEER!!!
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*
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #15 en: 1 Septiembre 2011, 07:46 am »
Cita de: 79137913 en 30 Agosto 2011, 19:47 pm
El exit function es un goto enfundado (para mi)

Ammm nop  exit function seria como una semejansza Uniforme de return como en C/C++, ya que termina la funcion ( Aun que estaria equivocado... pero... tendremos que ver el ASM de una funcion/proceso en vb6 para ver y poder afirmarlo. )

Exit Funcion en mi logica viene siendo una cutre representacion o simulacion de invocar al return de la funcion y por ende su terminacion, mas no de ir al final de una funcion... igual abria que ver el ASM de una funcion en vb6... Puedo estar errado...

Aun con pruebas... se sabe...

Dulces Lunas!¡.
En línea
The Dark Shadow is my passion.
raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #16 en: 3 Septiembre 2011, 04:44 am »
Resultados parciales
Código:
Testeo de calidad
==============================
31/07/2000	Tenient101 FAILS
30/07/2000	Tenient101 FAILS
01/02/2000	Tenient101 FAILS
25/05/2002	Tenient101 FAILS
15/07/2000	Tenient101 FAILS
28/02/2001	Tenient101 FAILS
31/05/2001	Tenient101 FAILS
30/12/2011	Tenient101 FAILS
29/02/2004	Tenient101 FAILS
01/01/2001	Tenient101 FAILS
31/12/9999	$Edu$ FAILS
31/12/9999	Tenient101 FAILS
29/02/2012	Tenient101 FAILS

Descargar proyecto de prueba
« Última modificación: 4 Septiembre 2011, 00:55 am por raul338 » En línea
ignorantev1.1


Desconectado Desconectado

Mensajes: 617


/\ Así acabo cuando quiero programar...


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #17 en: 3 Septiembre 2011, 05:21 am »
@raul338

Probé el proyecto(el que pusiste para descargar) varias veces y los resultados varían mucho, hay veces que incluso mi función es la más rápida... ¿Por qué?

@BlackZerox
De qué va que a veces firmas "Dulces Lunas" y otras "Temibles Lunas"?  :silbar:
En línea
raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #18 en: 3 Septiembre 2011, 05:32 am »
Por el uso del procesador, de todas formas, siempre prueba el proyecto COMPILADO! :D

PD: Mi version (iba a hacer algo asi para el IsNumeric pero Black me gano de mano :xD
Código
  1. Public Function IsDate_r338(ByVal str As String) As Boolean
  2. If str = vbNullString Then Exit Function
  3.     Dim strp As Long
  4.     strp = StrPtr(str)
  5. If lstrlenW(strp) <> 10 Then Exit Function
  6.  
  7.     Dim j As Long, k As Long, dia As Long, mes As Long, anio As Long, jp As Long
  8.  
  9.     jp = VarPtr(j)
  10.     For k = 0 To 18 Step 2
  11.         Call RtlMoveMemory(jp, strp + k, 1)
  12.         Select Case k / 2
  13.             Case 0
  14.                 If j < 48 And j > 51 Then Exit Function
  15.                 dia = (j - 48) * 10
  16.             Case 1
  17.                 If j < 48 And j > 57 Then Exit Function
  18.                 dia = dia + (j - 48)
  19.                 If dia = 0 Or dia > 31 Then Exit Function
  20.             Case 2, 5: If j <> 47 Then Exit Function
  21.             Case 3
  22.                 If j <> 48 And j <> 49 Then Exit Function
  23.                 mes = (j - 48) * 10
  24.             Case 4
  25.                 If j < 48 And j > 57 Then Exit Function
  26.                 mes = mes + (j - 48)
  27.                 If mes = 0 Or mes > 12 Then Exit Function
  28.                 If Not (mes = 1 Or mes = 3 Or mes = 5 Or mes = 7 Or mes = 8 Or mes = 10 Or mes = 12) And dia = 31 Then Exit Function
  29.                 If mes = 2 And dia > 29 Then Exit Function
  30.             Case 6
  31.                 If j < 48 And j > 57 Then Exit Function
  32.                 anio = (j - 48) * 1000
  33.             Case 7
  34.                 If j < 48 And j > 57 Then Exit Function
  35.                 anio = anio + (j - 48) * 100
  36.             Case 8
  37.                 If j < 48 And j > 57 Then Exit Function
  38.                 anio = anio + (j - 48) * 10
  39.             Case 9
  40.                 If j < 48 And j > 57 Then Exit Function
  41.                 anio = anio + (j - 48)
  42.  
  43.                 If mes = 2 And dia = 29 Then If Not (anio Mod 4 = 0 And Not (anio Mod 100 = 0 And anio Mod 400 <> 0)) Then Exit Function
  44.         End Select
  45.     Next
  46.     IsDate_r338 = True
  47. End Function
  48.  
« Última modificación: 4 Septiembre 2011, 00:46 am por raul338 » En línea
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #19 en: 3 Septiembre 2011, 08:36 am »
.
jajaja, la funcion de Raul338 tiene un parecido a la mia... aun asi no se moldea automaticamente a formatos D/M/YYYY, DD/M/YYYY, D/MM/YYYY, etc..., aun asi es muy buena!¡.

Edito:

MODIFIQUE MI FUNCION ( Aqui [en donde estaba el anterior codigo.]), solo modifique unos cuantos rangos... despresiando la velocidad.

Desde cuando "y0/45/hola" es una fecha? respeto el formato DD/MM/YYYY que querian que tuviera.

Código
  1.  
  2.     sTests = Split("31/07/2000|30/07/2000|01/02/2000|25/05/2002|15/07/2000|28/02/2001|" & _
  3.                     "31/05/2001|30/12/2011|29/02/2004|01/01/2001|31/12/9999|29/02/2012", "|")
  4.     sFalses = Split("01/00/2011|31/04/2001|00/12/2011|00/00/2011|01/13/2011|30/02/2001|y0/45/hola|" & _
  5.                     "29/02/2003|99/99/9999|32/12/9999|29/13/2000|LALA|00/00/0000|31/09/2011|y0/45/hola|", "|")
  6.  
  7.     Open App.Path & "\log.txt" For Output As #1
  8.     Call txt(" === Reto IsDate ====")
  9.     Call txt(Date$ & " " & Time$)
  10.  
  11.     Call txt("Testeo de calidad", True)
  12.     For i = 0 To UBound(sTests)
  13.         If modFunctions.heyIgnorante_isDate(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "Ignorante v1.1 FAILS")
  14.         If modFunctions.IsDate_7913_v2(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "79137913 FAILS")
  15.         If modFunctions.isDate_BlackZX(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "BlackZeroX FAILS")
  16.         If modFunctions.isDate_edu(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "$Edu$ FAILS")
  17.         If modFunctions.IsDate_T(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "Tenient101 FAILS")
  18.         If modFunctions.IsDate_r338(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "Raul338 FAILS")
  19.     Next
  20.  
  21.     Call txt("Testeo de falsos", True)
  22.     For i = 0 To UBound(sFalses)
  23.         If modFunctions.heyIgnorante_isDate(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "Ignorante v1.1 FAILS")
  24.         If modFunctions.IsDate_7913_v2(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "79137913 FAILS")
  25.         If modFunctions.isDate_BlackZX(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "BlackZeroX FAILS")
  26.         If modFunctions.isDate_edu(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "$Edu$ FAILS")
  27.         If modFunctions.IsDate_T(sFalses(i)) Then Call txt(sTests(i) & vbTab & "Tenient101 FAILS")
  28.         If modFunctions.IsDate_r338(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "Raul338 FAILS")
  29.     Next
  30.  
  31.  

Al test de velocidades hay que hacerle una media de velocidad ya que a mi me salio esto... claro que igual me gana en otras ocasiones Raul338...

Código:

 === Reto IsDate ====
09-03-2011 01:43:19

Testeo de calidad
==============================
31/07/2000	Tenient101 FAILS
30/07/2000	Tenient101 FAILS
01/02/2000	Tenient101 FAILS
25/05/2002	Tenient101 FAILS
15/07/2000	Tenient101 FAILS
28/02/2001	Tenient101 FAILS
31/05/2001	Tenient101 FAILS
30/12/2011	Tenient101 FAILS
29/02/2004	Tenient101 FAILS
01/01/2001	Tenient101 FAILS
31/12/9999	$Edu$ FAILS
31/12/9999	Tenient101 FAILS
29/02/2012	Tenient101 FAILS

Testeo de falsos
==============================
01/00/2011	Raul338 FAILS
00/12/2011	Raul338 FAILS
00/00/2011	Raul338 FAILS
01/13/2011	Raul338 FAILS
32/12/9999	Raul338 FAILS
29/13/2000	Raul338 FAILS
00/00/0000	Raul338 FAILS
31/09/2011	$Edu$ FAILS


Testeo de velocidades
==============================
79.816 msec		Ignorante v1.1
74.246 msec		79137913
10.764 msec		BlackZeroX
108.810 msec		$Edu$
63.844 msec		Tenient101
12.090 msec		Raul338


Sangriento Infierno Lunar!¡.
« Última modificación: 3 Septiembre 2011, 09:13 am por BlackZeroX▓▓▒▒░░ » En línea
The Dark Shadow is my passion.
Páginas: 1 [2] 3 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Reto ;)
Ingeniería Inversa 		NeoKiller 3 3,233 Último mensaje 15 Agosto 2004, 23:12 pm
por NeoKiller
Reto!!
Ingeniería Inversa 		HaCkZaTaN 2 3,248 Último mensaje 10 Septiembre 2004, 09:30 am
por Ðevastador
Reto vB
Ingeniería Inversa 		nhouse 2 3,737 Último mensaje 16 Marzo 2005, 09:41 am
por 4rS3NI(
reto en VB6
Ingeniería Inversa 		ellolo 1 2,843 Último mensaje 15 Abril 2005, 10:03 am
por UnpaCker!
Un reto !!! « 1 2 3 »
Programación Visual Basic 		VirucKingX 24 9,311 Último mensaje 8 Mayo 2006, 23:36 pm
por Kizar
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines