Einzelnen Beitrag anzeigen
Alt 01.02.2003, 05:03   #1
Stefan Kulpa
MOF Meister
MOF Meister
Normal Wie ermittle ich Zeitzonendaten (Sommerzeit etc.)?

Code:

Option Explicit
 
'// -------------------------------------------------------------------------------------
'// Dieser Codeausschnitt ermittelt verschiedene Zeitzoneninformationen und bedient sich
'// dabei des Win32-API. Folgende Funktionen stehen zur Verfügung:
'// -------------------------------------------------------------------------------------
'// Funktion:               Beschreibung:
'// -------------------------------------------------------------------------------------
'// DaylightSavingExists    Ermittelt, ob die Zeitzone (des Systems) eine Sommerzeit hat
'// DaylightSaving          Ermittelt, ob Sommerzeit besteht
'// StandardBias            Ermittelt die Sommerzeit-Zeitverschiebung gegenüber GMT-Uhrzeit in Minuten
'// DaylightBias            Ermittelt die die Standardzeit-Zeitverschiebung gegenüber GMT-Uhrzeit in Minuten
'// CurrentBias             Ermittelt die aktuelle Zeitverschiebung gegenüber GMT-Uhrzeit in Minuten
'// DaylightName            Ermittelt den Klartextnamen der Sommerzeit-Zeitzone
'// StandardName            Ermittelt den Klartextnamen der Standardzeit-Zeitzone
'// GMTTime                 Ermittelt die aktuelle GMT-Uhrzeit (inkl. Datum)
'// FirstDateDaylight       Ermittelt das Startdatum der Sommerzeit
'// FirstDateStandard       Ermittelt das Startdatum der Standardzeit
'// -------------------------------------------------------------------------------------
 
Const TIME_ZONE_ID_DAYLIGHT As Long = 2
 
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
 
Type TIME_ZONE_INFORMATION
     Bias                   As Long       ' Basis-Zeitverschiebung in Minuten
     StandardName(1 To 64)  As Byte       ' Name der Sommerzeit-Zeitzone
     StandardDate           As SYSTEMTIME ' Beginn der Standardzeit
     StandardBias           As Long       ' Zusätzliche Zeitverschiebung der Standardzeit
     DaylightName(1 To 64)  As Byte       ' Name der Sommerzeit-Zeitzone
     DaylightDate           As SYSTEMTIME ' Beginn der Sommerzeit
     DaylightBias           As Long       ' Zusätzliche Zeitverschiebung der Sommerzeit
End Type
 
Declare Function GetTimeZoneInformation Lib "kernel32" _
                (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
 
Sub Beispiel()
 
    Debug.Print "Aktuelle Zeit"
    Debug.Print "-------------"
    Debug.Print "Aktuelle Lokalzeit: "; Format$(Now(), "dd.mm.yyyy, hh:nn:ss U\hr")
    Debug.Print "Aktuelle GMT-Zeit: "; Format$(GMTTime(), "dd.mm.yyyy, hh:nn:ss U\hr")
    Debug.Print "Sommerzeit: "; IIf(DaylightSaving(), "Ja", "Nein")
    Debug.Print
    Debug.Print "Standardzeit"
    Debug.Print "------------"
    Debug.Print "Name der Standardzeit: "; StandardName()
    Debug.Print "Beginn der Standardzeit: "; Format$(FirstDateStandard(), "dd.mm.yyyy, hh:nn:ss U\hr")
    Debug.Print "Zeitverschiebung: "; "GMT" & IIf(StandardBias < 0, "", "+") & StandardBias & " Minuten"
    Debug.Print
    Debug.Print "Sommerzeit"
    Debug.Print "----------"
    If DaylightSavingExists = True Then
        Debug.Print "Name der Sommerzeit: "; DaylightName()
        Debug.Print "Beginn der Sommerzeit: "; Format$(FirstDateDaylight(), "dd.mm.yyyy, hh:nn:ss U\hr")
        Debug.Print "Zeitverschiebung: "; "GMT" & IIf(DaylightBias < 0, "", "+") & DaylightBias & " Minuten"
    Else
        Debug.Print vbTab; "Zeitzone hat keine Sommerzeit!"
    End If
'// -------------------------------------------------------------------------------------
'// Ausgabe:
'//
'// Aktuelle Zeit
'// -------------
'// Aktuelle Lokalzeit: 01.02.2003, 06:01:20 Uhr
'// Aktuelle GMT-Zeit: 01.02.2003, 05:01:20 Uhr
'// Sommerzeit: Nein
'//
'// Standardzeit
'// ------------
'// Name der Standardzeit: Westeuropäische Normalzeit
'// Beginn der Standardzeit: 26.10.2003, 03:00:00 Uhr
'// Zeitverschiebung: GMT+60 Minuten
'//
'// Sommerzeit
'// ----------
'// Name der Sommerzeit: Westeuropäische Sommerzeit
'// Beginn der Sommerzeit: 30.03.2003, 02:00:00 Uhr
'// Zeitverschiebung: GMT+120 Minuten
'// -------------------------------------------------------------------------------------
 
End Sub
 
Function DaylightSavingExists() As Boolean
'// Gibt zurück, ob die Zeitzone eine Sommerzeit hat.
    Dim udtTZI As TIME_ZONE_INFORMATION
    Dim RetVal As Long
    RetVal = GetTimeZoneInformation(udtTZI)
    DaylightSavingExists = (udtTZI.DaylightDate.wMonth <> 0)
 
End Function
 
Function DaylightSaving() As Boolean
'// Gibt zurück, ob Sommerzeit besteht.
    Dim udtTZI As TIME_ZONE_INFORMATION
    Dim RetVal As Long
    RetVal = GetTimeZoneInformation(udtTZI)
    DaylightSaving = (RetVal = TIME_ZONE_ID_DAYLIGHT)
 
End Function
 
Function StandardBias() As Integer
'// Gibt die Standardzeit-Zeitverschiebung
'// gegenüber GMT-Uhrzeit in Minuten zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    GetTimeZoneInformation udtTZI
    StandardBias = -(udtTZI.Bias + udtTZI.StandardBias)
 
End Function
 
Function DaylightBias() As Integer
'// Gibt die Sommerzeit-Zeitverschiebung
'// gegenüber GMT-Uhrzeit in Minuten zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    GetTimeZoneInformation udtTZI
    DaylightBias = -(udtTZI.Bias + udtTZI.DaylightBias)
 
End Function
 
Function CurrentBias() As Integer
'// Gibt die aktuelle Zeitverschiebung
'// gegenüber GMT-Uhrzeit in Minuten zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    Dim RetVal As Long
    RetVal = GetTimeZoneInformation(udtTZI)
    With udtTZI
        If RetVal = TIME_ZONE_ID_DAYLIGHT Then
              CurrentBias = -(.Bias + .DaylightBias)
        Else: CurrentBias = -(.Bias + .StandardBias)
        End If
    End With
 
End Function
 
Function DaylightName() As String
'// Gibt den Klartextnamen der Sommerzeit-Zeitzone zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    Dim lNullPos As Integer
    GetTimeZoneInformation udtTZI
    With udtTZI
        If InStr(.DaylightName, vbNullChar) > 0 Then
              DaylightName = Left$(.DaylightName, InStr(.DaylightName, vbNullChar) - 1)
        Else: DaylightName = .DaylightName
        End If
    End With
 
End Function
 
Function StandardName() As String
'// Gibt den Klartextnamen der Standardzeit-Zeitzone zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    GetTimeZoneInformation udtTZI
    With udtTZI
        If InStr(.StandardName, vbNullChar) > 0 Then
              StandardName = Left$(.StandardName, InStr(.StandardName, vbNullChar) - 1)
        Else: StandardName = .StandardName
        End If
    End With
 
End Function
 
Function GMTTime() As Date
'// Gibt die aktuelle GMT-Uhrzeit (inkl. Datum) zurück.
    GMTTime = DateAdd("n", -CurrentBias(), Now)
 
End Function
 
Function FirstDateDaylight(Optional ByVal InYear As Long) As Date
'// Gibt das Startdatum der Sommerzeit zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    If InYear = 0 Then InYear = Year(Now)
    GetTimeZoneInformation udtTZI
    FirstDateDaylight = GetTimezoneChangeDate(udtTZI.DaylightDate, InYear)
 
End Function
 
Public Function FirstDateStandard(Optional ByVal InYear As Long) As Date
'// Gibt das Startdatum der Standardzeit zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    If InYear = 0 Then InYear = Year(Now)
    GetTimeZoneInformation udtTZI
    FirstDateStandard = GetTimezoneChangeDate(udtTZI.StandardDate, InYear)
 
End Function
 
Function GetTimezoneChangeDate(Data As SYSTEMTIME, InYear As Long) As Date
    Dim dtTemp              As Date
    Dim lMonthFirstWeekday  As Long
'// In Data.wDayOfWeek wird ein Wochentag übergeben. Die Information in .wDay
'// legt fest, in welcher Woche des Monats der betroffene Tag zu ermitteln
'// ist (1-4) bzw., dass der letzte gleiche Wochentag des Monats gemeint ist.
    With Data
        Select Case .wDay '// Gibt die Woche im Monat an
            Case 1 To 4   '// Wochentag in 1.-4. Woche im Monat
            '// Wochentag des ersten Tages im Monat berechnen
                lMonthFirstWeekday = Weekday(DateSerial(InYear, .wMonth, 1))
            '// Den gesuchten Tag ermitteln
                GetTimezoneChangeDate = _
                    DateSerial(InYear, .wMonth, _
                              .wDayOfWeek - lMonthFirstWeekday + .wDay * 7 + 1) + _
                               TimeSerial(.wHour, .wMinute, .wSecond)
            Case 5                                    ' letzter Wochentag im Monat
            '// Letzten Tag des Monats berechnen
                dtTemp = DateSerial(InYear, .wMonth + 1, 0)
            '// Zum letzten passenden Wochentag dieses Monats rechnen
                GetTimezoneChangeDate = _
                    dtTemp + vbSunday - Weekday(dtTemp) + _
                    TimeSerial(.wHour, .wMinute, .wSecond)
        End Select
    End With
 
End Function
Code eingefügt mit dem MOF Code Converter
Angehängte Dateien
Dateityp: txt zeitzone.txt (9,1 KB, 1039x aufgerufen)

__________________

Stefan

Geändert von Stefan Kulpa (01.02.2003 um 05:30 Uhr).
Stefan Kulpa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten