--- Soumis par Dev Ashish---
L'heure, celle du serveur NT.
Pour obtenir l'heure tel que connue sur le serveur NT, on peut utliser la fonction API NetRemoteTOD (TimeOfDay) .
Note: NetRemoteTOD, de même que quelques autres fonction de l'API, n'existe que sous l'environnement Windows NT. Ce code ne fonctionnera PAS sous Windows 95 or 98.
'*************** Code Start ****************
Private Type TIME_OF_DAY_INFO
tod_elapsedt As Long 'le nombre de secondes _
depuis 00:00:00, January 1, 1970.
tod_msecs As Long 'le nombre de millisecondes _
depuis un point arbitraire _
(system reset).
tod_hours As Long 'l'heure locale (0-23)
tod_mins As Long 'la minute (0-59)
tod_secs As Long 'la seconde (0-59)
tod_hunds As Long 'le centième de seconde (0-99).
tod_timezone As Long 'TZ (time zone) du serveur, en minutes depuis UTC
tod_tinterval As Long 'Interval de chaque clic d'horloge _
Cet entier représente _
un dixième de milliseconde _
(0.0001 seconde).
tod_day As Long 'le jour du mois (1-31).
tod_month As Long 'le mois de l'année (1-12).
tod_year As Long 'l'année
tod_weekday As Long 'le premier jour de la semaine, 0 pour dimanche
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)
Public Function fGetServerTime(ByVal strServer As String) As String
'*******************************************
'Name: fGetServerTime [NT SEULEMENT] (Function)
'Purpose: Retourne l'heure du jour d'un serveur NT
'Author: Dev Ashish
'Date: Monday, January 11, 1999
'Called by: Any
'Calls: NetRemoteTOD, RtlMoveMemory
'Inputs: Name of NT Server in \\ServerName format
'Returns: Time of day for the NT Server
'*******************************************
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
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
'**************** Code End *****************