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