|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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 | |
Related: |
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 |
|
Prerequisites |
None. |
|
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 |
None. |
|
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)) 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 FILETIME 'ft dwLowDateTime As Long dwHighDateTime As Long End Type Private Type REG_TIME_ZONE_INFORMATION Bias As Long StandardBias As Long DaylightBias As Long StandardDate As SYSTEMTIME DaylightDate As SYSTEMTIME End Type Private Type OSVERSIONINFO 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 GetTimeZoneArray 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" Do '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 Else '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 rtzi As REG_TIME_ZONE_INFORMATION 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 Next 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 Dim OSV As OSVERSIONINFO 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 |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |