|
Postada em 25/10/2005 10:13 hs
'Coloque isso em um form.
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 ServerTime(ByVal pServerName _ As String) As Variant Dim t As TIME_OF_DAY Dim tPtr As Long Dim Result As Long Dim szServer As String Dim ServDate As Date If Left(pServerName, 2) = "" Then szServer = StrConv(pServerName, vbUnicode) Else szServer = StrConv("" & pServerName, _ vbUnicode) End If Result = NetRemoteTOD(szServer, tPtr) If Result = 0 Then Call CopyMemory(t, ByVal tPtr, Len(t)) ServDate = DateSerial(70, 1, 1) + _ (t.t_elapsedt / 60 / 60 / 24) ServDate = ServDate - (t.t_timezone / 60 / 24) NetApiBufferFree (tPtr) ServerTime = ServDate Else 'erro End If End Function
Private Sub Form_Click()
Dim hoje As Date Dim hora As Date
Data = ServerTime("fttp://Servidor") pos = InStr(Data, " ") hoje = Left(Data, (pos - 1)) hora = Right(Data, (Len(Data) - pos))
Date = hoje Time = hora
linha = Trim(Str(hoje)) + " - " + Trim(Str(hora))
MsgBox linha End Sub
(Data, (Len(Data) - pos))
Date = hoje Time = hora
linha = Trim(Str(hoje)) + " - " + Trim(Str(hora))
MsgBox linha End Sub
'*créditos deste código para jobasaint
|
|
|