根据时间日期格式从字符串中解析日期时间

根据时间日期格式从字符串中解析日期时间
function StrToDtFmt(const S, Fmt: String; Dft: TDateTime): TDateTime;

function StrToDtFmt(const S, Fmt: String; Dft: TDateTime): TDateTime;
var
  Pts: array[1..10] of Integer;
  Wds: array[1..10] of Integer;
  Vls: array[1..10] of Word;
  i, j, n, m, k, d: Integer;
  t: String;
  c: Char;
  dt: TDateTime;
begin
  // 只处理数字格式的日期和时间
  i := 1;
  n := 1;    
  t := Trim(AnsiUpperCase(Fmt));
  // 解析格式串
  while i <= Length(t) do
  begin
    case t[i] of
      'Y': Pts[n] := 1;
      'M': Pts[n] := 2;
      'D': Pts[n] := 3;
      'H': Pts[n] := 4;
      'N': Pts[n] := 5;
      'S': Pts[n] := 6;
      'Z': Pts[n] := 7;
      else
      begin
        i := i + 1;
        Continue;
      end;
    end;
    c := t[i];
    i := i + 1;
    m := 1;
    while t[i] = c do
    begin
      Inc(i);
      Inc(m);
    end;
    if t[i] in ['Y','M','D','H','N','S','Z'] then
      Wds[n] := m
    else
      Wds[n] := 0;
    n := n + 1;
    if n > 7 then Break;
  end;
  n := n - 1;
  // 开始转化
  Result := Dft;
  if Length(S) <= 0 then Exit;
  DecodeDate(Result, Vls[1], Vls[2], Vls[3]);
  DecodeTime(Result, Vls[4], Vls[5], Vls[6], Vls[7]);
  m := 1;
  i := 1;
  k := Length(S);
  while m <= n do
  begin
    while not (S[i] in ['0'..'9', #0]) do Inc(i);
    if i > k then Break;
    d := 0;
    j := i;
    while (S[i] in ['0'..'9']) and
      ((Wds[m] <= 0) or (i - j < Wds[m])) do
    begin
      d := d * 10 + Ord(S[i]) - Ord('0');
      i := i + 1;
    end;
    Vls[Pts[m]] := d;
    if i > k then Break;
    m := m + 1;
  end;
  if TryEncodeDate(Vls[1], Vls[2], Vls[3], dt) then
    Result := Int(dt) + Frac(Result);
  if TryEncodeTime(Vls[4], Vls[5], Vls[6], Vls[7], dt) then
    Result := Int(Result) + Frac(dt);
end;

本文地址：http://com.8s8s.com/it/it4782.htm