comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[FUNCION] Reemplazo de Funcin IsDate IsDate_7913_v2

  • 0 Respuestas
  • 1620 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Conectado 79137913

  • *
  • Moderator
  • Mensajes: 632
  • Actividad:
    6.67%
  • Reputación 11
  • 4 Esquinas
    • Ver Perfil
    • Doors.Party
    • Email
  • Skype: fg_mdq@hotmail.com
« en: Mayo 27, 2013, 03:34:08 pm »
HOLA!!!

Código: Visual Basic
  1. Private Function IsDate_7913_v2(str As String) As Boolean
  2. On Error GoTo Fin
  3. Dim Partes(2) As Long
  4. Dim Primer() As String
  5.     Primer = Split(str, "/")
  6.     If UBound(Primer) <> 2 Then GoTo Fin
  7.     Partes(0) = Primer(0): Partes(1) = Primer(1): Partes(2) = Primer(2)
  8.     If Partes(2) > 9999 Then GoTo Fin
  9.     Select Case Partes(1) 'verificamos el mes
  10.        Case 0
  11.             GoTo Fin
  12.         Case 1, 3, 5, 7, 8, 10, 12 'si es de 31 dias
  13.            Select Case Partes(0) 'verificamos el dia
  14.                Case Is > 31
  15.                     GoTo Fin 'si es mayor que 31 es false
  16.                Case Is < 1
  17.                     GoTo Fin 'si es menor que 1 es false
  18.                Case Else
  19.                     IsDate_7913_v2 = True : GoTo Fin 'sino true
  20.            End Select
  21.         Case 4, 6, 9, 11 'si es de 30 dias
  22.            Select Case Partes(0)
  23.                 Case Is > 30
  24.                     GoTo Fin
  25.                 Case Is < 1
  26.                     GoTo Fin
  27.                 Case Else
  28.                     IsDate_7913_v2 = True : GoTo Fin
  29.             End Select
  30.         Case 2 'si es febrero
  31.            Select Case Partes(0)
  32.                 Case Is > 29 'si es mayor que 29
  33.                    GoTo Fin
  34.                 Case Is < 1 ' si es menor a 1
  35.                    GoTo Fin
  36.                 Case 29
  37.                     If Partes(2) Mod 4 = 0 Then
  38.                         If Partes(2) Mod 100 = 0 Then
  39.                             If Partes(2) Mod 400 = 0 Then IsDate_7913_v2 = True 'si es biciesto multiplo de 100 y 400
  40.                        Else
  41.                             IsDate_7913_v2 = True : GoTo Fin  'si es biciesto
  42.                        End If
  43.                     End If
  44.                 Case Else
  45.                     IsDate_7913_v2 = True : GoTo Fin
  46.             End Select
  47.         End Select
  48. Fin:
  49. End Function
  50.  

Una version mucho mejor de Raul338:

Código: Visual Basic
  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, año 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.                 año = (j - 48) * 1000
  33.             Case 7
  34.                 If j < 48 And j > 57 Then Exit Function
  35.                 año = año + (j - 48) * 100
  36.             Case 8
  37.                 If j < 48 And j > 57 Then Exit Function
  38.                 año = año + (j - 48) * 10
  39.             Case 9
  40.                 If j < 48 And j > 57 Then Exit Function
  41.                 año = año + (j - 48)
  42.  
  43.                 If mes = 2 And dia = 29 Then If Not (año Mod 4 = 0 And Not (año Mod 100 = 0 And año Mod 400 <> 0)) Then Exit Function
  44.         End Select
  45.     Next
  46.     IsDate_r338 = True
  47. End Function


GRACIAS POR LEER!!!
"Algunos creen que soy un bot, puede que tengan razon"
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

*Shadow Scout Team*                                                   No tienes permisos para ver links. Registrate o Entra con tu cuenta

 

¿Te gustó el post? COMPARTILO!



[SUB] <FUNCION> Print7913Char (Imprime en PicBox caracteres tipo Google Fair).

Iniciado por 79137913

Respuestas: 0
Vistas: 1565
Último mensaje Mayo 27, 2013, 03:36:32 pm
por 79137913
[VB6] Funcion para subir Archivos FTP mediante Inet

Iniciado por 79137913

Respuestas: 0
Vistas: 585
Último mensaje Julio 11, 2018, 09:24:28 am
por 79137913
[FUNCION] Extraer numeros de cadenas ExtractNums7913

Iniciado por 79137913

Respuestas: 0
Vistas: 1783
Último mensaje Mayo 27, 2013, 03:34:35 pm
por 79137913
Función Enviar Archivo VirusTotal (Escanea)

Iniciado por Danyfirex

Respuestas: 1
Vistas: 2553
Último mensaje Mayo 14, 2013, 08:00:10 pm
por Snifer
[FUNCION] IsUnicode (Determina si una cadena es unicode o no)

Iniciado por 79137913

Respuestas: 0
Vistas: 2102
Último mensaje Noviembre 18, 2013, 10:13:33 am
por 79137913