Visual Basic Locale/Regionalization Routines
RegQueryValueEx: Enumerate Registry Time Zone Values
Posted:   Wednesday January 12, 2005
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP Pro
OS restrictions:   None
Author:   VBnet - Randy Birch


SetLocaleInfo: Change System Long and Short Date Formats
WM_TIMECHANGE: Detect System Changes to the Date/Time
RegQueryValueEx: Determine Windows Last Shutdown Date and Time
RegQueryValueEx: Identify Time Zones by Time Zone Bias
EnumDateFormats: Regional Locale Date Settings
EnumTimeFormats: Regional Locale Time Settings
GetLocaleInfo: Regional Locale Date Settings

Timezone info is stored in the registry under HKEY_LOCAL_MACHINE in either SOFTWARE \Microsoft \Windows NT \CurrentVersion \Time Zones, if using an NT-based system, or under \CurrentVersion \Time Zones if running Windows 9x.

Like the code in RegQueryValueEx: Identify Time Zones by Time Zone Bias this demo enumerates all entries under that key, but retrieves additional information: the "display name" - the same name you see under the Date/Time applet's Time Zone tab, along with the Standard time and Daylight Time zone names for the respective geographic area. A couple of values are not retrieved by the demo, primarily because either other APIs are better at returning the info or it has limited use outsize of Windows (e.g. the Index and MapID values). 

Unfortunately, the registry does not contain the friendly abbreviations for a geographic area's time zones, e.g. EST (eastern standard time), EDT (eastern daylight saving time) and the like.

 BAS Module Code

 Form Code
Add just a listview control (Listview1) and a command button (Command1) to a form. The Load code sets up the listview. Add the following code:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
'holds the correct key for the OS version
Private sTzKey As String

Private Const VER_PLATFORM_WIN32_NT = 2
Private Const SKEY_NT = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"
Private Const SKEY_9X = "SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones"
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
                                   KEY_QUERY_VALUE Or _
                                   KEY_ENUMERATE_SUB_KEYS Or _
                                   KEY_NOTIFY) And _
                                   (Not SYNCHRONIZE))
   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 FILETIME 'ft
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

   Bias As Long
   StandardBias As Long
   DaylightBias As Long
   StandardDate As SYSTEMTIME
   DaylightDate As SYSTEMTIME
End Type

   OSVSize         As Long
   dwVerMajor      As Long
   dwVerMinor      As Long
   dwBuildNumber   As Long
   PlatformID      As Long
   szCSDVersion    As String * 128
