Obtendo a hora de um servidor NT

Para obter a hora de um servidor NT, nós podemos usar a função da API NetRemoteTOD.

Nota: NetRemoteTOD, existe apenas no ambiente do NT. Este código não funcionará no Windows 95 ou 98.

Este é o código:

Private Type TIME_OF_DAY_INFO
  tod_elapsedt As Long  'número de segundos  _
                        desde 00:00:00, Janeiro 1, 1970.
  tod_msecs As Long     'o número de milisegundos _
                        de um ponto de início arbitrário  _
                        (system reset).
  tod_hours As Long     'hora atual (0-23)
  tod_mins  As Long     'minuto atual (0-59)
  tod_secs  As Long     'segundo atual (0-59)
  tod_hunds  As Long    'centésimo de segundo atual (0-99).
  tod_timezone  As Long 'TZ do servidor em minutos de GMT
  tod_tinterval  As Long 'intervalo de tempo para cada tic do relógio. _
                        Cada número representa 0.0001 de segundo.
  tod_day  As Long      'o dia do mes (1-31).
  tod_month  As Long    'o mes do ano (1-12).
  tod_year  As Long     'o ano.
  tod_weekday As Long   'o dia da semana: 0 é domingo
End Type

Private Declare Function apiNetRemoteTOD Lib "netapi32" _
  Alias "NetRemoteTOD" _
  (ByVal UncServerName As String, _
  BufferPtr As Long) _
  As Long

Private Declare Sub sapiCopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" _
  (hpvDest As Any, _
  hpvSource As Any, _
  ByVal cbCopy As Long)

'Função que pega a hora
Public Function fGetServerTime(ByVal strServer As String) As String

On Error GoTo ErrHandler
Dim tSvrTime As TIME_OF_DAY_INFO, lngRet As Long
Dim lngPtr As Long
Dim strOut As String
Dim intHoursDiff As Integer
Dim intMinsDiff As Integer
'Nome do servidor tem que ser precedido por \\
  If Not Left$(strServer, 2) = "\\" Then _
    Err.Raise vbObjectError + 5000

  strServer = StrConv(strServer, vbUnicode)
  lngRet = apiNetRemoteTOD(strServer, lngPtr)
  If Not lngRet = 0 Then Err.Raise vbObjectError + 5001
  Call sapiCopyMemory(tSvrTime, ByVal lngPtr, Len(tSvrTime))
 

  With tSvrTime
    intHoursDiff = .tod_timezone \ 60
    intMinsDiff = .tod_timezone Mod 60
    strOut = .tod_month & "/" & .tod_day & "/" _
       & .tod_year & " "
    If .tod_hours > 12 Then
      strOut = strOut & Format(.tod_hours - 12 - intHoursDiff, "00") _
        & ":" & Format$(.tod_mins - intMinsDiff, "00") & ":" _
       & Format$(.tod_secs, "00") & " PM"
    Else
      strOut = strOut & Format(.tod_hours - intHoursDiff, "00") _
        & ":" & Format$(.tod_mins - intMinsDiff, "00") & ":" _
       & Format$(.tod_secs, "00") & " AM"
    End If
  End With
  fGetServerTime = strOut
ExitHere:
  Exit Function
ErrHandler:
  fGetServerTime = vbNullString
  Resume ExitHere
End Function