Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0341: Andere Zeitzone setzen

VB 5/6-Tipp 0341: Andere Zeitzone setzen

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GetTimeZoneInformation, GetVersionExA (GetVersionEx), RegCloseKey, RegEnumKeyA (RegEnumKey), RegOpenKeyExA (RegOpenKeyEx), RegQueryValueExA (RegQueryValueEx), RegQueryValueExA (RegQueryValueExString), SetTimeZoneInformation

Download: Download des Beispielprojektes [3,36 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: Listen-Steuerelement "List1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Declare Function GetVersionEx Lib "kernel32" Alias _
        "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) _
        As Long

Private Declare Function GetTimeZoneInformation Lib "kernel32" _
        (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Declare Function SetTimeZoneInformation Lib "kernel32" _
        (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
        "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As _
        String, ByVal ulOptions As Long, ByVal samDesired As _
        Long, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
        Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _
        lpszValueName As String, ByVal lpdwReserved As Long, _
        lpdwType As Long, lpData As Any, lpcbData As Long) _
        As Long

Private Declare Function RegQueryValueExString Lib _
        "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey _
        As Long, ByVal lpValueName As String, ByVal lpReserved _
        As Long, lpType As Long, ByVal lpData As String, _
        lpcbData As Long) As Long

Private Declare Function RegEnumKey Lib "advapi32.dll" Alias _
        "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As _
        Long, ByVal lpName As String, ByVal cbName As Long) _
        As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" _
        (ByVal hKey As Long) As Long

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
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 REGTIMEZONEINFORMATION
    Bias As Long
    StandardBias As Long
    DaylightBias As Long
    StandardDate As SYSTEMTIME
    DaylightDate As SYSTEMTIME
End Type

Private Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName(0 To 63) As Byte
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(0 To 63) As Byte
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
End Type

Const TIME_ZONE_ID_INVALID As Long = &HFFFFFFFF
Const TIME_ZONE_ID_UNKNOWN As Long = 0&
Const TIME_ZONE_ID_STANDARD As Long = 1&
Const TIME_ZONE_ID_DAYLIGHT As Long = 2&

Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const KEY_ALL_ACCESS As Long = &H3F&
Const REG_SZ As Long = 1&
Const ERROR_SUCCESS As Long = 0&

Const VER_PLATFORM_WIN32_NT As Long = 2&

Dim SubKey As String

Private Sub Form_Load()
    Dim Result As Long, hKey As Long, Cnt As Long
    Dim Buffer As String
    Dim l As Long
    Dim OS As OSVERSIONINFO
    
    'NT oder Windows 9x
    OS.dwOSVersionInfoSize = Len(OS)
    Call GetVersionEx(OS)
    If OS.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        SubKey = "SOFTWARE\Microsoft\Windows NT\CurrentVer" & _
                 "sion\Time Zones"
    Else
        SubKey = "SOFTWARE\Microsoft\Windows\CurrentVersio" & _
                 "n\Time Zones"
    End If
    
    'Verfügbare Zeitzonen einlesen
    Result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, 0, _
                          KEY_ALL_ACCESS, hKey)
                          
    If Result = ERROR_SUCCESS Then
        'Zeitzonen aus der Registry enummerieren
        Do
            Buffer = Space(32)
            Result = RegEnumKey(hKey, Cnt, Buffer, Len(Buffer))
            
            If Result = ERROR_SUCCESS Then
                List1.AddItem Trim$(Buffer)
            End If
            
            Cnt = Cnt + 1
        Loop While Result = ERROR_SUCCESS
        
        Call RegCloseKey(hKey)
    Else
        MsgBox ("Fehler beim Öffnen der Registry!")
    End If
End Sub

Private Sub List1_DblClick()
    Dim Result As Long, hKey As Long, x As Long
    Dim Buffer As String
    
    Dim oldRTZI As REGTIMEZONEINFORMATION
    Dim oldTZI As TIME_ZONE_INFORMATION
    Dim newTZI As TIME_ZONE_INFORMATION
    
    Result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey & "\" & _
                          List1.Text, 0, KEY_ALL_ACCESS, hKey)
    
    If Result = ERROR_SUCCESS Then
        Result = RegQueryValueEx(hKey, "TZI", 0&, ByVal 0&, _
                               oldRTZI, Len(oldRTZI))
        
        If Result = ERROR_SUCCESS Then
            newTZI.Bias = oldRTZI.Bias
            newTZI.StandardBias = oldRTZI.StandardBias
            newTZI.DaylightBias = oldRTZI.DaylightBias
            newTZI.StandardDate = oldRTZI.StandardDate
            newTZI.DaylightDate = oldRTZI.DaylightDate
            
            Buffer = Space$(32)
            Result = RegQueryValueExString(hKey, "Std", 0&, REG_SZ, _
                                      Buffer, Len(Buffer))
            
            If Result = ERROR_SUCCESS Then
                Buffer = Trim(Buffer)
                
                For x = 0 To Len(Buffer) - 1
                    If Asc(Mid(Buffer, x + 1, 1)) = 0 Then
                        Exit For
                    Else
                        newTZI.StandardName(2 * x) = _
                            Asc(Mid(Buffer, x + 1, 1))
                    End If
                Next x
            Else
                Call RegCloseKey(hKey)
                Exit Sub
            End If
            
            Buffer = Space$(32)
            Result = RegQueryValueExString(hKey, "Dlt", 0&, REG_SZ, _
                                       Buffer, Len(Buffer))
            
            If Result = ERROR_SUCCESS Then
                Buffer = Trim(Buffer)
                
                For x = 0 To Len(Buffer) - 1
                    If Asc(Mid(Buffer, x + 1, 1)) = 0 Then
                        Exit For
                    Else
                        newTZI.DaylightName(2 * x) = Asc(Mid(Buffer, _
                                               x + 1, 1))
                    End If
                Next x
            Else
                Call RegCloseKey(hKey)
                Exit Sub
            End If
        
            Result = GetTimeZoneInformation(oldTZI)
            If Result = TIME_ZONE_ID_INVALID Then
                MsgBox "Fehler beim Lesen der originalen Zeitein" & _
                        "stellung!"
                
                Call RegCloseKey(hKey)
                Exit Sub
            Else
                Call SetTimeZoneInformation(newTZI)
                
                MsgBox "Die Zeitzone wurde erfolgreich geändert!" & _
                         vbCrLf & "Kontrollieren Sie die neue Eins" & _
                        "tellung durch einen Doppelklick auf die " & _
                        "Systemuhr." & vbCrLf & "Danach sollten S" & _
                        "ie diese wieder Schließen und den 'Ok' B" & _
                        "utton dieser MsgBox" & vbCrLf & "betätig" & _
                        "en, damit die ursprünglichen Einstellung" & _
                        "en wieder zurückgeschrieben" & vbCrLf & _
                        "werden können."
                        
                Call SetTimeZoneInformation(oldTZI)
            End If
        End If
        Call RegCloseKey(hKey)
    End If
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------