Rubrik: Datum/Zeit und Timer · Datums- und Zeitfunktionen | VB-Versionen: VB4, VB5, VB6 | 23.12.02 |
Zeitabgleich im Netzwerk Dieser Code zeigt, wie sich Datum und Uhrzeit eines Netzwerk-Rechners ermitteln lassen. | ||
Autor: Dieter Otter | Bewertung: | Views: 17.937 |
www.tools4vb.de | System: WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
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