# Pascal : date to longint and back

Jan 18th, 2022
814
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. function date_val(date : datestr) : longint;
2. var d,m,y,f : longint;
3.     e : integer;
4.
5. begin
6.   IF DATE='  /  /  ' THEN DATE:=FAR_AWAY_DATE;
7.
8.   val(copy(date,1,2),d,e);
9.   val(copy(date,4,2),m,e);
10.   val(copy(date,7,2),y,e);
11.
12.   if y>century_mark then y:=y+century1 else y:=y+century2;
13.
14.   f:=(365*y) + d + (31*(m-1));
15.
16.   if m<3 then begin
17.     f:=f + trunc((y-1)/4) - trunc(0.75*(trunc((y-1)/100)+1));
18.   end
19.   else begin
20.     f:=f - trunc(0.4*m+2.3) + trunc(y/4) - trunc(0.75*(trunc(y/100)+1));
21.   end;
22.
23.   date_val:=f;
24. end;
25.
26.
27. { ------------------------------------------------------------------------- }
28.
29. (******************************************)
30. (*** CONVERT numeric DATE TO string date  *)
31. (******************************************)
32. Function Date_Str (DateNum: longint) : Str8;
33.
34. var
35.    day,mon,year,temp,e : longint;
36.    Dstr, Mstr, Ystr : String [2];
37.    TempA, TempB, TempC: longint;
38. begin
39.
40.    TempA := DateNum + 68569;
41.    TempB := 4 * TempA div 146097;
42.    TempA := TempA - (146097 * TempB + 3) div 4;
43.    Year  := 4000 * (TempA + 1) div 1461001;
44.    TempC := Year;
45.    TempA := TempA - (1461 * TempC div 4) + 31;
46.    Mon   := 80 * TempA div 2447;
47.    TempC := Mon;
48.    Day   := TempA - (2447 * TempC div 80);
49.    TempA := Mon div 11;
50.    Mon   := Mon + 2 - (12 * TempA);
51.    Year  := 100 * (TempB - 49) + Year + TempA;
52.
53.    Str (Day :2,Dstr);
54.    Str (Mon :2,Mstr);
55.    If Year <= 1999
56.     then Dec (Year,1900)
57.     else Dec (Year,2000);
58.
59.    Str (Year:2,Ystr);
60.
61.    if Dstr [1] = ' ' then Dstr [1] := '0';
62.    if Mstr [1] = ' ' then Mstr [1] := '0';
63.    if Ystr [1] = ' ' then Ystr [1] := '0';
64.
65.    {if Ystr='0' then Ystr:='00';}
66.
67.    Date_Str := Dstr + '/' + Mstr + '/' + Ystr;
68.                       { handle blank field }
69.    if datenum = 0 then Date_Str := '  /  /  ';
70.
71. end;