segue script necessá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
creditos: www.macoratti.net
Postado : 12/04/2010 5:46 pm