[Reto] IsHour

Sanlegas · 15 Septiembre 2011, 04:16 AM

Bueno para seguir practicando y calentando, ahora por que no un reto para saber si una expresión es una hora

, creo que es mas facil pero bueno

la fecha limite es el 18/09/2011 y como no hay una funcion de vb que haga lo mismo (corregirme si me equivoco) se hara en lo mas logico, que acepte el siguiente formato HH:MM:SS (horas,minutos,segundos) y las siguientes reglas

* Debe aceptar de "00:00:00" hasta "23:59:59"
* En base a lo anterior y para hacerlo mas interesante lo correcto es llenar los dos lugares, si es menor que 10 se pondra un cero, ejemplo:
"05:59:59" ----> Correcto
"5:59:59" ---- > Falso
* Debe devolver True si la hora es correcta
* El delimitador para separar los numeros es ":"

Buena suerte a todos.. un saludo !

x64core · 15 Septiembre 2011, 05:23 AM

creo tener la mia

Código (VB) [Seleccionar]


Function R100(XXX As String) As Boolean
Dim X() As String

X = Split(XXX, ":")
If (CInt(X(0)) < 24) And (CInt(X(1) < 60)) And (CInt(X(2) < 60)) Then R100 = True
End Function

Sanlegas · 15 Septiembre 2011, 05:30 AM

@Raul100:

R100("aa:aa:aa") --- > Fail

para hacerlo mas interesante acabo de agregar una nueva regla

BlackZeroX · 15 Septiembre 2011, 07:03 AM

Es cuestion solo de modificar algunas cosillas de la funcion isDate. Por ejemplo aqui tienen la mia Donde solo Modifique la 2da funcion isDate de mi tutela. solo Modifique los rangos... y cambio el select case por un simple if then para verificar rangos...

Código (Vb) [Seleccionar]



Option Explicit
 
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
 
'   //  Formato aceptado   HH:MM:SS, H:/MM:S, HH:MM:S, etc!¡.
Public Function isHour_BlackZX(ByRef sStr As String, Optional bExtrictic As Boolean = True) As Boolean
Dim lChar           As Long
Dim lVal            As Long
Dim lConvert(2)     As Long
 
Dim lDim            As Long
Dim lMult           As Long
Dim pStr            As Long
Dim pChar           As Long
 
    pStr = LenB(sStr)
    If (bExtrictic) Then
        If Not (pStr = &H10) Then Exit Function
    ElseIf (pStr < &H5) And (pStr <= &H8) Then
        Exit Function
    End If
    
    pStr = StrPtr(sStr) + (pStr - &H2)
    pChar = VarPtr(lChar)
    
    lDim = &H2
    lMult = &H1
    lConvert(lDim) = &H0
    
    Do Until StrPtr(sStr) > pStr
        RtlMoveMemory pChar, pStr, &H2  '   //  Dos bytes = char...
        lVal = (lChar And &HFF)
        If (lVal = &H3A) Then
            lDim = (lDim - &H1)
            If ((lDim And &H80000000) = &H80000000) Then Exit Function
            lMult = &H1
        Else
            If ((lVal > &H39) Or (lVal < &H30)) Then Exit Function
            lConvert(lDim) = lConvert(lDim) + ((lVal - &H30) * lMult)
            lMult = (lMult * &HA)
        End If
        pStr = (pStr - &H2)
    Loop
        
    If (lConvert(&H0) > &H17) Or (lConvert(&H1) > &H3B) Or (lConvert(&H2) > &H3B) Then Exit Function
    
    isHour_BlackZX = True
   
End Function

Private Sub Form_Load()
    MsgBox isHour_BlackZX("23:59:9") & vbCrLf & _
           isHour_BlackZX("23:59:9", False)
End Sub

2da version, leyendo 32bits (la anterior es a 16bits pero es mas legible), esta un tanto ofuscada...

Código [Seleccionar]



Option Explicit
 
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)

