Subj : Julian to String Date [1/2] To : Leonard Erickson From : Dan Egli Date : Sat Feb 14 2004 06:43 pm Monday February 09 2004 15:40, you wrote to me: LE> "Julian date" is a term that can refer to any of *several* things LE> (date expressed as "year & day of year, date in the Julian (as LE> opposed to Gregorian) calendar, etc). It also gets comnfused with the LE> Julian day number. True. It does. LE> if ancient TP code is ok, here's a unit that does that and more. LE> What you want are day_of_year and reverse_day_of_year. Heh TP code is great. That's what I'm after is PAscal code. Thanks! LE> UNIT datetime; LE> INTERFACE LE> USES LE> dos; LE> TYPE LE> date = STRING[10]; LE> VAR LE> dterror : STRING; LE> FUNCTION validate_datestr(dt:STRING):BOOLEAN; LE> FUNCTION valid_date_range(d,mn,y:word):BOOLEAN; LE> FUNCTION validate_timestr(tm:STRING):BOOLEAN; LE> FUNCTION ReverseJulianDate(JD:longint):date; LE> FUNCTION reverse_day_of_year(n,y:word):date; LE> FUNCTION day_of_week(d,mn,y:word):word; {Zeller's congruence} LE> FUNCTION leap_year(year:word):BOOLEAN; LE> FUNCTION valid_date(d,mn,y:word):BOOLEAN; LE> FUNCTION valid_datestr_format(dt:STRING):BOOLEAN; LE> FUNCTION valid_time(h,m,s:word):BOOLEAN; LE> FUNCTION valid_timestr_format(tm:STRING):BOOLEAN; LE> FUNCTION day_of_year(d,mn,y:word):word; LE> FUNCTION JulianDate(d,mn,y:word):longint; LE> PROCEDURE JulianDayToDate(jd:longint;VAR d,mn,y:word); LE> PROCEDURE DayOfYearToDate(dy,y:word;VAR d,mn:word); LE> FUNCTION DateToDateStr(d,mn,y,l:word):STRING; LE> IMPLEMENTATION LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION validate_datestr(dt:STRING):BOOLEAN; LE> VAR LE> d,mn,y,code : INTEGER; LE> flag : BOOLEAN; LE> BEGIN LE> flag := valid_datestr_format(dt); LE> IF flag THEN LE> BEGIN LE> VAL(COPY(dt,1,2),mn,code); LE> VAL(COPY(dt,4,2),d,code); LE> VAL(COPY(dt,7,2),y,code); LE> END; LE> IF flag THEN flag := Valid_Date(d,mn,y); LE> IF flag THEN flag := valid_date_range(d,mn,y); LE> validate_datestr := flag; LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION valid_date_range(d,mn,y:word):BOOLEAN; LE> VAR LE> flag : BOOLEAN; LE> td,tmn,ty,tdw : word; LE> lo_jd,hi_jd,jd : longint; LE> BEGIN LE> flag := TRUE; LE> dterror := ''; LE> GetDate(ty,tmn,td,tdw); LE> lo_jd := JulianDate(1,1,1980); LE> hi_jd := JulianDate(td,tmn,ty); LE> jd := JulianDate(d,mn,1900+y); LE> flag := jd>=lo_jd; LE> IF flag THEN LE> BEGIN LE> flag := jd<=hi_jd; LE> IF NOT flag THEN LE> dterror := 'Date cannot be later than today!'; LE> END LE> ELSE LE> dterror := 'Year cannot be before 1980!'; LE> valid_date_range := flag LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION validate_timestr(tm:STRING):BOOLEAN; LE> VAR LE> h,m,s,code : INTEGER; LE> flag : BOOLEAN; LE> BEGIN LE> IF tm <> ' ' THEN LE> BEGIN LE> flag := valid_timestr_format(tm); LE> IF flag THEN LE> BEGIN LE> VAL(COPY(tm,1,2),h,code); LE> VAL(COPY(tm,4,2),m,code); LE> VAL(COPY(tm,7,2),s,code); LE> END; LE> IF flag THEN flag := Valid_Time(h,m,s); LE> END; LE> validate_timestr := flag; LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION ReverseJulianDate(JD:longint):date; LE> { y=4 digit year LE> mn=month LE> d=day of month} LE> VAR LE> y, mn, d : word; LE> BEGIN LE> JulianDayToDate(jd,d,mn,y); LE> ReverseJulianDate := DateToDateStr(d,mn,y,10); LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION reverse_day_of_year(n,y:word):date; LE> { y=4 digit year LE> n=day of year LE> mn=month LE> d=day of month} LE> VAR LE> mn,d : word; LE> BEGIN LE> DayOfYearToDate(n,y,d,mn); LE> Reverse_day_of_year := DateToDateStr(d,mn,y,10); LE> END; {reverse_day_of_year} LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION day_of_week(d,mn,y:word):word; {Zeller's congruence} LE> {returns day of week (0 thru 6)} LE> { y=4 digit year LE> mn=month LE> d=day of month LE> c8=century LE> d8=year in century LE> m8=adjusted month LE> y8=adjusted year} LE> VAR LE> c8,d8,m8,y8 : longINT; LE> dw : INTEGER; LE> BEGIN IF mn>> 2 THEN LE> BEGIN LE> m8 := mn-2; LE> y8 := y; LE> END LE> ELSE LE> BEGIN LE> m8 := mn+10; LE> y8 := y-1; LE> END; LE> c8 := y8 DIV 100; LE> d8 := y8 MOD 100; LE> dw := ((13*m8-1) DIV 5+d+d8+d8 DIV 4+c8 DIV 4-c8-c8) MOD 7; LE> day_of_week := (dw+7) MOD 7; LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION leap_year(year:word):BOOLEAN; LE> BEGIN LE> leap_year := FALSE; LE> IF (year MOD 4)=0 THEN leap_year := TRUE; LE> IF (year MOD 100)=0 THEN leap_year := FALSE; LE> IF (year MOD 400)=0 THEN leap_year := TRUE; LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION valid_date(d,mn,y:word):BOOLEAN; LE> VAR LE> flag : BOOLEAN; LE> BEGIN LE> CASE mn OF LE> 1,3,5,7,8,10,12 : BEGIN LE> flag := d<32; LE> dterror := 'Only 31 days in that month!'; LE> END; LE> 2 : BEGIN LE> IF leap_year(y) THEN LE> BEGIN LE> flag := d<30; LE> dterror := 'Only 29 days in that month!'; LE> END LE> ELSE LE> BEGIN LE> flag := d<29; LE> dterror := 'Only 28 days in that month!'; LE> END; LE> END; LE> 4,6,9,11 : BEGIN LE> flag := (d<31); LE> dterror := 'Only 31 days in that month!'; LE> END; LE> ELSE LE> flag := FALSE; LE> dterror := 'Illegal month!'; LE> END; LE> IF flag THEN dterror := ''; LE> valid_date := flag; LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION valid_datestr_format(dt:STRING):BOOLEAN; LE> CONST LE> msg = 'Correct format is MM-DD-YY.'; LE> VAR LE> ctr : INTEGER; LE> flag : BOOLEAN; LE> BEGIN LE> flag := TRUE; LE> dterror :=''; LE> FOR ctr := 1 TO 8 DO LE> CASE dt[ctr] OF LE> '0'..'9','-' : flag := flag LE> ELSE LE> flag := FALSE; LE> END; LE> IF NOT flag THEN dterror :='Illegal character! '+msg; LE> flag := flag AND (dt[3] = '-') AND (dt[6] = '-'); LE> IF NOT flag THEN dterror := 'Missing hyphen! '+msg; LE> flag := flag AND (dt[1] <> '-') AND (dt[2] <> '-') AND (dt[4] <> LE> '-') AND LE> (dt[5] <> '-') AND (dt[7] <> '-') AND (dt[8] <> '-'); LE> IF NOT flag THEN dterror := 'Extra hyphen! '+msg; LE> valid_datestr_format := flag; LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION valid_time(h,m,s:word):BOOLEAN; LE> VAR LE> flag : BOOLEAN; LE> BEGIN LE> flag := TRUE; IF ((h>> 23) OR (h<0)) THEN LE> BEGIN LE> dterror :='Illegal hour!'; LE> flag := FALSE; LE> END; LE> IF flag AND ((m>59) OR (m<0)) THEN LE> BEGIN LE> dterror := 'Illegal minute!'; LE> flag := FALSE; LE> END; LE> IF flag AND ((s>59) OR (s<0)) THEN LE> BEGIN LE> dterror := 'Illegal second!'; LE> flag := FALSE; LE> END; LE> valid_time := flag; LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION valid_timestr_format(tm:STRING):BOOLEAN; LE> CONST LE> msg = 'Correct format is HH:MM:SS.'; LE> VAR LE> ctr : INTEGER; LE> flag : BOOLEAN; LE> BEGIN LE> flag := TRUE; LE> IF tm <> ' ' THEN LE> BEGIN LE> dterror :=''; LE> FOR ctr := 1 TO 8 DO LE> CASE tm[ctr] OF LE> '0'..'9',':' : flag := flag LE> ELSE LE> flag := FALSE; LE> END; LE> IF NOT flag THEN dterror :='Illegal character! '+msg; LE> IF flag AND ((tm[3] <> ':') OR (tm[6] <> ':')) THEN LE> dterror := 'Missing colon! '+msg; LE> IF flag AND ((tm[1] = ':') OR (tm[2] = ':') OR (tm[4] = ':') OR LE> (tm[5] = ':') OR (tm[7] = ':') OR (tm[8] = ':')) THEN LE> dterror := 'Extra colon! '+msg; LE> END; LE> valid_timestr_format := flag; LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION day_of_year(d,mn,y:word):word; LE> { y=4 digit year LE> mn=month LE> d=day of month} LE> VAR LE> l,t : word; LE> BEGIN LE> t := (3055*(mn+2) DIV 100)-91; LE> IF leap_year(y) THEN LE> l := 1 LE> ELSE LE> l := 0; IF mn>> 2 THEN t := t-2+l; LE> day_of_year := t+d; LE> END; LE> {--------------------------------------------------------------------- LE> -} LE> FUNCTION JulianDate(d,mn,y:word):longint; LE> { y=4 digit year LE> mn=month LE> d=day of month LE> c8=century LE> d8=year in century LE> m8=adjusted month LE> y8=adjusted year} LE> VAR LE> c8,d8,m8,y8:longINT; LE> BEGIN IF mn>> 2 THEN LE> BEGIN LE> m8 := mn-3; LE> y8 := y; LE> END LE> ELSE LE> BEGIN LE> m8 := mn+9; LE> y8 := y-1; LE> END; LE> c8 := y8 DIV 100; LE> d8 := y8 MOD 100; LE> JulianDate := (146097*c8 DIV 4)+d+(1461*d8 DIV 4)+1721119+(153*m8+2) LE> DIV 5; END; LE> {--------------------------------------------------------------------- LE> -} LE> PROCEDURE JulianDayToDate(JD:longint;VAR d,mn,y:word); LE> { y=4 digit year LE> mn=month LE> d=day of month LE> t1,t2,t3=temp value} LE> VAR LE> yt, mt, dt : longint; LE> BEGIN LE> mt := JD-1721119; LE> yt := (4*mt-1) DIV 146097; LE> mt := 4*mt-1-146097*yt; LE> dt := mt DIV 4; LE> mt := (4*dt+3) DIV 1461; LE> dt := 4*dt+3-1461*mt; LE> dt := (dt+4) DIV 4; LE> mn := (5*dt-3) DIV 153; LE> dt := 5*dt-3-153*mn; LE> d := (dt+5) DIV 5; LE> y := 100*yt+mt; LE> IF mn<10 THEN LE> mn := mn+3 LE> ELSE LE> BEGIN LE> mn := mn-9; LE> y := y+1; LE> END; LE> END; LE> {--------------------------------------------------------------------- LE> -} >>>> Continued to next message... LE> -+- FMailX 1.60 LE> + Origin: Shadowgard (1:105/50) Dan Moderator BBS_SURVIVAL --- * Origin: Now accepting prisoners at telnet://thedungeon.dnsalias.ne (1:311/6) .