Alternative zu StrToDate?

[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.