Public Function addAscToNumber(ByVal lAsc As Long, ByRef rArrConvert() As Long, ByRef lIndex As Long, ByRef lMult As Long) As Long
    addAscToNumber = (-1)
    If (lAsc = &H3A) Then
        lMult = &H1
        lIndex = (lIndex + &H1)
    Else
        If (lAsc = &H0) Then addAscToNumber = &H1: Exit Function
        If ((lAsc > &H39) Or (lAsc < &H30)) Then addAscToNumber = &H0: Exit Function
        rArrConvert(lIndex) = (rArrConvert(lIndex) * lMult) + (lAsc - &H30)
        lMult = (lMult * &HA)
    End If
End Function

'   //  Formato aceptado   HH:MM:SS, H:/MM:S, HH:MM:S, etc!¡.
Public Function isHour_BlackZX(ByRef sStr As String, Optional bExtrictic As Boolean = True) As Boolean
Dim lChar           As Long
Dim lConvert(2)     As Long
Dim lIndex          As Long
Dim lMult           As Long
Dim lStrLnB         As Long
Dim pStr            As Long
Dim pStrLim         As Long
Dim pChar           As Long
    lStrLnB = LenB(sStr)
    If (bExtrictic) Then
        If Not (lStrLnB = &H10) Then Exit Function
    ElseIf (lStrLnB < &H5) And (lStrLnB <= &H8) Then
        Exit Function
    End If
    pStr = StrPtr(sStr)
    pStrLim = (lStrLnB + pStr - &H2)
    pChar = VarPtr(lChar)
    lMult = &H1
    For pStr = pStr To pStrLim Step &H4
        RtlMoveMemory pChar, pStr, &H4  '   //  Cuatro bytes = 4 --> 2 Char...
        Select Case addAscToNumber((lChar And &HFF), lConvert, lIndex, lMult)
            Case (1): Exit For
            Case (0): Exit Function
        End Select
        If (lIndex > &H2) Then Exit Function
        Select Case addAscToNumber(((lChar And &HFF0000) / &H10000), lConvert, lIndex, lMult)
            Case (1): Exit For
            Case (0): Exit Function
        End Select
        If (lIndex > &H2) Then Exit Function
    Next
    If (lConvert(&H0) > &H17) Or (lConvert(&H1) > &H3B) Or (lConvert(&H2) > &H3B) Then Exit Function
    isHour_BlackZX = True
End Function

Private Sub Form_Load()
    MsgBox isHour_BlackZX("23:59:9") & vbCrLf & _
           isHour_BlackZX("23:59:9", False)
End Sub

Output:

Código [Seleccionar]



Falso
Verdadero

Dulces Lunas!¡.

Sanlegas · 15 Septiembre 2011, 07:27 AM

@BlackZeroX▓▓▒▒░░: si tienes razon, pero es por que tu función es mas generica... , y claro para resolver un problema puedes usar diferentes soluciones...
Por cierto:
isHour_BlackZX("14:59:09") --- > Fail

Salu2 !

BlackZeroX · 15 Septiembre 2011, 08:08 AM

Cita de: Tenient101 en 15 Septiembre 2011, 07:27 AM

isHour_BlackZX("14:59:09") --- > Fail

jaja sorry se me ofusco el LenB()...

Código (vb,8) [Seleccionar]



Dim lMult           As Long
Dim pStr            As Long
Dim pChar           As Long
 
    pStr = LenB(sStr)
    If (bExtrictic) Then
        If Not (pStr = &H8) Then Exit Function
    ElseIf (pStr < &H5) And (pStr <= &H8) Then
        Exit Function
    End If

El valor &H8 deberia ser &H10 ya lo corregi, gracias por el aviso.

Edito:

Valen espacios en blanco? digo para meterle algo para que no diga False en casos como "23:59:59 " y " 23:59:59" o ambos casos " 23:59:59 ".

Dulces Lunas!¡.

Psyke1 · 15 Septiembre 2011, 11:05 AM

Ui que interesante, se me ocurren muchas formas de hacerlo, podré todas las que se me ocurran, con RegExp sería sencillísimo:

Código [Seleccionar]

^([01]\d|2[0-3])\:[0-5]\d\:[0-5]\d$
(Después lo desarollo antes de que se me adelante raul338)

Mi primera forma de hacerlo (dudo que sea la más rápida, pero igual si la más corta):

Código (vb) [Seleccionar]


Option Explicit

Public Static Function IsHour_Psyke1(ByRef sHour$) As Boolean
On Error Resume Next
    IsHour_Psyke1 = TimeValue(sHour) And (LenB(sHour) = 16)
End Function

Test:

Código (vb) [Seleccionar]

Private Sub Form_Load()
    Debug.Print IsHour_Psyke1("12:13:12")
    Debug.Print IsHour_Psyke1("24:13:12")
End Sub

Resultado:

Código [Seleccionar]

True
False

DoEvents!

Psyke1 · 15 Septiembre 2011, 12:49 PM

Mi segunda forma de hacerlo (sé que se puede simplificar código con bucles, pero yo lo elijo hacer así )

Código (vb) [Seleccionar]


'//En un módulo de clase.

Option Explicit
Private Declare Sub PutMem4 Lib "msvbvm60.dll" (ByVal Ptr&, ByVal Value&)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
 
Private lngAscHeader&(5), intAsc%()
 
Public Static Function IsHour_Psyke12(ByRef sHour$) As Boolean
    If LenB(sHour) = 16 Then
        lngAscHeader(3) = StrPtr(sHour)
 
        '//Check ":"
        If intAsc(2) = 58 And intAsc(5) = 58 Then
            '//Hours
            If intAsc(0) < 48 Or intAsc(0) > 50 Then Exit Function
            
            If intAsc(1) < 48 Then Exit Function
            If intAsc(0) = 50 Then
                If intAsc(1) > 51 Then Exit Function
            Else
                If intAsc(1) > 57 Then Exit Function
            End If
            
            '//Minutes
            If intAsc(3) < 48 Or intAsc(3) > 53 Then Exit Function
            If intAsc(4) < 48 Or intAsc(4) > 57 Then Exit Function
            
            '//Seconds
            If intAsc(6) < 48 Or intAsc(6) > 53 Then Exit Function
            If intAsc(7) < 48 Or intAsc(7) > 57 Then Exit Function
            
            IsHour_Psyke12 = True
        End If
    End If
End Function
 
Private Sub Class_Initialize()
    lngAscHeader(0) = 1
    lngAscHeader(1) = 2
    lngAscHeader(4) = &H7FFFFFFF
    PutMem4 VarPtrArray(intAsc), VarPtr(lngAscHeader(0))
End Sub
 
Private Sub Class_Terminate()
    PutMem4 VarPtrArray(intAsc), 0
End Sub

Test:

Código (vb) [Seleccionar]

Option Explicit

Private Sub Form_Load()
Dim c As New Class1

    Debug.Print String$(50, "=")
    Debug.Print c.IsHour_Psyke12(Time$)      'True
    Debug.Print c.IsHour_Psyke12("23:59:59") 'True
    Debug.Print c.IsHour_Psyke12("00:00:00") 'True
    Debug.Print c.IsHour_Psyke12("34:54:13") 'False
    Debug.Print c.IsHour_Psyke12("14:64:24") 'False
    Debug.Print c.IsHour_Psyke12("22:07:70") 'False
    
Set c = Nothing
End Sub

Resultados:

Código [Seleccionar]

==================================================
True
True
True
False
False
False

EDIT:

Mi tercera forma de hacerlo (no creo que sea muy rápida, tan solo doy más opciones... ):

Código (vb) [Seleccionar]


'//En un módulo de clase.

Option Explicit
Private oRegExp As Object
 
Public Static Function IsHour_Psyke13(ByRef sHour$) As Boolean
    IsHour_Psyke13 = oRegExp.Test(sHour)
End Function
 
Private Sub Class_Initialize()
    Set oRegExp = CreateObject("VBScript.RegExp")
    With oRegExp
        .Pattern = "^([01]\d|2[0-3])\:[0-5]\d\:[0-5]\d$"
        .Global = True
    End With
End Sub
 
Private Sub Class_Terminate()
    Set oRegExp = Nothing
End Sub

Código (vb) [Seleccionar]

Option Explicit

