AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

RFC822 Datum zu TDateTime

Ein Thema von Prototypjack · begonnen am 23. Aug 2009
Antwort Antwort
Prototypjack

Registriert seit: 2. Feb 2003
611 Beiträge
 
Delphi 2009 Professional
 
#1

RFC822 Datum zu TDateTime

  Alt 23. Aug 2009, 14:31
Moin,

Ich brauchte vor kurzem eine Funktion um ein RFC822-Datum in das TDateTime-Format zu konvertieren. Da es scheinbar keine gibt, habe ich selbst eine programmiert.
Es gibt nur ein Problem: Ich bin mir nicht ganz sicher, ob die Konvertierung am Ende der Funktion in die lokale Zeit wirklich richtig ist, wäre super, wenn sich das noch einmal jemand ansehen könnte. Edit: Neue Version: Die Umwandlung der Zonen sollte nun erwartungsgemäß arbeiten!

Ein Datum nach dem RFC-822-Standard sieht so aus: [Sun, ]23 Aug [20]09 14:28[:23] [GMT][+0100]. Die Teile in den eckigen Klammern sind dabei optional. Die einzige Abweichung des Standards befindet sich im Erkennen der Jahreszahl, denn nach dem originalen Standard sind hier nur zwei Ziffern erlaubt (z.B. 09). In dieser Funktion können auch vierstellige Jahreszahlen erkannt werden. Edit: Neue Version: Jetzt ist die Angabe der Zeitzone auch optional. Sollte keine gefunden werden, so wird UT-Zeit angenommen.

Benötigt wird die Unit DateUtils.

Delphi-Quellcode:
function RFC822DateToDateTime(RFC822DateTime: string): TDateTime;
resourcestring
  RFC822ConvertDateTimeConvertError = '"%s" ist keine gültige RFC822-Datums-/' +
    'Zeitangabe';
const
  DayArray: array[0..6] of string = ('Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat',
    'Sun');
  MonthArray: array[0..11] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May',
    'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  ZoneArray: array[0..14] of string = ('UT', 'GMT', 'EST', 'EDT', 'CST', 'CDT',
    'MST', 'MDT', 'PST', 'PDT', 'Z', 'A', 'M', 'N', 'Y');
var
  lString: string;
  lDayName: string;
  lMonthName: string;
  I: Integer;
  lProceed: Boolean;
  lDay: Integer;
  lMonth: Integer;
  lYear: Integer;
  lTmp: Integer;
  lHours: Integer;
  lMinutes: Integer;
  lSeconds: Integer;
  lTimeZone: TTimeZoneInformation;
  lLocalStringTime: TDateTime;
  lTimeZoneName: string;
  lTimeZoneIndex: Integer;
  lLocalDiffHours: Integer;
  lLocalDiffMinutes: Integer;
  lAddLocalDiff: Boolean;
