Работа с интервалами даты и времени

[alibek]

Процедура, возвращающая интервал между двумя датами. Возвращается интервалы от года до секунды.
Автор: Andrey Fedorov

Код: Выделить всё

' Функция получает разницу между датами в заданных единицах даты/времени
' При ReturnString=True возвращает строковое представление интервала
Public Function DateInterval(d1 As Date, d2 As Date, _
        Optional Years As Variant, Optional Months As Variant, Optional Days As Variant, _
        Optional Hours As Variant, Optional Minutes As Variant, Optional Seconds As Variant, _
        Optional ReturnString As Boolean = False) As String
   
    Const sr As String = ", "
    Const y As String = "yyyy", m As String = "m", d As String = "d", _
        h As String = "h", n As String = "n", s As String = "s"
    Dim dm As Date, dd As Date, dh As Date, dn As Date, ds As Date, _
        ss As String, i As Integer, sss As String

    If IsMissing(Years) Then
        dm = d1
    Else
        Years = DateDiff(y, d1, d2)
        dm = DateAdd(y, Years, d1)
        If dm > d2 Then
            Years = Years - 1
            dm = DateAdd(y, Years, d1)
        End If
        If ReturnString Then
            ss = Right$(Format$(Years, "00"), 2)
            If Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5 Then
                sss = Years & " лет"
            Else
                sss = Years & " год"
                If Right$(ss, 1) <> "1" Then sss = sss & "а"
            End If
        End If
    End If
    If IsMissing(Months) Then
        dd = dm
    Else
        Months = DateDiff(m, dm, d2)
        dd = DateAdd(m, Months, dm)
        If dd > d2 Then
            Months = Months - 1
            dd = DateAdd(m, Months, dm)
        End If
        If ReturnString Then
            ss = Right$(Format$(Months, "00"), 2)
            If Len(sss) Then sss = sss & sr
            sss = sss & Months & " месяц"
            If Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5 Then
                sss = sss & "ев"
            Else
                If Right$(ss, 1) <> "1" Then sss = sss & "а"
            End If
        End If
    End If
    If IsMissing(Days) Then
        dh = dd
    Else
        Days = DateDiff(d, dd, d2)
        dh = DateAdd(d, Days, dd)
        If dh > d2 Then
            Days = Days - 1
            dh = DateAdd(d, Days, dd)
        End If
        If ReturnString Then
            ss = Right$(Format$(Days, "00"), 2)
            If Len(sss) Then sss = sss & sr
            sss = sss & Days & " д"
            If Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5 Then
                sss = sss & "ней"
            Else
                sss = sss & IIf(Right$(ss, 1) = "1", "ень", "ня")
            End If
        End If
    End If
    If IsMissing(Hours) Then
        dn = dh
    Else
        Hours = DateDiff(h, dh, d2)
        dn = DateAdd(h, Hours, dh)
        If dn > d2 Then
            Hours = Hours - 1
            dn = DateAdd(h, Hours, dh)
        End If
        If ReturnString Then
            ss = Right$(Format$(Hours, "00"), 2)
            If Len(sss) Then sss = sss & sr
            sss = sss & Hours & " час"
            If Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5 Then
                sss = sss & "ов"
            Else
                If Right$(ss, 1) <> "1" Then sss = sss & "а"
            End If
        End If
    End If
    If IsMissing(Minutes) Then
        ds = dn
    Else
        Minutes = DateDiff(n, dn, d2)
        ds = DateAdd(n, Minutes, dn)
        If ds > d2 Then
            Minutes = Minutes - 1
            ds = DateAdd(n, Minutes, dn)
        End If
        If ReturnString Then
            ss = Right$(Format$(Minutes, "00"), 2)
            If Len(sss) Then sss = sss & sr
            sss = sss & Minutes & " минут"
            If Not (Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5) Then
                sss = sss & IIf(Right$(ss, 1) = "1", "а", "ы")
            End If
        End If
    End If
    If Not IsMissing(Seconds) Then
        Seconds = DateDiff(s, ds, d2)
        If ReturnString Then
            ss = Right$(Format$(Seconds, "00"), 2)
            If Len(sss) Then sss = sss & sr
            sss = sss & Seconds & " секунд"
            If Not (Right$(ss, 1) = "0" Or Left$(ss, 1) = "1" Or CInt(Right$(ss, 1)) >= 5) Then
                sss = sss & IIf(Right$(ss, 1) = "1", "а", "ы")
            End If
        End If
    End If
    If ReturnString Then DateInterval = sss
