Uit de losse pols: (tijd kosten dikke 15min)
Code:
program scandatetest;
{$APPTYPE CONSOLE}
uses
SysUtils,dateutils;
const whitespace = [' ',#13,#10];
hrfactor = 1/(24);
minfactor = 1/(24*60);
secfactor = 1/(24*60*60);
mssecfactor = 1/(24*60*60*1000);
function scandate(const pattern:string;s:string;startpos:integer=1) : tdatetime;
var len ,ind : integer;
plen,pind : integer;
i,j,k : integer;
pivot,
yy,mm,dd : integer;
function scanfixedint:integer;
var c : char;
begin
result:=0;
c:=pattern[pind];
while (pind<=plen) and (pattern[pind]=c) and (ind<=len) and (s[ind] IN ['0'..'9']) do
begin
result:=result*10+ord(s[ind])-48;
inc(pind);
inc(ind);
end;
while (pind<=plen) and (pattern[pind]=c) do inc(pind);
end;
begin
yy:=0; mm:=0; dd:=0;
result:=0.0;
len:=length(s); ind:=startpos;
while(ind<=len) and (s[ind] in whitespace) do inc(ind);
plen:=length(pattern); pind:=1;
while (ind<=len) and (pind<=plen) do
begin
case pattern[pind] of
'h': result:=result+scanfixedint* hrfactor;
'd': dd:=scanfixedint;
'n': result:=result+scanfixedint* minfactor;
's': result:=result+scanfixedint* secfactor;
'z': result:=result+scanfixedint* mssecfactor;
'y': begin
i:=pind;
yy:=scanfixedint;
i:=pind-i;
if i<=2 then
begin
pivot:=YearOf(now)-TwoDigitYearCenturyWindow;
inc(yy, pivot div 100 * 100);
if (TwoDigitYearCenturyWindow > 0) and (yy < pivot) then
inc(yy, 100);
end;
end;
'm': mm:=scanfixedint;
else
begin
inc(pind);
inc(ind);
end;
end;
end;
if (yy>0) and (mm>0) and (dd>0) then
result:=result+encodedate(yy,mm,dd);
end;
procedure dotest(pt,s:string);
var dt : Tdatetime;
begin
dt:=scandate(pt,s);
writeln(pt:20,s:20,' ':5,formatdatetime('yyyy mm dd hh:nn:ss',dt));
end;
begin
{ TODO -oUser -cConsole Main : Insert code here }
dotest('hh:nn:ss','10:20:30');
dotest('yyyy-mm-dd hh:nn:ss','2006-10-06 10:20:30');
dotest('hhnnss','102030');
dotest('yyyymmddhhnnss','20061006102030');
dotest('yymmddhhnnss','061006102030');
dotest('yy-mm-dd','06-5-3');
dotest('dd-mm-yy','06-5-3');
readln;
end.
Overigens; bij gebruik svp functie naam veranderen. Ik wil deze opschonen en aan FPC toevoegen, en dan heb ik liever geen namespace conflicten met oudere versies.
Bookmarks