Unit Date;

interface

Var DTErr:boolean;

Type Dat=record

day:1..31;

month:1..12;

year:integer;

dweek:0..6;

time:word;

end;

Const EWeek:array[0..6] of string[2]=('Mo','Tu','We','Th','Fr','Sa','Sa');

Const RWeek:array[0..6] of string[2]=('Џ­','‚в','`а','--в','Џв','`Ў','‚б');

procedure newdat(a:dat; delay:word; var b:dat);

procedure writedat(b:dat);

Function DayDiffer(A,B:dat):Integer;

Function STime(st:string):word;

Function dweek (a:dat):byte;

Procedure DTInput(var d:dat);

Procedure SDate(St:string; var a:dat);

Implementation

uses dos,crt;

Function DayInMonth(m:byte; y:integer):byte;forward;

procedure SDate(St:string; var a:dat);

const mthe:array[1..12] of string[3] =('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC');

const mthru:array[1..12] of string[3] =('џЌ‚','”…‚','ЊЂђ','ЂЏђ','ЊЂ‰','€ћЌ','€ћ‹','Ђ‚ѓ','`…Ќ','ЋЉ'','ЌЋџ','„…Љ');

const mthrl:array[1..12] of string[3] =('п­ў','䥢','¬ а',' Їа','¬ ©','Ёо­','Ёо«',' ўЈ','ᥭ','®Єв','­®п','¤ҐЄ');

var i,j,e:byte; mode:byte; S:word; err:boolean; D,M,Y,wd:word; c:shortint;

Procedure add(mode:byte;s:word;var a:dat);

begin

case mode of

1:if (s>0) and (s<=31) then A.day:=S else DTErr:=true;

3:if (s>0) and (s<=12) then A.month:=S else DTErr:=true;

5:if s>=100 then A.year:=S else A.year:=S+100*(Y div 100);

end;

end;

begin

DTErr:=false;

GetDate(Y,M,D,wd);

e:=length(st);

i:=1; mode:=0;

while (i<=e) do begin

c:=ord(st[i])-ord('0');

if ((mode mod 2)=0) and (c>=0) and (c<=9) then begin S:=c; inc(mode) end

else if (c<=9) and (c>=0) then S:=S*10+c

else if (mode mod 2)=1 then begin Add(mode,S,a); Inc(mode) end;

if (mode=2) then

for j:=1 to 12 do

if (mthe[j,1]=upcase(st[i])) and (mthe[j,2]=upcase(st[i+1])) and (mthe[j,3]=upcase(st[i+2])) or

((mthru[j,1]=st[i]) or (mthrl[j,1]=st[i])) and ((mthru[j,2]=st[i+1]) or (mthrl[j,2]=st[i+1])) and

((mthru[j,3]=st[i+2]) or (mthrl[j,3]=st[i+2])) then

begin add(3,j,a); mode:=4 end;

inc(i);

end;

if (mode mod 2)=1 then add(mode,S,a);

if mode<1 then add(1,D,a);

if mode<3 then add(3,M,a);

if mode<5 then add(5,Y,a);

if not DTErr then DTErr:=a.day>DayInMonth(a.month,a.year);

if not DTErr then a.dweek:=dweek(a);

end;

function dweek (a:dat):byte;

var n,m,y:word;

begin

DTErr:=false;

y:=a.year;

if a.month<=2 then begin m:=a.month+12; dec(y) end else m:=a.month;

n:=(A.day+2*m+trunc(0.6*(m+1))+y+(y div 4)-(y div 100)+(y div 400)) mod 7;

dweek:=n;

end;

Function STime (st:string):Word;

var i,e,mode:byte; a,s:word; c:shortint;

begin

DTErr:=false;

e:=length(st);

i:=1; mode:=0; a:=0;

while (i<=e) do begin

c:=ord(st[i])-ord('0');

if ((mode mod 2)=0) and (c>=0) and (c<=9) then begin S:=c; inc(mode) end

else if (c<=9) and (c>=0) then S:=S*10+c

else if mode=1 then begin A:=S; inc(mode) end

else if mode=3 then begin A:=A*60+S; inc(mode) end;

inc(i)

end;

if mode=3 then A:=a*60+s;

if a<1440 then Stime:=a else DTErr:=true;

end;

Function DayInMonth(m:byte; y:integer):byte;

const DayInM:array[1..12] of byte=(31,29,31,30,31,30,31,31,30,31,30,31);

begin

If M<>2 then DayInMonth:=DayInM[M]

else if (y mod 4)<>0 then DayInMonth:=28

else if (y mod 100)<>0 then DayInMonth:=29

else if (y mod 400)<>0 then DayInMonth:=28 else DayInMonth:=29

end;

Function DayDiffer(A,B:dat):Integer;

Var m1,m2,y1,y2:Integer;

Begin

DTErr:=false;

y1:=A.year;

y2:=B.year;

if a.month<=2 then begin m1:=a.month+12; dec(y1) end else m1:=a.month;

if b.month<=2 then begin m2:=b.month+12; dec(y2) end else m2:=b.month;

DayDiffer:=-(A.day+30*m1+trunc(0.6*(m1+1))+365*y1+(y1 div 4)-(y1 div 100)+(y1 div 400))+

(B.day+30*m2+trunc(0.6*(m2+1))+365*y2+(y2 div 4)-(y2 div 100)+(y2 div 400));

End;

Procedure DTInput(var d:dat);

var st:string; y:byte;

const empty=' ';

begin

y:=wherey;

repeat

GotoXY(1,y);

Write('„ в  ... ',empty);

GotoXY(10,y);

ReadLn(St);

SDate(st,d);

Until not DTErr;

GotoXY(10,y);

writeln(d.day,'.',d.month,'.',d.year,' ',Rweek[Dweek(d)]);

repeat

gotoxy(1,y+1);

write('‚६п ... ',empty);

gotoxy(11,y+1);

readln(st);

d.time:=stime(st);

until not DTErr;

gotoxy(11,y+1);

writeln(stime(st) div 60,':',stime(st) mod 60);

end;

procedure writedat(b:dat);

begin

write(b.time div 60,':',b.time mod 60,' ',b.day,'.',b.month,'.',b.year,' ',Rweek[b.dweek]);

end;

procedure newdat(a:dat; delay:word; var b:dat);

var c:word;

begin

B:=A;

B.time:=(a.time+(delay mod 1440)) mod 1440;

delay:=(delay div 1440)+((a.time+(delay mod 1440)) div 1440);

while delay+b.day>DayInMonth(b.month,b.year) do begin

delay:=delay-1-DayInMonth(b.month,b.year)+b.day;

b.day:=1;

b.month:=(b.month mod 12)+1;

if b.month=1 then inc(b.year);

end;

b.day:=delay+b.day;

end;

begin

end.

Страницы: 1, 2, 3