⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 timezone.cls

📁 VB 加密----------能够加密解密控件
💻 CLS
字号:
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "TimeZone"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'    CopyRight (c) 2004 Kelly Ethridge
'
'    This file is part of VBCorLib.
'
'    VBCorLib is free software; you can redistribute it and/or modify
'    it under the terms of the GNU Library General Public License as published by
'    the Free Software Foundation; either version 2.1 of the License, or
'    (at your option) any later version.
'
'    VBCorLib is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU Library General Public License for more details.
'
'    You should have received a copy of the GNU Library General Public License
'    along with Foobar; if not, write to the Free Software
'    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'    Module: TimeZone
'

''
' Represents timezone information for the local machine.
'
' @see TimeZoneStatic
'
Option Explicit
Implements IObject

Private Const FIND_LAST As Long = 5

Private mDayLightName           As String
Private mStandardName           As String
Private mUtcOffsetNoDLS         As TimeSpan
Private mUtcOffsetWithDLS       As TimeSpan
Private mTimeZoneInfo           As Time_Zone_Information
Private mNotUsedDayLightTimes   As DayLightTime


''
' Returns the name of the daylight savings period.
'
' @return Daylight savings period name.
Public Property Get DayLightName() As String
    DayLightName = mDayLightName
End Property

''
' Returns the name of the standard time period.
'
' @return Standard time period name.
Public Property Get StandardName() As String
    StandardName = mStandardName
End Property

''
' Returns the start and end of the daylight savings period.
'
' @param Year The year which contains the daylight savings period.
' @return The daylight savings period.
Public Function GetDayLightChanges(ByVal Year As Long) As DayLightTime
    Set GetDayLightChanges = GetDayLightTimes(Year)
End Function

''
' Returns the offset from UTC to the current timezone, adjusting for daylight savings.
'
' @param time The time to get the offset for.
' @return The offset from the time to UTC.
Public Function GetUtcOffset(ByRef Time As Variant) As TimeSpan
    If IsDayLightSavingTime(Time) Then
        Set GetUtcOffset = mUtcOffsetWithDLS
    Else
        Set GetUtcOffset = mUtcOffsetNoDLS
    End If
End Function

''
' Returns whether the time is currently in the daylight savings period.
'
' @param time The time to check if in the daylight savings period.
' @param dayLightTimes the daylight period to check the time against.
' @return Indicating if the time was in the daylight savings period.
Public Function IsDayLightSavingTime(ByRef Time As Variant, Optional ByVal dayLightTimes As DayLightTime) As Boolean
    Dim dt As cDateTime
    
    Set dt = cDateTime.GetcDateTime(Time)
    If dayLightTimes Is Nothing Then Set dayLightTimes = GetDayLightTimes(dt.Year)
    
    With dayLightTimes
        If .Delta.EqualTo(TimeSpan.Zero) Then Exit Function
        If .StartTime.LessThan(.EndTime) Then
            ' northern hemisphere
            If dt.LessThan(.StartTime) Then Exit Function
            If dt.GreaterThanOrEqualTo(.EndTime) Then Exit Function
        Else
            ' southern hemisphere
            If dt.GreaterThanOrEqualTo(.StartTime) Then Exit Function
            If dt.LessThan(.EndTime) Then Exit Function
        End If
    End With
    IsDayLightSavingTime = True
End Function

''
' Returns the time with the UTC offset applied to get the local time.
'
' @param time The UTC time to convert to local time.
' @return The local time converted from the UTC time.
Public Function ToLocalTime(ByRef Time As Variant) As cDateTime
    Dim dt As cDateTime
    
    Set dt = cDateTime.GetcDateTime(Time)
    Set ToLocalTime = dt.Add(GetUtcOffset(dt))
End Function

''
' Returns the local time with UTC offset removed to get the UTC time.
'
' @param time The local time to have the UTC offset removed.
' @return The UTC time converted from the local time.
Public Function ToUniversalTime(ByRef Time As Variant) As cDateTime
    Dim dt As cDateTime
    
    Set dt = cDateTime.GetcDateTime(Time)
    Set ToUniversalTime = dt.Subtract(GetUtcOffset(dt))
