Autor
|
Tema: [Reto] IsHour (Leído 8,720 veces)
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
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 !
|
|
« Última modificación: 15 Septiembre 2011, 05:29 am por Tenient101 »
|
En línea
|
|
|
|
x64core
Desconectado
Mensajes: 1.908
|
creo tener la mia 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
|
|
|
En línea
|
|
|
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
@Raul100: R100("aa:aa:aa") --- > Fail para hacerlo mas interesante acabo de agregar una nueva regla
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
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... 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... 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: Dulces Lunas!¡.
|
|
« Última modificación: 16 Septiembre 2011, 01:32 am por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
Sanlegas
Desconectado
Mensajes: 131
https://fbcdn-sphotos-e-a.akamaihd.net/hphotos-ak-
|
@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 !
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
isHour_BlackZX("14:59:09") --- > Fail
jaja sorry se me ofusco el LenB()... 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!¡.
|
|
« Última modificación: 15 Septiembre 2011, 08:10 am por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Ui que interesante, se me ocurren muchas formas de hacerlo, podré todas las que se me ocurran, con RegExp sería sencillísimo: ^([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): 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: Private Sub Form_Load() Debug.Print IsHour_Psyke1("12:13:12") Debug.Print IsHour_Psyke1("24:13:12") End Sub
Resultado: DoEvents!
|
|
« Última modificación: 16 Septiembre 2011, 00:55 am por Psyke1 »
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Mi segunda forma de hacerlo (sé que se puede simplificar código con bucles, pero yo lo elijo hacer así )'//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: 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: ================================================== 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... ): '//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
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: ================================================== True True True False False False
EDIT2:Mi cuarta forma de hacerlo: 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: 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: ================================================== 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!
|
|
« Última modificación: 15 Septiembre 2011, 22:36 pm por Psyke1 »
|
En línea
|
|
|
|
raul338
Desconectado
Mensajes: 2.633
La sonrisa es la mejor forma de afrontar las cosas
|
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) 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
|
|
« Última modificación: 15 Septiembre 2011, 15:04 pm por raul338 »
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. No me agradan los BadTypeConvert/EvilTypeConvert que hace Psyke1 aun que en fin de cuentas funciona pero no me agradan... Dulces Lunas!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Reto ;)
Ingeniería Inversa
|
NeoKiller
|
3
|
3,201
|
15 Agosto 2004, 23:12 pm
por NeoKiller
|
|
|
Reto!!
Ingeniería Inversa
|
HaCkZaTaN
|
2
|
3,214
|
10 Septiembre 2004, 09:30 am
por Ðevastador
|
|
|
Reto vB
Ingeniería Inversa
|
nhouse
|
2
|
3,708
|
16 Marzo 2005, 09:41 am
por 4rS3NI(
|
|
|
reto en VB6
Ingeniería Inversa
|
ellolo
|
1
|
2,823
|
15 Abril 2005, 10:03 am
por UnpaCker!
|
|
|
Un reto !!!
« 1 2 3 »
Programación Visual Basic
|
VirucKingX
|
24
|
9,250
|
8 Mayo 2006, 23:36 pm
por Kizar
|
|