Alternative zu StrToDate?

[hitzi]

Hallo,

ich habe das Problem, dass ein User eines meiner Programme bei sich das kurze Datumsformat "TT-MMM-JJJJ" eingestellt hat, was zur folgenden Datumsanzeige führt: "29-Aug-2006".
Ich lese nun aus einer auf seinen Computer erstellten Datei (wird von einen externen Programm erstellt - darauf habe ich keinen Einfluss) die einzelnen Zeilen aus und zerlege den String. Ein Teil davon ist ein Datum, was ich zur weiteren Berechnungen zu einen TDatetime umrechnen muss. Bisher hat StrToDate immer sehr gut funktioniert. Diese Funktion hat aber die Einschränkung, dass sie nur Zahlen und eben das Datumstrennzeichen akzeptiert. Bei "29-Aug-2006" kommt die Fehlermeldung "Kein gültiges Datum".

Jetzt eine eigene Funktion zu erstellen, die den String mit Hilfe von GetLocaleFormatSettings zerlegt ist auch nicht praktisch, da in jeder Sprache der jeweilige Monat eine andere Bezeichnung hat.

Windows muss doch aber auch das Datum von einem String wieder zurückwandeln können. Wie macht es das? Welche Funktion könnte ich für meine Zwecke verwenden? Oder gibt es vielleicht sogar eine reine Delphilösung ohne die Nutzung der WinAPI?

Gruss und schonmal vielen Dank

[xaromz]

Hallo,

warum verwendest Du nicht einfach den Ganzzahlanteil von TDateTime? Damit hast Du die Anzahl der Tage (IMHO ab dem 1.1.1900) als Integer und kannst diesen Wert in jeder Form darstellen, die Dir passt.

Gruß
xaromz

[hitzi]

Deshalb ...

Zitat von hitzi:

[...]Ich lese nun aus einer auf seinen Computer erstellten Datei (wird von einen externen Programm erstellt - darauf habe ich keinen Einfluss) die einzelnen Zeilen aus und zerlege den String. [...]

Das Datum steht schon so in der Datei und von dort muss ich es erstmal wieder in einen TDatetime Wert bekommen.

[xaromz]

Hallo,

ist mir gerade aufgefallen, dass ich diesen Teil überlesen hab.
Ich befürchte, Du musst Dir da eine Funktion bauen die den Text zerlegt und umwandelt. Ich bezweifle, dass Windows da etwas an Bord hat.

Gruß
xaromz

[shmia]

Es gibt schon irgendwo eine Umkehrfunktion zu FormatDateTime im Internet; man muss es nur finden.

[Jürgen Thomas]

Hallo Thomas,

ein direkter Weg fällt mir nicht ein. Aber vielleicht ist es Dir möglich, vor dem Einlesen der Textdatei die globale Variable ShortDateFormat zu ändern und danach zurückzusetzen; dann müsste dieses Format beim Konvertieren berücksichtigt werden.

Gruß Jürgen

Nachtrag zu xaromz #7
Aus diesem Grund habe ich 'vielleicht' geschrieben.

[xaromz]

Hallo,

Zitat von Jürgen Thomas:

Aber vielleicht ist es Dir möglich, vor dem Einlesen der Textdatei die globale Variable ShortDateFormat zu ändern und danach zurückzusetzen; dann müsste dieses Format beim Konvertieren berücksichtigt werden.

Man kann der StrToDate-Routine auch einen TFormatSettings-Record übergeben. Aber eine allgemeine Lösung ist das nicht: wenn die Namen der Monate in einer anderen Sprache vorliegen, sieht es schlecht aus.

Gruß
xaromz

[hitzi]

Zitat von shmia:

Es gibt schon irgendwo eine Umkehrfunktion zu FormatDateTime im Internet; man muss es nur finden.

Dein Hinweis hat mich auf die richtige Spur gebracht. Meinst du die funktion?

Delphi-Quellcode:

Function FormatStrToDateTime(Format : string; strDate : string) : TDateTime;
// throws EConvertError()

type
   TTokenType = (fmtUndef, fmtC, fmtD, fmtD2, fmtD3, fmtD4, fmtD5, fmtD6,
                  fmtM, fmtM2, fmtM3, fmtM4, fmtY2, fmtY4, fmtH, fmtH2,
                  fmtN, fmtN2, fmtS, fmtS2, fmtZ, fmtZ3, fmtT, fmtT2,
                  fmtAM_PM, fmtA_P, fmtAMPM, fmtDateSep, fmtTimeSep, fmtUserStr
               );
