根据时间日期格式从字符串中解析日期时间 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; 
|