Thanks very much. I'm using this now. I converted to VB and had to make a couple changes involving the .Split() method to get it to work.
I found a bug with recurrence when the rule is set to the Last day of week or month, it renders as the -1 day. I am working on a fix. For now, here is the vb:
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports System.Globalization
Public Class RecRuleParser
Private Sub New()
End Sub
Public Shared Function ParseRRule(rRule As String, showExceptions As Boolean) As String
If rRule = "" Then
Return ""
End If
Dim parsed As String = String.Empty
'set up the return string
Dim englishStatement As New StringBuilder()
'Break it into basic parts
Dim elements As String() = rRule.Split(vbCrLf)
'it's double spaced in the db, so deal with it accordingly
Dim startDate As String = elements(0).Trim
Dim endDate As String = elements(1).Trim
Dim recRule As String = elements(2).Trim
Dim recExcs As String = String.Empty
'check for exceptions
If elements.Length > 3 Then
recExcs = elements(3).Trim
End If
'Attempt to parse the zulu dates into something else
Dim dtStart As DateTime = DateTime.ParseExact(getElemValue(startDate), "yyyyMMddTHHmmssZ", System.Globalization.CultureInfo.InvariantCulture, DateTimeStyles.AdjustToUniversal)
Dim dtEnd As DateTime = DateTime.ParseExact(getElemValue(endDate), "yyyyMMddTHHmmssZ", System.Globalization.CultureInfo.InvariantCulture, DateTimeStyles.AdjustToUniversal)
Dim tsEnd As TimeSpan = dtEnd.Subtract(dtStart)
'Now work with the recurrence rule
Dim rruleElems As New Dictionary(Of String, String)()
'Convert the string to a dictionary so we can find things easy
parsed = getElemValue(recRule)
'no need having unnecessarily declared strings
elements = parsed.Split(";"c)
For i As Integer = 0 To elements.Length - 1
Dim tmp As String() = elements(i).Split("="c)
rruleElems.Add(tmp(0), tmp(1))
Next
englishStatement.Append("Occurs " & rruleElems("FREQ").ToLower())
Dim calType As String = String.Empty
'need a scratchpad
'start translating into English
Dim timeToAdd As Integer = 0
Try
timeToAdd = Convert.ToInt32(rruleElems("COUNT"))
Catch
timeToAdd = 0
End Try
Dim days As String()
Select Case rruleElems("FREQ").ToLower()
Case "daily"
days = rruleElems("BYDAY").Split(","c)
englishStatement.Append(parseDayNames(days))
dtEnd = dtEnd.AddDays(timeToAdd)
calType = "days"
Exit Select
Case "weekly"
calType = "weeks"
dtEnd = dtEnd.AddDays(timeToAdd * 7)
Try
days = rruleElems("BYDAY").Split(","c)
englishStatement.Append(parseDayNames(days))
Catch
'just in case we missed something on this one
Throw New Exception("Error while processing Recurrence Rule")
End Try
Exit Select
Case "monthly"
calType = "months"
dtEnd = dtEnd.AddMonths(timeToAdd)
'see if it's positional
Try
Dim bsp As String = getDayEnding(rruleElems("BYSETPOS"))
englishStatement.Append(" on the " & bsp & " " & parseDayNames(rruleElems("BYDAY").Split(","c)).Replace(" every ", ""))
Catch
'Ok, no BYSETPOS, let's go for BYMONTHDAY
Dim bsp As String = getDayEnding(rruleElems("BYMONTHDAY"))
englishStatement.Append(" on the " & bsp & " day of each month")
End Try
Exit Select
Case "yearly"
calType = "years"
dtEnd = dtEnd.AddYears(timeToAdd)
'looks a lot like monthly....
Dim mName As String = CultureInfo.CurrentCulture.DateTimeFormat.GetMonthName(Convert.ToInt32(rruleElems("BYMONTH")))
'see if it's positional
Try
Dim bsp As String = getDayEnding(rruleElems("BYSETPOS"))
englishStatement.Append(" on the " & bsp & " " & parseDayNames(rruleElems("BYDAY").Split(","c)).Replace(" every ", "") & " of " & mName)
Catch
'Ok, no BYSETPOS, let's go for BYMONTHDAY
Dim bsp As String = getDayEnding(rruleElems("BYMONTHDAY"))
englishStatement.Append(" on the " & bsp & " day of " & mName)
End Try
Exit Select
Case "hourly"
calType = "hours"
dtEnd = dtEnd.AddHours(timeToAdd)
Exit Select
Case Else
Exit Select
End Select
englishStatement.Append(" starting on " & dtStart.ToLocalTime().ToShortDateString() & " at " & dtStart.ToLocalTime().ToShortTimeString())
If timeToAdd > 0 Then
englishStatement.Append(" for the next " & rruleElems("COUNT") & " " & calType)
englishStatement.Append(" ending on " & dtEnd.ToLocalTime().ToShortDateString() & " at " & dtStart.AddHours(tsEnd.Hours).ToLocalTime().ToShortTimeString())
End If
If recExcs.Length > 0 AndAlso showExceptions Then
Dim excs As String() = recExcs.Split(":"c)(1).Split(","c)
Dim retString As String = String.Empty
englishStatement.Append(" except on ")
For r As Integer = 0 To excs.Length - 1
'we'll use dtEnd, it's not doing anything now
dtEnd = DateTime.ParseExact(excs(r), "yyyyMMddTHHmmssZ", System.Globalization.CultureInfo.InvariantCulture, DateTimeStyles.AdjustToUniversal).ToLocalTime()
If r < excs.Length AndAlso excs.Length > 2 Then
retString += dtEnd & ","
Else
If r < excs.Length - 1 AndAlso excs.Length = 2 Then
retString += dtEnd & " and "
Else
retString += dtEnd
End If
End If
Next
englishStatement.Append(retString)
End If
Return englishStatement.ToString()
End Function
Private Shared Function getElemValue(elem As String) As String
'just easier than writing split all over the place
Dim elems As String() = elem.Split(":"c)
Return elems(1).Trim()
End Function
Private Shared Function getDayName(day As String) As String
'pretty self explanatory
Select Case day
Case "MO"
Return "Monday"
Case "TU"
Return "Tuesday"
Case "WE"
Return "Wednesday"
Case "TH"
Return "Thursday"
Case "FR"
Return "Friday"
Case "SA"
Return "Saturday"
Case "SU"
Return "Sunday"
Case Else
Return ""
End Select
End Function
Private Shared Function parseDayNames(days As String()) As String
Dim retString As String = String.Empty
If True Then
If days.Length < 7 Then
retString += " every"
For d As Integer = 0 To days.Length - 1
days(d) = getDayName(days(d))
If d = days.Length - 1 AndAlso days.Length > 1 Then
days(d) = " and " & days(d)
Else
If days.Length > 2 Then
days(d) += ","
End If
End If
retString += " " & days(d)
Next
End If
End If
Return retString
End Function
Private Shared Function getDayEnding(d As String) As String
'tried to avoid a big ugly if statement
'handle the events on the "n"th day of the month
If d.EndsWith("1") AndAlso d <> "11" Then
d += "st"
End If
If d.EndsWith("2") AndAlso d <> "12" Then
d += "nd"
End If
If d.EndsWith("3") AndAlso d <> "13" Then
d += "rd"
End If
If d.Length < 3 Then
'hasn't been appended yet
d += "th"
End If
Return d
End Function
End Class