-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathchekdate.pas
73 lines (61 loc) · 1.88 KB
/
chekdate.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Unit ChekDate;
{ Michael Hoenie }
{
Allright... I checked around a lot of DATE and TIME routines, and came up
with this, taken from about three different routines. This routine works,
as far as I know, and I've implemented it successfully into my own code.
If anyone knows that this routine has a bug in it, please let me know.
This procedure uses the Julian calander mathmatical equasions to convert
two dates and give the # of days inbetween. If anyone knows a faster way
of writing this procedure, please let me know.
}
interface
function check_date(stream1, stream2: string): integer;
implementation
type
string80=string[80];
function check_date(stream1, stream2: string): integer;
var
internal1,internal2:longint;
JNUM:real;
cd,month,day,year: integer;
out:string[25];
function Jul( mo, da, yr: integer): real;
var
i, j, k, j2, ju: real;
begin
i := yr; j := mo; k := da;
j2 := int( (j - 14)/12 );
ju := k - 32075 + int(1461 * ( i + 4800 + j2 ) / 4 );
ju := ju + int( 367 * (j - 2 - j2 * 12) / 12);
ju := ju - int(3 * int( (i + 4900 + j2) / 100) / 4);
Jul := ju;
end;
begin
out:=copy(stream1,1,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,month,cd);
out:=copy(stream1,4,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,day,cd);
out:=copy(stream1,7,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,year,cd);
jnum:=jul(month,day,year);
str(jnum:10:0,out);
val(out,internal1,cd);
out:=copy(stream2,1,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,month,cd);
out:=copy(stream2,4,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,day,cd);
out:=copy(stream2,7,2);
if copy(out,1,1)='0' then delete(out,1,1);
val(out,year,cd);
jnum:=jul(month,day,year);
str(jnum:10:0,out);
val(out,internal2,cd);
check_date:=internal1-internal2;
end;
end.