Tipp 0460 TimeServer-Client (Winsock-API)
Autor/Einsender:
Datum:
  Daniel Heinrich
14.09.2005
Entwicklungsumgebung:   VB 6
Dieser Tipp enthält ein Beispiel eines TimeServer-Clients, welches auf der RFC 2030 basiert, und demonstriert, wie man die Systemzeit mit der "Atomzeit" abgleichen kann.
Dabei geht das Beispielprogramm sowohl auf die verschiedenen Zeitzonen als auch auf die Sommer/Winterzeit ein. Auch eventuelle Übertragungszeiten werden natürlich berücksichtigt.
Das Programm verbindet sich per Winsock-API mit dem TimeServer und empfängt einen 4-Byte langen Wert, welcher die Zeitspanne seit dem 01.01.1900 um 0 Uhr darstellt. Dieser wird anschließend umgerechnet, wobei die Zeitzone sowie Sommer und Winterzeit mit in die Rechnung einbezogen werden. Bevor die Systemzeit ggf. aktualisiert wird, wird auch die Zeit berücksichtigt, die das Programm für die Datenübertragung benötigt hat.
Code im Codebereich des Moduls
 
Option Explicit

Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal _
      wVersionRequired As Integer, ByRef lpWSAData As WSADATA) _
      As Long

Private Declare Function socket Lib "ws2_32.dll" (ByVal af As _
      Long, ByVal lType As Long, ByVal protocol As Long) As Long

Private Declare Function connect Lib "ws2_32.dll" (ByVal s As _
      Long, ByRef Name As SOCKADDR, ByVal namelen As Long) As Long

Private Declare Function htons Lib "ws2_32.dll" (ByVal hostshort _
      As Integer) As Integer

Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As _
      String) As Long

Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, _
      ByVal buf As String, ByVal lLen As Long, ByVal flags _
      As Long) As Long

Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s _
      As Long) As Long

Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long

Private Declare Function WSAGetLastError Lib "ws2_32.dll" () _
      As Long

Private Declare Function GetTimeZoneInformation Lib _
      "kernel32.dll" (lpTZI As TIME_ZONE_INFORMATION) As Long

Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Private Const WS_VERSION_REQD     As Long = &H101&
Private Const WSADESCRIPTION_LEN  As Long = 256
Private Const WSASYS_STATUS_LEN   As Long = 128

Private Const AF_INET       As Long = 2
Private Const SOCK_STREAM   As Long = 1
Private Const IPPROTO_TCP   As Long = 6

Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2

Private Type WSADATA
  wVersion        As Integer
  wHighVersion    As Integer
  szDescription   As String * WSADESCRIPTION_LEN
  szSystemStatus  As String * WSASYS_STATUS_LEN
  iMaxSockets     As Integer
  iMaxUdpDg       As Integer
  lpVendorInfo    As Long
End Type

Private Type SOCKADDR
  sin_family  As Integer
  sin_port    As Integer
  sin_addr    As Long
  sin_zero    As String * 8
End Type

Private Type SYSTEMTIME
  wYear           As Integer
  wMonth          As Integer
  wDayOfWeek      As Integer
  wDay            As Integer
  wHour           As Integer
  wMinute         As Integer
  wSecond         As Integer
  wMilliseconds   As Integer
End Type

Private Type TIME_ZONE_INFORMATION
  Bias As Long
  StandardName(31)  As Integer
  StandardDate      As SYSTEMTIME
  StandardBias      As Long
  DaylightName(31)  As Integer
  DaylightDate      As SYSTEMTIME
  DaylightBias      As Long
End Type

Dim startup_ans  As Long
Dim socket_ans   As Long
Dim connect_ans  As Long
Dim recv_ans     As Long
Dim recv_data    As String * 5
Dim close_ans    As Long
Dim TZI_ans      As Long
Dim GTC_ans_1    As Long

'IP des Servers
Private Const SERVER_IP As String = "131.188.3.221"

Private Const AUTO_UPDATE As Boolean = True
Private Const SHOW_ANS    As Boolean = True

Private Sub Main()
  Dim data        As WSADATA
  Dim adresse     As SOCKADDR
  Dim Zeit_Roh    As String
  Dim Zeitstempel As Double
  Dim Zeit        As Date
  Dim Zeitzone    As TIME_ZONE_INFORMATION

  Dim strErrMsg As String
  strErrMsg = ""

  startup_ans = WSAStartup(WS_VERSION_REQD, data)
  If startup_ans <> 0 Then
    strErrMsg = "Probleme beim Initiieren der Sockets!"
    GoTo err_Handler
  End If

  socket_ans = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
  If socket_ans > 10000 And socket_ans < 11005 Then
    strErrMsg = "Probleme beim Erstellen des Sockets!"
    GoTo err_Handler
  End If

  adresse.sin_family = AF_INET
  adresse.sin_addr = inet_addr(SERVER_IP)
  adresse.sin_port = htons(37)
  connect_ans = connect(socket_ans, adresse, Len(adresse))
  If connect_ans <> 0 Then
    strErrMsg = "Kann nicht zum Server " & SERVER_IP & _
          " verbinden!"
    GoTo err_Handler
  End If

  GTC_ans_1 = GetTickCount()

  recv_ans = recv(socket_ans, recv_data, Len(recv_data), 0)
  Zeit_Roh = Left$(recv_data, recv_ans)
  If recv_ans <> 4 Then
    strErrMsg = "Unverständliche Daten!"
    GoTo err_Handler
  End If

  close_ans = closesocket(socket_ans)
  If close_ans <> 0 Then
    strErrMsg = "Fehler beim Schließen des Sockets!"
    GoTo err_Handler
  End If

  WSACleanup

  Zeitstempel = Asc(Mid(Zeit_Roh, 1, 1)) * 256 ^ 3 + _
      Asc(Mid(Zeit_Roh, 2, 1)) * 256 ^ 2 + _
      Asc(Mid(Zeit_Roh, 3, 1)) * 256 ^ 1 + _
      Asc(Mid(Zeit_Roh, 4, 1)) - 3155673600#

  TZI_ans = GetTimeZoneInformation(Zeitzone)
  If TZI_ans = TIME_ZONE_ID_DAYLIGHT Then
    Zeitstempel = Zeitstempel - (Zeitzone.Bias * 60 + _
          Zeitzone.DaylightBias * 60)
  Else
    Zeitstempel = Zeitstempel - Zeitzone.Bias * 60
  End If

  GTC_ans_1 = Round((GetTickCount - GTC_ans_1) / 1000, 0)

  Zeitstempel = Zeitstempel + GTC_ans_1
  Zeit = DateAdd("s", Zeitstempel, "1.1.2000")

  If AUTO_UPDATE = True Then
    Date = DateValue(Zeit)
    Time = TimeValue(Zeit)
  End If

  If SHOW_ANS = True Then
    MsgBox "Die aktuelle Zeit: " & CStr(Zeit) & vbCrLf & _
          "Korrekturfaktor: " & CStr(GTC_ans_1), _
          vbInformation, "Die Aktuelle Zeit..."
  End If
  Exit Sub

err_Handler:
  MsgBox strErrMsg, vbCritical, "FEHLER!"
End Sub
 
Weitere Links zum Thema
How to change time zone information by using Visual Basic
Zeitzonen-Informationen auslesen
Hinweis für VBA-Anwender
Die im Download befindliche *.bas-Datei kann für die Verwendung in einem (Office-)Programm im VB-Editor des entsprechenden Programms importiert werden.

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (3,7 kB) Downloads bisher: [ 1178 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Mittwoch, 24. August 2011