Attribute VB_Name = "MRfc2822" ' ************************************************************************* ' Copyright ©2006 Karl E. Peterson ' All Rights Reserved, http://vb.mvps.org/ ' ************************************************************************* ' You are free to use this code within your own applications, but you ' are expressly forbidden from selling or otherwise distributing this ' source code, non-compiled, without prior written consent. ' ************************************************************************* Option Explicit Private Const Months As String = "|Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec|" Private Const Days As String = "|Sun|Mon|Tue|Wed|Thu|Fri|Sat|" Private Const RollOver As Long = 1950 Private Const Indeterminate As String = "-0000" Public Function DatestampFormat(ByVal DateStamp As Date) As String ' This returns an RFC2822-compliant datestamp string. ' TODO: Offer timezone offset? Dim m As Long, w As Long Dim Result As String ' Extract weekday from constant array, append day, ' extract month from constant array, append year, ' append time. DatestampFormat = _ Mid$(Days, (((Weekday(DateStamp) - 1) * 4) + 2), 3) & ", " & _ Format$(Day(DateStamp), "00") & " " & _ Mid$(Months, (((Month(DateStamp) - 1) * 4) + 2), 3) & " " & _ Format$(Year(DateStamp), "0000") & " " & _ Format$(TimeValue(DateStamp), "hh:mm:ss") End Function Public Function DatestampNormalize(ByVal DateStamp As String, Optional NewOffset As String = "+0000") As Date Dim nChar As Long Dim Parts As Variant Dim d As Long, m As Long, y As Long Dim h As Long, n As Long, s As Long Dim TimeStamp As String Dim ZoneOffset As String Dim Result As Date ' Crunch down all whitespace. DateStamp = UnfoldWhitespace(DateStamp) ' Remove day-of-week, if present. nChar = InStr(DateStamp, ",") If nChar > 0 And nChar < Len(DateStamp) Then DateStamp = Trim$(Mid$(DateStamp, nChar + 1)) End If ' Break remainder of datestamp into consitituent parts, ' and start assigning values. Parts = Split(DateStamp, " ") On Error Resume Next ' Question is, should we bail if any parts are missing??? d = Val(Parts(0)) m = ((InStr(Months, "|" & Parts(1) & "|") - 1) \ 4) + 1 y = YearCheck(Parts(2)) TimeStamp = Parts(3) ZoneOffset = Parts(4) On Error GoTo 0 ' Break apart timestamp into separate parts. Parts = Split(TimeStamp, ":") On Error Resume Next h = Val(Parts(0)) n = Val(Parts(1)) s = Val(Parts(2)) '<= optional! On Error GoTo 0 ' Intermediate result without timezone shift(s). Result = DateSerial(y, m, d) + TimeSerial(h, n, s) ' Adjust our time value by appropriate zone shift value ' so that it's now normalized to UTC. ZoneOffset = ZoneCheck(ZoneOffset) If ZoneOffset <> Indeterminate Then Result = DateAdd("n", ZoneValue(ZoneOffset), Result) End If ' Apply optional zone shift to localize as requested, ' but not in cases where the original isn't known. If ZoneOffset <> Indeterminate Then ZoneOffset = ZoneCheck(NewOffset) If ZoneOffset <> Indeterminate Then ' Note negation!!!!!!!!!! Result = DateAdd("n", -ZoneValue(ZoneOffset), Result) End If End If ' Return a normalized datevalue. DatestampNormalize = Result End Function Private Function UnfoldWhitespace(ByVal HeaderText As String) As String ' Replace CR/LF/TAB chars with spaces. HeaderText = Replace$(HeaderText, vbCr, " ") HeaderText = Replace$(HeaderText, vbLf, " ") HeaderText = Replace$(HeaderText, vbTab, " ") ' Crunch down all multi-space seqs to single. HeaderText = Trim$(HeaderText) Do While InStr(HeaderText, " ") HeaderText = Replace$(HeaderText, " ", " ") Loop ' Return results UnfoldWhitespace = HeaderText End Function Private Function YearCheck(ByVal YearValue As String) As Long Dim Result As Long ' Do simple error-trapped coercion to numeric value. On Error Resume Next Result = Val(YearValue) On Error GoTo 0 ' Where a two or three digit year occurs in a date, the year is to ' be interpreted as follows: If a two digit year is encountered ' whose value is between 00 and 49, the year is interpreted by ' adding 2000, ending up with a value between 2000 and 2049. If a ' two digit year is encountered with a value between 50 and 99, or ' any three digit year is encountered, the year is interpreted by ' adding 1900# Select Case Len(YearValue) Case 2 If Result >= 50 Then Result = Result + 2000 Else Result = Result + 1900 End If Case 3 Result = Result + 1900 Case 4 ' sanity! Case Else ' wtf??? Result = Year(Now) End Select YearCheck = Result End Function Private Function ZoneValue(ByVal ZoneOffset As String) As Long ' The zone specifies the offset from Coordinated Universal Time (UTC, ' formerly referred to as "Greenwich Mean Time") that the date and ' time-of-day represent. The "+" or "-" indicates whether the ' time-of-day is ahead of (i.e., east of) or behind (i.e., west of) ' Universal Time. The first two digits indicate the number of hours ' difference from Universal Time, and the last two digits indicate the ' number of minutes difference from Universal Time. (Hence, +hhmm ' means +(hh * 60 + mm) minutes, and -hhmm means -(hh * 60 + mm) ' minutes). The form "+0000" SHOULD be used to indicate a time zone at ' Universal Time. Though "-0000" also indicates Universal Time, it is ' used to indicate that the time was generated on a system that may be ' in a local time zone other than Universal Time and therefore ' indicates that the date-time contains no information about the local ' time zone. ZoneValue = (Val(Mid$(ZoneOffset, 2, 2) * 60 + _ Val(Mid$(ZoneOffset, 4, 2)))) * _ -Sgn(Val(ZoneOffset)) End Function Private Function ZoneCheck(ByVal ZoneOffset As String) As String Dim Result As String Dim i As Long ' Be charitable towards "obsolete" timezone designations. Select Case ZoneOffset Case "GMT", "UT" Result = "+0000" Case "EDT" Result = "-0400" Case "EST", "CDT" Result = "-0500" Case "CST", "MDT" Result = "-0600" Case "MST", "PDT" Result = "-0700" Case "PST" Result = "-0800" Case Else ' Probably an obsolete zone offset value. Possibly a ' 1-digit military zone, or some other abbreviation ' that we're not aware of. We will presume that anything ' other than a 5-character string composed of a sign and ' four digits is indeterminate. ' Check for proper length. If Len(ZoneOffset) = 5 Then ' Check for leading sign. If (InStr(ZoneOffset, "+") = 1) Or (InStr(ZoneOffset, "-") = 1) Then ' Assume success at this point Result = ZoneOffset ' Check that each following character is numeric. For i = 2 To Len(ZoneOffset) If InStr("0123456789", Mid$(ZoneOffset, i, 1)) = 0 Then Result = Indeterminate Exit For End If Next i Else Result = Indeterminate End If Else Result = Indeterminate End If End Select ZoneCheck = Result End Function ' ************************************************************************* ' RFC 2822 (rfc2822) - Internet Message Format ' http://www.faqs.org/rfcs/rfc2822.html ' ************************************************************************* ' 3.3. Date and Time Specification ' ' Date and time occur in several header fields. This section specifies ' the syntax for a full date and time specification. Though folding ' white space is permitted throughout the date-time specification, it ' is RECOMMENDED that a single space be used in each place that FWS ' appears (whether it is required or optional); some older ' implementations may not interpret other occurrences of folding white ' space correctly. ' ' date-time = [ day-of-week "," ] date FWS time [CFWS] ' ' day-of-week = ([FWS] day-name) / obs-day-of-week ' ' day-name = "Mon" / "Tue" / "Wed" / "Thu" / ' "Fri" / "Sat" / "Sun" ' ' date = day month year ' ' Year = 4 * DIGIT / obs - Year ' ' month = (FWS month-name FWS) / obs-month ' ' month-name = "Jan" / "Feb" / "Mar" / "Apr" / ' "May" / "Jun" / "Jul" / "Aug" / ' "Sep" / "Oct" / "Nov" / "Dec" ' ' day = ([FWS] 1*2DIGIT) / obs-day ' ' time = time-of-day FWS zone ' ' time-of-day = hour ":" minute [ ":" second ] ' ' hour = 2DIGIT / obs-hour ' ' minute = 2DIGIT / obs-minute ' ' second = 2DIGIT / obs-second ' ' zone = (( "+" / "-" ) 4DIGIT) / obs-zone ' ' The day is the numeric day of the month. The year is any numeric ' year 1900 or later. ' ' The time-of-day specifies the number of hours, minutes, and ' optionally seconds since midnight of the date indicated. ' ' The date and time-of-day SHOULD express local time. ' ' The zone specifies the offset from Coordinated Universal Time (UTC, ' formerly referred to as "Greenwich Mean Time") that the date and ' time-of-day represent. The "+" or "-" indicates whether the ' time-of-day is ahead of (i.e., east of) or behind (i.e., west of) ' Universal Time. The first two digits indicate the number of hours ' difference from Universal Time, and the last two digits indicate the ' number of minutes difference from Universal Time. (Hence, +hhmm ' means +(hh * 60 + mm) minutes, and -hhmm means -(hh * 60 + mm) ' minutes). The form "+0000" SHOULD be used to indicate a time zone at ' Universal Time. Though "-0000" also indicates Universal Time, it is ' used to indicate that the time was generated on a system that may be ' in a local time zone other than Universal Time and therefore ' indicates that the date-time contains no information about the local ' time zone. ' ' A date-time specification MUST be semantically valid. That is, the ' day-of-the-week (if included) MUST be the day implied by the date, ' the numeric day-of-month MUST be between 1 and the number of days ' allowed for the specified month (in the specified year), the ' time-of-day MUST be in the range 00:00:00 through 23:59:60 (the ' number of seconds allowing for a leap second; see [STD12]), and the ' zone MUST be within the range -9959 through +9959. ' ' ************************************************************************* ' RFC 2822 (rfc2822) - Internet Message Format ' http://www.faqs.org/rfcs/rfc2822.html ' ************************************************************************* ' 4.3. Obsolete Date and Time ' ' The syntax for the obsolete date format allows a 2 digit year in the ' date field and allows for a list of alphabetic time zone ' specifications that were used in earlier versions of this standard. ' It also permits comments and folding white space between many of the ' tokens. ' ' obs-day-of-week = [CFWS] day-name [CFWS] ' ' obs-year = [CFWS] 2*DIGIT [CFWS] ' ' obs-month = CFWS month-name CFWS ' ' obs-day = [CFWS] 1*2DIGIT [CFWS] ' ' obs-hour = [CFWS] 2DIGIT [CFWS] ' ' obs-minute = [CFWS] 2DIGIT [CFWS] ' ' obs-second = [CFWS] 2DIGIT [CFWS] ' ' obs-zone = "UT" / "GMT" / ; Universal Time ' ' ; North American UT ' ; offsets ' "EST" / "EDT" / ; Eastern: - 5/ - 4 ' "CST" / "CDT" / ; Central: - 6/ - 5 ' "MST" / "MDT" / ; Mountain: - 7/ - 6 ' "PST" / "PDT" / ; Pacific: - 8/ - 7 ' ' %d65-73 / ; Military zones - "A" ' %d75-90 / ; through "I" and "K" ' %d97-105 / ; through "Z", both ' %d107-122 ; upper and lower case ' ' Where a two or three digit year occurs in a date, the year is to be ' interpreted as follows: If a two digit year is encountered whose ' value is between 00 and 49, the year is interpreted by adding 2000, ' ending up with a value between 2000 and 2049. If a two digit year is ' encountered with a value between 50 and 99, or any three digit year ' is encountered, the year is interpreted by adding 1900. ' ' In the obsolete time zone, "UT" and "GMT" are indications of ' "Universal Time" and "Greenwich Mean Time" respectively and are both ' semantically identical to "+0000". ' ' The remaining three character zones are the US time zones. The first ' letter, "E", "C", "M", or "P" stands for "Eastern", "Central", ' "Mountain" and "Pacific". The second letter is either "S" for ' "Standard" time, or "D" for "Daylight" (or summer) time. Their ' interpretations are as follows: ' ' EDT is semantically equivalent to -0400 ' EST is semantically equivalent to -0500 ' CDT is semantically equivalent to -0500 ' CST is semantically equivalent to -0600 ' MDT is semantically equivalent to -0600 ' MST is semantically equivalent to -0700 ' PDT is semantically equivalent to -0700 ' PST is semantically equivalent to -0800 ' ' The 1 character military time zones were defined in a non-standard ' way in [RFC822] and are therefore unpredictable in their meaning. ' The original definitions of the military zones "A" through "I" are ' equivalent to "+0100" through "+0900" respectively; "K", "L", and "M" ' are equivalent to "+1000", "+1100", and "+1200" respectively; "N" ' through "Y" are equivalent to "-0100" through "-1200" respectively; ' and "Z" is equivalent to "+0000". However, because of the error in ' [RFC822], they SHOULD all be considered equivalent to "-0000" unless ' there is out-of-band information confirming their meaning. ' ' Other multi-character (usually between 3 and 5) alphabetic time zones ' have been used in Internet messages. Any such time zone whose ' meaning is not known SHOULD be considered equivalent to "-0000" ' unless there is out-of-band information confirming their meaning. ' ************************************************************************* ' RFC 2234 (rfc2234) - Augmented BNF for Syntax Specifications: ABNF ' http://www.faqs.org/rfcs/rfc2234.html ' ************************************************************************* ' 3.6 Variable Repetition *Rule ' ' The operator "*" preceding an element indicates repetition. The full ' form is: ' ' *element ' ' where and are optional decimal values, indicating at least ' and at most occurrences of element. ' ' Default values are 0 and infinity so that * allows any ' number, including zero; 1* requires at least one; ' 3*3 allows exactly 3 and 1*2 allows one or two. '