VB - Obtendo a hora do servidor

Precisando obter a hora do seu servidor ? Acabou de achar como se faz...

Crie um novo projeto no VB6 do tipo standardEXE e no formulário padrão inclua um botão e uma caixa de texto.(Ver figura abaixo)

Agora inclua o seguinte código no formulário :

Private Declare Function NetRemoteTOD Lib "NETAPI32.DLL" (ByVal server As String, buffer As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (buffer As Any) As Long

Private Type TIME_OF_DAY
  t_elapsedt As Long
  t_msecs As Long
  t_hours As Long
  t_mins As Long
  t_secs As Long
  t_hunds As Long
  t_timezone As Long
  t_tinterval As Long
  t_day As Long
  t_month As Long
  t_year As Long
  t_weekday As Long
End Type

Public Function HoraServidor(ByVal pNomeServidor As String) As Variant

Dim t As TIME_OF_DAY
Dim tPtr As Long
Dim Resultado As Long
Dim szServer As String
Dim dataServidor As Date

On Error GoTo trata_erro

If Left(pNomeServidor, 2) = "\\" Then
   szServer = StrConv(pNomeServidor, vbUnicode)
Else
   szServer = StrConv("\\" & pNomeServidor, vbUnicode)
End If

Resultado = NetRemoteTOD(szServer, tPtr)

If Resultado = 0 Then

  Call CopyMemory(t, ByVal tPtr, Len(t))

  dataServidor = DateSerial(70, 1, 1) + (t.t_elapsedt / 60 / 60 / 24)
  dataServidor = dataServidor - (t.t_timezone / 60 / 24)
  NetApiBufferFree (tPtr)
  HoraServidor = dataServidor

Else

  MsgBox "Não foi possivel obter a hora do servidor"

End If

Exit Function

trata_erro:
MsgBox Err.Number & " - " & Err.Description

End Function

´chamando a função para obter a hora
Private Sub Command1_Click()
   'aqui você informa o nome do seu servidor
  Data = HoraServidor("\\macoratti11a81")
  Text1.Text = Data
End Sub

Bom proveito...

José Carlos Macoratti