Enumurate Time Zone

Posted on 2003-03-31
Medium Priority
Last Modified: 2010-05-01
Hi experts,
I want to Enumurate the listings in windows >> control Panel >> Date/Time >> Time Zone

into my own combo box.

Can you please give me some type of code for it.

Code would help.

Thanks in adv.
Question by:msali
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions

Accepted Solution

maquejph earned 600 total points
ID: 8237655
Well something like that. On you form you should have 2 button, 2 textbox, 1 label and 2 list. It is long but ... :)

Option Explicit

Private BiasAdjust As Boolean

' results UDT
   TimeZoneName As String
   Bias As Long
   IsDST As Boolean
End Type

Private tzinfo() As TZ_LOOKUP_DATA

'holds the correct key for the OS version
Private sTzKey As String

'windows constants and declares
Private Const TIME_ZONE_ID_UNKNOWN As Long = 1
Private Const TIME_ZONE_ID_STANDARD As Long = 1
Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2
Private Const VER_PLATFORM_WIN32_NT = 2

'registry constants
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 REG_SZ As Long = 1
Private Const REG_BINARY = 3
Private Const REG_DWORD As Long = 4
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
   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

   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

   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 GetTimeZoneInformation Lib "kernel32" _
   (lpTimeZoneInformation As TIME_ZONE_INFORMATION) 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 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 Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Sub Form_Load()

   With Command1
      .Caption = "Load TZ Array"
      .Enabled = True
   End With
   With Command2
      .Caption = "Lookup Time Zone"
      .Enabled = False
   End With
   With Text1
      .Text = -120
   End With
   BiasAdjust = IsDaylightSavingTime()
   With Label1
      If BiasAdjust Then
         .Caption = "(Bias shown is for Daylight Saving Time)"
         .Caption = "(Bias shown is for Standard Time)"
      End If
   End With
End Sub

Private Sub Command1_Click()

  'enable the lookup key if
  'results returned
   Command2.Enabled = GetTimeZoneArray()

End Sub

Private Sub Command2_Click()

   Dim cnt As Long
  'do a lookup for the Bias entered
   With List2
      For cnt = LBound(tzinfo) To UBound(tzinfo)
         If tzinfo(cnt).Bias = Text1.Text Then
            .AddItem tzinfo(cnt).TimeZoneName
            Debug.Print tzinfo(cnt).TimeZoneName
         End If
   End With
End Sub

Private Sub List1_Click()

   Dim pos As Long
  'on a list click, show the Bias in the
  'textbox to make lookups easier
   If List1.ListIndex > -1 Then
      pos = InStr(List1.List(List1.ListIndex), vbTab)
      Text1.Text = Left$(List1.List(List1.ListIndex), pos - 1)
   End If
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 ft As FILETIME

  'Win9x and WinNT have a slightly
  'different registry structure.
  'Determine the operating system and
  'set a module variable to the
  'correct key.
  '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
  'BiasAdjust is used when calculating the
  'bias values retrieved from the registry.
  'If True, the reg value retrieved represents
  'the location's bias with the bias for
  'daylight saving time added. If false, the
  'location's bias is returned with the
  'standard bias adjustment applied (this
  'is usually 0). Doing this allows us to
  'use the bias returned from a TIME_OF_DAY_INFO
  'call as the correct lookup value dependant
  'on whether the world is currently on
  'daylight saving time or not. For those
  'countries not recognizing daylight saving
  'time, the registry daylight bias will be 0,
  'therefore proper lookup will not be affected.
  'Not considered (nor can such be coded) are those
  'special areas within a given country that do
  'not recognize daylight saving time, even
  'when the rest of the country does (like
  'Saskatchewan in Canada).
   BiasAdjust = IsDaylightSavingTime()

  'open the timezone 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
        'create a UDT array for the time zone info
         ReDim tzinfo(0 To dwSubKeys - 1) As TZ_LOOKUP_DATA
         dwIndex = 0
         cbName = 32
           '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 the appropriate
              'tzinfo UDT array members
               With tzinfo(dwIndex)
                  .TimeZoneName = TrimNull(sName)
                  .Bias = GetTZBiasByName(.TimeZoneName)
                  .IsDST = BiasAdjust
                 'for demo purposes only, the data
                 'is also added to a list
                  List1.AddItem .Bias & vbTab & .TimeZoneName
               End With
            End If
           'increment the loop...
            dwIndex = dwIndex + 1
        '...and continue while the reg
        'call returns success.
         Loop While success = ERROR_SUCCESS

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

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

End Function

Private Function IsDaylightSavingTime() As Boolean


   IsDaylightSavingTime = GetTimeZoneInformation(tzi) = TIME_ZONE_ID_DAYLIGHT

End Function

Private Function GetTZBiasByName(sTimeZone As String) As Long

   Dim hKey As Long

  'open the passed time zone key
   hKey = OpenRegKey(HKEY_LOCAL_MACHINE, sTzKey & "\" & sTimeZone)
   If hKey <> 0 Then
     'obtain the data from the TZI member
      If RegQueryValueEx(hKey, _
                         "TZI", _
                         0&, _
                         ByVal 0&, _
                         rtzi, _
                         Len(rtzi)) = ERROR_SUCCESS Then

        'tweak the Bias when in Daylight Saving time
         If BiasAdjust Then
            GetTZBiasByName = (rtzi.Bias + rtzi.DaylightBias)
            GetTZBiasByName = (rtzi.Bias + rtzi.StandardBias) 'StandardBias is usually 0
         End If

      End If

      RegCloseKey hKey
   End If
End Function

Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
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 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


Author Comment

ID: 8244250
Thanks a Mil

Featured Post

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question