Private Sub Form_Load()
Dim c As New Class1

    Debug.Print String$(50, "=")
    Debug.Print c.IsHour_Psyke13(Time$)      'True
    Debug.Print c.IsHour_Psyke13("23:59:59") 'True
    Debug.Print c.IsHour_Psyke13("00:00:00") 'True
    Debug.Print c.IsHour_Psyke13("34:54:13") 'False
    Debug.Print c.IsHour_Psyke13("14:64:24") 'False
    Debug.Print c.IsHour_Psyke13("22:07:70") 'False
    
Set c = Nothing
End Sub

Resultados:

Código [Seleccionar]

==================================================
True
True
True
False
False
False

EDIT2:

Mi cuarta forma de hacerlo:

Código (vb) [Seleccionar]


Option Explicit

Public Static Function IsHour_Psyke14(ByRef sHour$) As Boolean
Dim h As Byte, m As Byte, s As Byte
On Error GoTo NoHour:
    If LenB(sHour) = 16 Then
        If InStrB(1, ":", MidB$(sHour, 5, 2), vbBinaryCompare) = 0 Then Exit Function
        If InStrB(1, ":", MidB$(sHour, 11, 2), vbBinaryCompare) = 0 Then Exit Function
        
        h = LeftB$(sHour, 4) + 0
        If h > 23 Then Exit Function
        m = MidB$(sHour, 7, 4) + 0
        If m > 59 Then Exit Function
        s = RightB$(sHour, 4) + 0
        If s > 59 Then Exit Function
        
        IsHour_Psyke14 = True
    End If
    Exit Function
NoHour:
End Function

Test:

Código (vb) [Seleccionar]

Option Explicit

Private Sub Form_Load()
    Debug.Print String$(50, "=")
    Debug.Print IsHour_Psyke14(Time$)      'True
    Debug.Print IsHour_Psyke14("23:59:59") 'True
    Debug.Print IsHour_Psyke14("00:00:00") 'True
    Debug.Print IsHour_Psyke14("34:54:13") 'False
    Debug.Print IsHour_Psyke14("14:64:24") 'False
    Debug.Print IsHour_Psyke14("22:04:70") 'False
End Sub

Resultados:

Código [Seleccionar]

==================================================
True
True
True
False
False
False

PD: Lo próximo que tenga que decir haré un comentario nuevo que sino hago una pág kilométrica.

DoEvents!

raul338 · 15 Septiembre 2011, 15:02 PM

Buena idea con el reto

yo me olvide que iba a proponer de reto y después se me paso

Hice lo mismo que BlackZeroX, agarre mi IsDate y lo transforme a IsHour!!

Ademas de que lo optimize (y puedo optimizar tambien el IsDate, pero ya fue xD)

Código (vb) [Seleccionar]


Public Function IsHour_r338(str As String) As Boolean
If str = vbNullString Then Exit Function
If LenB(str) <> 16 Then Exit Function
    
    Dim j As Long, k As Long, vTemp As Byte, jp As Long
    Dim strp As Long
    strp = StrPtr(str)
    jp = VarPtr(j)
    For k = 0 To 14 Step 2
        Call RtlMoveMemory(jp, strp + k, 1)
        Select Case k
            Case 0
                If j < 48 And j > 50 Then Exit Function
                vTemp = (j - 48) * 10
            Case 2
                If j < 48 And j > 57 Then Exit Function
                vTemp = vTemp + (j - 48)
                If vTemp > 23 Then Exit Function
            Case 4, 10: If j <> 58 Then Exit Function
            Case 6, 12
                If j < 48 And j > 53 Then Exit Function
                vTemp = (j - 48) * 10
            Case 8, 14
                If j < 48 And j > 57 Then Exit Function
                vTemp = vTemp + (j - 48)
                If vTemp > 59 Then Exit Function
        End Select
    Next
    IsHour_r338 = True
End Function

BlackZeroX · 15 Septiembre 2011, 19:53 PM

.
No me agradan los BadTypeConvert/EvilTypeConvert que hace Psyke1 aun que en fin de cuentas funciona pero no me agradan...

Dulces Lunas!¡.