Datum und Uhrzeit eines NT-Rechners holen
[Windows NT]

17.11.1999


Eine tolle Funktion, die leider nur unter Windows NT zur Verfügung steht !
    Ähnlich wie der "Net Time" Befehl holt diese Routine Datum und Uhrzeit
    eines im Netzwerk befindlichen NT-Rechners.

ERFORDERLICHE OBJEKTE
   1 CommandButton (Command1)
   1 Klassenmodul (clsServerTimer)

FORM-CODE

   Private Server As clsServerTime
   Private Sub Form_Load()
      Set Server = New clsServerTime
   End Sub
   Private Sub Command1_Click()
      ServerName = "\\Server"
      Server.Name = ServerName
      If Server.IsWindowsNT Then
         MsgBox "Datum und Uhrzeit von " & ServerName & " :" & _
            Chr(13) &    Chr(13) & Server.Zeit & Chr(13) & _
            Server.Datum, vbExclamation, "ServerTime"
      Else
         MsgBox "Betriebssystem Windows NT erforderlich !", _
            vbCritical
      End If
   End Sub
 KLASSENMODUL-CODE
   Private Type OSVERSIONINFO
      dwOSVersionInfoSize As Long
      dwMajorVersion As Long
      dwMinorVersion As Long
      dwBuildNumber As Long
      dwPlatformId As Long
      szCSDVersion As String * 128
   End Type
   Dim OS As OSVERSIONINFO
   Private Declare Function NetRemoteTOD Lib "netapi32.dll" _
      (ByVal Server As String, buffer As Any) As Long
   Private Declare Sub CopyMem Lib "kernel32" Alias _
      "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
   Private Declare Function NetApiBufferFree Lib "netapi32.dll" _
      (ByVal Ptr As Long) As Long
   Private Declare Function GetVersionEx Lib "kernel32" Alias _
      "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) 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
   Private Type Info
      sZeit As String * 8
      sDatum As String * 10
      NT As Boolean
   End Type
   Private ServerInfo As Info
   Private sServerName As String
   Public Property Get Name() As String
      ServerName = sServerName
   End Property
   Public Property Let Name(ByVal strServerName As String)
      ServerInfo.NT = IsNT
      Dim lngBuffer As Long
      Dim strServer As String
      Dim lngNet32ApiReturnCode As Long
      Dim days As Date
      Dim TOD As TIME_OF_DAY
      On Error Resume Next
      strServer = StrConv(strServerName, vbUnicode)
      lngNet32ApiReturnCode = NetRemoteTOD(strServer, lngBuffer)
      If lngNet32ApiReturnCode = 0 Then
         CopyMem TOD, ByVal lngBuffer, Len(TOD)
         days = DateSerial(70, 1, 1) + (TOD.t_elapsedt / 60 / 60 / 24)
         days = days - (TOD.t_timezone / 60 / 24)
         ServerInfo.sDatum = Format(days, "DD.MM.YYYY")
         ServerInfo.sZeit = Format(days, "HH:MM:SS")
      Else
         ServerInfo.sDatum = "Fehler"
         ServerInfo.sZeit = "Fehler"
      End If
      Call NetApiBufferFree(lngBuffer)
   End Property
   Public Property Get Zeit() As String
      Zeit = ServerInfo.sZeit
   End Property
   Public Property Get Datum() As String
      Datum = ServerInfo.sDatum
   End Property
   Public Property Get IsWindowsNT() As String
      IsWindowsNT = ServerInfo.NT
   End Property
   Private Function IsNT()
      OS.dwOSVersionInfoSize = Len(OS)
      GetVersionEx OS
      If OS.dwMajorVersion = 4 And OS.dwPlatformId = 2 Then 
         IsNT = True
      Else
         IsNT = False
      End If
   End Function
 
Download - 3 KB