End Function

''
' Returns a string representation of this object instance.
'
' @return String representing this instance.
Public Function ToString() As String
    ToString = Object.ToString(Me, App)
End Function

''
' Returns a boolean indicating if the value and this object
' instance are the same instance.
'
' @param value The value to compare equality to.
' @return Boolean indicating equality.
Public Function Equals(ByRef Value As Variant) As Boolean
    Equals = Object.Equals(Me, Value)
End Function

''
' Returns a pseudo-unique number identifying this instance.
'
' @return Pseudo-unique number identifying this instance.
Public Function GetHashCode() As Long
    GetHashCode = ObjPtr(CUnk(Me))
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    Dim r As Long
    
    r = GetTimeZoneInformation(mTimeZoneInfo)
    If r = TIME_ZONE_ID_UNKNOWN Or mTimeZoneInfo.DaylightBias = 0 Then
        Set mNotUsedDayLightTimes = Cor.NewDayLightTime(cDateTime.MinValue, cDateTime.MinValue, TimeSpan.Zero)
    End If
    
    mDayLightName = SysAllocString(VarPtr(mTimeZoneInfo.DayLightName(0)))
    mStandardName = SysAllocString(VarPtr(mTimeZoneInfo.StandardName(0)))
    Set mUtcOffsetNoDLS = TimeSpan.FromMinutes(-(mTimeZoneInfo.Bias + mTimeZoneInfo.StandardBias))
    Set mUtcOffsetWithDLS = TimeSpan.FromMinutes(-(mTimeZoneInfo.Bias + mTimeZoneInfo.DaylightBias))
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetDayLightTimes(ByVal Year As Long) As DayLightTime
    Dim StartTime As cDateTime
    Dim EndTime As cDateTime
    
    If mNotUsedDayLightTimes Is Nothing Then
        Set StartTime = GetCrossOverPoint(Year, mTimeZoneInfo.DaylightDate)
        Set EndTime = GetCrossOverPoint(Year, mTimeZoneInfo.StandardDate)
        Set GetDayLightTimes = Cor.NewDayLightTime(StartTime, EndTime, TimeSpan.FromMinutes(mTimeZoneInfo.Bias))
    Else
        Set GetDayLightTimes = mNotUsedDayLightTimes
    End If
End Function

Private Function GetCrossOverPoint(ByVal Year As Long, ByRef Time As SystemTime) As cDateTime
    Dim ret As cDateTime
    Dim mydow As DayOfWeek
    Dim targetdow As DayOfWeek
    
    If Time.wDay = FIND_LAST Then
        ' find last dayofweek in month
        Set ret = Cor.NewcDateTime(Year, Time.wMonth + 1, 1, Time.wHour)
        mydow = ret.DayOfWeek
        targetdow = mydow - Time.wDayOfWeek
        If targetdow < 0 Then targetdow = targetdow + 7
        Set ret = ret.AddDays(-targetdow)
    Else
        ' find nth dayofweek of month
        Set ret = Cor.NewcDateTime(Year, Time.wMonth, 1, Time.wHour)
        mydow = ret.DayOfWeek
        targetdow = Time.wDayOfWeek
        If targetdow < mydow Then targetdow = targetdow + 7
        Set ret = ret.AddDays(targetdow - mydow)
        If Time.wDay > 1 Then
            Set ret = ret.AddDays((Time.wDay - 1) * 7)
        End If
    End If
    
    Set GetCrossOverPoint = ret
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IObject Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IObject_Equals(Value As Variant) As Boolean
    IObject_Equals = Equals(Value)
End Function

Private Function IObject_GetHashcode() As Long
    IObject_GetHashcode = GetHashCode
End Function

Private Function IObject_ToString() As String
    IObject_ToString = ToString
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -