[RETO] IsDate

[raul338]

Bueno, para seguir con esto de los retos y hacer que haya mas actividad competitiva y cooperativa (y no tantas dudas ) propongo hacer la alternativa a la función IsDate con la siguiente firma

Código (vb) [Seleccionar] Expandir

Function IsDate_Nombre(str As String) As Boolean
Function IsDate_Nombre_vX(str As String) As Boolean
'Ejemplos
Function IsDate_r338(str As String) As Boolean
Function IsDate_r338_v2(str As String) As Boolean
Function IsDate_7913(str As String) As Boolean


Tienen hasta el 5/09/2011 para proponer sus funciones bien pulidas y ahí las pondré a prueba  

• Para medir los tiempos se utilizará la clase CTiming utilizada en otros retos (Ver ejemplo de como se utiliza)
• Se recomiendan usar API's, otras funciones, ASM, lo que se les ocurra
• No te inhibes, mientras mas concursantes participen, mejor!
• No es estrictamente necesario que sea igual que IsDate (como paso con IsNumeric que "1..2..3" era un numero, WTF!) tan solo debe validar fechas
• Debe aceptar desde 01/01/0000 hasta 31/12/9999
• La fecha DEBE ser valida, deben fijarse si el año es bisiesto, no debe devolver TRUE en un dia 31 con un mes que solo tiene 30 dias
• Puede aceptar en distintos formatos, pero la mayoría de las pruebas las haré con "DD/MM/YYYY" para no presionar tanto
  
  
  
  • 1/1/2000
  • 01/01/2000
  • 1/1/00
  • 01/01/00
• Sobre los separadores y el formato por default tomare "DD/MM/YYYY" con "/" como separador, aunque hay rutinas para obtener el formato y el separador

Código (vb) [Seleccionar] Expandir


Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Function GetDateSeparator() As String
   Dim strLen As Long
   GetDateSeparator = String$(5, 0)
   strLen = GetProfileString("Intl", "sDate", "", GetDateSeparator, Len(GetDateSeparator))
   GetDateSeparator = Left$(GetDateSeparator, strLen)
End Function

Function GetDateFormat() As String
   Dim strLen As Long
   GetDateFormat = String$(11, 0)
   strLen = GetProfileString("Intl", "sShortDate", "", GetDateFormat, Len(GetDateFormat))
   GetDateFormat = Left$(GetDateFormat, strLen)
End Function



Por el momento con estas fechas debe devolver true

Código [Seleccionar] Expandir


31/07/2000
30/07/2000
01/02/2000
25/05/2002
15/07/2000
28/02/2001
31/05/2001
30/12/2011
29/02/2004


Y con estas false

Código [Seleccionar] Expandir


01/00/2011 ' No existe Mes 00
31/04/2001 ' Abril no tiene 31 xD
00/12/2011 ' Dia 00, WTF
00/00/2011 ' Dia 00, Mes 00, WTF x2
01/13/2011 ' Mes 13, WTF!
30/02/2001 ' Febrero NUNCA tendra 30
29/02/2003 ' 2003 No es bisiesto :3


Suerte a todos   y repito

No te inhibes, mientras mas concursantes participen, mejor!

[BlackZeroX]

.
Espacios en blanco?... = valen o se descartan...

Dulces Lunas!¡.

[ignorantev1.1]

Código (vb) [Seleccionar] Expandir

Function heyIgnorante_isDate(ByVal sDate As String) As Boolean
   Dim elemts() As String
   Dim D As Integer, M As Integer, A As Integer
   
   sDate = Trim$(sDate)
   elemnts = Split(sDate, "/")
   
   If UBound(elemnts) <> 2 Then Exit Function
   
   D = Val(elemnts(0)): M = Val(elemnts(1)): A = Val(elemnts(2))
   
   If D > 31 Or D < 1 Or M > 12 Or M < 1 Or A > 9999 Or A < 0 Then Exit Function
       
    If ((M < 8 And M Mod 2 = 0) Or (M > 7 And M Mod 2 = 1)) And D > 30 Then Exit Function
   
   If (A Mod 4 <> 0 And M = 2 And D > 28) Or _
   (A Mod 100 = 0 And A Mod 400 <> 0) Then
        Exit Function
   End If
   heyIgnorante_isDate = True
End Function


A ver, aquí esta mi archirecontraultrasupermegavegetarianamarcianarobotpirata función...
Bastante básica, pero pasó las pruebas que pusiste y solo a eso se limita.

No mencionaste sobre... los... emmm... no sé como llamarlos, los caracteres que dividen día, mes, año: "/" <---- así que solo acepta este...

Saludos!

Edite: ¡JUM! , @BlackZeroX▓▓▒▒░░

[x64core]

bueno yo creo que la funcion debe de tener las misma caracteristicas de la funcion isdate sino no se llamara del todo reemplazo de la funcion y pienso que raul338 dio informacion adicional acerca de la funcion isdate y no creo que no se referia a restricciones o adiciones a nuestra funcion

[raul338]

Espacios en blanco?... = valen o se descartan...

Sin espacios.. solo numeros y "/"

