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

 

 


Tema destacado: Usando Git para manipular el directorio de trabajo, el índice y commits (segunda 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 11,459 veces)
$Edu$


Desconectado Desconectado

Mensajes: 1.842



Ver Perfil
Re: [RETO] IsDate
« Respuesta #20 en: 3 Septiembre 2011, 20:54 pm »
A ver que yo nunca hago retos, quiero saber que hice mal yo xD y que es eso de que falla con el año 9999? no es una fecha eso? digo por lo del codigo de ignorante..
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 #21 en: 4 Septiembre 2011, 00:41 am »
Cita de: $Edu$ en  3 Septiembre 2011, 20:54 pm
A ver que yo nunca hago retos, quiero saber que hice mal yo xD y que es eso de que falla con el año 9999? no es una fecha eso? digo por lo del codigo de ignorante..


Quiere decir que tu funcion no devuelve como se espera, en la sección "Testeo de calidad" tu funcion deberia devolver TRUE pero devuelve false, si esta en "Testeo de falsos" tu funcion devuelve true y deberia ser falsos :xD

Utilizando mi ultima versión y la ultima de Black con 500000 vueltas por prueba

Código:
Testeo de velocidades
==============================
529,028 msec		Raul338
532,471 msec		BlackZeroX
3.522,390 msec		79137913
3.797,892 msec		Tenient101
3.887,114 msec		Ignorante v1.1
5.204,378 msec		$Edu$
« Última modificación: 4 Septiembre 2011, 00:55 am por raul338 » En línea
$Edu$


Desconectado Desconectado

Mensajes: 1.842



Ver Perfil
Re: [RETO] IsDate
« Respuesta #22 en: 4 Septiembre 2011, 01:20 am »
Si raul lo se -_-' xD pero me refiero a porque si yo habia probado todos y andaban bien, y que es eso del codigo de ignorante que un año no puede ser mayor a 9999? xD
En línea
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #23 en: 4 Septiembre 2011, 06:58 am »
@$Edu$

Seguramente solo es por que asi esta definido como reto, vaya puede ser del año -infinito hasta infinito tomando en cuenta que el 0 es donde se dice que es la era cristiana... y los numeros negativos los años A.C., pero claro como no hay años negativos (signo negativo) se pueden interpretar como A.C. y no D.C ( Actualidad ).

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

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #24 en: 12 Septiembre 2011, 03:47 am »
Un poco tarde... :silbar: aquí está la mía:

Código
  1. Option Explicit
  2. Private Const sMonths$ = "01 02 03 04 05 06 07 08 09 10 11 12"
  3. Private Const s31Months$ = " 1 3 5 7 8 01 03 05 08 10 12 "
  4. Private Const sDays$ = sMonths & " 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31"
  5.  
  6. '// Acepta formatos: DD/MM/YYYY, D/MM/YYYY y DD/M/YYYY.
  7. Public Static Function IsDate_Psyke1(ByRef sDate$) As Boolean
  8. Dim sDay$, sMonth$, sYear$, lp1&, lp2&
  9.     If LenB(sDate) < &H16 And LenB(sDate) > &HE Then
  10.         lp1 = InStrB(1, sDate, "/", vbBinaryCompare)
  11.         If lp1 = 0 Then Exit Function
  12.  
  13.         sDay = LeftB$(sDate, lp1 - 1)
  14.         If InStrB(1, sDays, sDay, vbBinaryCompare) Then
  15.             lp2 = InStrB(lp1 + 1, sDate, "/", vbBinaryCompare)
  16.             If lp2 = 0 Then Exit Function
  17.  
  18.             sMonth = MidB$(sDate, lp1 + 2, lp2 - lp1 - 2)
  19.             If InStrB(1, sMonths, sMonth, vbBinaryCompare) Then
  20.                 sYear = RightB$(sDate, 8)
  21.                 If Not (sYear Like "####") Then Exit Function
  22.  
  23.                 If InStrB(1, "02", sMonth, vbBinaryCompare) Then
  24.                     If InStrB(1, "29", sDay, vbBinaryCompare) Then
  25.                         IsDate_Psyke1 = ((sYear Mod &H4 = 0) And (sYear Mod &H64) Or (sYear Mod &H190 = 0))
  26.                         Exit Function
  27.                     ElseIf InStrB(1, "30", sDay, vbBinaryCompare) Then
  28.                         Exit Function
  29.                     End If
  30.                 ElseIf InStrB(1, "31", sDay, vbBinaryCompare) Then
  31.                     IsDate_Psyke1 = InstrB(1, s31Months, sMonth, vbBinaryCompare)
  32.                     Exit Function
  33.                 End If
  34.  
  35.                 IsDate_Psyke1 = True
  36.             End If
  37.         End If
  38.     End If
  39. End Function

