oracle 类似date,实现类似Oracle中to_date的格式化日期转换函数

[2007年9月20日 1:46 @

MSN SPACE]

Delphi中已有FormatDateTime函数用于把时间格式化为字符串，也有StrToDateTime来把字符串转化成时间。可是StrToDateTime却无法使用格式化串，只能用限制很大的"ShortDateFormat"和"LongDateFormat"来指定格式。想起Oracle中的to_date函数是如此的方便，为何我们不尝试实现一个类似的函数呢？

于是我试着做了这么个StrToDateTimeEx函数，它现在可以用的格式符(不区分大小写)包括有：yyyy、mm、dd、hh、nn、ss、zzz，其中可以匹配长度为1至格式符长度的数字串(如"yyyy"可匹配1-4个数字)。有兴趣的朋友不妨一起测试、改进

^^ 函数代码(较长)如下：

unit DateUtilsEx;

interface

uses

SysUtils, StrUtils, DateUtils;

function StrToDateTimeEx(AString, AFormat:

WideString): TDateTime;

implementation

const

ERROR_MATCH_FAILED = 'Failed to match ''%s'' in string ''%s'' and

''%s'' in format ''%s''';

ERROR_PART_DUPLICATED = 'Invalid input: %s part can''t appear

twice in the string';

ERROR_CONVERT_FAILED = 'Failed to convert ''%s'' into numeral

using the format specifier ''%s''';

ERROR_OUT_OF_RANGE = '%d is out of the range(%s) of the %s

part';

ERROR_DAY_NOT_EXIST = '%d-%d does not exist %d days';

ERROR_REMAIN_UNPARSED_DATA = '%s remains unparsed data while %s is

already empty';

function StrToDateTimeEx(AString, AFormat:

WideString): TDateTime;

type

TPart = (prtYear, prtMonth, prtDay, prtHour, prtMinute, prtSecond,

prtMilliSecond);

TPartValues = array[0..6] of

Word;

TCmdRec = record

Command: String;

Caption: String;

end;

const

Cmds: array[0..6] of TCmdRec

=

((Command: 'YYYY'; Caption: 'Year'),

(Command: 'MM'; Caption: 'Month'),

(Command: 'DD'; Caption: 'Day'),

(Command: 'HH'; Caption: 'Hour'),

(Command: 'NN'; Caption: 'Minute'),

(Command: 'SS'; Caption: 'Second'),

(Command: 'ZZZ'; Caption: 'MilliSecond'));

CmdRanges: array[0..6, 1..2]

of Word =

((1, 9999), (1, 12), (1, 31), (0, 24), (0, 59), (0, 59), (0,

999));

procedure Push(var ABuffer,

ASource : WideString; ACount: Integer = 1);

begin

//

字符进缓冲

ABuffer := ABuffer + Copy(ASource, 1, ACount);

Delete(ASource, 1, ACount);

end;

procedure Pop(var ABuffer:

WideString);

begin

//

缓冲清空

ABuffer := EmptyWideStr;

end;

procedure Return(var

ABuffer, ASource : WideString; ACount: Integer = 1);

var

iPos: Integer;

begin

//

返还缓冲中的字符

iPos := Length(ABuffer) - ACount + 1;

ASource := Copy(ABuffer, iPos , ACount) + ASource;

Delete(ABuffer, iPos, ACount);

end;

function IsCommandPrefix(ACmd:

String): Boolean;

var

i: Integer;

begin

//

是否格式符前缀

for i := Low(Cmds) to

High(Cmds) do

begin

Result := AnsiStartsText(ACmd, Cmds[i].Command);

if Result then Break;

end;

end;

function IsCommand(ACmd:

String): Integer;

var

i: Integer;

begin

//

是否格式符

Result := -1;

for i := Low(Cmds) to

High(Cmds) do

if SameText(ACmd, Cmds[i].Command)

then

begin

Result := i;

Break;

end;

end;

function IsNumber(AString:

String): Boolean;

var

iTemp: Integer;

begin

//

是否数字串

Result := TryStrToInt(AString, iTemp);

end;

function NotOutOfRange(AValue: Word; APart:

TPart): Boolean;

begin

//

是否有超出日期范围

Result := (AValue >= CmdRanges[Integer(APart), 1])

and (AValue <=

CmdRanges[Integer(APart), 2]);

end;

function GetRangeStr(APart: TPart):

String;

begin

//

获取范围的字符串

