Add a label (Label1) to hold the return value representing the Bias time, a command button (Command1) a text box (Text1) and two lists (List1, List2) to a form. Other labels are optional. Add the following code: --------------------------------------------------------------------------------
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 LongPrivate 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 LongPrivate Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As LongPrivate 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
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)
'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 hKeyEnd Function Private Function IsDaylightSavingTime() As Boolean Dim tzi As TIME_ZONE_INFORMATION IsDaylightSavingTime = GetTimeZoneInformation(tzi) = TIME_ZONE_ID_DAYLIGHTEnd 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 IfEnd Function Private Function IsWinNTPlus() As Boolean 'returns True if running WinNT or better #If Win32 Then
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
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)
'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 hKeyEnd Function Private Function IsDaylightSavingTime() As Boolean Dim tzi As TIME_ZONE_INFORMATION IsDaylightSavingTime = GetTimeZoneInformation(tzi) = TIME_ZONE_ID_DAYLIGHTEnd 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 IfEnd Function Private Function IsWinNTPlus() As Boolean 'returns True if running WinNT or better #If Win32 Then
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2002 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 can not publish
' or reproduce this code on any web site,
' on any online service, or distribute on
' any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'IsDaylightSavingTime flag
Private BiasAdjust As Boolean' results UDT
Private Type TZ_LOOKUP_DATA
TimeZoneName As String
Bias As Long
IsDST As Boolean
End TypePrivate 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 TypePrivate Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End TypePrivate Type REG_TIME_ZONE_INFORMATION
Bias As Long
StandardBias As Long
DaylightBias As Long
StandardDate As SYSTEMTIME
DaylightDate As SYSTEMTIME
End TypePrivate 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 TypePrivate Type OSVERSIONINFO
OSVSize As Long
dwVerMajor As Long
dwVerMinor As Long
dwBuildNumber As Long
PlatformID As Long
szCSDVersion As String * 128
End TypePrivate Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As LongPrivate Declare Function GetTimeZoneInformation Lib "kernel32" _
(lpTimeZoneInformation As TIME_ZONE_INFORMATION) As LongPrivate 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 LongPrivate 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 LongPrivate 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 LongPrivate 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 LongPrivate Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As LongPrivate Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
.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 hKeyEnd Function
Private Function IsDaylightSavingTime() As Boolean Dim tzi As TIME_ZONE_INFORMATION IsDaylightSavingTime = GetTimeZoneInformation(tzi) = TIME_ZONE_ID_DAYLIGHTEnd 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 IfEnd 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 IfEnd Function
.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 hKeyEnd Function
Private Function IsDaylightSavingTime() As Boolean Dim tzi As TIME_ZONE_INFORMATION IsDaylightSavingTime = GetTimeZoneInformation(tzi) = TIME_ZONE_ID_DAYLIGHTEnd 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 IfEnd 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 IfEnd Function