End Type

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

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
   Alias "RegOpenKeyExA" _
  (ByVal hKey As Long, _
   ByVal lpsSubKey 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 RegQueryInfoKey Lib "advapi32.dll" _
   Alias "RegQueryInfoKeyA" _
  (ByVal hKey As Long, _
   ByVal lpClass As String, _
   lpcbClass As Long, _
   ByVal lpReserved As Long, _
   lpcsSubKeys As Long, _
   lpcbMaxsSubKeyLen As Long, _
   lpcbMaxClassLen As Long, _
   lpcValues As Long, _
   lpcbMaxValueNameLen As Long, _
   lpcbMaxValueLen As Long, _
   lpcbSecurityDescriptor As Long, _
   lpftLastWriteTime As FILETIME) 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 Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Sub Form_Load()

   With ListView1
      .ColumnHeaders.Add , , "Time Zone"
      .ColumnHeaders.Add , , "Display Name"
      .ColumnHeaders.Add , , "Std Time Name"
      .ColumnHeaders.Add , , "Dlt Time Name"
      .ColumnHeaders.Add , , "Std Bias"
      .ColumnHeaders.Add , , "Dlt Bias"
      .View = lvwReport
   End With
   With Command1
      .Caption = "Load Timezone Info"
   End With
End Sub

Private Sub Command1_Click()

  'this just reduces flickering - useless 
  'if you decide to toss in a DoEvents!
   ListView1.Visible = False
   ListView1.Visible = True
End Sub

Private Function GetTimeZoneArray() As Boolean

   Dim success As Long
   Dim dwIndex As Long
   Dim cbName As Long
   Dim hKey As Long
   Dim sName As String
   Dim dwSubKeys As Long
   Dim dwMaxSubKeyLen As Long
   Dim itmx As ListItem
   Dim sTzName As String
   Dim biasStd As Long
   Dim biasDlt As Long
   Dim sKeys(0 To 2) As String
   Dim ft As FILETIME

  'Win9x and WinNT have a slightly
  'different registry structure.
  'Determine the operating system and
  'set a module variable to the
  'correct sTzKey.
  'assume OS is win9x
   sTzKey = SKEY_9X
  'see if OS is NT, and if so,
  'use assign the correct key
   If IsWinNTPlus Then sTzKey = SKEY_NT
  'open the time zone registry key
   hKey = OpenRegKey(HKEY_LOCAL_MACHINE, sTzKey)
   If hKey <> 0 Then
     'query registry for the number of
     'entries under that key
      If RegQueryInfoKey(hKey, _
                         0&, _
                         0&, _
                         0, _
                         dwSubKeys, _
                         dwMaxSubKeyLen&, _
                         0&, _
                         0&, _
                         0&, _
                         0&, _
                         0&, _
                         ft) = ERROR_SUCCESS Then
         dwIndex = 0
         cbName = 32
         sKeys(0) = "Display"
         sKeys(1) = "Std"
         sKeys(2) = "Dlt"

           'pad a string for the returned value
            sName = Space$(cbName)
            success = RegEnumKey(hKey, dwIndex, sName, cbName)
            If success = ERROR_SUCCESS Then
              'add the data to listview
               With ListView1
                 'once we have the key name,
                 'get the rest of the data
                  sTzName = TrimNull(sName)
                 'GetTZInfo takes the time zone name and
                 'the array of values to interrogate, in
                 'this case the "Display", "Std" and "Dlt"
                 'keys. Functions under VB5 - as I recall -
                 'can not return a string array, so if using
                 'VB5 (or VB4-32) pass sResults() as a parameter
                 'and change the Function to a Sub.
                 'sResults() is redimmed each pass to ensure
                 'it is a fresh array
                  ReDim sResults(0 To 2) As String
                  sResults() = GetTZInfo(sTzName, sKeys())
                 'here we're lazy and pass two variables
                 'for the routine to fill in
                  Call GetTZBiasData(sTzName, biasStd, biasDlt)
                 'show the data
                  Set itmx = .ListItems.Add(, , sTzName)
                  itmx.SubItems(1) = sResults(0)
                  itmx.SubItems(2) = sResults(1)
                  itmx.SubItems(3) = sResults(2)
                  itmx.SubItems(4) = biasStd
                  itmx.SubItems(5) = biasDlt
               End With  'ListView1

            End If  'success
           'increment the enumeration loop...
            dwIndex = dwIndex + 1
        '...and continue while the reg
        'call returns success
         Loop While success = ERROR_SUCCESS

        'done, so clean up
         RegCloseKey hKey
        'return success if, well, successful
         GetTimeZoneArray = dwIndex > 0

      End If  'RegQueryInfoKey
     'could not open registry key
      GetTimeZoneArray = False
   End If  'hKey

End Function

Private Sub GetTZBiasData(sTimeZone As String, biasStd As Long, biasDlt As Long)

   Dim hKey As Long

   hKey = OpenRegKey(HKEY_LOCAL_MACHINE, sTzKey & "\" & sTimeZone)
   If hKey <> 0 Then
      If RegQueryValueEx(hKey, _
                         "TZI", _
                         0&, _
                         ByVal 0&, _
                         rtzi, _
                         Len(rtzi)) = ERROR_SUCCESS Then

         biasDlt = (rtzi.Bias + rtzi.DaylightBias)
         biasStd = (rtzi.Bias + rtzi.StandardBias)

      End If

      RegCloseKey hKey
   End If
End Sub

Private Function GetTZInfo(sTimeZone As String, sKeys() As String) As String()

   Dim hKey As Long
   Dim dwSize As Long
   Dim cnt As Long
   Dim sResults(0 To 2) As String

   hKey = OpenRegKey(HKEY_LOCAL_MACHINE, _
                     sTzKey & "\" & sTimeZone)
   If hKey <> 0 Then
     'loop through the three passed keys
      For cnt = 0 To 2
        'pad the buffer - 256 is plenty
         sResults(cnt) = Space$(256)
         dwSize = 256
        'increment the keys and return buffer
        'count for each loop
         If RegQueryValueEx(hKey, _
                            sKeys(cnt), _
                            0&, _
                            ByVal 0&, _
                            ByVal sResults(cnt), _
                            dwSize) = ERROR_SUCCESS Then

           'still have to trim the string
            sResults(cnt) = TrimNull(sResults(cnt))
         End If

   End If
  'return the string array (VB6 only)
   GetTZInfo = sResults()
End Function

Private Function IsWinNTPlus() As Boolean

  'returns True if running WinNT or better
   #If Win32 Then
      OSV.OSVSize = Len(OSV)
      If GetVersionEx(OSV) = 1 Then
         IsWinNTPlus = (OSV.PlatformID = VER_PLATFORM_WIN32_NT)
      End If

   #End If

End Function

Private Function OpenRegKey(ByVal hKey As Long, _
                            ByVal lpSubKey As String) As Long

   Dim hSubKey As Long

   If RegOpenKeyEx(hKey, _
                  lpSubKey, _
                  0&, _
                  KEY_READ, _
                  hSubKey) = ERROR_SUCCESS Then

      OpenRegKey = hSubKey

   End If

End Function

Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter