--- 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 *****************