Result := Format('%d-%d', [CmdRanges[Integer(APart), 1],

CmdRanges[Integer(APart), 2]]);

end;

procedure DoConvertError(Msg:

String; Args: array of

const);

begin

//

处理异常

raise EConvertError.Create(Format(Msg,

Args));

end;

procedure TryMatch(var AString, AFormat:

WideString);

begin

//

尝试匹配首字符

if AString[1] = AFormat[1]

then

begin

Delete(AString, 1, 1);

Delete(AFormat, 1, 1);

end

else

DoConvertError(ERROR_MATCH_FAILED, [String(AString[1]), AString,

String(AFormat[1]), AFormat]);

end;

var

CurrentPart: TPart;

ExistedParts: set of

TPart;

PartValues: TPartValues;

StringBuf, FormatBuf: WideString;

iCmd, iValue: Integer;

wYear, wMonth, wDay: Word;

begin

ExistedParts := [];

while (AString

<> EmptyWideStr) and

(AFormat <> EmptyWideStr)

do

begin

if Ord(AFormat[1]) > 255

then

begin

//

如果Format的首字符非单字节，则直接把它和String匹配。

TryMatch(AString, AFormat);

Continue;

end;

//

尝试寻找一个格式符

while (AFormat

<> EmptyWideStr) and

IsCommandPrefix(FormatBuf + AFormat[1]) do

Push(FormatBuf, AFormat);

iCmd := IsCommand(FormatBuf);

while (iCmd = -1) and

(FormatBuf <> EmptyWideStr)

do

begin

Return(FormatBuf, AFormat);

iCmd := IsCommand(FormatBuf);

end;

if iCmd = -1 then

begin

TryMatch(AString, AFormat);

Continue;

end;

//

把合要求的输入读入缓冲

while (Length(AString) > 0)

and (Length(StringBuf) <

Length(Cmds[iCmd].Command)) and

IsNumber(AString[1]) do

Push(StringBuf, AString);

CurrentPart := TPart(iCmd);

//

特殊处理不完整的年份

if (CurrentPart = prtYear)

and IsNumber(StringBuf)

then

case Length(StringBuf)

of

1: StringBuf := Copy(FormatDateTime('YYYY', Now), 1, 2) + '0' +

StringBuf;

2: StringBuf := Copy(FormatDateTime('YYYY', Now), 1, 2) +

StringBuf;

end;

if TryStrToInt(StringBuf, iValue)

then

if NotOutOfRange(iValue, CurrentPart)

then

if not (CurrentPart

in ExistedParts) then

begin

//

格式化匹配成功

Include(ExistedParts, CurrentPart);

PartValues[iCmd] := iValue;

Pop(StringBuf);

Pop(FormatBuf);

end

else

DoConvertError(ERROR_Part_DUPLICATED,

[Cmds[iCmd].Caption])

else

DoConvertError(ERROR_OUT_OF_RANGE, [iValue,

GetRangeStr(CurrentPart), Cmds[iCmd].Caption])

else

DoConvertError(ERROR_CONVERT_FAILED, [StringBuf,

Cmds[iCmd].Command]);

end;　 // END OF

WHILE

if not((AString =

EmptyWideStr) and (AFormat = EmptyWideStr))

then

if AString <>

EmptyWideStr then

DoConvertError(ERROR_REMAIN_UNPARSED_DATA, ['The string', 'the

format'])

else

DoConvertError(ERROR_REMAIN_UNPARSED_DATA, ['The format', 'the

string']);

//

判断是否需要给时间默认值

DecodeDate(Now, wYear, wMonth, wDay);

if not(prtYear

in ExistedParts) then

PartValues[0] := wYear;

if not(prtMonth

in ExistedParts) then

PartValues[1] := wMonth;

if not(prtDay

in ExistedParts) then

PartValues[2] := 1;

case PartValues[1] of

2:

if not((PartValues[2]

<= 28) or ((PartValues[2]

<= 29) and

(IsLeapYear(PartValues[0])))) then

DoConvertError(ERROR_DAY_NOT_EXIST, [PartValues[0],

PartValues[1], PartValues[2]]);

4, 6, 8, 9, 11:

if PartValues[2] > 30

then

DoConvertError(ERROR_DAY_NOT_EXIST, [PartValues[0],

PartValues[1], PartValues[2]]);

end;

Result := EncodeDateTime(PartValues[0], PartValues[1],

PartValues[2], PartValues[3], PartValues[4], PartValues[5],

PartValues[6]);

end;

end.