End Function


Функция, возвращающая интервал между двумя датами. Возвращаются интервалы от дня до секунды.
Автор: alibek

Код: Выделить всё

Function DeltaDate(ByVal Date1 As Date, ByVal Date2 As Date, Optional ByVal ItemSeparator As String = " ", Optional ByVal SecondsSuffix As String, Optional ByVal MinutesSuffix As String, Optional ByVal HoursSuffix As String, Optional ByVal DaysSuffix As String) As String
Const SM As Long = 60&, MH As Long = 60&, HD As Long = 24&
Dim D As Long, H As Long, M As Long, S As Long
If Date2 > Date1 Then
  S = (Date2 - Date1) * SM * MH * HD
Else
  S = (Date1 - Date2) * SM * MH * HD
End If
If Len(DaysSuffix) > 0 Then
  M = Fix(S / SM)
  S = S - M * SM
  H = Fix(M / MH)
  M = M - H * MH
  D = Fix(H / HD)
  H = H - D * HD
  DeltaDate = Trim$(Str$(D)) & DaysSuffix _
            & IIf(Len(HoursSuffix) = 0, vbNullString, ItemSeparator & Trim$(Str$(H)) & HoursSuffix) _
            & IIf(Len(MinutesSuffix) = 0, vbNullString, ItemSeparator & Trim$(Str$(M)) & MinutesSuffix) _
            & IIf(Len(SecondsSuffix) = 0, vbNullString, ItemSeparator & Trim$(Str$(S)) & SecondsSuffix)
ElseIf Len(HoursSuffix) > 0 Then
  M = Fix(S / SM)
  S = S - M * SM
  H = Fix(M / MH)
  M = M - H * MH
  DeltaDate = Trim$(Str$(H)) & HoursSuffix _
            & IIf(Len(MinutesSuffix) = 0, vbNullString, ItemSeparator & Trim$(Str$(M)) & MinutesSuffix) _
            & IIf(Len(SecondsSuffix) = 0, vbNullString, ItemSeparator & Trim$(Str$(S)) & SecondsSuffix)
ElseIf Len(MinutesSuffix) > 0 Then
  M = Fix(S / SM)
  S = S - M * SM
  DeltaDate = Trim$(Str$(M)) & MinutesSuffix _
            & IIf(Len(SecondsSuffix) = 0, vbNullString, ItemSeparator & Trim$(Str$(S)) & SecondsSuffix)
Else
  DeltaDate = Format$(S, "0") & SecondsSuffix
End If
End Function

Пример использования:

?DeltaDate(Now(),Now()-0.74,", "," с."," м."," ч."," д.")
0 д., 17 ч., 45 м., 36 с.

[Andrey Fedorov]

А теперь парочка функций для MS SQL 2005 на эту-же тему.

Код: Выделить всё

Imports System
Imports System.Data
Imports System.Data.SqlClient
Imports System.Data.SqlTypes
Imports Microsoft.SqlServer.Server

Partial Public Class UserDefinedFunctions
    <Microsoft.SqlServer.Server.SqlFunction()> _
    Public Shared Function ufnGetAgo(ByVal d1 As Date, ByVal d2 As Date, _
                    ByVal RetValue As Char, _
                    Optional ByVal RetValues As String = "YMDHNS" _
                ) As SqlInt32
        Dim Years As Integer, Months As Integer, Weeks As Integer, Days As Integer, Hours As Integer, Minutes As Integer, Seconds As Integer
        Dim dm As Date, dw As Date, dd As Date, dh As Date, dn As Date, ds As Date

        RetValue = UCase(RetValue)
        RetValues = UCase(RetValues)
        If RetValues.IndexOf(RetValue) < 0 Then Return New SqlInt32()

        If RetValues.IndexOf("Y") < 0 Then
            dm = d1
            If RetValue = "Y" Then Return New SqlInt32()
        Else
            Years = CInt(DateDiff(DateInterval.Year, d1, d2))
            dm = DateAdd(DateInterval.Year, Years, d1)
            If dm > d2 Then
                Years -= 1
                dm = DateAdd(DateInterval.Year, Years, d1)
            End If
        End If
        If RetValue = "Y" Then Return New SqlInt32(Years)

        If RetValues.IndexOf("M") < 0 Then
            dw = dm
            If RetValue = "M" Then Return New SqlInt32()
        Else
            Months = CInt(DateDiff(DateInterval.Month, dm, d2))
            dw = DateAdd(DateInterval.Month, Months, dm)
            If dw > d2 Then
                Months -= 1
                dw = DateAdd(DateInterval.Month, Months, dm)
            End If
        End If
        If RetValue = "M" Then Return New SqlInt32(Months)

        If RetValues.IndexOf("W") < 0 Then
            dd = dw
            If RetValue = "W" Then Return New SqlInt32()
        Else
            Weeks = CInt(DateDiff(DateInterval.Weekday, dw, d2))
            dd = DateAdd(DateInterval.Weekday, Weeks, dw)
            If dd > d2 Then
                Weeks -= 1
                dd = DateAdd(DateInterval.Weekday, Weeks, dw)
            End If
        End If
        If RetValue = "W" Then Return New SqlInt32(Weeks)

        If RetValues.IndexOf("D") < 0 Then
            dh = dd
            If RetValue = "D" Then Return New SqlInt32()
        Else
            Days = CInt(DateDiff(DateInterval.Day, dd, d2))
            dh = DateAdd(DateInterval.Day, Days, dd)
            If dh > d2 Then
                Days -= 1
                dh = DateAdd(DateInterval.Day, Days, dd)
            End If
        End If
        If RetValue = "D" Then Return New SqlInt32(Days)

        If RetValues.IndexOf("H") < 0 Then
            dn = dh
            If RetValue = "H" Then Return New SqlInt32()
        Else
            Hours = CInt(DateDiff(DateInterval.Hour, dh, d2))
            dn = DateAdd(DateInterval.Hour, Hours, dh)
            If dn > d2 Then
                Hours -= 1
                dn = DateAdd(DateInterval.Hour, Hours, dh)
            End If
        End If
        If RetValue = "H" Then Return New SqlInt32(Hours)

        If RetValues.IndexOf("N") < 0 Then
            ds = dn
            If RetValue = "N" Then Return New SqlInt32()
        Else
            Minutes = CInt(DateDiff(DateInterval.Minute, dn, d2))
            ds = DateAdd(DateInterval.Minute, Minutes, dn)
            If ds > d2 Then
                Minutes -= 1
                ds = DateAdd(DateInterval.Minute, Minutes, dn)
            End If
        End If
        If RetValue = "N" Then Return New SqlInt32(Minutes)

        If Seconds = 0 Then
            Return New SqlInt32()
        Else
            Seconds = CInt(DateDiff(DateInterval.Second, ds, d2))
        End If
        If RetValue = "S" Then Return New SqlInt32(Minutes)
    End Function

    <Microsoft.SqlServer.Server.SqlFunction()> _
    Public Shared Function ufnGetAgoString(ByVal d1 As Date, ByVal d2 As Date, _
                    Optional ByVal RetValues As String = "YMDHNS" _
                ) As SqlString

        Const sr As String = ", "
        Dim Years As Integer, Months As Integer, Weeks As Integer, Days As Integer, Hours As Integer, Minutes As Integer, Seconds As Integer
        Dim dm As Date, dw As Date, dd As Date, dh As Date, dn As Date, ds As Date
        Dim ss As String, s0 As String = vbNullString, sb As New System.Text.StringBuilder

        RetValues = RetValues.ToUpper
        If RetValues.Length = 0 Then Return New SqlString()

        If RetValues.IndexOf("Y") < 0 Then
            dm = d1
        Else
            Years = CInt(DateDiff(DateInterval.Year, d1, d2))
            dm = DateAdd(DateInterval.Year, Years, d1)
            If dm > d2 Then
                Years -= 1
                dm = DateAdd(DateInterval.Year, Years, d1)
            End If
            If Years > 0 Then
                ss = Right(Years.ToString, 2)
                If ss.EndsWith("0") Or ss.StartsWith("1") Or CInt(Right(ss, 1)) >= 5 Then
                    sb.Append(Years.ToString & " лет")
                Else
                    sb.Append(Years.ToString & " год")
                    If Not ss.EndsWith("1") Then sb.Append("а")
                End If
            Else
                s0 = "лет"
            End If
        End If

        If RetValues.IndexOf("M") < 0 Then
            dw = dm
        Else
            Months = CInt(DateDiff(DateInterval.Month, dm, d2))
            dw = DateAdd(DateInterval.Month, Months, dm)
            If dw > d2 Then
                Months -= 1
                dw = DateAdd(DateInterval.Month, Months, dm)
            End If
            If Months > 0 Then
                ss = Right((100 + Months).ToString, 2)
                If sb.Length > 0 Then sb.Append(sr)
                sb.Append(Months.ToString & " месяц")
                If ss.EndsWith("0") Or ss.StartsWith("1") Or CInt(Right(ss, 1)) >= 5 Then
                    sb.Append("ев")
                Else
                    If Not ss.EndsWith("1") Then sb.Append("а")
                End If
            Else
                s0 = "месяцев"
            End If
        End If

        If RetValues.IndexOf("W") < 0 Then
            dd = dw
        Else
            Weeks = CInt(DateDiff(DateInterval.WeekOfYear, dw, d2))
            dd = DateAdd(DateInterval.WeekOfYear, Weeks, dw)
            If dd > d2 Then
                Weeks -= 1
                dd = DateAdd(DateInterval.WeekOfYear, Weeks, dw)
            End If
            If Weeks > 0 Then
                ss = Right((100 + Weeks).ToString, 2)
                If sb.Length > 0 Then sb.Append(sr)
                sb.Append(Weeks.ToString & " недел")
                If ss.EndsWith("0") Or ss.StartsWith("1") Or CInt(Right(ss, 1)) >= 5 Then
                    sb.Append("ь")
                Else
                    sb.Append(IIf(ss.EndsWith("1"), "я", "и"))
                End If
            Else
                s0 = "недель"
            End If
        End If

        If RetValues.IndexOf("D") < 0 Then
            dh = dd
        Else
            Days = CInt(DateDiff(DateInterval.Day, dd, d2))
            dh = DateAdd(DateInterval.Day, Days, dd)
            If dh > d2 Then
                Days -= 1
                dh = DateAdd(DateInterval.Day, Days, dd)
            End If
            If Days > 0 Then
                ss = Right((100 + Days).ToString, 2)
                If sb.Length > 0 Then sb.Append(sr)
                sb.Append(Days.ToString & " д")
                If ss.EndsWith("0") Or ss.StartsWith("1") Or CInt(Right(ss, 1)) >= 5 Then
                    sb.Append("ней")
                Else
                    sb.Append(IIf(ss.EndsWith("1"), "ень", "ня"))
                End If
            Else
                s0 = "дней"
            End If
        End If

        If RetValues.IndexOf("H") < 0 Then
            dn = dh
        Else
            Hours = CInt(DateDiff(DateInterval.Hour, dh, d2))
            dn = DateAdd(DateInterval.Hour, Hours, dh)
            If dn > d2 Then
                Hours -= 1
                dn = DateAdd(DateInterval.Hour, Hours, dh)
            End If
            If Hours > 0 Then
                ss = Right((100 + Hours).ToString, 2)
                If sb.Length > 0 Then sb.Append(sr)
                sb.Append(Hours.ToString & " час")
                If ss.EndsWith("0") Or ss.StartsWith("1") Or CInt(Right(ss, 1)) >= 5 Then
                    sb.Append("ов")
                Else
                    If Not ss.EndsWith("1") Then sb.Append("а")
                End If
            Else
                s0 = "часов"
            End If
        End If

        If RetValues.IndexOf("N") < 0 Then
            ds = dn
        Else
            Minutes = CInt(DateDiff(DateInterval.Minute, dn, d2))
            ds = DateAdd(DateInterval.Minute, Minutes, dn)
            If ds > d2 Then
                Minutes -= 1
                ds = DateAdd(DateInterval.Minute, Minutes, dn)
            End If
            If Minutes > 0 Then
                ss = Right((100 + Minutes).ToString, 2)
                If sb.Length > 0 Then sb.Append(sr)
                sb.Append(Minutes.ToString & " минут")
                If Not (ss.EndsWith("0") Or ss.StartsWith("1") Or CInt(Right(ss, 1)) >= 5) Then
                    sb.Append(IIf(ss.EndsWith("1"), "а", "ы"))
                End If
            Else
                s0 = "минут"
            End If
        End If

        If RetValues.IndexOf("N") >= 0 Then
            Seconds = CInt(DateDiff(DateInterval.Second, ds, d2))
            If Seconds > 0 Then
                ss = Right((100 + Seconds).ToString, 2)
                If sb.Length > 0 Then sb.Append(sr)
                sb.Append(Seconds.ToString & " секунд")
                If Not (ss.EndsWith("0") Or ss.StartsWith("1") Or CInt(Right$(ss, 1)) >= 5) Then
                    sb.Append(IIf(ss.EndsWith("1"), "а", "ы"))
                End If
            Else
                s0 = "секунд"
            End If
        End If

        If sb.Length > 0 Then
            Return New SqlString(sb.ToString)
        Else
            Return New SqlString("0 " & s0)
        End If
    End Function
End Class


Пример использования:

Код: Выделить всё

Select
   Лет = dbo.ufnGetAgo('19621010',GETDATE(), 'Y', 'Y'),
   Месяцев = dbo.ufnGetAgo('19621010',GETDATE(), 'M', 'YM'),
   ВсегоМесяцев = dbo.ufnGetAgo('19621010',GETDATE(), 'M', 'M'),
   [Возраст строкой] = dbo.ufnGetAgoString('19621010',GETDATE(), 'YMDHNS')
UNION ALL
Select
   Лет = dbo.ufnGetAgo('19621010',GETDATE(), 'Y', 'Y'),
   Месяцев = dbo.ufnGetAgo('19621010',GETDATE(), 'M', 'YM'),
   ВсегоМесяцев = dbo.ufnGetAgo('19921010',GETDATE(), 'M', 'M'),
   [Возраст строкой] = dbo.ufnGetAgoString('19921010',GETDATE(), 'YMDHNS')
UNION ALL
Select
   Лет = dbo.ufnGetAgo('19621010',GETDATE(), 'Y', 'Y'),
   Месяцев = dbo.ufnGetAgo('19621010',GETDATE(), 'M', 'YM'),
   ВсегоМесяцев = dbo.ufnGetAgo('19921010',GETDATE(), 'M', 'M'),
   [Возраст строкой] = dbo.ufnGetAgoString('19921015',GETDATE(), 'YMDHNS')
UNION ALL
Select
   Лет = dbo.ufnGetAgo('19621010',GETDATE(), 'Y', 'Y'),
   Месяцев = dbo.ufnGetAgo('19621010',GETDATE(), 'M', 'YM'),
   ВсегоМесяцев = dbo.ufnGetAgo('19921010',GETDATE(), 'M', 'M'),
   [Возраст строкой] = dbo.ufnGetAgoString('19921015',GETDATE(), 'wDHNS')

-- И результат:

Лет         Месяцев     ВсегоМесяцев Возраст строкой                                                                                                                                                                                                                                                 
----------- ----------- ------------ ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
43          5           521          43 года, 5 месяцев, 28 дней, 12 часов, 7 минут, 34 секунды                                                                                                                                                                                                       
43          5           161          13 лет, 5 месяцев, 28 дней, 12 часов, 7 минут, 34 секунды                                                                                                                                                                                                       
43          5           161          13 лет, 5 месяцев, 23 дня, 12 часов, 7 минут, 34 секунды                                                                                                                                                                                                         
43          5           161          703 недели, 1 день, 12 часов, 7 минут, 34 секунды