dateandtime.vb

大名鼎鼎的mono是.NET平台的跨平台（支持linux

'
' DateAndTime.vb
'
' Author:
'   Chris J Breisch ([e-mail]) 
'   Pablo Cardona ([e-mail]) CRL Team
'   Mizrahi Rafael ([e-mail])
'

'
' Copyright (C) 2002-2006 Mainsoft Corporation.
' Copyright (C) 2004-2006 Novell, Inc (http://www.novell.com)
'
' Permission is hereby granted, free of charge, to any person obtaining
' a copy of this software and associated documentation files (the
' "Software"), to deal in the Software without restriction, including
' without limitation the rights to use, copy, modify, merge, publish,
' distribute, sublicense, and/or sell copies of the Software, and to
' permit persons to whom the Software is furnished to do so, subject to
' the following conditions:
' 
' The above copyright notice and this permission notice shall be
' included in all copies or substantial portions of the Software.
' 
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
' EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
' MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
' NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
' LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
' OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
' WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'

Imports System
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports System.Globalization
Imports Microsoft.VisualBasic.CompilerServices

Namespace Microsoft.VisualBasic
    Public Module DateAndTime
        Public Property DateString() As String
            Get
                Return DateTime.Today.ToString("MM-dd-yyyy")
            End Get

            Set(ByVal Value As String)
                Dim formats() As String = {"M-d-yyyy", "M-d-y", "M/d/yyyy", "M/d/y"}

                Try
                    Dim dtToday As DateTime = DateTime.ParseExact(Value, formats, _
                     DateTimeFormatInfo.CurrentInfo, _
                     DateTimeStyles.None)

                    OSSpecific.OSDriver.Driver.SetDate(dtToday)
                Catch e As FormatException
                    Throw New InvalidCastException(String.Format("Cast from string {0} to type 'Date' is not valid.", Value))
                End Try
            End Set
        End Property

        Public Property Today() As System.DateTime
            Get
                Return DateTime.Today
            End Get
            Set(ByVal Value As System.DateTime)
                OSSpecific.OSDriver.Driver.SetDate(Value)
            End Set
        End Property

        Public ReadOnly Property Timer() As Double
            Get
                Dim DTNow As DateTime = DateTime.Now

                Return DTNow.Hour * 3600 + DTNow.Minute * 60 + _
                        DTNow.Second + DTNow.Millisecond / 1000D
            End Get
        End Property

        Public ReadOnly Property Now() As System.DateTime
            Get
                Return DateTime.Now
            End Get
        End Property

        Public Property TimeOfDay() As System.DateTime
            Get
                Dim TSpan As TimeSpan = DateTime.Now.TimeOfDay

                Return New DateTime(1, 1, 1, TSpan.Hours, _
                 TSpan.Minutes, TSpan.Seconds, _
                 TSpan.Milliseconds)
            End Get
            Set(ByVal Value As System.DateTime)
                OSSpecific.OSDriver.Driver.SetTime(Value)
            End Set
        End Property

        Public Property TimeString() As String
            Get
                Return DateTime.Now.ToString("HH:mm:ss")
            End Get
            Set(ByVal Value As String)
                Dim formats() As String = {"hh:mm:ss tt", "H:mm:ss tt", "HH:mm:ss", "H:mm:ss", "h:mm:ss", "hh:mm:ss", "hh:mm", "hh:mm tt", "h:mm", "h:mm tt", "h:m", "h:m tt"}

                Try
                    Dim dtToday As DateTime = DateTime.ParseExact(Value, formats, _
                     DateTimeFormatInfo.CurrentInfo, _
                     DateTimeStyles.None)

                    OSSpecific.OSDriver.Driver.SetTime(dtToday)
                Catch e As FormatException
                    Throw New InvalidCastException(String.Format("Cast from string {0} to type '{1}' is not valid.", Value, "Date"))
                End Try
            End Set
        End Property

        ' Methods
        Public Function DateAdd(ByVal Interval As DateInterval, _
        ByVal Number As Double, ByVal DateValue As System.DateTime) As System.DateTime
            Dim value As Integer

            value = CInt(Conversion.Fix(Number))

            Select Case Interval
                Case DateInterval.Year
                    Return Threading.Thread.CurrentThread.CurrentCulture.Calendar.AddYears(DateValue, value)
                Case DateInterval.Quarter
                    Return Threading.Thread.CurrentThread.CurrentCulture.Calendar.AddMonths(DateValue, value * 3)
                Case DateInterval.Month
                    Return Threading.Thread.CurrentThread.CurrentCulture.Calendar.AddMonths(DateValue, value)
                Case DateInterval.WeekOfYear
                    Return Threading.Thread.CurrentThread.CurrentCulture.Calendar.AddDays(DateValue, value * 7)
                Case DateInterval.Day, DateInterval.DayOfYear, DateInterval.Weekday
                    Return Threading.Thread.CurrentThread.CurrentCulture.Calendar.AddDays(DateValue, value)
                Case DateInterval.Hour
                    Return Threading.Thread.CurrentThread.CurrentCulture.Calendar.AddHours(DateValue, value)
                Case DateInterval.Minute
                    Return Threading.Thread.CurrentThread.CurrentCulture.Calendar.AddMinutes(DateValue, value)
                Case DateInterval.Second
                    Return Threading.Thread.CurrentThread.CurrentCulture.Calendar.AddSeconds(DateValue, value)
                Case Else
                    Throw New ArgumentException
            End Select
        End Function

        Friend Function GetDayRule(ByVal StartOfWeek As FirstDayOfWeek, ByVal DayRule As DayOfWeek) As DayOfWeek
            Select Case StartOfWeek
                Case FirstDayOfWeek.System
                    Return DayRule
                Case FirstDayOfWeek.Sunday
                    Return DayOfWeek.Sunday
                Case FirstDayOfWeek.Monday
                    Return DayOfWeek.Monday
                Case FirstDayOfWeek.Tuesday
                    Return DayOfWeek.Tuesday
                Case FirstDayOfWeek.Wednesday
                    Return DayOfWeek.Wednesday
                Case FirstDayOfWeek.Thursday
                    Return DayOfWeek.Thursday
                Case FirstDayOfWeek.Friday
                    Return DayOfWeek.Friday
                Case FirstDayOfWeek.Saturday
                    Return DayOfWeek.Saturday
                Case Else
                    Throw New ArgumentException
            End Select
        End Function

        Friend Function GetWeekRule(ByVal StartOfYear As FirstWeekOfYear, ByVal WeekRule As CalendarWeekRule) As CalendarWeekRule

            Select Case StartOfYear
                Case FirstWeekOfYear.System
                    Return WeekRule
                Case FirstWeekOfYear.FirstFourDays
                    Return CalendarWeekRule.FirstFourDayWeek
                Case FirstWeekOfYear.FirstFullWeek
                    Return CalendarWeekRule.FirstFullWeek
                Case FirstWeekOfYear.Jan1
                    Return CalendarWeekRule.FirstDay
                Case Else
                    Throw New ArgumentException
            End Select
        End Function

        Public Function DateDiff(ByVal Interval As DateInterval, _
        ByVal Date1 As System.DateTime, ByVal Date2 As System.DateTime, _
        Optional ByVal StartOfWeek As FirstDayOfWeek = FirstDayOfWeek.Sunday, _
        Optional ByVal StartOfYear As FirstWeekOfYear = FirstWeekOfYear.Jan1) As Long

            Dim YearMonths As Integer
            Dim YearQuarters As Integer
            Dim YearWeeks As Integer
            Dim WeekRule As CalendarWeekRule = CalendarWeekRule.FirstDay
            Dim DayRule As DayOfWeek = DateTimeFormatInfo.CurrentInfo.FirstDayOfWeek
			Dim WeekDiff as Long

            Select Case Interval
                Case DateInterval.Year
                    Return Date2.Year - Date1.Year
                Case DateInterval.Quarter
                    YearQuarters = (Date2.Year - Date1.Year) * 4
                    Return Convert.ToInt64(Date2.Month / 4 - Date1.Month / 4 + YearQuarters)
                Case DateInterval.Month
                    YearMonths = (Date2.Year - Date1.Year) * 12
                    Return Date2.Month - Date1.Month + YearMonths
                Case DateInterval.WeekOfYear
                    WeekDiff = Convert.ToInt64(Date2.Subtract(Date1).Days \ 7)
                    DayRule = GetDayRule(StartOfWeek, DayRule)
                    if (Date2.DayOfWeek >= DayRule And Date1.DayOfWeek < DayRule)
                        return WeekDiff + 1
                    Else if (Date2.DayOfWeek >= DayRule And Date1.DayOfWeek > Date2.DayOfWeek)
                        return WeekDiff + 1
                    Else if (Date1.DayOfWeek >= DayRule And Date2.DayOfWeek < DayRule)
                        return WeekDiff
                    Else if (Date2.DayOfWeek < Date1.DayOfWeek)
                        return WeekDiff + 1
                    Else
                        return WeekDiff
                    End If
                Case DateInterval.Weekday
                    Return Convert.ToInt64(((Date2.Subtract(Date1)).Days \ 7))
                Case DateInterval.DayOfYear, _
                     DateInterval.Day
                    Return Date2.Subtract(Date1).Days
                Case DateInterval.Hour
                    Return Convert.ToInt64(Date2.Subtract(Date1).TotalHours)
                Case DateInterval.Minute
                    Return Convert.ToInt64(Date2.Subtract(Date1).TotalMinutes)
                Case DateInterval.Second
                    Return Convert.ToInt64(Date2.Subtract(Date1).TotalSeconds)
                Case Else
                    Throw New ArgumentException
            End Select
        End Function

        Friend Function ConvertWeekDay(ByVal Day As DayOfWeek, ByVal Offset As Integer) As Integer
            If (Offset = 0) Then
                Return CType(Day + 1, Integer)
            End If

            Dim Weekday As Integer = CType(Day, Integer) + 1 - Offset
            If (Weekday < 0) Then
                Weekday += 7
            End If

            Return Weekday + 1

            '/*
            '         If (Offset >= 7) Then
            '             Offset -= 7
            '         End If

            '         Dim Weekday As Integer = CType(Day + Offset, Integer)

            '         If (Weekday > 7) Then
            '             Weekday -= 7
            '         End If

            'select (DayOfWeek)Weekday 
            '             Case DayOfWeek.Sunday
            '		return (int)FirstDayOfWeek.Sunday
            '             Case DayOfWeek.Monday
            '		return (int)FirstDayOfWeek.Monday
            '             Case DayOfWeek.Tuesday
            '		return (int)FirstDayOfWeek.Tuesday
            '             Case DayOfWeek.Wednesday
            '		return (int)FirstDayOfWeek.Wednesday
            '             Case DayOfWeek.Thursday
            '		return (int)FirstDayOfWeek.Thursday
            '             Case DayOfWeek.Friday
            '		return (int)FirstDayOfWeek.Friday
            '             Case DayOfWeek.Saturday
            '		return (int)FirstDayOfWeek.Saturday
            '	default:
            '                 Throw New ArgumentException
            '         End Select
            '*/