Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0340: Zeitzoneninformation ermitteln

VB 5/6-Tipp 0340: Zeitzoneninformation ermitteln

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GetTimeZoneInformation

Download: Download des Beispielprojektes [3,21 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Schaltfläche "Command1" auf Frame1
' Steuerelement: Beschriftungsfeld "Label14" auf Frame1
' Steuerelement: Beschriftungsfeld "Label13" auf Frame1
' Steuerelement: Beschriftungsfeld "Label12" auf Frame1
' Steuerelement: Beschriftungsfeld "Label11" auf Frame1
' Steuerelement: Beschriftungsfeld "Label10" auf Frame1
' Steuerelement: Beschriftungsfeld "Label8" auf Frame1
' Steuerelement: Beschriftungsfeld "Label6" auf Frame1
' Steuerelement: Beschriftungsfeld "Label4" auf Frame1
' Steuerelement: Beschriftungsfeld "Label2" auf Frame1
' Steuerelement: Beschriftungsfeld "Label9" auf Frame1
' Steuerelement: Beschriftungsfeld "Label7" auf Frame1
' Steuerelement: Beschriftungsfeld "Label5" auf Frame1
' Steuerelement: Beschriftungsfeld "Label3" auf Frame1
' Steuerelement: Beschriftungsfeld "Label1" auf Frame1


'Der Tip, speziell die Funktion "GetTimezoneChangeDate", ist der
'Klasse von Mathias Schiffer entnommen. Sie ist unter
'www.microsoft.com/germany/ms/msdnbiblio/quickie/timezone.htm
'als ganzes downloadbar.

Option Explicit

Private Declare Function GetTimeZoneInformation Lib "kernel32" _
        (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
  
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(1 To 64) As Byte
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(1 To 64) As Byte
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
End Type

Const TIME_ZONE_ID_UNKNOWN  As Long = &H0&
Const TIME_ZONE_ID_STANDARD As Long = &H1&
Const TIME_ZONE_ID_DAYLIGHT As Long = &H2&

Dim SommerZeit As Boolean
Dim SommerZeitDate As Date
Dim SommerZeitName As String
Dim SommerZeitGMT As Long
Dim NormalZeitDate As Date
Dim NormalZeitName As String
Dim NormalZeitGMT As Long

Private Sub Form_Load()
    Call DisplayTimeZone
End Sub

Private Sub Command1_Click()
    Call DisplayTimeZone
End Sub

Private Sub DisplayTimeZone()
    Call GetTimeZone
    Label2.Caption = SommerZeit
    Label4.Caption = SommerZeitDate
    Label6.Caption = NormalZeitDate
    Label8.Caption = SommerZeitName
    Label10.Caption = NormalZeitName
    Label12.Caption = SommerZeitGMT & " Min"
    Label14.Caption = NormalZeitGMT & " Min"
End Sub

Private Function GetTimeZone() As Boolean
    Dim TZI As TIME_ZONE_INFORMATION
    Dim Result As Long
    Dim ErrFlag As Boolean
  
    Result = GetTimeZoneInformation(TZI)
    
    Select Case Result
        Case TIME_ZONE_ID_UNKNOWN:  SommerZeit = False
        Case TIME_ZONE_ID_STANDARD: SommerZeit = False
        Case TIME_ZONE_ID_DAYLIGHT: SommerZeit = True
        Case Else:                  MsgBox ("Fehler!")
                                    Exit Function
    End Select
    
    With TZI
        SommerZeitDate = GetTimezoneChangeDate(.DaylightDate, _
                                             Year(Now))
        
        NormalZeitDate = GetTimezoneChangeDate(.StandardDate, _
                                             Year(Now))
        
        SommerZeitName = Left$(.DaylightName, InStr(.DaylightName, _
                             Chr$(0)) - 1)
        
        NormalZeitName = Left$(.StandardName, InStr(.StandardName, _
                             Chr$(0)) - 1)
      
        SommerZeitGMT = -(.Bias + .DaylightBias)
        NormalZeitGMT = -(.Bias + .StandardBias)
    End With
    
    GetTimeZone = True
End Function

Private Function GetTimezoneChangeDate(Data As SYSTEMTIME, InYear _
                                       As Long) As Date
    Dim tempDate As Date
    Dim MonthFirstWeekday 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
        
        'Gibt die Woche im Monat an
        Select Case .wDay
        
            'Wochentag in 1.-4. Woche im Monat
            Case 1 To 4
            
              'Wochentag des ersten Tages im Monat berechnen
              MonthFirstWeekday = Weekday(DateSerial(InYear, .wMonth, 1))
            
              'Den gesuchten Tag ermitteln
              GetTimezoneChangeDate = DateSerial(InYear, .wMonth, _
                                    .wDayOfWeek - MonthFirstWeekday _
                                    + .wDay * 7 + 1) + _
                                    TimeSerial(.wHour, .wMinute, _
                                    .wSecond)
            
            'letzter Wochentag im Monat
            Case 5
            
                'Letzten Tag des Monats berechnen
                tempDate = DateSerial(InYear, .wMonth + 1, 0)
                
                'Zum letzten passenden Wochentag dieses Monats rechnen
                GetTimezoneChangeDate = DateAdd("d", tempDate, - _
                                  (Weekday(tempDate) - .wDayOfWeek _
                                  + 7) Mod 7) + TimeSerial(.wHour, _
                                  .wMinute, .wSecond)
            
        End Select
    End With
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 6 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.