bueno yo creo que la funcion debe de tener las misma caracteristicas de la funcion isdate sino no se llamara del todo reemplazo de la funcion

Pero no puse que sea "reemplazo"

Ahi agrego un edit sobre el "/"

[x64core]

Sin espacios.. solo numeros y "/"
Pero no puse que sea "reemplazo"

"Bueno, para seguir con esto de los retos y hacer que haya mas actividad competitiva y cooperativa (y no tantas dudas ) propongo hacer el reemplazo a la función IsDate con la siguiente firma"



v_v'

[raul338]

@Raul100: No era la intencion

Ahi puse un codigo para obtener el formato y el separador, por si alguien quiere experimentar a  futuro

[79137913]

HOLA!!!

Me puse a ver que podia hacer y salio esto:
Uso GoTos no me reten
/Ofuscando codigo /

VERSION 2.0

Código (vb) [Seleccionar] Expandir

Private Function IsDate_7913_v2(str As String) As Boolean
On Error GoTo Fin
Dim Partes(2) As Long
Dim Primer() As String
   Primer = Split(str, "/")
   If UBound(Primer) <> 2 Then GoTo Fin
   Partes(0) = Primer(0): Partes(1) = Primer(1): Partes(2) = Primer(2)
   If Partes(2) > 9999 Then GoTo Fin
   Select Case Partes(1) 'verificamos el mes
       Case 0
           GoTo Fin
       Case 1, 3, 5, 7, 8, 10, 12 'si es de 31 dias
           Select Case Partes(0) 'verificamos el dia
               Case Is > 31
                   GoTo Fin 'si es mayor que 31 es false
               Case Is < 1
                   GoTo Fin 'si es menor que 1 es false
               Case Else
                   IsDate_7913_v2 = True : GoTo Fin 'sino true
           End Select
       Case 4, 6, 9, 11 'si es de 30 dias
           Select Case Partes(0)
               Case Is > 30
                   GoTo Fin
               Case Is < 1
                   GoTo Fin
               Case Else
                    IsDate_7913_v2 = True : GoTo Fin
           End Select
       Case 2 'si es febrero
           Select Case Partes(0)
               Case Is > 29 'si es mayor que 29
                   GoTo Fin
               Case Is < 1 ' si es menor a 1
                   GoTo Fin
               Case 29
                   If Partes(2) Mod 4 = 0 Then
                       If Partes(2) Mod 100 = 0 Then
                           If Partes(2) Mod 400 = 0 Then IsDate_7913_v2 = True 'si es biciesto multiplo de 100 y 400
                       Else
                            IsDate_7913_v2 = True : GoTo Fin  'si es biciesto
                       End If
                   End If
               Case Else
                    IsDate_7913_v2 = True : GoTo Fin
           End Select
       End Select
Fin:
End Function


GRACIAS POR LEER!!!

[$Edu$]

Aca va el mio a ver que tal, no se si sera lento, pero lo intente hacer con mejor funcionalidad.

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()
Debug.Print "------CORRECTAS-------"
Debug.Print isDate_edu("31/07/2000")
Debug.Print isDate_edu("30/07/2000")
Debug.Print isDate_edu("01/02/2000")
Debug.Print isDate_edu("25/05/2002")
Debug.Print isDate_edu("15/07/2000")
Debug.Print isDate_edu("28/02/2001")
Debug.Print isDate_edu("31/05/2001")
Debug.Print isDate_edu("30/12/2011")
Debug.Print isDate_edu("29/02/2004")

Debug.Print "------FALSAS----------"
Debug.Print isDate_edu("01/00/2011")
Debug.Print isDate_edu("31/04/2001")
Debug.Print isDate_edu("00/12/2011")
Debug.Print isDate_edu("00/00/2011")
Debug.Print isDate_edu("01/13/2011")
Debug.Print isDate_edu("30/02/2001")
Debug.Print isDate_edu("29/02/2003")

End Sub

Function isDate_edu(str As String) As Boolean
   
   Dim dato() As String
   Dim anno, mes, dia As String
   
str = Trim$(str)

dato = Split(str, "/")

If UBound(dato) <> 2 Then Exit Function

dia = Val(dato(0))
mes = Val(dato(1))
anno = Val(dato(2))

If anno < 1 Or mes < 1 Or dia < 1 Then Exit Function
If mes > 12 Or dia > 31 Then Exit Function

If (Not mes And 1) And (mes <> 8) And (dia > 30) Then Exit Function

If (mes = 2 And dia > 28) And Not (anno Mod 4 = 0 And Not (anno Mod 100 = 0 And anno Mod 400 <> 0)) Then Exit Function

isDate_edu = True
End Function


Acuerdense que hay una exepcion para lo de los años biciestros, pueden mirar mi codigo y despues eso que pusiste ignore.. un año mayor que 9999 no puede ser? xD

[BlackZeroX]

un dato a añadir...

Un año es bisiesto si es divisible entre 4, excepto el último de cada siglo (aquel divisible por 100), salvo que este último sea divisible por 400.

Dulces Lunas!¡.