Comment modifier les informations de fuseau horaire à l'aide de Visual Basic

Il est parfois nécessaire de modifier par programme le fuseau horaire pour le système où l'application est en cours d'exécution. Cet article illustre cette technique.

La façon de mettre en oeuvre de cet effet est la suivante :

1. Déterminez quel fuseau horaire que vous souhaitez modifier.
2. Recherchez la clé du Registre qui contient les informations nécessaires pour remplir la structure TIME_ZONE_INFORMATION de Windows.
3. Lisez ces informations et charger les valeurs dans une variable de type TIME_ZONE_INFORMATION de Windows.
4. Appeler l'API SetTimeZoneInformation, en lui passant la variable de struct TIME_ZONE_INFORMATION de Windows.

L'emplacement dans le Registre contient des informations de fuseau horaire diffère entre Windows 9 x et Windows NT/Windows 2000.

Pour Windows NT et Windows 2000, il se trouve à l'adresse suivante : Pour Windows 9 x, il se trouve à l'adresse suivante : Les noms de clé de fuseau horaire diffèrent entre Windows NT, Windows 2000 et Windows 9 x ainsi car Windows NT et Windows 2000 ajouter la chaîne "Heure d'hiver" aux différentes clés que Windows 9 x ne le fait pas.

Par exemple :

Dans Windows NT et Windows 2000, cette clé s'affichent :
alors que dans Windows 9 x, vous voyez cette clé :L'emplacement de Registre où se trouvent les paramètres de date/heure en cours est le suivant :

Exemple pas à pas

L'exemple de code suivant nécessite un formulaire avec une zone de liste. La zone de liste est chargée avec les valeurs de fuseau horaire possible que l'utilisateur peut sélectionner avec un double-clic pour changer le fuseau horaire. Il affiche un messagebox qui, une fois fermée, modifiera les paramètres système leurs valeurs d'origine.