Tests:
Código
  1. Private Sub Form_Load()
  2. Const sLine$ = "----------------------------------------"
  3.  
  4.     Debug.Print sLine; "TRUE"; sLine
  5.     Debug.Print IsDate_Psyke1("31/07/2000")
  6.     Debug.Print IsDate_Psyke1("29/02/2004")
  7.     Debug.Print IsDate_Psyke1("15/07/2000")
  8.     Debug.Print IsDate_Psyke1("30/12/2011")
  9.  
  10.     Debug.Print sLine; "FALSE"; sLine
  11.     Debug.Print IsDate_Psyke1("29/02/2003")
  12.     Debug.Print IsDate_Psyke1("01/13/2011")
  13.     Debug.Print IsDate_Psyke1("30/02/2001")
  14.     Debug.Print IsDate_Psyke1("00/12/2011")
  15.     Debug.Print IsDate_Psyke1("as/12/2000")
  16.     Debug.Print IsDate_Psyke1("13/as/2000")
  17.     Debug.Print IsDate_Psyke1("-31/44/2070")
  18.     Debug.Print IsDate_Psyke1("31/12/20s0")
  19. End Sub

Resultado:
Código:
----------------------------------------TRUE----------------------------------------
True
True
True
True
----------------------------------------FALSE----------------------------------------
False
False
False
False
False
False
False
False

Ahora con el proyecto de raul338 (compilado y con la función de BlackZeroX actualizada), los tests me dicen que devuelve resultados correctos, y en cuanto a velocidad me dio esto:
Código:
Testeo de velocidades
==============================
43,920 msec		Ignorante v1.1
35,993 msec		79137913
21,728 msec		BlackZeroX
73,901 msec		$Edu$
89,051 msec		Tenient101
27,381 msec		Raul338
16,374 msec		Psyke1

@Raul338, @Ignorante :
Código
  1.     Debug.Print IsDate_r338("31/12/20f0")         ' = True.. xD
  2.     Debug.Print heyIgnorante_isDate("31/12/25y0") ' = True.. xD
  3.  

Por tanto las funciones que dan resultados correctos:
Código:
Testeo de velocidades
==============================
35,993 msec		79137913
21,728 msec		BlackZeroX
16,374 msec		Psyke1


@BlackZeroX:
Me gustaría que me explicaras un par de cosas de tu código, si te pillo por el msn te molesto, que hace mucho que no hablamos. :-*

DoEvents! :P
« Última modificación: 14 Septiembre 2011, 01:13 am por Psyke1 » En línea
http://foro.h-sec.org/
Sanlegas

Desconectado Desconectado

Mensajes: 131


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


Ver Perfil
Re: [RETO] IsDate
« Respuesta #25 en: 13 Septiembre 2011, 03:58 am »
Yo igual repare la mia...  :rolleyes:

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. Dim F2          As Boolean
  10.  
  11.             P1 = InStr(1, Expresion, "/")
  12.             If (Not CBool(P1)) Then Exit Function
  13.             P2 = InStr(P1 + 1, Expresion, "/")
  14.             If (Not CBool(P2)) Then Exit Function
  15.  
  16.             A = Mid(Expresion, 1, P1 - 1)
  17.             B = Mid(Expresion, P1 + 1, P2 - P1 - 1)
  18.             C = Mid(Expresion, P2 + 1, Len(Expresion))
  19.  
  20.             If (A And &H20) Then Exit Function
  21.             If (C And &H8000) Then Exit Function
  22.  
  23.             If (B And &H8) Then
  24.                 P1 = (B - &H8)
  25.                 If (P1 And &H4) Then
  26.                     P1 = (P1 - &H4)
  27.                     If (P1 And &H1) Then
  28.                         Exit Function
  29.                     Else
  30.                         F2 = True
  31.                     End If
  32.                 Else
  33.                     If (P1 And &H2) Then
  34.                         P1 = (P1 - &H2)
  35.                         If (P1 Or &H0) = &H0 Then F2 = True
  36.                     Else
  37.                         If (P1 Or &H0) = &H0 Then F2 = True
  38.                     End If
  39.                 End If
  40.             Else
  41.                 If (B And &H4) Then
  42.                     P1 = (B - &H4)
  43.                     If (P1 And &H2) Then
  44.                         P1 = (P1 - &H2)
  45.                         If (P1 And &H1) Then F2 = True
  46.                     Else
  47.                         If (P1 And &H1) Then F2 = True
  48.                     End If
  49.                 Else
  50.                     If (B And &H2) Then
  51.                         P1 = (B - &H2)
  52.                         If (P1 And &H1) Then F2 = True
  53.                     Else
  54.                         If (B And &H1) Then F2 = True
  55.                     End If
  56.                 End If
  57.             End If
  58.  
  59.             If (C And &H2000) Then
  60.                 P1 = (P1 - &H2000)
  61.                 If (P1 And &H400) Then
  62.                     P1 = (P1 - &H400)
  63.                     If (P1 And &H200) Then
  64.                         P1 = (P1 - &H200)
  65.                         If (P1 And &H100) Then
  66.                             P1 = (P1 - &H100)
  67.                             If (P1 And &H10) Then Exit Function
  68.                         End If
  69.                     End If
  70.                 End If
  71.             End If
  72.  
  73.             F = (((Not CBool((C Mod &H4))) And CBool(C Mod &H64)) Or (Not CBool(C Mod &H190)))
  74.  
  75.             IsDate_T = True
  76.  
  77.             If (A And &H10) Then
  78.                 P1 = (A - &H10)
  79.                 If (P1 And &H10) Then
  80.                     If ((Not F2) And (Not F)) Then IsDate_T = False
  81.                 Else
  82.                     If (P1 And &H8) Then
  83.                         P1 = (P1 - &H8)
  84.                         If (P1 And &H4) Then
  85.                             P1 = (P1 - &H4)
  86.                             If P1 Then
  87.                                 If (B = &H2) Then
  88.                                     If (Not F) Then
  89.                                         IsDate_T = False
  90.                                     Else
  91.                                         If (Not (P1 = &H1)) Then IsDate_T = False
  92.                                     End If
  93.                                 Else
  94.                                     If (P1 And &H2) Then
  95.                                         P1 = (P1 - &H2)
  96.                                         If (P1 And &H1) Then
  97.                                             IsDate_T = F2
  98.                                         Else
  99.                                             If (P1 Or &H0) = &H0 Then
  100.                                                 IsDate_T = F2
  101.                                             Else
  102.  
  103.                                                 IsDate_T = Not F2
  104.                                             End If
  105.                                         End If
  106.                                     End If
  107.                                 End If
  108.                             End If
  109.                         End If
  110.                     End If
  111.                 End If
  112.             End If
  113. err:
  114. End Function

@Psyke1: "31/02/2011" = True  :o

Salu2!
« Última modificación: 13 Septiembre 2011, 17:59 pm por Tenient101 » En línea
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #26 en: 13 Septiembre 2011, 07:34 am »
Ook, gracias, se me escapó una cosa, sólo fue cambiar el orden de un If... :silbar:

DoEvents! :P
En línea
http://foro.h-sec.org/
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #27 en: 13 Septiembre 2011, 12:55 pm »
Mi nueva minifunción (no es para ir rápido, pero creo que es la manera más corta de hacerlo):
Código
  1. Option Explicit
  2.  
  3. '// Acepta formatos: DD/MM/YYYY, D/MM/YYYY y DD/M/YYYY.
  4. Public Static Function IsDate_Psyke12(ByRef sDate$) As Boolean
  5. On Error Resume Next
  6.     IsDate_Psyke12 = InStrB(1, CDate(sDate), sDate, vbBinaryCompare)
  7. End Function

La más rápida que se me ocurre:
Código
  1. Option Explicit
  2.  
  3. '// Acepta formatos: DD/MM/YYYY, D/MM/YYYY y DD/M/YYYY.
  4. Public Static Function IsDate_Psyke13(ByRef sDate$) As Boolean
  5. Dim lDay&, lMonth&, lYear&, lp1&
  6. On Error GoTo DateError
  7.  
  8.     lp1 = InStrB(1, sDate, "/", vbBinaryCompare)
  9.     If lp1 = 0 Then Exit Function
  10.  
  11.     lYear = RightB$(sDate, 8)
  12.  
  13.     lDay = LeftB$(sDate, lp1 - 1)
  14.     If lDay > 31 Then Exit Function
  15.     If lDay < 1 Then Exit Function
  16.  
  17.     lMonth = MidB$(sDate, lp1 + 2, InStrB(lp1 + 1, sDate, "/", vbBinaryCompare) - lp1 - 2)
  18.     Select Case lMonth
  19.         Case Is > 12, Is < 1
  20.             Exit Function
  21.         Case 2
  22.             If lDay = 29 Then
  23.                 IsDate_Psyke13 = ((lYear Mod &H4 = 0) And (lYear Mod &H64) Or (lYear Mod &H190 = 0))
  24.                 Exit Function
  25.             ElseIf lDay > 29 Then
  26.                 Exit Function
  27.             End If
  28.         Case Else
  29.             If lDay = 31 Then
  30.                 Select Case lMonth
  31.                     Case 1,3,5,7,8,10,12
  32.                         IsDate_Psyke13 = True 
  33.                 End Select
  34.                 Exit Function
  35.             End If
  36.     End Select
  37.  
  38.     IsDate_Psyke13 = True
  39.     Exit Function
  40. DateError:
  41. End Function

@Tenient101
Quizás un poco larga, pero me gustó la idea, por cierto:
Código:
Testeo de calidad
==============================
30/07/2000	Tenient101 FAILS
30/12/2011	Tenient101 FAILS
31/12/9999	$Edu$ FAILS

Resultados:
Código:
Testeo de velocidades
==============================
43,271 msec		Ignorante v1.1
43,986 msec		79137913
21,627 msec		BlackZeroX
60,085 msec		$Edu$
20,118 msec		Tenient101
27,267 msec		Raul338
18,805 msec		Psyke1
29,638 msec		Psyke12
12,705 msec		Psyke13
23,933 msec		IsDate (función original de vb)

IsDate() PWND! :xD


DoEvents! :P
« Última modificación: 14 Septiembre 2011, 21:32 pm por Psyke1 » En línea
http://foro.h-sec.org/
Sanlegas

Desconectado Desconectado

Mensajes: 131


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


Ver Perfil
Re: [RETO] IsDate
« Respuesta #28 en: 13 Septiembre 2011, 18:06 pm »
Ya esta corregida  :rolleyes:, pero dos funciones tuyas siguen dando fail

Citar
"31/11/2011" --- Psyke1
"31/11/2011" --- Psyke13

Salu2 !
En línea
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] IsDate
« Respuesta #29 en: 13 Septiembre 2011, 18:38 pm »
Ook, ya están bien, recordemos que aún estoy engrasando motores, que llevo tiempo sin programar, ando oxidado.
Venga, ¿a qué esperáis? ¡otro reto ya!

DoEvents! :P
En línea
http://foro.h-sec.org/
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 2,919 Último mensaje 15 Agosto 2004, 23:12 pm
por NeoKiller
Reto!!
Ingeniería Inversa 		HaCkZaTaN 2 2,969 Último mensaje 10 Septiembre 2004, 09:30 am
por Ðevastador
Reto vB
Ingeniería Inversa 		nhouse 2 3,528 Último mensaje 16 Marzo 2005, 09:41 am
por 4rS3NI(
reto en VB6
Ingeniería Inversa 		ellolo 1 2,647 Último mensaje 15 Abril 2005, 10:03 am
por UnpaCker!
Un reto !!! « 1 2 3 »
Programación Visual Basic 		VirucKingX 24 8,520 Último mensaje 8 Mayo 2006, 23:36 pm
por Kizar
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines