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