Fala aí. Veja se isso serve: Para se atualizar a hora via Web podemos utilizar o time Protocol ou o NTP (Network time Protocol), o primeiro é mais simples e serve para se obter um timestamp de um servidor, 'time server'.
Estes são geralmente públicos e gratuitos, servindo a hora certa produzida por um relógio atômico a qualquer cliente que souber se conectar. Com isso basta vc implementar um modelo de acesso e instalar nos seus servidores que eles ficarão sempre sincronizados.
Lá vai o exemplo, ai vc muda o que precisar, eu adaptei este código de uma outra pessoa para ficar mais simples. Tudo que o servidor faz é retornar 4 bytes contendo o número de segundos desde 1/1/1900, o resto é com a gente. A data resultante será sempre GMT (Greenwich Mean Time), ou seja, a hora no meridiano 0.
Para testar desenhe os seguintes controles num form vazio:
1 TextBox MultiLine
1 Combo com o Style = DropDownList
1 Winsock
1 CommandButton
Cole o seguinte código no form:
Const TIME_ZONE_ID_UNKNOWN = 0
Const TIME_ZONE_ID_STANDARD = 1
Const TIME_ZONE_ID_DAYLIGHT = 2
Private TimeDelay As Single
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
Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName As String * 64
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName As String * 64
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Sub Command1_Click()
Text1 = ""
With Winsock1
If .State <> sckClosed Then .Close
.RemoteHost = Combo1.Text
.RemotePort = 37 ' porta do servidor (Time Server)
.Connect
End With
End Sub
Private Sub Winsock1_Connect()
' Marca o tempo para que quando a resposta vier a gente compute a demora
TimeDelay = Timer
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim NTPTime As Double
Dim LocalTime As Date
Dim dwSecondsSince1990 As Long
Dim Difference As Long
Dim ST As SYSTEMTIME
Dim Resp As Long
Dim UTCTime As Date
Dim RemoteTime As String
Dim ZoneFactor As Long
' recebe a informação do servidor
Winsock1.GetData RemoteTime, vbString
Winsock1.Close
RemoteTime = Trim(RemoteTime)
If Len(RemoteTime) = 4 Then
' Calcula a diferença de fuso (Zona)
ZoneFactor = 60 * AdjustTimeForTimeZone
' Transforma o string recebido num inteiro longo
NTPTime = Asc(Left$(RemoteTime, 1)) * (256 ^ 3) + Asc(Mid$(RemoteTime, 2, 1)) * (256 ^ 2) + Asc(Mid$(RemoteTime, 3, 1)) * (256 ^ 1) + Asc(Right$(RemoteTime, 1))
' Calcular o tempo de conexão
TimeDelay = (Timer - TimeDelay)
' Crie uma data baseada nos segundos passados desde 1/1/1900
dwSecondsSince1990 = NTPTime - 2840140800# + CDbl(TimeDelay)
UTCTime = DateAdd("s", CDbl(dwSecondsSince1990), #1/1/1990#)
'converter a hora UTC time para hora local e obter a diferença
LocalTime = DateAdd("s", CDbl(ZoneFactor), UTCTime)
Difference = DateDiff("s", Now, LocalTime)
' Passa a hora do servidor para a estrutura do sistema
With ST
.wYear = Year(UTCTime)
.wMonth = Month(UTCTime)
.wDay = Day(UTCTime)
.wHour = Hour(UTCTime)
.wMinute = Minute(UTCTime)
.wSecond = Second(UTCTime)
End With
' Feedback
Text1 = "Hora do Servidor Remoto: " & UTCTime & vbCrLf
Text1 = Text1 & "Hora Local: " & Now & vbCrLf
Text1 = Text1 & "Hora Convertida: " & LocalTime & vbCrLf
Text1 = Text1 & "Diferença: " & Difference & " segundos" & vbCrLf
Text1 = Text1 & "Fuso Horário: " & DateDiff("h", UTCTime, LocalTime) & " horas" & vbCrLf
' Ajusta o relógio local
If Check1.Value = 1 Then
Resp = SetSystemTime(ST)
End If
Else
MsgBox "Tempo recebido é inválido", vbCritical, "Erro"
End If
End Sub
Private Sub Form_Load()
' Alguns time servers
With Combo1
.AddItem "time-a.timefreq.bldrdoc.gov"
.AddItem "time-b.timefreq.bldrdoc.gov"
.AddItem "time-c.timefreq.bldrdoc.gov"
.AddItem "utcnist.colorado.edu"
.AddItem "time-nw.nist.gov"
.AddItem "nist1.nyc.certifiedtime.com"
.AddItem "nist1.dc.certifiedtime.com"
.AddItem "nist1.sjc.certifiedtime.com"
.AddItem "nist1.datum.com"
.AddItem "ntp2.cmc.ec.gc.ca"
.AddItem "ntps1-0.uni-erlangen.de"
.AddItem "ntps1-1.uni-erlangen.de"
.AddItem "ntps1-2.uni-erlangen.de"
.AddItem "ntps1-0.cs.tu-berlin.de"
.AddItem "time.ien.it"
.AddItem "ptbtime1.ptb.de"
.AddItem "ptbtime2.ptb.de"
.ListIndex = 0
End With
Check1.Caption = "Acertar Relógio Local com a hora recebida"
Command1.Caption = "Busca"
End Sub
Private Function AdjustTimeForTimeZone() As Long
Dim TZI As TIME_ZONE_INFORMATION
Dim RetVal As Long
Dim ZoneCorrection As Long
RetVal = GetTimeZoneInformation(TZI)
ZoneCorrection = TZI.Bias
If RetVal = TIME_ZONE_ID_STANDARD Then
ZoneCorrection = ZoneCorrection + TZI.StandardBias
ElseIf RetVal = TIME_ZONE_ID_DAYLIGHT Then
ZoneCorrection = ZoneCorrection + TZI.DaylightBias
Else
MsgBox "Não foi possível obter informação de fuso.", vbExclamation, "Erro"
End If
AdjustTimeForTimeZone = -ZoneCorrection 'correção em minutos
End Function
Não foi possível obter informação de fuso.", vbExclamation, "Erro"
End If
AdjustTimeForTimeZone = -ZoneCorrection 'correção em minutos
End Function