begin
  lTimeZoneIndex := -1;
  lAddLocalDiff := False;
  lMonth := -1;
  lTmp := 0;
  lString := RFC822DateTime;
  lProceed := False;
  if Pos(',', lString) > 0 then
  begin
    // Includes DayName
    lDayName := Copy(lString, 1, 3);
    for I := 0 to Length(DayArray) - 1 do
    begin
      if lDayName = DayArray[I] then
      begin
        // Found
        lProceed := True;
        Break;
      end;
    end;
    Delete(lString, 1, 5);
  end;
  if lProceed then
  begin
    // Day
    if not TryStrToInt(Copy(lString, 1, 2), lDay) then
    begin
      lProceed := False;
    end;
  end;
  // MonthName
  if lProceed then
  begin
    lMonthName := Copy(lString, 4, 3);
    lProceed := False;
    for I := 0 to Length(MonthArray) - 1 do
    begin
      if lMonthName = MonthArray[I] then
      begin
        // Found
        lProceed := True;
        // Month
        lMonth := Succ(I);
        Break;
      end;
    end;
  end;
  // Year
  if lProceed then
  begin
    if not TryStrToInt(Copy(lString, 8, 4), lYear) then
    begin
      // might be only 2 characters long
      if not TryStrToInt(Copy(lString, 8, 2), lYear) then
      begin
        lProceed := False;
      end
      else
      begin
        lTmp := 2;
      end;
    end
    else
    begin
      lTmp := 4;
    end;
  end;
  // Hours
  if lProceed then
  begin
    lTmp := 8 + Succ(lTmp);
    if not TryStrToInt(Copy(lString, lTmp, 2), lHours) then
    begin
      lProceed := False;
    end;
  end;
  // Minutes
  if lProceed then
  begin
    Inc(lTmp, 3);
    if not TryStrToInt(Copy(lString, lTmp, 2), lMinutes) then
    begin
      lProceed := False;
    end;
  end;
  // Seconds
  if lProceed then
  begin
    Inc(lTmp, 3);
    if not TryStrToInt(Copy(lString, lTmp, 2), lSeconds) then
    begin
      // Just proceed, seconds are optional.
      lSeconds := 0;
    end;
  end;
  if lProceed then
  begin
    // Get TimeZone
    Inc(lTmp, 3); // Start of TimeZone
    lTimeZoneName := Copy(lString, lTmp, 3); // e.g. "GMT"
    if (Copy(lTimeZoneName, 1, 1) = '-') or (Copy(lTimeZoneName, 1, 1) = '+') or
      (Length(lTimeZoneName) = 0) then
    begin
      // Assume UTC
      lTimeZoneIndex := 0;
    end
    else
    begin
      lProceed := False;
      if Length(lTimeZoneName) = 3 then
      begin
        for I := 0 to Length(ZoneArray) - 1 do
        begin
          if ZoneArray[I] = lTimeZoneName then
          begin
            // Found
            lTimeZoneIndex := I;
            lProceed := True;
            Break;
          end;
        end;
      end;
      if not lProceed then
      begin
        // Try the ones with only 2 letters
        for I := 0 to Length(ZoneArray) - 1 do
        begin
          if ZoneArray[I] = Copy(lTimeZoneName, 1, 2) then
          begin
            // Found
            lTimeZoneIndex := I;
            lProceed := True;
            Break;
          end;
        end;
      end;
      if not lProceed then
      begin
        // Try the ones with only 1 letter
        for I := 0 to Length(ZoneArray) - 1 do
        begin
          if ZoneArray[I] = lTimeZoneName[1] then
          begin
            // Found
            lTimeZoneIndex := I;
            lProceed := True;
            Break;
          end;
        end;
      end;
      Inc(lTmp, Length(ZoneArray[lTimeZoneIndex])); // Begin of + / -
    end;
  end;
  if lProceed then
  begin
    // Get local differential hours
    lAddLocalDiff := Copy(lString, lTmp, 1) = '+';
    Inc(lTmp, 1); // Begin of local diff hours
    if lTmp < Length(lString) then
    begin
      // Has local differential hours
      if not TryStrToInt(Copy(lString, lTmp, 2), lLocalDiffHours) then
      begin
        lProceed := False;
      end;
    end
    else
    begin
      // No local diff time
      lLocalDiffHours := -1;
      lLocalDiffMinutes := -1;
    end;
  end;
  if (lProceed) and (lLocalDiffHours <> -1) then
  begin
    // Get local differential minutes
    Inc(lTmp, 2); // Begin of local diff minutes
    if not TryStrToInt(Copy(lString, lTmp, 2), lLocalDiffMinutes) then
    begin
      lProceed := False;
    end;
  end;
  if lProceed then
  begin
    // Create current local time of string as TDateTime
    lLocalStringTime := EncodeDate(lYear, lMonth, lDay) +
      EncodeTime(lHours, lMinutes, lSeconds, 0);
    case lTimeZoneIndex of
      0, 1, 10: lTmp := 0; // UT, GMT, Z
      2: lTmp := 5; // EST, - 5
      3: lTmp := 4; // EDT, - 4
      4: lTmp := 6; // CST, - 6
      5: lTmp := 5; // CDT, - 5
      6: lTmp := 7; // MST, - 7
      7: lTmp := 6; // MDT, - 6
      8: lTmp := 8; // PST, - 8
      9: lTmp := 7; // PDT, - 7
      11: lTmp := 1; // A, - 1
      12: lTmp := 12; // M, - 12
      13: lTmp := -1; // N, + 1
      14: lTmp := -12; // Y, + 12
    end;
    // Calculate the UTC-Time of the given string
    lLocalStringTime := lLocalStringTime + (lTmp * OneHour);
    if lLocalDiffHours <> -1 then
    begin
      if lAddLocalDiff then
      begin
        lLocalStringTime := lLocalStringTime - (lLocalDiffHours * OneHour) -
          (lLocalDiffMinutes * OneMinute);
      end
      else
      begin
        lLocalStringTime := lLocalStringTime + (lLocalDiffHours * OneHour) +
          (lLocalDiffMinutes * OneMinute);
      end;
    end;
    // Now calculate the time in local format
    if GetTimeZoneInformation(lTimeZone) = TIME_ZONE_ID_DAYLIGHT then
    begin
      Result := lLocalStringTime - ((lTimeZone.Bias + lTimeZone.DaylightBias)
        * OneMinute);
    end
    else
    begin
      Result := lLocalStringTime - ((lTimeZone.Bias + lTimeZone.StandardBias)
        * OneMinute);
    end;
  end
  else
  begin
    raise EConvertError.Create(Format(RFC822ConvertDateTimeConvertError,
      [RFC822DateTime]));
  end;
end;
Ich hoffe ihr könnt das mal brauchen

Edit: Falls es jemand braucht, hier die Syntax des RFC822-Standards: http://asg.web.cmu.edu/rfc/rfc822.html#sec-5.

Grüße,
Max
Max
„If you have any great suggestions, feel free to mail me, and I'll probably feel free to ignore you.“ . Linus Torvalds
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 18:36 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz