?
Solved

Enumurate Time Zone

Posted on 2003-03-31
2
Medium Priority
?
184 Views
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.
msali.
0
Comment
Question by:msali
[X]
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
2 Comments
 

Accepted Solution

by:
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
Private Type TZ_LOOKUP_DATA
   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 TIME_ZONE_ID_INVALID As Long = &HFFFFFFFF
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1

'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))

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
   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 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

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 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)"
      Else
         .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
      .Clear
     
      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
         
      Next
     
   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
   
         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 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
   
   Else
     
     'could not open reg key
      GetTimeZoneArray = False
   
   End If  'If hKey

End Function


Private Function IsDaylightSavingTime() As Boolean

   Dim tzi As TIME_ZONE_INFORMATION

   IsDaylightSavingTime = GetTimeZoneInformation(tzi) = TIME_ZONE_ID_DAYLIGHT

End Function


Private Function GetTZBiasByName(sTimeZone As String) As Long

   Dim rtzi As REG_TIME_ZONE_INFORMATION
   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)
         Else
            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
 
      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





0
 

Author Comment

by:msali
ID: 8244250
Thanks a Mil
0

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