Attribute VB_Name = "modTimeZones" Option Explicit '============================================================================================================= ' ' modTimeZones Module ' ------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : August 1, 2000 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : NOTHING ' ' Description : This module is meant to make it easy to find out what time zone the user is in, whether that ' time zone is subject to Daylight Savings time, and if so... what the offsets for Standard ' time and Daylight Savings time are. ' ' Example Use : ' ' Dim TimeZone As String ' Dim DLS As Boolean ' Dim TZOffset As Long ' Dim STDOffset As Long ' Dim DLSOffset As Long ' ' If GetTimeInfo(TimeZone, DLS, TZOffset, STDOffset, DLSOffset, True) = True Then ' MsgBox "Time Zone Name " & vbTab & vbTab & "= " & TimeZone & Chr(13) & _ ' "Time Zone GMT Offset " & vbTab & vbTab & "= " & CStr(TZOffset) & Chr(13) & _ ' "Daylight Savings " & vbTab & vbTab & "= " & CStr(DLS) & Chr(13) & _ ' "Standard Offset Time Offset " & vbTab & "= " & CStr(STDOffset) & Chr(13) & _ ' "Daylight Savings Time Offset " & vbTab & "= " & CStr(DLSOffset) ' End If ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= 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 TIME_ZONE_INFORMATION Bias As Long StandardName(63) As Byte StandardDate As SYSTEMTIME StandardBias As Long DaylightName(63) As Byte DaylightDate As SYSTEMTIME DaylightBias As Long End Type Private Const TIME_ZONE_ID_INVALID = &HFFFFFFFF Private Const TIME_ZONE_ID_UNKNOWN = 0 Private Const TIME_ZONE_ID_STANDARD = 1 Private Const TIME_ZONE_ID_DAYLIGHT = 2 Private Declare Function GetTimeZoneInformation Lib "kernel32.dll" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long Public Function GetTimeInfo(Optional ByRef Return_TimeZone As String, Optional ByRef Return_DayLightSavings As Boolean, Optional ByRef Return_GMTOffset As Long, Optional ByRef Return_StandardBias As Long, Optional ByRef Return_DaylightBias As Long, Optional ByVal ShowErrorPrompts As Boolean = True) As Boolean On Error GoTo ErrorTrap Dim TZ_Info As TIME_ZONE_INFORMATION Dim ReturnValue As Long ReturnValue = GetTimeZoneInformation(TZ_Info) Select Case ReturnValue Case TIME_ZONE_ID_INVALID If ShowErrorPrompts = True Then MsgBox "An error occured in the GetTimeZoneInformation API while trying to obtain the system time information:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.LastDllError), vbOKOnly + vbExclamation, " API Error" End If GetTimeInfo = False Exit Function Case TIME_ZONE_ID_UNKNOWN Return_DayLightSavings = False Case TIME_ZONE_ID_STANDARD Return_DayLightSavings = False Case TIME_ZONE_ID_DAYLIGHT Return_DayLightSavings = True End Select With TZ_Info Return_TimeZone = .StandardName Return_TimeZone = Left(Return_TimeZone, InStr(Return_TimeZone, Chr(0)) - 1) Return_GMTOffset = .Bias / 60 ' Deviding by 60 returns HOURS Return_StandardBias = .StandardBias / 60 ' Deviding by 60 returns HOURS Return_DaylightBias = .DaylightBias / 60 ' Deviding by 60 returns HOURS End With GetTimeInfo = True Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error If ShowErrorPrompts = True Then MsgBox Err.Source & " encountered the following error while retrieving the system time info:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description End If GetTimeInfo = False Err.Clear Exit Function End If End Function