Zeitabgleich im Netzwerk Dieser Code zeigt, wie sich Datum und Uhrzeit eines Netzwerk-Rechners ermitteln lassen.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  18.182
www.tools4vb.de	System:  WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 35 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.4 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Nachfolgender Code zeigt, wie sich Datum und Uhrzeit eines Netzwerk-Rechners ermitteln lassen, um z.B. einen Zeitabgleich für den eigenen Rechner durchzuführen.

' Benötigte API-Deklarationen
Private Declare Function NetRemoteTOD Lib "netapi32.dll" ( _
  UncServerName As Any, _
  lpBuffer As Long) As Long
 
Private Declare Function NetApiBufferFree Lib "netapi32.dll" ( _
  ByVal lpBuffer As Long) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  Destination As Any, _
  ByVal Source As Any, _
  ByVal Length As Long)
 
Private Type TIME_OF_DAY_INFO
  tod_elapsedt As Long
  tod_msecs As Long
  tod_hours As Long
  tod_mins As Long
  tod_secs As Long
  tod_hunds As Long
  tod_timezone As Long
  tod_tinterval As Long
  tod_day As Long
  tod_month As Long
  tod_year As Long
  tod_weekday As Long
End Type

' Zeit-Infos eines Rechners ermitteln
Public Function GetNetTime(ByVal sServer As String) As Date
  Dim nBuffer As Long
  Dim nResult As Long
  Dim uTIME As TIME_OF_DAY_INFO
  Dim bServer() As Byte
 
  If Trim$(sServer) = "" Then
    ' Eingestellte Zeit des eigenen Rechners ermitteln
    nResult = NetRemoteTOD(vbNullString, nBuffer)
  Else
    ' Name des Servers muss als Byte-Array
    ' übergeben werden!
    bServer = sServer & vbNullChar
    nResult = NetRemoteTOD(bServer(0), nBuffer)
  End If
 
  If nResult = 0 Then
    ' Ergebnis in TIME_OF_DAY_INFO Structur kopieren
    CopyMemory uTIME, nBuffer, Len(uTIME)
    NetApiBufferFree nBuffer
 
    With uTIME
      ' Jetzt nur noch das Datum "zusammenbauen" :-)
      GetNetTime = DateSerial(.tod_year, .tod_month, .tod_day) + _
        TimeSerial(.tod_hours, .tod_mins - .tod_timezone, .tod_secs)
    End With
  End If
End Function

Beispiel für den Aufruf:
Nachfolgendes Beispiel ermittelt Datum und Uhrzeit des eigenen Rechners:

Dim vDate As Date
vDate = GetNetTime("")
MsgBox vDate

Das zweite Beispiel ermittelt Datum und Uhrzeit eines Netzwerkrechners und setzt dann die aktuelle Systemzeit entsprechend den ermittelten Daten.

Dim vDate As Date
vDate = GetNetTime("\\Server")
If vDate <> "00:00:00" Then
  Date = vDate
  Time = vDate
End If