He visto en alguna ocasión el código para insertar dentro de un
Userform la hora actual del sistema, y que la misma se actualice de
tal manera que se muestre como un Reloj. Esto es muy útil y funciona a
la perfección, pero yo quisiera que el usuario no pueda registrar una
acción en una hora o fecha previa a la real (por ejemplo cambiando la
hora del sistema), por eso me gustaría que este reloj se actualice a
través de un horario tomado de internet o algo por el estilo.. no se
si sea posible.. si pueden ayudarme se los agradecería mucho.
Saludos!
> He visto en alguna ocasi�n el c�digo para insertar dentro de un Userform la hora actual del sistema
>, y que la misma se actualice de tal manera que se muestre como un Reloj.
> Esto es muy util y funciona a la perfeccion, pero yo quisiera que el usuario no pueda registrar una accion
> en una hora o fecha previa a la real (por ejemplo cambiando la hora del sistema)
> por eso me gustaria que este reloj se actualice a traves de un horario tomado de internet o algo por el estilo...
si el "punto debil" NO esta en la programacion o alternativas posibles de programar
sino en la falta de personal "honesto"... de fiar... responsable de sus acciones, etc.
prueba alternativas para prevenir manipulaciones a la hora del sistema (reiniciando con horas "convenientes")
-> visitando sitios como los que encuentras aqui: http://search.live.com/results.aspx?q=world-clock&src=IE-SearchBox
(por tus macros podrias depositar una hora "estandar" o quiza, la que corresponda a la localidad del operador/usuario) -???-
saludos,
hector.
Cabe anotar que mi código es el siguiente:
//En el Formulario:
Private Sub UserForm_Activate()
Call SetTime
frmReloj.txtFecha.Value = Format$(Now, "hh:mm:ss")
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As
Integer)
Call Disable
'EndProcess
End Sub
//En un módulo normal:
Option Explicit
Public SchedRecalc As Date
Sub SetTime()
SchedRecalc = Now + TimeValue("00:00:01")
Application.OnTime SchedRecalc, "Recalc"
End Sub
Sub Recalc()
frmReloj.txtFecha.Value = Format$(Now, "hh:mm:ss")
Call SetTime
End Sub
Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc",
Schedule:=False
End Sub
Luego lo que hago es que el usuario escriba su identificación en un
textbox y al presionar un botón se registre la hora y fecha de la
acción.
Mi pregunta es ahora cómo depositar la Hora que corresponda a la
localidad del usuario en txtFecha, de tal manera que no use la función
Now que hasta donde se recoge únicamente la hora del sistema.
Muchísimas Gracias nuevamente!
> ... he visitado el link que me recomendaste y me direccione a http://www.timeanddate.com/worldclock/full.html
> El problema es que no puedo realizar la siguiente parte de tu mensaje:
> "(por tus macros podrias depositar una hora "estandar" o quiza, la que corresponda a la localidad del operador/usuario)" ...
> Cabe anotar que mi codigo es el siguiente: (... ... ...)
> Luego lo que hago es que el usuario escriba su identificacion en un textbox
> y al presionar un boton se registre la hora y fecha de la accion.
> Mi pregunta es ahora c�mo depositar la Hora que corresponda a la localidad del usuario en txtFecha
> de tal manera que no use la funcion Now que hasta donde se recoge unicamente la hora del sistema...
1) es probable que puedas evitar el uso de procedimientos recursivos (OnTime) para (solo) refrescar la hora en un control de textos
si en lugar de controles de texto (etiquetas o cuadros) utilizas un control "StatusBar" (toma la hora del sistema sin codigos extra)
a) agrega un control (statusbar) al cuadro de controles del editor de vba (y obviamente agregas un control a tu formulario)
lo encuentras por orden alfabetico (mas controles...) +/- en: -> Microsoft StatusBar Control, version x.0 (SPx)
b) en el modulo de codigo de tu fornulario agregas el siguiente procedimiento (ojo con el nombre real del control)
Private Sub UserForm_Initialize()
Me.StatusBar1.Panels(1).Style = sbrTime
End Sub
2) no se que tanto pudiera resultar mas efectivo "buscar" en paginas globales la hora correspondiente a la configuracion regional de x_equipo
o buscar mejor una sincronizacion de la fecha/hora del sistema, lo que evitaria "manipulaciones" por parte de los usuarios (?)
para la segunda alternativa, prueba visitando (y adaptando para VBA) los siguientes ejemplos (para VB):
Synchronizing Date and Time to a Remote Server
http://vbnet.mvps.org/code/network/netremotetodsync.htm
NetRemoteTOD: Get Time of Day Info for Local or Remote Machines
http://vbnet.mvps.org/code/network/netremotetod.htm
SetSystemTime: SNTP Time Server Synchronization using Winsock
http://vbnet.mvps.org/code/network/winsocksynctime.htm
WM_TIMECHANGE: Detect System Changes to the Date/Time
http://vbnet.mvps.org/code/subclass/datetime.htm
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.
__ el codigo expuesto __
//En el Formulario:
Private Sub UserForm_Activate()
Call SetTime
frmReloj.txtFecha.Value = Format$(Now, "hh:mm:ss")
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call Disable
'EndProcess
End Sub
//En un modulo normal:
A continuación expongo las 2 funciones que considero son las más
importantes, cabe recalcar que en Text2 es donde se captura la fecha y
hora del servidor remoto
Private Function GetRemoteTOD(ByVal sServer As String) As
TIME_OF_DAY_INFO
Dim bServer() As Byte
Dim tod As TIME_OF_DAY_INFO
Dim bufptr As Long
'A null passed as sServer retrieves
'the date for the local machine. If
'sServer is null, no slashes are added.
If sServer <> vbNullChar Then
'If a server name was specified,
'assure it has leading double slashes
If Left$(sServer, 2) <> "\\" Then
bServer = "\\" & sServer & vbNullChar
Else
bServer = sServer & vbNullChar
End If
Else
'null or empty string was passed
bServer = sServer & vbNullChar
End If
'get the time of day (TOD) from the specified server
If NetRemoteTOD(bServer(0), bufptr) = NERR_SUCCESS Then
'copy the buffer into a
'TIME_OF_DAY_INFO structure
CopyMemory tod, ByVal bufptr, LenB(tod)
End If
Call NetApiBufferFree(bufptr)
'return the TIME_OF_DAY_INFO structure
GetRemoteTOD = tod
End Function
Private Function SynchronizeTOD(ByVal sRemoteServer As String) As Date
Dim newdate As Date
Dim sys_sync As SYSTEMTIME
Dim server_date As TIME_OF_DAY_INFO
Dim local_date As TIME_OF_DAY_INFO
'Obtain a TIME_OF_DAY_INFO structure from the
'remote machine with which to synchronize to.
server_date = GetRemoteTOD(sRemoteServer)
'case returned values into a SYSTEMTIME structure
'and pass to the SetSystemTime api
With sys_sync
.wHour = server_date.tod_hours
.wMinute = server_date.tod_mins
.wSecond = server_date.tod_secs
.wDay = server_date.tod_day
.wMonth = server_date.tod_month
.wYear = server_date.tod_year
End With
If SetSystemTime(sys_sync) <> 0 Then
'sync was successful, so return Now
SynchronizeTOD = Now
End If
'--- for demo only ---
'The first shows calculating the
'date using the tod_elapsedt member.
'tod_elapsedt is a value that contains
'the number of seconds since
'00:00:00, January 1, 1970, GMT.
'Since tod_elapsedt is based on GMT (UTC),
'the next date applies the tod_timezone
'offset to adjust the date to the local time.
newdate = DateAdd("s", server_date.tod_elapsedt, #1/1/1970#)
newdate = DateAdd("n", -server_date.tod_timezone, newdate)
Text2.Text = newdate
'-----------------------
End Function
Muchas Gracias!
pd: la propuesta que hiciste del status bar me parece grandiosa!!
Gracias =)
> ... revise el primer link que me sugeriste puesto que en el se captura la fecha y hora de un servidor remoto dentro de un textbox
> El problema es que cuando ejecuto el programa en este text me aparece 01/01/1970 nada mas y no se que esta ocurriendo =s ...
solo faltaria que comentes la direccion del servidor que le pasas a las funciones (?)
saludos,
hector.
__ OP __
Gracias
> ... el nombre del servidor es: "laptop2000"
1) este servidor (si es el que estas usando) es el del ejemplo (entonces...)
confirmas que tambien es parte existente en tu red o en la red donde buscas ?
2) el inicio de la secuencia de acciones (en la pagina sugerida) es la accion de un boton (donde dice)
______
Private Sub Command1_Click()
Text1.Text = Now
'Text2 is set in SynchronizeTOD function
Text3.Text = SynchronizeTOD("laptop2000")
End Sub
------------
=> como y donde estas tu inciando esta secuencia ?
saludos,
hector.
y por ahora estoy manejando el código exacto como se encuentra en la
página sugerida.. había planeado que cuando este me funcione
correctamente colocaría el código correspondiente en mi aplicación.
Saludos!
> ... no habia caido en cuenta que "laptop2000" debe ser un equipo en Red.
> que sucede si quiero que sea tomada de un sitio externo una pagina en internet por ej?
> si es un equipo en Red lo identifico directamente con su nombre en la Red? ...
(creo que) usar alguna pagina web te obligaria a buscar la zona horaria del pc donde se ejecute tu codigo (?)
si es equipo de red solo necesitas su identificacion (las funciones completan convencionalismos como "\\" etc.)
(probablemente) lo que te convendria es adaptar el ejemplo de otra de las paginas sugeridas (esta:)
SetSystemTime: SNTP Time Server Synchronization using Winsock
http://vbnet.mvps.org/code/network/winsocksynctime.htm
(observa en el dialogo de "ajustar fecha y hora" cuando haces un clic-secundario en el icono de fecha-hora del systray)
solo necesitas uno de los servidores de sincronizacion horaria que utiliza windows (por omision)
de los que usa el ejemplo al inicializar/cargar el formulario (de VB) -> Private Sub Form_Load()
solo utiliza alguno de los siguientes:
- time.windows.com
- time.nist.gov
el ejemplo de la pagina sugerida hace mencion del siguiente articulo de la MS-KB: Q216734
aqui tienes algunos enlaces relacionados (incluyendo el de la pagina):
Como configurar un servidor horario con autoridad en Windows 2000
http://support.microsoft.com/kb/216734/
Como configurar un servidor horario con autorizacion en Windows XP
http://support.microsoft.com/kb/314054/
Lista de servidores horarios disponibles en Internet que utilizan el Protocolo simple de tiempo de redes
http://support.microsoft.com/kb/262680/
Entradas del Registro para el servicio W32Time
http://support.microsoft.com/kb/223184/
para consultar la hora exacta en tu zona horaria
http://www.worldtimeserver.com/
saludos,
hector.