var
   // Òåêóùèå ïîçèöèè â ñòðîêàõ ñ ôîðìàòîì è äàòîé.
   pFormat, pDate   : PChar;

   // Òåêóùàÿ ëåêñåìà ôîðìàòà.
   formatToken   : string;

   // Òåêóùàÿ âûäåëåííàÿ äàòà.
   date : TSystemTime;

   isPilotAnal   : boolean;


   //
   // Âûäåëÿåò î÷åðåäíóþ ëåêñåìó ñòðîêè ôîðìàòèðîâàíèÿ.
   //
   Function GetFormatToken   : TTokenType;
   begin
      if pFormat^ = #0 then
         Result   := fmtUndef
      else if Pos(pFormat^, #9#10#13' .,`~!@#$%^&*()_-=+\|]}[{?;') > 0 then begin
         Result   := fmtUserStr;
         formatToken   := pFormat^;
         inc(pFormat);
      end else if pFormat^ = 'C' then   begin
         Result   := fmtC;
         formatToken   := 'C';
         inc(pFormat);
      end else if (pFormat^ = 'D') and ((pFormat + 1)^ <> 'D') then begin
         Result   := fmtD;
         formatToken   := 'D';
         inc(pFormat);
      end else if (pFormat^ = 'D') and ((pFormat + 1)^ = 'D') and ((pFormat + 2)^ <> 'D') then begin
         Result   := fmtD2;
         formatToken   := 'DD';
         inc(pFormat, 2);
      end else if (pFormat^ = 'D') and ((pFormat + 1)^ = 'D') and ((pFormat + 2)^ = 'D') and ((pFormat + 3)^ <> 'D') then begin
         Result   := fmtD3;
         formatToken   := 'DDD';
         inc(pFormat, 3);
      end else if (pFormat^ = 'D') and ((pFormat + 1)^ = 'D') and ((pFormat + 2)^ = 'D') and ((pFormat + 3)^ = 'D') and ((pFormat + 4)^ <> 'D') then begin
         Result   := fmtD4;
         formatToken   := 'DDDD';
         inc(pFormat, 4);
      end else if (pFormat^ = 'D') and ((pFormat + 1)^ = 'D') and ((pFormat + 2)^ = 'D') and ((pFormat + 3)^ = 'D') and ((pFormat + 4)^ = 'D') and ((pFormat + 5)^ <> 'D') then begin
         Result   := fmtD5;
         formatToken   := 'DDDDD';
         inc(pFormat, 5);
      end else if (pFormat^ = 'D') and ((pFormat + 1)^ = 'D') and ((pFormat + 2)^ = 'D') and ((pFormat + 3)^ = 'D') and ((pFormat + 4)^ = 'D') and ((pFormat + 5)^ = 'D') then begin
         Result   := fmtD6;
         formatToken   := 'DDDDDD';
         inc(pFormat, 6);
      end else if (pFormat^ = 'M') and ((pFormat + 1)^ <> 'M') then begin
         Result   := fmtM;
         formatToken   := 'M';
         inc(pFormat);
      end else if (pFormat^ = 'M') and ((pFormat + 1)^ = 'M') and ((pFormat + 2)^ <> 'M') then begin
         Result   := fmtM2;
         formatToken   := 'MM';
         inc(pFormat, 2);
      end else if (pFormat^ = 'M') and ((pFormat + 1)^ = 'M') and ((pFormat + 2)^ = 'M') and ((pFormat + 3)^ <> 'M') then begin
         Result   := fmtM3;
         formatToken   := 'MMM';
         inc(pFormat, 3);
      end else if (pFormat^ = 'M') and ((pFormat + 1)^ = 'M') and ((pFormat + 2)^ = 'M') and ((pFormat + 3)^ = 'M') and ((pFormat + 4)^ <> 'M') then begin
         Result   := fmtM4;
         formatToken   := 'MMMM';
         inc(pFormat, 4);
      end else if (pFormat^ = 'Y') and ((pFormat + 1)^ = 'Y') and ((pFormat + 2)^ <> 'Y') then begin
         Result   := fmtY2;
         formatToken   := 'YY';
         inc(pFormat, 2);
      end else if (pFormat^ = 'Y') and ((pFormat + 1)^ = 'Y') and ((pFormat + 2)^ = 'Y') and ((pFormat + 3)^ = 'Y') then begin
         Result   := fmtY4;
         formatToken   := 'YYYY';
         inc(pFormat, 4);
      end else if (pFormat^ = 'H') and ((pFormat + 1)^ <> 'H') then begin
         Result   := fmtH;
         formatToken   := 'H';
         inc(pFormat);
      end else if (pFormat^ = 'H') and ((pFormat + 1)^ = 'H') then begin
         Result   := fmtH2;
         formatToken   := 'HH';
         inc(pFormat, 2);
      end else if (pFormat^ = 'N') and ((pFormat + 1)^ <> 'N') then begin
         Result   := fmtN;
         formatToken   := 'N';
         inc(pFormat);
      end else if (pFormat^ = 'N') and ((pFormat + 1)^ = 'N') then begin
         Result   := fmtN2;
         formatToken   := 'NN';
         inc(pFormat, 2);
      end else if (pFormat^ = 'S') and ((pFormat + 1)^ <> 'S') then begin
         Result   := fmtS;
         formatToken   := 'S';
         inc(pFormat);
      end else if (pFormat^ = 'S') and ((pFormat + 1)^ = 'S') then begin
         Result   := fmtS2;
         formatToken   := 'SS';
         inc(pFormat, 2);
      end else if (pFormat^ = 'Z') and ((pFormat + 1)^ <> 'Z') then begin
         Result   := fmtZ;
         formatToken   := 'Z';
         inc(pFormat);
      end else if (pFormat^ = 'Z') and ((pFormat + 1)^ = 'Z') and ((pFormat + 2)^ = 'Z') then begin
         Result   := fmtZ3;
         formatToken   := 'ZZZ';
         inc(pFormat, 3);
      end else if (pFormat^ = 'T') and ((pFormat + 1)^ <> 'T') then begin
         Result   := fmtT;
         formatToken   := 'T';
         inc(pFormat);
      end else if (pFormat^ = 'T') and ((pFormat + 1)^ = 'T') then begin
         Result   := fmtT2;
         formatToken   := 'TT';
         inc(pFormat, 2);
      end else if (pFormat^ = 'A') and ((pFormat + 1)^ = 'M') and ((pFormat + 2)^ = '/') and ((pFormat + 3)^ = 'P') and ((pFormat + 4)^ = 'M') then begin
         Result   := fmtAM_PM;
         formatToken   := 'AM/PM';
         inc(pFormat, 5);
      end else if (pFormat^ = 'A') and ((pFormat + 1)^ = '/') and ((pFormat + 2)^ = 'P') then begin
         Result   := fmtA_P;
         formatToken   := 'A/P';
         inc(pFormat, 3);
      end else if (pFormat^ = 'A') and ((pFormat + 1)^ = 'M') and ((pFormat + 2)^ = 'P') and ((pFormat + 3)^ = 'M') then begin
         Result   := fmtAMPM;
         formatToken   := 'AMPM';
         inc(pFormat, 4);
      end else if (pFormat^ = '''') or (pFormat^ = '"') then begin
         Result   := fmtUserStr;
         formatToken   := ExtractQuoteLexem(pFormat, isPilotAnal);
      end else if (pFormat^ = '/') then begin
         Result   := fmtDateSep;
         formatToken   := '/';
         inc(pFormat);
      end else if (pFormat^ = ':') then begin
         Result   := fmtTimeSep;
         formatToken   := ':';
         inc(pFormat);
      end else
         Result   := fmtUndef;
   end;

   Procedure ReportError;
   begin
      raise EConvertError.Create('On format: ' + pFormat + ' string: ' + pDate);
   end;

   //
   //   Ïûòàåòñÿ èçâëå÷ü ÷èñëî âïëîòü äî óêàçàííîé äëèíû, ïåðåäâèãàÿ óêàçàòåëü.
   //
   Function ScanNumber(numLen : integer) : integer;
   var
      str    : string;
      i      : integer;
   begin
      str   := '';
      for i := 0 to numLen - 1 do
         if (pDate[i] >= '0') and (pDate[i] <= '9') then
            str   := str + pDate[i]
         else
            break;
      inc(pDate, i);
      Result   := StrToInt(str);
   end;

   //
   // Âîçâðàùàåò èñòèíó, åñëè äàòà ñîîòâåòñòâóåò çàäàííîìó øàáëîíó è
   // ïåðåäâèãàåò ïîçèöèþ.
   //
   Function ScanStr(template : string) : boolean;
   begin
      Result   := AnsiSameText(Copy(pDate, 1, Length(template)), template);
      if Result then
         inc(pDate, Length(template));
   end;

   //
   // Èùåì Sun-Sat, âîçâðàùàÿ 1 - 7
   //
   Function ScanArray(strArray : array of string) : integer;
   begin
      for Result := 0 to High(strArray) do
         if ScanStr(strArray[Result]) then
            break;
      if Result > High(strArray) then
         ReportError
      else
         inc(Result);
   end;

begin
   DateTimeToSystemTime(0, date);

   if Format = '' then pFormat   := 'C'
   else pFormat   := PChar(AnsiUpperCase(Format));
   pDate      := PChar(AnsiUpperCase(strDate));

   isPilotAnal   := true;

   //
   // Ñíà÷àëà çàìåíèì âñå ïîäñòàíîâî÷íûå ñïåöèôèêàòîðû,
   // à èìåííî fmtC, fmtD5, fmtD6, fmtT, fmtT2.
   //
   Format   := '';
   while true do begin
      case GetFormatToken of
         fmtUndef   : break;
         fmtC     : Format   := Format + ShortDateFormat + ' ' + LongTimeFormat;
         fmtD5    : Format   := Format + ShortDateFormat;
         fmtD6    : Format   := Format + LongDateFormat;
         fmtT     : Format   := Format + ShortTimeFormat;
         fmtT2    : Format   := Format + LongTimeFormat;
      else
         Format   := Format + formatToken;
      end;
   end;

   pFormat   := PChar(AnsiUpperCase(Format));
   isPilotAnal   := false;

   //
   // Ðàçáèðàåì ñòðîêó.
   //
   repeat
      // Î÷åðåäíàÿ ëåêñåìà.
      case GetFormatToken of
         fmtUndef   : ReportError;
         fmtD,
         fmtD2    : date.wDay   := ScanNumber(2);
         fmtD3    : date.wDayOfWeek   := ScanArray(ShortDayNames);
         fmtD4    : date.wDayOfWeek   := ScanArray(LongDayNames);
         fmtM,
         fmtM2    : date.wMonth   := ScanNumber(2);
         fmtM3    : date.wMonth   := ScanArray(ShortMonthNames);
         fmtM4    : date.wMonth   := ScanArray(LongMonthNames);
         fmtY2    : begin date.wYear   := ScanNumber(2); if date.wYear >= 50  then inc(date.wYear, 1900) else inc(date.wYear, 2000) end;
         fmtY4    : date.wYear   := ScanNumber(4);
         fmtH,
         fmtH2    : date.wHour   := ScanNumber(2);
         fmtN,
         fmtN2    : date.wMinute   := ScanNumber(2);
         fmtS,
         fmtS2    : date.wSecond   := ScanNumber(2);
         fmtZ,
         fmtZ3    : date.wMilliseconds   := ScanNumber(3);
         fmtAM_PM : begin if ScanStr('PM') then inc(date.wHour, 12) else if not ScanStr('AM') then ReportError; end;
         fmtA_P   : begin if ScanStr('P') then inc(date.wHour, 12) else if not ScanStr('A') then ReportError; end;
         fmtAMPM  : begin if ScanStr(TimePMString) then inc(date.wHour, 12) else if not ScanStr(TimeAMString) then ReportError; end;
         fmtDateSep   : if not ScanStr(DateSeparator) then ReportError;
         fmtTimeSep  : if not ScanStr(TimeSeparator) then ReportError;
         fmtUserStr  : if not ScanStr(formatToken) then ReportError;
      end;

   until (pFormat^ = #0) or (pDate^ = #0);

   Result   := SystemTimeToDateTime(date);
end;

Quelle: http://www.torry.net/vcl/datetime/da...atdatetime.zip (HP: http://www.winpeak.ru/)

Teste das morgen mal durch.

Meld mich später nochmal, ob's klappt.

[Chewie]

Was sind denn das für Variablennamen?

isPilotAnal := false;