Autor
|
Tema: [RETO] IsDate (Leído 12,344 veces)
|
$Edu$
Desconectado
Mensajes: 1.842
|
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
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
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 Utilizando mi ultima versión y la ultima de Black con 500000 vueltas por prueba 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
Mensajes: 1.842
|
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
Mensajes: 3.158
I'Love...!¡.
|
@$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
Mensajes: 1.089
|
Un poco tarde... aquí está la mía: Option Explicit Private Const sMonths$ = "01 02 03 04 05 06 07 08 09 10 11 12" Private Const s31Months$ = " 1 3 5 7 8 01 03 05 08 10 12 " Private Const sDays$ = sMonths & " 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31" '// Acepta formatos: DD/MM/YYYY, D/MM/YYYY y DD/M/YYYY. Public Static Function IsDate_Psyke1(ByRef sDate$) As Boolean Dim sDay$, sMonth$, sYear$, lp1&, lp2& If LenB(sDate) < &H16 And LenB(sDate) > &HE Then lp1 = InStrB(1, sDate, "/", vbBinaryCompare) If lp1 = 0 Then Exit Function sDay = LeftB$(sDate, lp1 - 1) If InStrB(1, sDays, sDay, vbBinaryCompare) Then lp2 = InStrB(lp1 + 1, sDate, "/", vbBinaryCompare) If lp2 = 0 Then Exit Function sMonth = MidB$(sDate, lp1 + 2, lp2 - lp1 - 2) If InStrB(1, sMonths, sMonth, vbBinaryCompare) Then sYear = RightB$(sDate, 8) If Not (sYear Like "####") Then Exit Function If InStrB(1, "02", sMonth, vbBinaryCompare) Then If InStrB(1, "29", sDay, vbBinaryCompare) Then IsDate_Psyke1 = ((sYear Mod &H4 = 0) And (sYear Mod &H64) Or (sYear Mod &H190 = 0)) Exit Function ElseIf InStrB(1, "30", sDay, vbBinaryCompare) Then Exit Function End If ElseIf InStrB(1, "31", sDay, vbBinaryCompare) Then IsDate_Psyke1 = InstrB(1, s31Months, sMonth, vbBinaryCompare) Exit Function End If IsDate_Psyke1 = True End If End If End If End Function
Tests: Private Sub Form_Load() Const sLine$ = "----------------------------------------" Debug.Print sLine; "TRUE"; sLine Debug.Print IsDate_Psyke1("31/07/2000") Debug.Print IsDate_Psyke1("29/02/2004") Debug.Print IsDate_Psyke1("15/07/2000") Debug.Print IsDate_Psyke1("30/12/2011") Debug.Print sLine; "FALSE"; sLine Debug.Print IsDate_Psyke1("29/02/2003") Debug.Print IsDate_Psyke1("01/13/2011") Debug.Print IsDate_Psyke1("30/02/2001") Debug.Print IsDate_Psyke1("00/12/2011") Debug.Print IsDate_Psyke1("as/12/2000") Debug.Print IsDate_Psyke1("13/as/2000") Debug.Print IsDate_Psyke1("-31/44/2070") Debug.Print IsDate_Psyke1("31/12/20s0") End Sub
Resultado: ----------------------------------------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: 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 : Debug.Print IsDate_r338("31/12/20f0") ' = True.. xD Debug.Print heyIgnorante_isDate("31/12/25y0") ' = True.. xD
Por tanto las funciones que dan resultados correctos: 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!
|
|
« Última modificación: 14 Septiembre 2011, 01:13 am por Psyke1 »
|
En línea
|
|
|
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
Yo igual repare la mia... Public Function IsDate_T(ByRef Expresion As String) As Boolean On Error GoTo err Dim A As Integer Dim B As Integer Dim C As Integer Dim P1 As Integer Dim P2 As Integer Dim F As Boolean Dim F2 As Boolean P1 = InStr(1, Expresion, "/") If (Not CBool(P1)) Then Exit Function P2 = InStr(P1 + 1, Expresion, "/") If (Not CBool(P2)) Then Exit Function A = Mid(Expresion, 1, P1 - 1) B = Mid(Expresion, P1 + 1, P2 - P1 - 1) C = Mid(Expresion, P2 + 1, Len(Expresion)) If (A And &H20) Then Exit Function If (C And &H8000) Then Exit Function If (B And &H8) Then P1 = (B - &H8) If (P1 And &H4) Then P1 = (P1 - &H4) If (P1 And &H1) Then Exit Function Else F2 = True End If Else If (P1 And &H2) Then P1 = (P1 - &H2) If (P1 Or &H0) = &H0 Then F2 = True Else If (P1 Or &H0) = &H0 Then F2 = True End If End If Else If (B And &H4) Then P1 = (B - &H4) If (P1 And &H2) Then P1 = (P1 - &H2) If (P1 And &H1) Then F2 = True Else If (P1 And &H1) Then F2 = True End If Else If (B And &H2) Then P1 = (B - &H2) If (P1 And &H1) Then F2 = True Else If (B And &H1) Then F2 = True End If End If End If If (C And &H2000) Then P1 = (P1 - &H2000) If (P1 And &H400) Then P1 = (P1 - &H400) If (P1 And &H200) Then P1 = (P1 - &H200) If (P1 And &H100) Then P1 = (P1 - &H100) If (P1 And &H10) Then Exit Function End If End If End If End If F = (((Not CBool((C Mod &H4))) And CBool(C Mod &H64)) Or (Not CBool(C Mod &H190))) IsDate_T = True If (A And &H10) Then P1 = (A - &H10) If (P1 And &H10) Then If ((Not F2) And (Not F)) Then IsDate_T = False Else If (P1 And &H8) Then P1 = (P1 - &H8) If (P1 And &H4) Then P1 = (P1 - &H4) If P1 Then If (B = &H2) Then If (Not F) Then IsDate_T = False Else If (Not (P1 = &H1)) Then IsDate_T = False End If Else If (P1 And &H2) Then P1 = (P1 - &H2) If (P1 And &H1) Then IsDate_T = F2 Else If (P1 Or &H0) = &H0 Then IsDate_T = F2 Else IsDate_T = Not F2 End If End If End If End If End If End If End If End If End If err: End Function
@Psyke1: "31/02/2011" = True Salu2!
|
|
« Última modificación: 13 Septiembre 2011, 17:59 pm por Tenient101 »
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Ook, gracias, se me escapó una cosa, sólo fue cambiar el orden de un If... DoEvents!
|
|
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Mi nueva minifunción (no es para ir rápido, pero creo que es la manera más corta de hacerlo): Option Explicit '// Acepta formatos: DD/MM/YYYY, D/MM/YYYY y DD/M/YYYY. Public Static Function IsDate_Psyke12(ByRef sDate$) As Boolean On Error Resume Next IsDate_Psyke12 = InStrB(1, CDate(sDate), sDate, vbBinaryCompare) End Function
La más rápida que se me ocurre: Option Explicit '// Acepta formatos: DD/MM/YYYY, D/MM/YYYY y DD/M/YYYY. Public Static Function IsDate_Psyke13(ByRef sDate$) As Boolean Dim lDay&, lMonth&, lYear&, lp1& On Error GoTo DateError lp1 = InStrB(1, sDate, "/", vbBinaryCompare) If lp1 = 0 Then Exit Function lYear = RightB$(sDate, 8) lDay = LeftB$(sDate, lp1 - 1) If lDay > 31 Then Exit Function If lDay < 1 Then Exit Function lMonth = MidB$(sDate, lp1 + 2, InStrB(lp1 + 1, sDate, "/", vbBinaryCompare) - lp1 - 2) Select Case lMonth Case Is > 12, Is < 1 Exit Function Case 2 If lDay = 29 Then IsDate_Psyke13 = ((lYear Mod &H4 = 0) And (lYear Mod &H64) Or (lYear Mod &H190 = 0)) Exit Function ElseIf lDay > 29 Then Exit Function End If Case Else If lDay = 31 Then Select Case lMonth Case 1,3,5,7,8,10,12 IsDate_Psyke13 = True End Select Exit Function End If End Select IsDate_Psyke13 = True Exit Function DateError: End Function
@Tenient101Quizás un poco larga, pero me gustó la idea, por cierto: Testeo de calidad ============================== 30/07/2000 Tenient101 FAILS 30/12/2011 Tenient101 FAILS 31/12/9999 $Edu$ FAILS Resultados: 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! DoEvents!
|
|
« Última modificación: 14 Septiembre 2011, 21:32 pm por Psyke1 »
|
En línea
|
|
|
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
Ya esta corregida , pero dos funciones tuyas siguen dando fail "31/11/2011" --- Psyke1 "31/11/2011" --- Psyke13 Salu2 !
|
|
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
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!
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Reto ;)
Ingeniería Inversa
|
NeoKiller
|
3
|
3,233
|
15 Agosto 2004, 23:12 pm
por NeoKiller
|
|
|
Reto!!
Ingeniería Inversa
|
HaCkZaTaN
|
2
|
3,248
|
10 Septiembre 2004, 09:30 am
por Ðevastador
|
|
|
Reto vB
Ingeniería Inversa
|
nhouse
|
2
|
3,737
|
16 Marzo 2005, 09:41 am
por 4rS3NI(
|
|
|
reto en VB6
Ingeniería Inversa
|
ellolo
|
1
|
2,843
|
15 Abril 2005, 10:03 am
por UnpaCker!
|
|
|
Un reto !!!
« 1 2 3 »
Programación Visual Basic
|
VirucKingX
|
24
|
9,311
|
8 Mayo 2006, 23:36 pm
por Kizar
|
|