1. Créez un nouveau projet standard EXE. Form1 est créé par défaut.
2. Ajoutez un contrôle ListBox à Form1.
3. Ajoutez le code suivant à la section déclarations générales de Form1 :

   Option Explicit
   
   ' Operating System version information declares
   
   Private Const VER_PLATFORM_WIN32_NT = 2
   Private Const VER_PLATFORM_WIN32_WINDOWS = 1
   
   Private Type OSVERSIONINFO
           dwOSVersionInfoSize As Long
           dwMajorVersion As Long
           dwMinorVersion As Long
           dwBuildNumber As Long
           dwPlatformId As Long
           szCSDVersion As String * 128 ' Maintenance string
   End Type
   
   Private Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
   
   ' Time Zone information declares
   
   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 ' used to accommodate Unicode strings
      StandardDate As SYSTEMTIME
      StandardBias As Long
      DaylightName(0 To 63) As Byte ' used to accommodate Unicode strings
      DaylightDate As SYSTEMTIME
      DaylightBias As Long
   End Type
   
   Private Const TIME_ZONE_ID_INVALID = &HFFFFFFFF
   Private Const TIME_ZONE_ID_UNKNOWN = 0
   Private Const TIME_ZONE_ID_STANDARD = 1
   Private Const TIME_ZONE_ID_DAYLIGHT = 2
   
   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
   
   ' Registry information declares
   Private Const REG_SZ As Long = 1
   Private Const REG_BINARY = 3
   Private Const REG_DWORD As Long = 4
   
   Private Const HKEY_CLASSES_ROOT = &H80000000
   Private Const HKEY_CURRENT_USER = &H80000001
   Private Const HKEY_LOCAL_MACHINE = &H80000002
   Private Const HKEY_USERS = &H80000003
   
   Private Const ERROR_SUCCESS = 0
   Private Const ERROR_BADDB = 1
   Private Const ERROR_BADKEY = 2
   Private Const ERROR_CANTOPEN = 3
   Private Const ERROR_CANTREAD = 4
   Private Const ERROR_CANTWRITE = 5
   Private Const ERROR_OUTOFMEMORY = 6
   Private Const ERROR_ARENA_TRASHED = 7
   Private Const ERROR_ACCESS_DENIED = 8
   Private Const ERROR_INVALID_PARAMETERS = 87
   Private Const ERROR_NO_MORE_ITEMS = 259
   
   Private Const KEY_ALL_ACCESS = &H3F
   
   Private Const REG_OPTION_NON_VOLATILE = 0
   
   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
   
   ' Registry Constants
   Const SKEY_NT = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"
   Const SKEY_9X = "SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones"
   
   ' The following declaration is different from the one in the API viewer.
   ' To disable implicit ANSI<->Unicode conversion, it changes the 
   ' variable types of lpMultiByteStr and lpWideCharStr to Any.
   '
   Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
       ByVal CodePage As Long, _
       ByVal dwFlags As Long, _
       lpMultiByteStr As Any, _
       ByVal cchMultiByte As Long, _
       lpWideCharStr As Any, _
       ByVal cchWideChar As Long) As Long
       
   ' The above Declare and the following Constants are used to make
   ' this sample compatible with Double Byte Character Systems (DBCS).
   Private Const CP_ACP = 0
   Private Const MB_PRECOMPOSED = &H1
   Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ 
   ByRef Destination As Any, _
   ByRef Source As Any, _
   ByVal numbytes As Long)
   Dim SubKey As String
   
   Private Sub Form_Load()
      Dim lRetVal As Long, lResult As Long, lCurIdx As Long
      Dim lDataLen As Long, lValueLen As Long, hKeyResult As Long
      Dim strvalue As String
      Dim osV As OSVERSIONINFO
   
   ' Win9x and WinNT have a slightly different registry structure. Determine
   ' the operating system and set a module variable to the correct subkey.
   
      osV.dwOSVersionInfoSize = Len(osV)
      Call GetVersionEx(osV)
      If osV.dwPlatformId = VER_PLATFORM_WIN32_NT Then
         SubKey = SKEY_NT
      Else
         SubKey = SKEY_9X
      End If
   
      lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, 0, _
                             KEY_ALL_ACCESS, hKeyResult)
   
      If lRetVal = ERROR_SUCCESS Then
   
         lCurIdx = 0
         lDataLen = 32
         lValueLen = 32
   
         Do
            strvalue = String(lValueLen, 0)
            lResult = RegEnumKey(hKeyResult, lCurIdx, strvalue, lDataLen)
   
            If lResult = ERROR_SUCCESS Then
               List1.AddItem Left(strvalue, lValueLen)
            End If
   
            lCurIdx = lCurIdx + 1
   
         Loop While lResult = ERROR_SUCCESS
   
         RegCloseKey hKeyResult
      Else
         List1.AddItem "Could not open registry key"
      End If
   End Sub
   
   Private Sub List1_DblClick()
      Dim TZ As TIME_ZONE_INFORMATION, oldTZ As TIME_ZONE_INFORMATION
      Dim rTZI As REGTIMEZONEINFORMATION
      Dim bytDLTName(32) As Byte, bytSTDName(32) As Byte
      Dim cbStr As Long, dwType As Long
      Dim lRetVal As Long, hKeyResult As Long, lngData As Long
   
      lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey & "\" & List1.Text, _
                              0, KEY_ALL_ACCESS, hKeyResult)
   
      If lRetVal = ERROR_SUCCESS Then
         lRetVal = RegQueryValueEx(hKeyResult, "TZI", 0&, ByVal 0&, _
                                     rTZI, Len(rTZI))
   
         If lRetVal = ERROR_SUCCESS Then
            TZ.Bias = rTZI.Bias
            TZ.StandardBias = rTZI.StandardBias
            TZ.DaylightBias = rTZI.DaylightBias
            TZ.StandardDate = rTZI.StandardDate
            TZ.DaylightDate = rTZI.DaylightDate
   
            cbStr = 32
            dwType = REG_SZ
   
            lRetVal = RegQueryValueEx(hKeyResult, "Std", _
                        0&, dwType, bytSTDName(0), cbStr)
   
            If lRetVal = ERROR_SUCCESS Then
               Call MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, _
                  bytSTDName(0), cbStr, TZ.StandardName(0), 32)
            Else
               RegCloseKey hKeyResult
               Exit Sub
            End If
   
            cbStr = 32
            dwType = REG_SZ
   
            lRetVal = RegQueryValueEx(hKeyResult, "Dlt", _
                        0&, dwType, bytDLTName(0), cbStr)
   
            If lRetVal = ERROR_SUCCESS Then
               Call MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, _
                  bytDLTName(0), cbStr, TZ.DaylightName(0), 32)
            Else
               RegCloseKey hKeyResult
               Exit Sub
            End If
   
            lRetVal = GetTimeZoneInformation(oldTZ)
   
            If lRetVal = TIME_ZONE_ID_INVALID Then
               MsgBox "Error getting original TimeZone Info"
               RegCloseKey hKeyResult
               Exit Sub
            Else
            If TZ.DaylightDate.wMonth <> 0 And TZ.DaylightBias <> 0 Then
               lRetVal = SetTimeZoneInformation(TZ)
            Else
              Call CopyMemory(TZ.DaylightName(0), TZ.StandardName(0), 64)
              TZ.DaylightBias = 0
              lRetVal = SetTimeZoneInformation(TZ)
            End If
               MsgBox "Time Zone Changed, Click OK to restore"
               lRetVal = SetTimeZoneInformation(oldTZ)
            End If
         End If
   
         RegCloseKey hKeyResult
      End If
   End Sub
   					

4. Exécutez le programme et notez que la zone de liste affiche tous les fuseaux horaires disponibles.
5. Sélectionnez un fuseau horaire et double-cliquez dessus. Les paramètres régionaux de votre système sont remplacée par la zone sélectionnée. Le message suivant s'affiche :
   Changé de fuseau horaire, cliquez sur OK pour restaurer
6. Dans le panneau de configuration, double-cliquez sur l'icône Date/heure. Vous pouvez également atteindre cette boîte de dialogue en double-cliquant sur l'horloge dans la barre d'état système. Cliquez sur l'onglet fuseau horaire et observez que le fuseau horaire a été modifié.
7. Fermez la boîte de dialogue Propriétés de date/heure, cliquez sur OK dans la boîte de message affichée par votre application. Répétez l'étape précédente pour confirmer que les informations time zone a été restaurées.