unit uStrToDateFmt;
interface
function TryStrToDateFmt(
const AStr, AFmt :
string;
var AResult : TDateTime ) : Boolean;
overload;
function TryStrToDateFmt(
const AStr :
string;
const AFmt :
array of string;
var AResult : TDateTime ) : Boolean;
overload;
function StrToDateFmt(
const AStr, AFmt :
string ) : TDateTime;
overload;
function StrToDateFmt(
const AStr :
string;
const AFmt :
array of string ) : TDateTime;
overload;
function StrToDateFmtDef(
const AStr, AFmt :
string;
const default : TDateTime ) : TDateTime;
overload;
function StrToDateFmtDef(
const AStr :
string;
const AFmt :
array of string;
const default : TDateTime ) : TDateTime;
overload;
implementation
uses
SysUtils, SysConst, StrUtils;
// --- aus SysUtils kopiert --- START ---
procedure ConvertError( ResString : PResStringRec );
local;
begin
raise EConvertError.CreateRes( ResString );
end;
procedure ConvertErrorFmt( ResString : PResStringRec;
const Args :
array of const );
local;
begin
raise EConvertError.CreateResFmt( ResString, Args );
end;
// --- aus SysUtils kopiert --- ENDE ---
function StrToDateFmtDef(
const AStr, AFmt :
string;
const default : TDateTime ) : TDateTime;
begin
if not TryStrToDateFmt( AStr, AFmt, Result )
then
Result :=
default;
end;
function StrToDateFmtDef(
const AStr :
string;
const AFmt :
array of string;
const default : TDateTime ) : TDateTime;
begin
if not TryStrToDateFmt( AStr, AFmt, Result )
then
Result :=
default;
end;
function StrToDateFmt(
const AStr, AFmt :
string ) : TDateTime;
begin
if not TryStrToDateFmt( AStr, AFmt, Result )
then
ConvertErrorFmt( @SInvalidDate, [ AStr ] );
end;
function StrToDateFmt(
const AStr :
string;
const AFmt :
array of string ) : TDateTime;
begin
if not TryStrToDateFmt( AStr, AFmt, Result )
then
ConvertErrorFmt( @SInvalidDate, [ AStr ] );
end;
function TryStrToDateFmt(
const AStr :
string;
const AFmt :
array of string;
var AResult : TDateTime ) : Boolean;
var
idx : Integer;
begin
Result := False;
idx := low( AFmt );
while not Result
and ( idx <= high( AFmt ) )
do
begin
Result := Result
or TryStrToDateFmt( AStr, AFmt[ idx ], AResult );
Inc( idx );
end;
end;
function TryStrToDateFmt(
const AStr, AFmt :
string;
var AResult : TDateTime ) : Boolean;
var
dps, fps :
string;
dpi, fpi : Integer;
d, m, y : Word;
idx, yl : Integer;
begin
Result := Length( AFmt ) = Length( AStr );
d := 0;
m := 0;
y := 0;
yl := 0;
idx := 1;
while Result
and ( idx <= Length( AFmt ) )
do
begin
dps := Copy( AStr, idx, 1 );
dpi := StrToIntDef( dps, -1 );
fpi := IndexText( Copy( AFmt, idx, 1 ), [ '
D', '
M', '
Y' ] );
// Wenn wir einen Platzhalter erwischt haben, dann müssen wir dazu auch eine Ziffer haben
Result :=
not( ( fpi >= 0 )
and ( dpi < 0 ) );
case fpi
of
0 :
// Tag
d := d * 10 + dpi;
1 :
// Monat
m := m * 10 + dpi;
2 :
// Jahr
begin
y := y * 10 + dpi;
Inc( yl );
end;
else // Format-Zeichen prüfen
Result := ( dps = Copy( AFmt, idx, 1 ) );
end;
Inc( idx );
end;
if Result
then
begin
// kurze Jahreszahl mit dem aktuellen Jahr erweitern
case yl
of
0 :
// kein Jahr übergeben
y := CurrentYear;
1 :
// Jahr einstellig übergeben
if Abs( y - CurrentYear
mod 10 ) > 2
then
y := ( CurrentYear
div 10 - 1 ) * 10 + y
else
y := CurrentYear
div 10 * 10 + y;
2 :
// Jahr zweistellig übergeben
if Abs( y - CurrentYear
mod 100 ) > 10
then
y := ( CurrentYear
div 100 - 1 ) * 100 + y
else
y := CurrentYear
div 100 * 100 + y;
3 :
// Jahr dreistellig übergeben
if Abs( y - CurrentYear
mod 1000 ) > 10
then
y := ( CurrentYear
div 1000 - 1 ) * 1000 + y
else
y := CurrentYear
div 1000 * 1000 + y;
end;
end;
if Result
then
Result := TryEncodeDate( y, m, d, AResult );
end;
end.