Hola amigos, estuve intentando sincronizar la hora desde Internet, logro conectar a un servidor ej: time.ien.it y recibir datos por medio del Modulo WinSock32 de Lea, pero al recivir los datos y establecer la hora y fecha en mi equipo lo hacen de manera incorrecta, me refiero a que no es ni la hora ni la fecha que corresponde. Les muestro el code, que va acompañado del Modulo WinSock32 de Leandro.
Option Explicit
Private Declare Function SetSystemTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME) As Long
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Dim sNTP As String 'the 32bit time stamp returned by the server
Dim TimeDelay As Single 'the time between the acknowledgement of
'the connection and the data received.
'we compensate by adding half of the round
'trip latency
Dim IP As String
Dim PORT As String
Private Sub Command_Click()
Call Conectar
End Sub
Private Sub Form_Load()
IP = "time.ien.it"
PORT = "37"
Call Conectar
End Sub
Sub Conectar()
WinSock32.InitWinSock Me
sNTP = Empty
If WinSock32.WsConnect(IP, PORT) Then 'Si conecta entonces...
Debug.Print "Conectado con " & IP & " en el puerto " & PORT
Debug.Print "Cliente - Conexiones activas: " & Sockets.Count
Else
Debug.Print "Error, no conectó"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
TerminateWinSock
End Sub
Public Sub Socket_DataArrival(ID As Long, IP As String, Puerto As String, Data As String)
Debug.Print IP & vbTab & Data
sNTP = sNTP & Data
End Sub
Public Sub Socket_Conect(ID As Long, IP As String, Puerto As String)
TimeDelay = Timer
End Sub
Public Sub Socket_Close(ID As Long, IP As String, Puerto As String)
Debug.Print "Se cortó la conexión con " & IP
'On Error Resume Next
'WinSock32.TerminateWinSock
WinSock32.WsClose 1
DoEvents
TimeDelay = ((Timer - TimeDelay) / 2)
Call SyncClock(sNTP)
End Sub
Private Sub SyncClock(tStr As String)
Dim NTPTime As Double
Dim UTCDATE As Date
Dim LngTimeFrom1990 As Long
Dim ST As SYSTEMTIME
tStr = Trim(tStr)
If Len(tStr) <> 4 Then
MsgBox "NTP Server returned an invalid response.", vbCritical, "Invalid Response "
Exit Sub
End If
NTPTime = Asc(Left$(tStr, 1)) * 256 ^ 3 + Asc(Mid$(tStr, 2, 1)) * 256 ^ 2 + _
Asc(Mid$(tStr, 3, 1)) * 256 ^ 1 + Asc(Right$(tStr, 1))
LngTimeFrom1990 = NTPTime - 2840140800#
UTCDATE = DateAdd("s", CDbl(LngTimeFrom1990 + CLng(TimeDelay)), #1/1/1990#)
ST.wYear = Year(UTCDATE)
ST.wMonth = Month(UTCDATE)
ST.wDay = Day(UTCDATE)
ST.wHour = Hour(UTCDATE)
ST.wMinute = Minute(UTCDATE)
ST.wSecond = Second(UTCDATE)
Call SetSystemTime(ST)
Debug.Print UTCDATE
End Sub
espero su ayuda. SAlu2