给大家看一个有价值的源代码
最近无聊啊，就到书店逛了逛，看了一下，买了一本PASCAL程序设计看看，觉得这语言不错，就认真看了几天，突发奇想地写了个没人研究过地程序，给大家看看，哪位能看懂是干嘛用的，就Q我，QQ：704339488，我喜欢和高手交朋友，看不懂的别捣乱啊program 1(input,output);
var
year,month,d,h,m,s,e1,e2,zh,zd,zm,zy:integer;
f1,f2:char;
procedure m(h,d,e1,e2,f2,month,year;var zh,zd,zm,zy:integer);
var
e3,e4,zdt:integer;
begin
if f2='m'
then begin
zh:=h;
zd:=d;
zm:=month;
zy:=year
end
else if f2='e'
then begin
e3:=e2-e1;
zh:=h+e3;
if zh>24
then begin
zh:=zh-24;
zd:=d+1
end
else zd:=d;
case month of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end;{case}
if zd>zdt
then begin
zd:=zd-zdt;
zm:=month+1;
if zd>29
then begin
if zm=2
then begin
zm=zm+1;
if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zd:=zd-29
else zd:=zd-28
end
end;
if zm>12
then begin
zm:=zm-12;
zy:=year+1
end
end
else if f2='b'
then begin
zh:=h+12;
if zh>24
then begin
zh:=zh-24;
zd:=d+1
end
else zd:=d
case month of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=o)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end;{case}
if zd>zdt
then begin
zd:=zd-zdt;
zm:=month+1;
if zd>29
then begin
if zm=2
then begin
zm:=zm+1;
if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zd:=zd-29
else zd:=zd-28
end
end
end
end
else if f2='w'
then begin
case e2 of
11:e4:=13;
10:e4:=14;
9 :e4:=15;
8 :e4:=16;
7 :e4:=17;
6 :e4:=18;
5 :e4:=19;
4 :e4:=20;
3 :e4:=21;
2 :e4:=22;
1 :e4:=23
end;{case}
e3:=e1+e4;
zh:=h+e3;
if zh>24
then begin
zh:=zh-24;
zd:=d+1;
end
else zd:=d
case month of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end;{case}
if zd>zdt
then begin
zd:=zd-zdt;
zm:=month+1;
if zd>29
then begin
if zm=2
then begin
zm:=zm+1;
if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zd:=zd-29
else zd:=zd-28
end
end
end
end
end;{m}
procedure w(h,d,e1,e2,f2,month,year;var zh,zd,zm,zy:integer);
var
e3,e4,zdt:integer;
begin
if f2='w'
then begin
if e1>e2
then begin
e3:=e1-e2;
zh:=h+e3;
if zh>24
then begin
zh:=zh-24;
zd:=d+1
end
else zd:=d
case month of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end;{case}
if zd>zdt
then begin
zd:=zd-zdt;
zm:=month+1;
if zd>29
then begin
if zm=2
then begin
zm:=zm+1;
if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zd:=zd-29
else zd:=zd-28
end
end
end
end
else if e1<e2
then begin
e3:=e2-e1;
zh:=h-e3;
if zh<0
then begin
zh:=zh+24;
zd:=d-1
end
else zd:=d;
if zd<=0
then begin
zm:=month-1;
if zm<=0
then begin
zy:=year-1;
zm:=zm+12
end
case zm of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end{case}
end
end
end
else if f2='b'
then begin
e3:=e2-e1;
zh:=h-e3;
if zh<0
then begin
zh:=zh+24;
zd:=d-1
end
else zd:=d
if zd<=0
then begin
zm:=month-1;
if zm<=0
then begin
zy:=year-1;
zm:=zm+12
end
case zm of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end{case}
end
end
else if f2='e'
then begin
e3:=e2-e1;
zh:=h-e3;
if zh<0
then begin
zh:=zh+24;
zd:=d-1
end
else zd:=d;
if zd<=0
then begin
zm:=month-1;
if zm<=0
then begin
zy:=year-1;
zm:=zm+12
end
case month of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400 =0)
then zdt:=29
else zdt:=28
end{case}
end
end
else if f2='m'
then begin
case e1 of
11:e4:=13;
10:e4:=14;
9 :e4:=15;
8 :e4:=16;
7 :e4:=17;
6 :e4:=18;
5 :e4:=19;
4 :e4:=20;
3 :e4:=21;
2 :e4:=22;
1 :e4:=23;
end;{case}
e3:=e4;
zh:=h-e3;
if zh<0
then begin
zh:=zh+24;
zd:=d-1
end
else zd:=d;
if zd<=0
then begin
zm:=month-1;
if zm<=0
then begin
zy:=year-1;
zm:=zm+12
end
case zm of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end{case}
end
end
end{w}
procedure e(h,d,e1,e2,f2,month,year;var zh,zd,zm,zy:integer);
var
e3,e4,zdt:integer;
begin
if f2='e'
then begin
if e1>e2
then begin
e3:=e1-e2;
zh:=h-e3;
if zh<0
then begin
zh:=zh+24;
zd:=d-1;
end
else zd:=d
if zd<=0
then begin
zm:=month-1;
if zm<=0
then begin
zy:=year-1;
zm:=zm+12
end
case zm of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end{case}
end
end
else if e1<e2
then begin
e3:=e2-e1;
zh:=h+e3;
if zh>24
then begin
zh:=zh-24;
zd:=d+1;
end
else zd:=d
end
case month of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400 =0)
then zdt:=29
else zdt:=28
end{case}
if zd >zdt
then begin
zd:=zd-zdt;
zm:=month+1;
if zd>29
then begin
if zm=2
then begin
zm:=zm+1
if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then begin
zd:=zd-29
end
else zd:=zd-28
end
end
end
end
else if f2='b'
then begin
e3:=e2-e1;
zh:=h+e3;
if zh>24
then begin
zh:=zh-24;
zd:=d+1;
end
else zd:=d;
case month of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400 =0)
then zdt:=29
else zdt:=28
end{case}
if zd >zdt
then begin
zd:=zd-zdt;
zm:=month+1;
if zd>29
then begin
if zm=2
then begin
zm:=zm+1
if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then begin
zd:=zd-29
end
else zd:=zd-28
end
end
end
end
else if f2='e'
then begin
case e2 of
11:e4:=13;
10:e4:=14;
9 :e4:=15;
8 :e4:=16;
7 :e4:=17;
6 :e4:=18;
5 :e4:=19;
4 :e4:=20;
3 :e4:=21;
2 :e4:=22;
1 :e4:=23;
end;{case}
e3:=e4-e1;
zh:=2+e3;
if zh>24
then begin
zh:=zh-24;
zd:=d+1
end
else zd:=d;
case month of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400 =0)
then zdt:=29
else zdt:=28
end{case}
if zd >zdt
then begin
zd:=zd-zdt;
zm:=month+1;
if zd>29
then begin
if zm=2
then begin
zm:=zm+1
if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then begin
zd:=zd-29
end
else zd:=zd-28
end
end
end
end
else if f2='m'
then begin
e3:=e1-e2;
zh:=h-e3;
if zh<0
then begin
zh:=zh+24;
zd:=d-1
end
else zd:=d;
if zd<=0
then begin
zm:=month-1;
if zm<=0
then begin
zy:=year-1;
zm:=zm+12
end
case zm of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end{case}
end
end
end;{e}
procedure b(h,d,e1,e2,f2,month,year;var zh,zd,zm,zy:integer);
var
e3,zdt:integer;
begin
if f2='b'
then zh:=h
else if f2='w'
then begin
e3:=e1-e2;
zh:=h+e3;
if zh>24
then begin
zh:=zh-24;
zd:=d+1
end
else zd:=d
case month of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400 =0)
then zdt:=29
else zdt:=28
end{case}
if zd >zdt
then begin
zd:=zd-zdt;
zm:=month+1;
if zd>29
then begin
if zm=2
then begin
zm:=zm+1
if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then begin
zd:=zd-29
end
else zd:=zd-28
end
end
end
end
else if f2='m'
then begin
zh:=h-12
if zh<0
then begin
zh:=zh+24;
zd:=d-1
end
else zd:=d
if zd<=0
then begin
zm:=month-1;
if zm<=0
then begin
zy:=year-1;
zm:=zm+12
end
case zm of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end{case}
end
end
else if f2='e';
then begin
e3:=e1-e2;
zh:=h-e3;
if zh<0
then begin
zh:=zh+24;
zd:=d-1
end
else zd:=d
if zd<=0
then begin
zm:=month-1;
if zm<=0
then begin
zy:=year-1;
zm:=zm+12
end
case zm of
1,3,5,7,8,10,12:zdt:=31;
4,6,9,11 :zdt:=30;
2 :if (year mod 4=0)
and(year mod 100<>0)
or(year mod 400=0)
then zdt:=29
else zdt:=28
end{case}
end
end
end;{b}
begin
writeln('please input h d e1 e2 f2 month year');
read(h,d,e1,e2,f2,month,year);
if f1='m'
then m(h,d,e1,e2,f2,month,year)
else if f1='w'
then w(h,d,e1,e2,f2,month,year)
else if f1='e'
then e(h,d,e1,e2,f2,month,year)
else if f1='b'
then b(h,d,e1,e2,f2,month,year)
else writeln('no this char in system');
writeln(zm,'/',zd,'/',zy,'','',zh,':',m,':',s)
end.
