[RETO] IsDate

[$Edu$]

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..

[raul338]

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

Código [Seleccionar] Expandir


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$


[$Edu$]

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

[BlackZeroX]

@$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!¡.

[Psyke1]

Un poco tarde... aquí está la mía:

Código (vb) [Seleccionar] Expandir


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:

Código (vb) [Seleccionar] Expandir


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:

Código [Seleccionar] Expandir

----------------------------------------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 [Seleccionar] Expandir

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 (vb) [Seleccionar] Expandir


   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:

Código [Seleccionar] Expandir

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!

[Sanlegas]

Yo igual repare la mia...  

Código (vb) [Seleccionar] Expandir

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!

[Psyke1]

Ook, gracias, se me escapó una cosa, sólo fue cambiar el orden de un If...

DoEvents!

[Psyke1]

Mi nueva minifunción (no es para ir rápido, pero creo que es la manera más corta de hacerlo):

Código (vb) [Seleccionar] Expandir


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:

Código (vb) [Seleccionar] Expandir


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

@Tenient101
Quizás un poco larga, pero me gustó la idea, por cierto:

Código [Seleccionar] Expandir

Testeo de calidad
==============================
30/07/2000 Tenient101 FAILS
30/12/2011 Tenient101 FAILS
31/12/9999 $Edu$ FAILS

Resultados:

Código [Seleccionar] Expandir

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!

[Sanlegas]

Ya esta corregida  , pero dos funciones tuyas siguen dando fail

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

Salu2 !

[Psyke1]

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!