SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00042 DATE & TIME ROUTINES 1 05-28-9313:37ALL INBAR RAZ Unix Like time in ASM IMPORT 39 ╬N⌡^ I saw a thread going on here, about the subject.ππI just happen to have programmed such a thing, for a certain program. It's notπperfect, in the essence that It will produce good results only from 1970 toπ2099, because I didn't feel like starting to investigate which are leap yearsπand which are not. All the leap years between 1970 and 2099 ARE included,πthough.ππ---------------------------------= cut here =---------------------------------π{ ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ }ππ { This procedure returns a LongInt UNIX-like timestamp. TimeRec will be }π { overwritten by the resulted UNSIGNED DWORD. }ππ Procedure SecondSince1970(Year, Month, Day, Hour, Minute:Word; Var TimeRec);ππ Var T_Lo,π T_Hi : Word;ππ Beginπ Asmππ Call @Tableππ @Table:ππ Pop Siπ Add Si,6 { Point Si to data table }π Jmp @Computeππ { This table contains the number of days in all months UNTIL this one }ππ dw 0 { Within January }π dw 31 { January }π dw 59 { February }π dw 90 { Mars }π dw 120 { April }π dw 151 { May }π dw 181 { June }π dw 212 { July }π dw 243 { August }π dw 273 { September }π dw 304 { October }π dw 334 { November }ππ { This i a routine to multiply a DWORD by a WORD }π { Input: DX:AX word to multilpy, CX multiplier }ππ @Calc:ππ Push Siπ Push Diππ Mov Di,Dxπ Mov Si,Axππ Dec Cx { We already have it multiplied by 1 }ππ @Addit:ππ Add Ax,Siπ Adc Dx,Diππ Loop @Additππ Pop Diπ Pop Siππ Retππ @Compute:ππ Xor Di,Di { Variable for leap year }ππ { Seconds of round years }ππ Mov Bx,Yearπ Sub Bx,1970π Mov Ax,365*24 { Hours per year }π Mov Cx,60*60 { Seconds per hour }π Xor Dx,Dxππ Call @Calc { Multiply dword response by CX }π Mov Cx,Bxπ Call @Calcππ Push Axπ Push Dxππ { Seconds of leap years }ππ Mov Ax,Yearπ Sub Ax,1972 { First leap year after 1972 }π Mov Bx,4π Xor Dx,Dxπ Div Bxππ { DX now holds number of days to add becaues of leap years. }π { If DX is 0, this is a leap year, and we need to take it intoπconideration }ππ Mov Di,Dx { If DI is 0, this is a leap year }ππ Inc Ax { We must count 1972 as well }π Xor Dx,Dxπ Mov Bx,60*60π Mov Cx,24ππ Mul Bxπ Call @Calcππ Mov Cx,Dxπ Mov Bx,Axππ { Now add what we had before }ππ Pop Dxπ Pop Axππ Add Ax,Bxπ Adc Dx,Cxππ Push Axπ Push Dxππ { DX:AX holds the number of seconds since 1970 till the beginning of yearπ}ππ { Add days within this year }ππ Mov Bx,Monthπ Dec Bxπ Shl Bx,1π Add Bx,Siπ Mov Bx,cs:[Bx] { Lookup Table, sum of months EXCEPT this one }π Add Bx,Day { Add days within this one }π Dec Bx { Today hasn't ended yet }ππ Mov Ax,60*60π Mov Cx,24π Xor Dx,Dxπ Mul Bxπ Call @Calcππ Mov Cx,Dxπ Mov Bx,Axππ { Now add what we had before - days until beginning of the year }ππ Pop Dxπ Pop Axππ Add Ax,Bxπ Adc Dx,Cxππ { DX:AX now holds the number of secondss since 1970 till beginning ofπday. }ππ Push Axπ Push Dxππ { DX:AX holds the number of seconds until the beginning of this day }ππ Mov Bx,Hourπ Mov Ax,60*60 { Seconds per hour }π Xor Dx,Dxπ Mul Bxππ Push Axπ Push Dxππ Mov Bx,Minuteπ Mov Ax,60 { Seconds per minute }π Xor Dx,Dxπ Mul Bxππ Mov Cx,Dxπ Mov Bx,Axππ Pop Dxπ Pop Axππ Add Bx,Axπ Adc Cx,Dxππ { And add the seconds until beginning of year }ππ Pop Dxπ Pop Axππ Add Ax,Bxπ Adc Dx,Cxππ { DX:AX now holds number of second since 1970 }ππ Mov T_Hi,Dxπ Mov T_Lo,Axππ End;ππ Move(Mem[Seg(T_Lo):Ofs(T_Lo)],π Mem[Seg(TimeRec):Ofs(TimeRec)],2);ππ Move(Mem[Seg(T_Hi):Ofs(T_Hi)],π Mem[Seg(TimeRec):Ofs(TimeRec)+2],2);ππ End;ππ{ ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ }ππ---------------------------------= cut here =---------------------------------ππHope this helps.ππInbar Razππ--- FMail 0.94π * Origin: Castration takes balls. (2:403/100.42)π 2 05-28-9313:37ALL LEE BARKER DATE1.PAS IMPORT 9 ╬Næ╓ {πI posted some routines on doing calendar math using Integers quiteπa While back. That gives you a relative date of about 89 years. UseπLongInt For more. Avoids pulling in the Real lib that julian requires.πJust making them up again as I Type them in the reader. There may be aπtypo or two.π}ππFunction leapyear (c, y : Byte) : Boolean;πbeginπ if (y and 3) <> 0 thenπ leapyear := Falseπ elseπ if y <> 0 thenπ leapyear := Trueπ elseπ if (c and 3) = 0 thenπ leapyear := Trueπ elseπ leapyear := False;πend;ππFunction DaysInMonth (c, y, m : Byte) : Integer;πbeginπ if m = 2 thenπ if leapyear thenπ DaysInMonth := 29π elseπ DaysInMonth := 28π elseπ DaysInMonth := 30 + (($0AB5 shr m) and 1);πend;ππFunction DaysInYear (c, y : Byte) : Integer;πbeginπ DaysInYear := DaysInMonth(c, y, 2) + 337;πend;ππFunction DayOfYear (c, y, m, d :Byte) : Integer;πVar i, j : Integer;πbeginπ j := d;π For i := 1 to pred(m) doπ j := j + DaysInMonth(c,y,i);π DayOfYear := j;πend; 3 05-28-9313:37ALL GREG VIGNEAULT DATE2.PAS IMPORT 26 ╬N╦┼ {DF> I need an accurate method of converting back and Forth betweenπ > Gregorian and Julian dates.ππ if you mean the True Julian day, as used in astronomy ...π}ππProgram JulianDate; { Gregorian date to Julian day }ππUses Crt; { Turbo/Quick Pascal }πVar Month, Year, greg : Integer;π Day, JulianDay : Real;π LeapYear, DateOkay : Boolean;πbeginπ ClrScr;π WriteLn( 'Julian Dates v0.1 Dec.20.91 G.Vigneault' );π WriteLn( '[Enter Gregorian calendar values]');π WriteLn;π { A.D. years entered normally, B.C. years as negative }π Write( 'Enter Year (nnnn For A.D., -nnnn For B.C.): ' );π ReadLn( Year );π LeapYear := False; { assume not }π if ((Year MOD 4)=0) { possible LeapYear? }π then if ((Year MOD 100)<>0) { LeapYear if not century }π or ((Year MOD 100)=0) and ((Year MOD 400)=0)π then LeapYear := True;π Repeatπ Write( 'Enter Month (1..12): ' );π ReadLn( Month );π Until ( Month < 13 ) and ( Month > 0 );ππ WriteLn('Julian Days begin at Greenwich mean noon (12:00 UT)');π DateOkay := False;π Repeatπ Write( 'Enter Day (1.0 <= Day < 32.0): ' );π ReadLn( Day ); {may be decimal to include hours}π if ( Day >= 1.0 ) and ( Day < 32.0 )π then Case Month ofπ 1,3,5,7,8,10,12 : if Day < 32.0 then DateOkay := True;π 4,6,9,11 : if Day < 31.0 then DateOkay := True;π 2 : if ( Day < 29.0 ) orπ ( Day < 30.0 ) and LeapYearπ then DateOkay := Trueπ else WriteLn('not a leapyear!');π end; {Case}π if not DateOkay then Write( #7 ); { beep }π Until DateOkay;ππ (* here is where we start calculation of the Julian Date *)ππ if Month in [ 1, 2 ]π then beginπ DEC( Year );π inC( Month, 12 )π end;ππ { account For Pope Gregory's calendar correction, when }π { the day after Oct.4.1582 was Oct.15.1582 }ππ if ( Year < 1582 ) orπ ( Year = 1582 ) and ( Month < 10 ) orπ ( Year = 1582 ) and ( Month = 10 ) and ( Day <= 15 )π then greg := 0 { Oct.15.1582 or earlier }π else begin { Oct.16.1582 or later }π greg := TRUNC( Year div 100 );π greg := 2 - greg + TRUNC( greg div 4 );π end;ππ if ( Year >= 0 ) { circa A.D. or B.C. ? }π then JulianDay := inT( 365.25 * Year ) {AD}π else JulianDay := inT( 365.25 * Year - 0.75 ); {BC}ππ JulianDay := JulianDayπ + inT( 30.6001 * ( Month + 1 ) )π + Dayπ + 1720994.5π + greg;ππ WriteLn;π WriteLn( 'Equivalent Julian date is : ', JulianDay:8:2 );π WriteLn;πend. {JulianDate}π 4 05-28-9313:37ALL SWAG SUPPORT TEAM DATE3.PAS IMPORT 28 ╬Nû Program Gregorian; { Julian day to Gregorian date }πUses Crt; { Turbo/Quick Pascal }πType String3 = String[3];π String9 = String[9];πConst MonthName : Array [1..12] of String3 =π ('Jan','Feb','Mar','Apr','May','Jun',π 'Jul','Aug','Sep','Oct','Nov','Dec');π DayName : Array [1..7] of String9 =π ('Sunday','Monday','Tuesday','Wednesday',π 'Thursday','Friday','Saturday');πVar Day, JulianDay, F : Real;π Month : Byte;π Year : Integer;π A, B, C, D, E, G, Z : LongInt;π LeapYear : Boolean;ππFunction DayofWeek( Month : Byte; Day : Real; Year : Integer ): Byte;π Var iVar1, iVar2 : Integer;π beginπ iVar1 := Year MOD 100;π iVar2 := TRUNC( Day ) + iVar1 + iVar1 div 4;π Case Month ofπ 4, 7 : iVar1 := 0;π 1, 10 : iVar1 := 1;π 5 : iVar1 := 2;π 8 : iVar1 := 3;π 2,3,11 : iVar1 := 4;π 6 : iVar1 := 5;π 9,12 : iVar1 := 6;π end; {Case}π iVar2 := ( iVar1 + iVar2 ) MOD 7;π if ( iVar2 = 0 ) then iVar2 := 7;π DayofWeek := Byte( iVar2 );π end; {DayofWeek}ππFunction DayofTheYear( Month : Byte; DAY : Real ): Integer;π Var N : Integer;π beginπ if LeapYear then N := 1 else N := 2;π N := 275 * Month div 9π - N * (( Month + 9 ) div 12)π + TRUNC( Day ) - 30;π DayofTheYear := N;π end; {DayofTheYear}ππbegin {Gregorian}π ClrScr;π WriteLn('Gregorian dates v0.0 Dec.91 Greg Vigneault');π WriteLn('[Enter Julian day values]');ππ Repeat WriteLn;π Write('Enter (positive) Julian day number: ');π ReadLn( JulianDay );π Until ( JulianDay >= 706.0 );ππ JulianDay := JulianDay + 0.5;π Z := TRUNC( JulianDay ); F := FRAC( JulianDay );ππ if ( Z < 2299161 )π then A := Zπ else begin G := TRUNC( ( Z - 1867216.25 ) / 36524.25);π A := Z + 1 + G - G div 4;π end; {if}ππ B := A + 1524; C := TRUNC( ( B - 122.1 ) / 365.25 );π D := TRUNC( 365.25 * C ); E := TRUNC( ( B - D ) / 30.6001 );ππ Day := B - D - TRUNC( 30.6001 * E ) + F;ππ if ( E < 13.5 )π then Month := Byte( E - 1 )π else if ( E > 13.5 ) then Month := Byte( E - 13 );ππ if ( Month > 2.5 )π then Year := Integer( C - 4716 )π else if ( Month < 2.5 ) then Year := Integer( C - 4715 );ππ if ((Year MOD 100)<>0) and ((Year MOD 4)=0)π then LeapYear := Trueπ else LeapYear := False;ππ Write(#10,'Gregorian '); if LeapYear then Write('LeapYear ');π WriteLn('date is ',DayName[DayofWeek(Month,Day,Year)],π ', ',MonthName[ Month ],' ',Day:2:2,',',Year:4,π ' (day of year= ',DayofTheYear(Month,Day),')',#10);πend. {Gregorian}π 5 05-28-9313:37ALL SWAG SUPPORT TEAM DATE4.PAS IMPORT 15 ╬Na {π I need an accurate method of converting back andπ Forth between Gregorian and Julian dates. if anyoneπ}ππProcedure GregoriantoJulianDN;ππVarπ Century,π XYear : LongInt;ππbegin {GregoriantoJulianDN}π if Month <= 2 then beginπ Year := pred(Year);π Month := Month + 12;π end;π Month := Month - 3;π Century := Year div 100;π XYear := Year mod 100;π Century := (Century * D1) shr 2;π XYear := (XYear * D0) shr 2;π JulianDN := ((((Month * 153) + 2) div 5) + Day) + D2 + XYear + Century;πend; {GregoriantoJulianDN}ππ{**************************************************************}ππProcedure JulianDNtoGregorian;ππVarπ Temp,π XYear : LongInt;π YYear,π YMonth,π YDay : Integer;ππbegin {JulianDNtoGregorian}π Temp := (((JulianDN - D2) shl 2) - 1);π XYear := (Temp mod D1) or 3;π JulianDN := Temp div D1;π YYear := (XYear div D0);π Temp := ((((XYear mod D0) + 4) shr 2) * 5) - 3;π YMonth := Temp div 153;π if YMonth >= 10 then beginπ YYear := YYear + 1;π YMonth := YMonth - 12;π end;π YMonth := YMonth + 3;π YDay := Temp mod 153;π YDay := (YDay + 5) div 5;π Year := YYear + (JulianDN * 100);π Month := YMonth;π Day := YDay;πend; {JulianDNtoGregorian}πππ{**************************************************************}ππProcedure GregoriantoJulianDate;ππVarπ Jan1,π today : LongInt;ππbegin {GregoriantoJulianDate}π GregoriantoJulianDN(Year, 1, 1, Jan1);π GregoriantoJulianDN(Year, Month, Day, today);π JulianDate := (today - Jan1 + 1);πend; {GregoriantoJulianDate}ππ{**************************************************************}ππProcedure JuliantoGregorianDate;ππVarπ Jan1 : LongInt;ππbeginπ GregoriantoJulianDN(Year, 1, 1, Jan1);π JulianDNtoGregorian((Jan1 + JulianDate - 1), Year, Month, Day);πend; {JuliantoGregorianDate}ππ 6 05-28-9313:37ALL SWAG SUPPORT TEAM DATE5.PAS IMPORT 4 ╬NìΩ Procedure TheDate(Var Date:String;Var doW:Integer);π Varπ D,M,Y : Integer;π beginπ GetDate(Y,M,D,doW);π Date:=chr((M div 10)+48)+chr((M mod 10)+48)+'-'+chr((D div 10)+48+π chr((D mod 10)+48)+'-'+chr(((Y mod 100) div 10)+48)+π chr(((Y mod 100) mod 10)+48);π if Date[1]='0' then Date[1]:=' ';π end;π 7 05-28-9313:37ALL SWAG SUPPORT TEAM DATE6.PAS IMPORT 60 ╬N≥Æ Unit Julian;π{DEMO Routinesπ/beginπ/ ClrScr;π/ GetDate(Year,Month,Day,Dow);π/ WriteLn('Year : ',Year);π/ WriteLn('Month : ',Month);π/ WriteLn('Day : ',Day);π/ WriteLn('doW : ',Dow);π/ WriteLn(MachineDate);π/ JulianDate := DatetoJulian(MachineDate);π/ WriteLn('Julian Date = ',JulianDate);π/ WriteLn('Jul to Date = ',JuliantoDate(JulianDate));π/ WriteLn('Day of Week = ',DayofWeek(JulianDate));π/ WriteLn('Time = ',MachineTime(4));π/end.}πInterfaceππUses Crt, Dos;ππTypeπ Str3 = String[3];π Str8 = String[8];π Str9 = String[9];π Str11 = String[11];ππVarπ Hour,Minute,Second,S100,π Year,Month,Day,Dow : Word;π Syear,Smonth,Sday,Sdow : String;π JulianDate : Integer;ππFunction MachineTime(Len : Byte) : Str11;πFunction MachineDate : Str8;πFunction DateFactor(MonthNum, DayNum, YearNum : Real) : Real;πFunction DatetoJulian(DateLine : Str8) : Integer;πFunction JuliantoDate(DateInt : Integer): Str11;πFunction JuliantoStr8(DateInt : Integer): Str8;πFunction DayofWeek(Jdate : Integer) : Str3;πProcedure DateDiff(Date1,Date2 : Integer; Var Date_Difference : Str9);ππImplementationπFunction MachineTime(Len : Byte) : Str11;πVarπ I : Byte;π TempStr : String;π TimeStr : Array[1..4] of String;πbeginπ TempStr := ''; FillChar(TimeStr,Sizeof(TimeStr),0);π GetTime(Hour,Minute,Second,S100);π Str(Hour,TimeStr[1]);π Str(Minute,TimeStr[2]);π Str(Second,TimeStr[3]);π Str(S100,TimeStr[4]);π TempStr := TimeStr[1];π For I := 2 to Len Do TempStr := TempStr + ':' + TimeStr[I];π MachineTime := TempStr;πend;ππFunction MachineDate : Str8;πbeginπ GetDate(Year,Month,Day,Dow);π Str(Year,Syear);π Str(Month,Smonth);π if Month < 10 then Smonth := '0' + Smonth;π Str(Day,Sday);π if Day < 10 then Sday := '0' + Sday;π MachineDate := smonth + sday + syear;πend;ππFunction DateFactor(MonthNum, DayNum, YearNum : Real) : Real;πVarπ Factor : Real;πbeginπ Factor := (365 * YearNum)π + DayNumπ + (31 * (MonthNum-1));π if MonthNum < 3π then Factor := Factorπ + Int((YearNum-1) / 4)π - Int(0.75 * (Int((YearNum-1) / 100) + 1))π else Factor := Factorπ - Int(0.4 * MonthNum + 2.3)π + Int(YearNum / 4)π - Int(0.75 * (Int(YearNum / 100) + 1));π DateFactor := Factor;πend;ππFunction DatetoJulian(DateLine : Str8) : Integer;πVarπ Factor, MonthNum, DayNum, YearNum : Real;π Ti : Integer;πbeginπ if Length(DateLine) = 7π then DateLine := '0'+DateLine;π MonthNum := 0.0;π For Ti := 1 to 2 Doπ MonthNum := (10 * MonthNum)π + (ord(DateLine[Ti])-ord('0'));π DayNum := 0.0;π For Ti := 3 to 4 Doπ DayNum := (10 * DayNum)π + (ord(DateLine[Ti])-ord('0'));π YearNum := 0.0;π For Ti := 5 to 8 Doπ YearNum := (10 * YearNum)π + (ord(DateLine[Ti])-ord('0'));π Factor := DateFactor(MonthNum, DayNum, YearNum);π DatetoJulian :=π Trunc((Factor - 679351.0) - 32767.0);πend;ππFunction JuliantoDate(DateInt : Integer): Str11;πVarπ holdstr : String[2];π anystr : String[11];π StrMonth : String[3];π strDay : String[2];π stryear : String[4];π test,π error,π Year,π Dummy,π I : Integer;π Save,Temp : Real;π JuliantoanyString : Str11;πbeginπ holdstr := '';π JuliantoanyString := '00000000000';π Temp := Int(DateInt) + 32767 + 679351.0;π Save := Temp;π Dummy := Trunc(Temp/365.5);π While Save >= DateFactor(1.0,1.0,Dummy+0.0)π Do Dummy := Succ(Dummy);π Dummy := Pred(Dummy);π Year := Dummy;π (* Determine number of Days into current year *)π Temp := 1.0 + Save - DateFactor(1.0,1.0,Year+0.0);π (* Put the Year into the output String *)π For I := 8 downto 5 Doπ beginπ JuliantoanyString[I]π := Char((Dummy mod 10)+ord('0'));π Dummy := Dummy div 10;π end;π Dummy := 1 + Trunc(Temp/31.5);π While Save >= DateFactor(Dummy+0.0,1.0,Year+0.0)π Do Dummy := Succ(Dummy);π Dummy := Pred(Dummy);π Temp := 1.0 + Save - DateFactor(Dummy+0.0,1.0,Year+0.0);π For I := 2 Downto 1 Doπ beginπ JuliantoanyString[I]π := Char((Dummy mod 10)+ord('0'));π Dummy := Dummy div 10;π end;π Dummy := Trunc(Temp);π For I := 4 Downto 3 Doπ beginπ JuliantoanyString[I]π := Char((Dummy mod 10)+ord('0'));π Dummy := Dummy div 10;π end;π holdstr := copy(juliantoanyString,1,2);π val(holdstr,test,error);π Case test ofπ 1 : StrMonth := 'Jan';π 2 : StrMonth := 'Feb';π 3 : StrMonth := 'Mar';π 4 : StrMonth := 'Apr';π 5 : StrMonth := 'May';π 6 : StrMonth := 'Jun';π 7 : StrMonth := 'Jul';π 8 : StrMonth := 'Aug';π 9 : StrMonth := 'Sep';π 10 : StrMonth := 'Oct';π 11 : StrMonth := 'Nov';π 12 : StrMonth := 'Dec';π end;π stryear := copy(juliantoanyString,5,4);π strDay := copy(juliantoanyString,3,2);π anystr := StrDay + '-' + StrMonth + '-' +stryear;π JuliantoDate := anystr;πend;ππFunction JuliantoStr8(DateInt : Integer): Str8;πVarπ holdstr : String[2]; anystr : String[8]; StrMonth : String[2];π strDay : String[2]; stryear : String[4]; Save, Temp : Real;π test, error, Year, Dummy, I : Integer; JuliantoanyString : Str8;πbeginπ holdstr := ''; JuliantoanyString := '00000000';π Temp := Int(DateInt) + 32767 + 679351.0;π Save := Temp; Dummy := Trunc(Temp/365.5);π While Save >= DateFactor(1.0,1.0,Dummy+0.0) Do Dummy := Succ(Dummy);π Dummy := Pred(Dummy); Year := Dummy;π Temp := 1.0 + Save - DateFactor(1.0,1.0,Year+0.0);π For I := 8 downto 5 Doπ beginπ JuliantoanyString[I] := Char((Dummy mod 10)+ord('0'));π Dummy := Dummy div 10;π end;π Dummy := 1 + Trunc(Temp/31.5);π While Save >= DateFactor(Dummy+0.0,1.0,Year+0.0) Do Dummy := Succ(Dummy);π Dummy := Pred(Dummy);π Temp := 1.0 + Save - DateFactor(Dummy+0.0,1.0,Year+0.0);π For I := 2 Downto 1 Doπ beginπ JuliantoanyString[I] := Char((Dummy mod 10)+ord('0'));π Dummy := Dummy div 10;π end;π Dummy := Trunc(Temp);π For I := 4 Downto 3 Doπ beginπ JuliantoanyString[I] := Char((Dummy mod 10)+ord('0'));π Dummy := Dummy div 10;π end;π holdstr := copy(juliantoanyString,1,2); val(holdstr,test,error);π Case test ofπ 1 : StrMonth := '01'; 2 : StrMonth := '02'; 3 : StrMonth := '03';π 4 : StrMonth := '04'; 5 : StrMonth := '05'; 6 : StrMonth := '06';π 7 : StrMonth := '07'; 8 : StrMonth := '08'; 9 : StrMonth := '09';π 10 : StrMonth := '10'; 11 : StrMonth := '11'; 12 : StrMonth := '12';π end;π StrYear := copy(juliantoanyString,5,4);π StrDay := copy(juliantoanyString,3,2);π AnyStr := StrMonth + StrDay + StrYear; JuliantoStr8 := AnyStr;πend;ππFunction DayofWeek(Jdate : Integer) : Str3;πbeginπ Case jdate MOD 7 ofπ 0:DayofWeek:='Sun'; 1:DayofWeek:='Mon'; 2:DayofWeek := 'Tue';π 3:DayofWeek:='Wed'; 4:DayofWeek:='Thu'; 5:DayofWeek := 'Fri';π 6:DayofWeek:='Sat';π end;πend;ππProcedure DateDiff(Date1,Date2 : Integer;π Var Date_Difference : Str9);πVarπ Temp,Rdate1,Rdate2,Diff1 : Real; Diff : Integer;π Return : String[9]; Hold : String[3];πbeginπ Rdate2 := Date2 + 32767.5; Rdate1 := Date1 + 32767.5;π Diff1 := Rdate1 - Rdate2; Temp := Diff1;π if Diff1 < 32 then (* determine number of Days *)π beginπ Diff := Round(Diff1); Str(Diff,Hold);π Return := Hold + ' ' + 'Day';π if Diff > 1 then Return := Return + 's ';π end;π if ((Diff1 > 31) and (Diff1 < 366)) thenπ beginπ Diff1 := Diff1 / 30; Diff := Round(Diff1); Str(Diff,Hold);π Return := Hold + ' ' + 'Month';π if Diff > 1 then Return := Return + 's';π end;π if Diff1 > 365 thenπ beginπ Diff1 := Diff1 / 365; Diff := Round(Diff1); Str(Diff,Hold);π Return := Hold;π end;π Date_Difference := Return; Diff := Round(Diff1);πend;πend.π 8 05-28-9313:37ALL SWAG SUPPORT TEAM DATE7.PAS IMPORT 10 ╬N¼ {πI have seen a number of Julian Date Functions showing up here lately.πNone of them seem to agree With each other. of course, if your Programπis the only thing using them, then it will remain consistent and workπfine. But if you need to find the JD For astronomical or scientificπpurposes, then you will need to be able to agree With the acceptedπmethod. The following seems to work well For me. Using Real For theπVar Types allows you to find the JD to great accuracy.πBTW, JD 0.0 is Greenwich Mean Noon, Jan. 1, 4713 BC (which is why if youπenter a "whole" day. ie. 1,2,3... your answer will have a '.5' at theπend.π}ππFunction JulianDate(Day, Month, Year : Real) : Real;πVarπ A, B, C, D : Real;πbeginπ if Month <= 2 thenπ beginπ Year := Year - 1;π Month := Month + 12;π end;ππ if Year >= 1582 thenπ beginπ A := inT(Year / 100);π B := inT((2 - A) + inT(A / 4));π endπ elseπ B := 0;ππ if Year < 0 thenπ C := inT((365.25 * Year) - 0.75)π elseπ C := inT(365.25 * Year);ππ D := inT (30.6001 * (Month + 1));π JulianDate := B + C + D + Day + 1720994.5;πend;ππ 9 05-28-9313:37ALL SWAG SUPPORT TEAM DATEFRMT.PAS IMPORT 25 ╬N┘0 (*π> Function SYS_DATE : STR8; { Format System Date as YY/MM/DD }ππ No doubt, your Function will work. But don't you think that nowadaysπProgrammers, even if they live in the United States, should Write softwareπwhich is a little bit more open-minded? The date Format "YY/MM/DD" is commonlyπused in your country, but in the country where I live "DD-MM-YY" is standard,πand in other countries there are other date and time Formats in use.ππ Dates expressed in your country Format appear somewhat strange andπbizarre outside the US. I wonder why most American Programmers don't careπabout the country support alReady built-in into Dos. Is this arrogance or doesπthis indicate a somewhat narrow-minded American way of thinking?ππ Use the following Unit to determine the current country settings Validπon the Computer your Program is operating on:π*)ππUnit country;ππInterfaceππTypeπ str4 = String[4];ππFunction countryCode : Byte;πFunction currencySymbol : str4;πFunction dateFormat : Word;πFunction dateSeparator : Char;πFunction DecimalSeparator : Char;πFunction timeSeparator : Char;πππImplementationπUsesπ Dos;ππTypeπ countryInfoRecord = Recordπ dateFormat : Word;π currency : Array[1..5] of Char;π thouSep,π DecSep,π dateSep,π timeSep : Array[1..2] of Char;π currencyFormat,π significantDec,π timeFormat : Byte;π CaseMapAddress : LongInt;π dataListSep : Array[1..2] of Char;π reserved : Array[1..5] of Wordπ end;ππVarπ countryRecord : countryInfoRecord;π reg : Registers;πππProcedure getCountryInfo; { generic Dos call used by all Functions }ππbeginππ reg.AH := $38;π reg.AL := 0;π reg.DS := seg(countryRecord);π reg.DX := ofs(countryRecord);π msDos(reg)ππend; { getCountryInfo }πππFunction countryCode : Byte; { returns country code as set in Config.Sys }ππbeginππ countryCode := reg.ALππend; { countryCode }ππFunction currencySymbol : str4; { returns currency symbol }πVarπ temp : str4;π i : Byte;ππbeginππ With countryRecord doπ beginπ temp := '';π i := 0;π Repeatπ Inc(i);π if currency[i] <> #0 then temp := temp + currencyπ Until (i = 5) or (currency[i] = #0)π end;π currencySymbol := tempππend; { currencySymbol }πππFunction dateFormat : Word;π{ 0 : USA standard mm/dd/yy }π{ 1 : Europe standard dd-mm-yy }π{ 2 : Japan standard yy/mm/dd }πbeginππ dateFormat := countryRecord.dateFormatππend; { dateFormat }πππFunction dateSeparator : Char; { date separator Character }ππbeginππ dateSeparator := countryRecord.dateSep[1]ππend; { dateSeparator }πππFunction DecimalSeparator : Char; { Decimal separator Character }ππbeginππ DecimalSeparator := countryRecord.DecSep[1]ππend; { DecimalSeparator }πππFunction timeSeparator : Char; { time separator Character }ππbeginππ timeSeparator := countryRecord.timeSep[1]ππend; { timeSeparator }ππbeginππ getCountryInfoππend. { Unit country }π 10 05-28-9313:37ALL SWAG SUPPORT TEAM DAYOF-YR.PAS IMPORT 8 ╬NAC { RN> Does someone have a Procedure I can use to give me a Stringπ RN> containing the "day number" ? ie: if today is day numberπ RN> 323, the Function/Procedure would contain that.π}π Uses Crt;ππ Var today,π year, month, day : Word;ππ Constπ TDays : Array[Boolean,0..12] of Word =π ((0,31,59,90,120,151,181,212,243,273,304,334,365),π (0,31,60,91,121,152,182,213,244,274,305,335,366));ππFunction DayofTheYear(yr,mth,d : Word): Word;π { valid For all years 1901 to 2078 }π Varπ temp : Word;π lyr : Boolean;π beginπ lyr := (yr mod 4 = 0);π temp := TDays[lyr][mth-1];π inc(temp,d);π DayofTheYear := temp;π end; { PackedDate }ππbeginπ ClrScr;π year := 92;π month := 12;π day := 31;π today := DayofTheYear(year,month,day);π Writeln(today);π readln;πend. 11 05-28-9313:37ALL SEAN PALMBER DAYSOFWK.PAS IMPORT 6 ╬N║┐ {πSEAN PALMERππ> This is kinda primative, but it will work, and hopefully ifπ> someone else has a more elegant way of testing a set, theyπ> will jump inπ}ππUsesπ Crt;πTypeπ days = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);ππVarπ d : days;ππConstπ fullWeek : set of days = [Sun..Sat];π weekend : set of days = [Sun, Sat];π weekDays : set of days = [Mon..Fri];π weekChars : Array[days] of Char = ('S','M','T','W','T','F','S');ππbeginπ Writeln;π For d := Sun to Sat doπ beginπ if d in weekDays thenπ TextAttr := 14π elseπ TextAttr := 7;π Write(weekChars[d]);π end;π Writeln;π TextAttr := 7;πend.π 12 05-28-9313:37ALL JEAN MEEUS EASTER.PAS IMPORT 17 ╬N(╖ { ===============================================================π From chapter 4 of "Astronomical Formulae for Calculators" 2ndπ edition; by Jean Meeus; publisher: Willmann-Bell Inc.,π ISBN 0-943396-01-8 ...ππ Date of Easter.ππ The method used below has been given by Spencer Jones in hisπ book "General Astronomy" (pages 73-74 of the edition of 1922).π It has been published again in the "Journal of the Britishπ Astronomical Association", Vol.88, page 91 (December 1977)π where it is said that it was devised in 1876 and appeared inπ the Butcher's "Ecclesiastical Calendar."ππ Unlike the formula given by Guass, this method has no exceptionπ and is valid for all years in the Gregorian calendar, that isπ from the year 1583 on.ππ [...text omitted...]ππ The extreme dates of Easter are March 22 (as in 1818 and 2285)π and April 25 (as in 1886, 1943, 2038).π ===============================================================ππ The following Modula-2 code by Greg Vigneault, April 1993.ππ Converted To Pascal by Kerry Sokalskyπ}πProcedure FindEaster(Year : Integer);π{ Year MUST be greater than 1583 }πVARπ a, b, c,π d, e, f,π g, h, i,π k, l, m,π n, p : INTEGER;π Month : String[5];πBEGINπ If Year < 1583 thenπ beginπ Writeln('Year must be 1583 or later.');π Exit;π end;ππ a := Year MOD 19;π b := Year DIV 100;π c := Year MOD 100;π d := b DIV 4;π e := b MOD 4;π f := (b + 8) DIV 25;π g := (b - f + 1) DIV 3;π h := (19 * a + b - d - g + 15) MOD 30;π i := c DIV 4;π k := c MOD 4;π l := (32 + 2 * e + 2 * i - h - k) MOD 7;π m := (a + 11 * h + 22 * l) DIV 451;π p := (h + l - 7 * m + 114);π n := p DIV 31; (* n = month number 3 or 4 *)π p := (p MOD 31) + 1; (* p = day in month *)ππ IF (n = 3) THENπ Month := 'March'π ELSEπ Month := 'April';ππ WriteLn('The date of Easter for ', Year : 4, ' is: ', Month, p : 3);ππEND;πππbeginπ FindEaster(1993);πend. 13 05-28-9313:37ALL SWAG SUPPORT TEAM LEAPYEAR.PAS IMPORT 5 ╬N|≥ {π> I'm doing some date routines and I need to know if it is a leap year toπ> validate a date.. A leap year is evenly divisble by 4.. I have noπ> idea how to check to see if a remainder is present.. I'm going to tryπ> to read my manauls and stuff... but I'd appreciate any help! Thanks!π}ππ LeapYear := Byte((Year mod 4 = 0) and (Month = 2));ππ if LeapYear = 1 thenπ if Byte((Year mod 100 = 0) and (Year mod 400 <> 0)) = 1 thenπ LeapYear := 0;ππ 14 05-28-9313:37ALL SWAG SUPPORT TEAM PACKTIME.PAS IMPORT 21 ╬Nx° {>I noticed that Pascal has Functions called unpacktime() and packtime().π>Does anyone know how these two Functions work? I need either a sourceπ>code example of the equiValent or just a plain algorithm to tell me howπ>these two Functions encode or Decode and date/time into a LongInt.ππ The packed time Format is a 32 bit LongInt as follows:ππ bits fieldπ ---- -----π 0-5 = secondsπ 6-11 = minutesπ 12-16 = hoursπ 17-21 = daysπ 22-25 = monthsπ 26-31 = yearsππ DateTime is a Record structure defined Within the Dos Unit With theπ following structure:ππ DateTime = Recordπ year,month,day,hour,min,sec : Wordπ end;ππ The GetFtime Procedure loads the date/time stamp of an opened Fileπ into a LongInt. UnPackTime extracts the Various bit patterns into theπ DateTime Record structure. PackTime will take the Values you Assignπ to the DateTime Record structure and pack them into a LongInt - youπ could then use SetFTime to update the File date stamp. A small sampleπ Program follows.π}πProgram prg30320;ππUsesπ Dos;ππVarπ TextFile : Text;π Filetime : LongInt;π dt : DateTime;ππbeginπ Assign(TextFile,'TextFile.txt');π ReWrite(TextFile);π WriteLn(TextFile,'Hi, I''m a Text File');π GetFtime(TextFile,Filetime);π Close(TextFile);π UnPackTime(Filetime,dt);π WriteLn('File was written: ',dt.month,'/',dt.day,'/',dt.year,π ' at ',dt.hour,':',dt.min,':',dt.sec);π ReadLn;πend.ππ{πThe following example shows how to pick apart the packed date/time.π}ππProgram PKTIME;πUsesπ Dos;ππVarπ dt : DateTime;π pt : LongInt;π Year : 0..127; { Years sInce 1980 }π Month : 1..12; { Month number }π Day : 1..31; { Day of month }π Hour : 0..23; { Hour of day }π Min : 0..59; { Minute of hour }π Sec2 : 0..29; { Seconds divided by 2 }ππProcedure GetDateTime(Var dt : DateTime);π{ Get current date and time. Allow For crossing midnight during execution. }πVarπ y, m, d, dow : Word;π Sec100 : Word;πbeginπ GetDate(y, m, d, dow);π GetTime(dt.Hour, dt.Min, dt.Sec, Sec100);π GetDate(dt.Year, dt.Month, dt.Day, dow);π if dt.Day <> d thenπ GetTime(dt.Hour, dt.Min, dt.Sec, Sec100);πend;ππbeginπ GetDateTime(dt);π PackTime(dt, pt);π Year := (pt shr 25) and $7F;π Month := (pt shr 21) and $0F;π Day := (pt shr 16) and $1F;π Hour := (pt shr 11) and $1F;π Min := (pt shr 5) and $3F;π Sec2 := pt and $1F;π WriteLn(Month, '/', Day, '/', Year+1980);π WriteLn(Hour, ':', Min, ':', Sec2*2);πend.π 15 05-28-9313:37ALL TREVOR J. CARLSEN TCDATE.PAS IMPORT 88 ╬Ná┼ Unit TCDate;ππ { Author: Trevor J Carlsen Released into the public domain }π { PO Box 568 }π { Port Hedland }π { Western Australia 6721 }π { Voice +61 91 732 026 }ππInterfaceππUses Dos;ππTypeπ Date = Word;π UnixTimeStamp = LongInt;ππConstπ WeekDays : Array[0..6] of String[9] =π ('Sunday','Monday','Tuesday','Wednesday','Thursday',π 'Friday','Saturday');π months : Array[1..12] of String[9] =π ('January','February','March','April','May','June','July',π 'August','September','October','November','December');ππFunction DayofTheWeek(pd : date): Byte;π { Returns the day of the week For any date Sunday = 0 .. Sat = 6 }π { pd = a packed date as returned by the Function PackedDate }π { eg... Writeln('today is ',WeekDays[DayofTheWeek(today))]; }ππFunction PackedDate(yr,mth,d: Word): date;π { Packs a date into a Word which represents the number of days since }π { Dec 31,1899 01-01-1900 = 1 }ππFunction UnixTime(yr,mth,d,hr,min,sec: Word): UnixTimeStamp;π { Packs a date and time into a four Byte unix style Variable which }π { represents the number of seconds that have elapsed since midnight }π { on Jan 1st 1970. }ππProcedure UnPackDate(Var yr,mth,d: Word; pd : date);π { Unpacks a Word returned by the Function PackedDate into its }π { respective parts of year, month and day }ππProcedure UnPackUnix(Var yr,mth,d,hr,min,sec: Word; uts: UnixTimeStamp);π { Unpacks a UnixTimeStamp Variable into its Component parts. }ππFunction DateStr(pd: date; Format: Byte): String;π { Unpacks a Word returned by the Function PackedDate into its }π { respective parts of year, month and day and then returns a String }π { Formatted according to the specifications required. }π { if the Format is > 9 then the day of the week is prefixed to the }π { returned String. }π { Formats supported are: }π { 0: dd/mm/yy }π { 1: mm/dd/yy }π { 2: dd/mm/yyyy }π { 3: mm/dd/yyyy }π { 4: [d]d xxx yyyy (xxx is alpha month of 3 Chars) }π { 5: xxx [d]d, yyyy }π { 6: [d]d FullAlphaMth yyyy }π { 7: FullAlphaMth [d]d, yyyy }π { 8: [d]d-xxx-yy }π { 9: xxx [d]d, 'yy } π πFunction ValidDate(yr,mth,d : Word; Var errorcode : Byte): Boolean;π { Validates the date and time data to ensure no out of range errors }π { can occur and returns an error code to the calling Procedure. A }π { errorcode of zero is returned if no invalid parameter is detected. }π { Errorcodes are as follows: }ππ { Year out of range (< 1901 or > 2078) bit 0 of errorcode is set. }π { Month < 1 or > 12 bit 1 of errorcode is set. }π { Day < 1 or > 31 bit 2 of errorcode is set. }π { Day out of range For month bit 2 of errorcode is set. }ππProcedure ParseDateString(Var dstr; Var y,m,d : Word; Format : Byte);π { Parses a date String in several Formats into its Component parts }π { It is the Programmer's responsibility to ensure that the String }π { being parsed is a valid date String in the Format expected. }π { Formats supported are: }π { 0: dd/mm/yy[yy] }π { 1: mm/dd/yy[yy] } ππFunction NumbofDaysInMth(y,m : Word): Byte;π { returns the number of days in any month }ππFunction IncrMonth(pd: date; n: Word): date;π { Increments pd by n months. }ππFunction today : date;π { returns the number of days since 01-01-1900 }ππFunction ordDate (Y,M,D : Word):LongInt; { returns ordinal Date yyddd }ππFunction Dateord (S : String) : String; { returns Date as 'yymmdd' }ππππ{============================================================================= }ππImplementationππ Constπ TDays : Array[Boolean,0..12] of Word =π ((0,31,59,90,120,151,181,212,243,273,304,334,365),π (0,31,60,91,121,152,182,213,244,274,305,335,366));π UnixDatum = LongInt(25568);π SecsPerDay = 86400;π SecsPerHour = LongInt(3600);π SecsPerMin = LongInt(60);π MinsPerHour = 60;ππFunction DayofTheWeek(pd : date): Byte;π beginπ DayofTheWeek := pd mod 7;π end; { DayofTheWeek }ππFunction PackedDate(yr,mth,d : Word): date;π { valid For all years 1901 to 2078 }π Varπ temp : Word;π lyr : Boolean;π beginπ lyr := (yr mod 4 = 0);π if yr >= 1900 thenπ dec(yr,1900);π temp := yr * Word(365) + (yr div 4) - ord(lyr);π inc(temp,TDays[lyr][mth-1]);π inc(temp,d);π PackedDate := temp;π end; { PackedDate }ππFunction UnixTime(yr,mth,d,hr,min,sec: Word): UnixTimeStamp;π { Returns the number of seconds since 00:00 01/01/1970 }π beginπ UnixTime := SecsPerDay * (PackedDate(yr,mth,d) - UnixDatum) +π SecsPerHour * hr + SecsPerMin * min + sec;π end; { UnixTime }ππProcedure UnPackDate(Var yr,mth,d: Word; pd : date);π { valid For all years 1901 to 2078 }π Varπ julian : Word;π lyr : Boolean;π beginπ d := pd;π yr := (LongInt(d) * 4) div 1461;π julian := d - (yr * 365 + (yr div 4));π inc(yr,1900);π lyr := (yr mod 4 = 0);π inc(julian,ord(lyr));π mth := 0;π While julian > TDays[lyr][mth] doπ inc(mth);π d := julian - TDays[lyr][mth-1];π end; { UnPackDate }ππProcedure UnPackUnix(Var yr,mth,d,hr,min,sec: Word; uts: UnixTimeStamp);π Varπ temp : UnixTimeStamp;π beginπ UnPackDate(yr,mth,d,date(uts div SecsPerDay) + UnixDatum);π temp := uts mod SecsPerDay;π hr := temp div SecsPerHour;π min := (temp mod SecsPerHour) div MinsPerHour;π sec := temp mod SecsPerMin;π end; { UnPackUnix }ππFunction DateStr(pd: date; Format: Byte): String;ππ Varπ y,m,d : Word;π YrStr : String[5];π MthStr : String[11];π DayStr : String[8];π TempStr : String[5];π beginπ UnpackDate(y,m,d,pd);π str(y,YrStr);π str(m,MthStr);π str(d,DayStr);π TempStr := '';π if Format > 9 then π TempStr := copy(WeekDays[DayofTheWeek(pd)],1,3) + ' ';π if (Format mod 10) < 4 then beginπ if m < 10 then π MthStr := '0'+MthStr;π if d < 10 thenπ DayStr := '0'+DayStr;π end;π Case Format mod 10 of { Force Format to a valid value }π 0: DateStr := TempStr+DayStr+'/'+MthStr+'/'+copy(YrStr,3,2);π 1: DateStr := TempStr+MthStr+'/'+DayStr+'/'+copy(YrStr,3,2);π 2: DateStr := TempStr+DayStr+'/'+MthStr+'/'+YrStr;π 3: DateStr := TempStr+MthStr+'/'+DayStr+'/'+YrStr;π 4: DateStr := TempStr+DayStr+' '+copy(months[m],1,3)+' '+YrStr;π 5: DateStr := TempStr+copy(months[m],1,3)+' '+DayStr+' '+YrStr;π 6: DateStr := TempStr+DayStr+' '+months[m]+' '+YrStr;π 7: DateStr := TempStr+months[m]+' '+DayStr+' '+YrStr;π 8: DateStr := TempStr+DayStr+'-'+copy(months[m],1,3)+'-'+copy(YrStr,3,2);π 9: DateStr := TempStr+copy(months[m],1,3)+' '+DayStr+', '''+copy(YrStr,3,2);π end; { Case } π end; { DateStr }ππFunction ValidDate(yr,mth,d : Word; Var errorcode : Byte): Boolean;π beginπ errorcode := 0;π if (yr < 1901) or (yr > 2078) thenπ errorcode := (errorcode or 1);π if (d < 1) or (d > 31) thenπ errorcode := (errorcode or 2);π if (mth < 1) or (mth > 12) thenπ errorcode := (errorcode or 4);π Case mth ofπ 4,6,9,11: if d > 30 then errorcode := (errorcode or 2);π 2: if d > (28 + ord((yr mod 4) = 0)) thenπ errorcode := (errorcode or 2);π end; {Case }π ValidDate := (errorcode = 0);π if errorcode <> 0 then Write(#7);π end; { ValidDate }ππProcedure ParseDateString(Var dstr; Var y,m,d : Word; Format : Byte);π Varπ left,middle : Word;π errcode : Integer;π st : String Absolute dstr;π beginπ val(copy(st,1,2),left,errcode);π val(copy(st,4,2),middle,errcode);π val(copy(st,7,4),y,errcode);π Case Format ofπ 0: beginπ d := left;π m := middle;π end;π 1: beginπ d := middle;π m := left;π end;π end; { Case }π end; { ParseDateString }π πFunction NumbofDaysInMth(y,m : Word): Byte;π { valid For the years 1901 - 2078 }π beginπ Case m ofπ 1,3,5,7,8,10,12: NumbofDaysInMth := 31;π 4,6,9,11 : NumbofDaysInMth := 30;π 2 : NumbofDaysInMth := 28 +π ord((y mod 4) = 0);π end;π end; { NumbofDaysInMth }ππFunction IncrMonth(pd: date; n: Word): date;π Var y,m,d : Word;π beginπ UnpackDate(y,m,d,pd);π dec(m);π inc(m,n);π inc(y,m div 12); { if necessary increment year }π m := succ(m mod 12);π if d > NumbofDaysInMth(y,m) thenπ d := NumbofDaysInMth(y,m);π IncrMonth := PackedDate(y,m,d);π end; { IncrMonth }ππFunction today : date;π Var y,m,d,dw : Word;π beginπ GetDate(y,m,d,dw);π today := PackedDate(y,m,d);π end; { today }ππFunction ordDate (Y,M,D : Word): LongInt; { returns ordinal Date as yyddd }πVar LYR : Boolean;π TEMP : LongInt;πbeginπ LYR := (Y mod 4 = 0) and (Y <> 1900);π Dec (Y,1900);π TEMP := LongInt(Y) * 1000;π Inc (TEMP,TDays[LYR][M-1]); { Compute # days through last month }π Inc (TEMP,D); { # days this month }π ordDate := TEMPπend; { ordDate }ππFunction Dateord (S : String) : String; { returns Date as 'yymmdd' }πVar LYR : Boolean;π Y,M,D : Word;π TEMP : LongInt;π N : Integer;π StoP : Boolean;π SW,ST : String[6];πbeginπ Val (Copy(S,1,2),Y,N); Val (Copy(S,3,3),TEMP,N);π Inc (Y,1900); LYR := (Y mod 4 = 0) and (Y <> 1900); Dec (Y,1900);π N := 0; StoP := False;π While not StoP and (TDays[LYR][N] < TEMP) doπ Inc (N);π M := N; { month }π D := TEMP-TDays[LYR][M-1]; { subtract # days thru this month }π Str(Y:2,SW); Str(M:2,ST);π if ST[1] = ' ' then ST[1] := '0'; SW := SW+ST;π Str(D:2,ST);π if ST[1] = ' ' then ST[1] := '0'; SW := SW+ST;π Dateord := SWπend; { Dateord }πππππend. { Unit TCDate }π 16 05-28-9313:37ALL JAMES MILLER TIME1.PAS IMPORT 31 ╬N└% {Does anyone have any code that takes a minutes figure away from the dateπand time ?πThe following should do the trick. note that it Uses a non-TP-standardπdate/time Record structure, but you could modify it if you wanted to.ππ------------------------------------------------------------------------------π}ππUnit timeadj;ππInterfaceππTypeππtimtyp = Record {time Record}π hour : Byte;π min : Byte;π end;ππdattyp = Record {date Record}π year : Integer;π mon : Byte;π day : Byte;π dayno: Byte;π end;ππdttyp = Record {date time Record}π time : timtyp;π date : dattyp;π end;ππFunction adjtime(od : dttyp ; nmins : Integer ; Var nd : dttyp) : Boolean;π {add/subtract nmins to od to give nd}π {return T if day change}ππImplementationππ{Date/Julian Day conversion routinesπ Valid from 1582 onwardsπ from James Miller G3RUH, Cambridge, England}ππConstπ{days in a month}πmonthd : Array [1..12] of Byte = (31,28,31,30,31,30,31,31,30,31,30,31);ππd0 : LongInt = -428; {James defines this as the general day number}ππProcedure date2jul(Var dn : LongInt ; dat : dattyp);π{calc julian date DN from date DAT}πVarπm : Byte;ππbeginπ With dat doπ beginπ m := mon;π if m <= 2 thenπ beginπ m := m + 12;π dec(year);π end;π dn := d0 + day + trunc(30.61 * (m + 1)) + trunc(365.25 * year) +π {the next line may be omitted if only used from Jan 1900 to Feb 2100}π trunc(year / 400) - trunc(year / 100) + 15;π endπend; {date2jul}ππProcedure jul2date(dn : LongInt ; Var dat : dattyp);π{calc date DAT from julian date DN}πVarπd : LongInt;ππbeginπ With dat doπ beginπ d := dn - d0;π dayno := (d + 5) mod 7;π {the next line may be omitted if only used from Jan 1900 to Feb 2100}π d := d + trunc( 0.75 * trunc(1.0 * (d + 36387) / 36524.25)) - 15;π year := trunc((1.0 * d - 122.1) / 365.25);π d := d - trunc(365.25 * year);π mon := trunc(d / 30.61);π day := d - trunc(30.61 * mon);π dec(mon);π if mon > 12 thenπ beginπ mon := mon - 12;π inc(year);π end;π end;πend; {jul2date}ππFunction juld2date(jul : Word ; Var jd : dattyp) : Boolean;π{convert julian day to date}π{ret T if no err}ππVarπsum : Integer;πj : LongInt;ππbeginπ if jul > 366 thenπ beginπ juld2date := False;π Exit;π endπ elseπ juld2date := True;π if (jd.year mod 4) = 0 thenπ monthd[2] := 29π elseπ monthd[2] := 28;π sum := 0;π jd.mon := 0;π Repeatπ inc(jd.mon);π sum := sum + monthd[jd.mon];π Until sum >= jul;π sum := sum - monthd[jd.mon];π jd.day := jul - sum;π date2jul(j,jd);π jul2date(j,jd);πend; {juld2date}ππProcedure adjdate(od : dattyp ; ndays : Integer ; Var nd : dattyp);π {add/subtract ndays to od to give nd}ππVarπj : LongInt;ππbeginπ date2jul(j,od);π j := j + ndays;π jul2date(j,nd);πend;ππFunction adjtime(od : dttyp ; nmins : Integer ; Var nd : dttyp) : Boolean;π {add/subtract nmins to od to give nd}π {return T if day change}πVarπemins : Integer;πtnd : dttyp; {needed in Case routine called With od & nd the same}ππbeginπ adjtime := False;π tnd := od;π emins := od.time.hour*60 + od.time.min + nmins;π if emins > 1439 thenπ beginπ adjtime := True;π emins := emins - 1440;π adjdate(od.date,1,tnd.date);π end;π if emins < 0 thenπ beginπ adjtime := True;π emins := emins + 1440;π adjdate(od.date,-1,tnd.date);π end;π tnd.time.hour := emins div 60;π tnd.time.min := emins mod 60;π nd := tnd;πend; {adjtime}ππend.π 17 05-28-9313:37ALL SWAG SUPPORT TEAM TIME2.PAS IMPORT 12 ╬Nα├ { PW>question, I want to declare Type Time as (Hour,Min). Where hour andπ PW>minute are predeifed Types 0..23 and 0..59 respectively. I then takeπ PW>the Type Time and use it as a field in a Record. How would I promt aπ PW>user to enter the time? Ie. Enter (date,min): ??? Is there a way to doπ PW>this without reading a String and then Formatting it and changing it toπ PW>Integers?π}π It can be done, but it's probably not worth the efFort to process it thatπway. I do this a lot, and I allow entering the Time as hh:mm or hhmm, whereπit's simply a String. then, I parse out the ":", if it exists, and do a coupleπof divide and mod operations to then convert it to seconds - and store it thatπway. I also have a routine which will Format seconds into time. I do thisπenough (I'm in the race timing business), that I've found it easy to do thisπthroughout my system - and keep all data in seconds. I have aπparsing/conversion routine and a conversion/display routine in my global Unit.πSomething like this:ππVar S : String;π I,T,N : Word;ππ Write ('Enter Time as hh:mm '); readln (S);π if Pos(':',S) > 0 then Delete (S,Pos(':',S),1); Val (S,I,N);π T := ((I div 100) * 3600) + ((I mod 100) * 60);ππ There should be some error-checking in this, but I'm sure you can figure itπout...π 18 05-28-9313:37ALL DAVID DRZYZGA TIME3.PAS IMPORT 5 ╬N╝' { DAVID DRZYZGA }ππProgram timetest;πUsesπ Dos;ππFunction time : String;πVarπ reg : Registers;π h, m, s : String[2];ππ Function tch(s : String) : String;π Varπ temp : String[2];π beginπ temp := s;π if length(s) < 2 thenπ tch := '0' + tempπ elseπ tch := temp;π end;ππbeginπ reg.ax := $2c00;π intr($21, reg);π str(reg.cx shr 8, h);π str(reg.cx mod 256, m);π str(reg.dx shr 8, s);π time := tch(h) + ':' + tch(m) + ':' + tch(s);πend;ππbeginπ Writeln(time);πend.π 19 05-28-9313:37ALL MIKE COPELAND TIMEFORM.PAS IMPORT 10 ╬N(Σ {πMIKE COPELANDππ> I'm looking For some FAST routines to change seconds into aπ> readable format, (ie. H:M:S).π> For instance, 8071 seconds = 2:14:31ππ Here's the code I use, and it's fast enough For me:π}ππTypeπ Str8 = String[8];ππFunction FORMAT_TIME (V : Integer) : STR8; { format time as hh:mm:ss }πVarπ X, Z : Integer;π PTIME : STR8;πbegin { note: incoming time is in seconds }π Z := ord('0');π PTIME := ' : : '; { initialize }π X := V div 3600;π V := V mod 3600; { process hours }π if (X > 0) and (X <= 9) thenπ PTIME[2] := chr(X+Z)π elseπ if X = 0 thenπ PTIME[3] := ' ' { zero-suppress }π elseπ PTIME[2] := '*'; { overflow... }π X := V div 60;π V := V mod 60; { process minutes }π PTIME[4] := chr((X div 10)+Z);π PTIME[5] := chr((X mod 10)+Z);π PTIME[7] := chr((V div 10)+Z); { process seconds }π PTIME[8] := chr((V mod 10)+Z);π FORMAT_TIME := PTIMEπend; { FORMAT_TIME }ππbeginπ Writeln(Format_Time(11122));πend. 20 06-22-9309:11ALL SWAG SUPPORT TEAM OOP Calendar Unit IMPORT 27 ╬Nù╘ UNIT CalUnit;π{ Object oriented calander unit }ππINTERFACEππUSES CRT,DOS;ππTYPEπ Calendar = OBJECTπ ThisMonth, ThisYear : Word;π CONSTRUCTOR Init(Month, Year: Integer);π PROCEDURE DrawCalendar;π PROCEDURE SetMonth(Month: Integer);π PROCEDURE SetYear(Year: Integer);π FUNCTION GetMonth: Integer;π FUNCTION GetYear: Integer;π DESTRUCTOR Done;π END;ππIMPLEMENTATIONππCONSTRUCTOR Calendar.Init(Month, Year: Integer);πBEGINπ SetYear(Year);π SetMonth(Month);π DrawCalendar;πEND;ππPROCEDURE Calendar.DrawCalendar;ππVARπ CurYear,CurMonth,CurDay,CurDow,π ThisDay,ThisDOW : Word;π I,DayPos,NbrDays : Byte;ππCONSTπ DOM: ARRAY[1..12] OF Byte =π (31,28,31,30,31,30,31,31,30,31,30,31);π MonthName: ARRAY[1..12] OF String[3] =π ('Jan','Feb','Mar','Apr','May','Jun',π 'Jul','Aug','Sep','Oct','Nov','Dec');ππBEGINππ GetDate(CurYear,CurMonth,CurDay,CurDow);ππ {Set to day 1 so we can use GetDate function}π ThisDay := 1;ππ SetDate(ThisYear,ThisMonth,ThisDay);ππ {ThisDOW stands for This day of the week}ππ GetDate(ThisYear,ThisMonth,ThisDay,ThisDOW);ππ SetDate(CurYear,CurMonth,CurDay);ππ WriteLn(' ',MonthName[ThisMonth],π ' ',ThisYear);π WriteLn;π WriteLn(' S M T W R F S');ππ NbrDays := DOM[ThisMonth];ππ {Check for leap year, which occurs when theπ year is evenly divisible by 4 and not evenlyπ divisable by 100 or if the year is evenlyπ divisable by 400}ππ IF ((ThisMonth = 2) ANDπ ((ThisYear MOD 4 = 0) ANDπ (ThisYear MOD 100 <> 0))π OR (ThisYear MOD 400 = 0))π THEN NbrDays := 29;ππ FOR I:= 1 TO NbrDays DOπ BEGINπ DayPos := ThisDOW * 4 + 2; {Position day #}π GotoXY(DayPos,WhereY);π Inc(ThisDOW);π Write(I:3);π IF ThisDOW > 6 THENπ BEGINπ ThisDOW := 0;π WriteLnπ ENDπ END;π WriteLnπEND;ππPROCEDURE Calendar.SetMonth(Month: Integer);πBEGINπ ThisMonth := Month;π WHILE ThisMonth < 1 DOπ BEGINπ Dec(ThisYear);π Inc(ThisMonth, 12);π END;π WHILE ThisMonth > 12 DOπ BEGINπ Inc(ThisYear);π Dec(ThisMonth, 12);π END;πEND;ππPROCEDURE Calendar.SetYear(Year: Integer);πBEGINπ ThisYear := Year;πEND;ππFUNCTION Calendar.GetMonth: Integer;πBEGINπ GetMonth := ThisMonth;πEND;ππFUNCTION Calendar.GetYear: Integer;πBEGINπ GetYear := ThisYear;πEND;ππDESTRUCTOR Calendar.Done;πBEGINπ {for dynamic object instances,π the Done method still works evenπ though it contains nothing exceptπ the destructor declaration }πEND;ππEND.ππ{ --------------------------- TEST PROGRAM ---------------------}πPROGRAM CalTest;ππUSES DOS,CRT,CalUnit;ππVARπ MyCalendar: Calendar;π TYear,TMonth,Tday,TDOW: Word;ππBEGINπ ClrScr;π GetDate(TYear,TMonth,Tday,TDOW);π WITH MyCalendar DOπ BEGINπ WriteLn(' Current Month''s Calendar');π WriteLn;π Init(TMonth, TYear);π WHILE (TMonth <> 0) DOπ BEGINπ WriteLn;π WriteLn(' Enter a Month and Year');π WriteLn('(Separate values by a space)');π WriteLn;π WriteLn(' exm. 3 1990');π WriteLn;π Write (' or 0 0 to quit: ');π ReadLn(TMonth, TYear);π IF TMonth <> 0 THENπ BEGINπ ClrScr;π SetYear(TYear);π SetMonth(TMonth);π DrawCalendarπ ENDπ ENDπ END;π ClrScrπEND.ππ 21 06-22-9309:13ALL CYRUS PATEL Day of the Week IMPORT 19 ╬NQc ===========================================================================π BBS: The Beta ConnectionπDate: 06-07-93 (00:10) Number: 773πFrom: CYRUS PATEL Refer#: 744π To: STEPHEN WHITIS Recvd: NO πSubj: DATE CALCULATIONS Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------πSW>Does anyone know where I can find an algorithm, or better yet TPπSW>5.5 code, to calculate the day of the week for a give date?ππHere's TP source for day of the week...ππConstπ CurrentYear = 1900;ππTypeπ DateStr: String[8];πππProcedure ConvDate(DateStr: DateRecord;π Var Month, Day, Year: Word);ππ {this converts the date from string to numbers for month, day, and year}ππ Varπ ErrorCode: Integer;ππ Beginπ Val(Copy(DateStr, 1, 2), Month, ErrorCode);π Val(Copy(DateStr, 4, 2), Day, ErrorCode);π Val(Copy(DateStr, 7, 2), Year, ErrorCode);π Year := Year + CurrentYearπ End;πππFunction Dow(DateStr: DateRecord): Byte;ππ {this returns the Day Of the Week as follows:π Sunday is 1, Monday is 2, etc... Saturday is 7}ππ Varπ Month, Day, Year, Y1, Y2: Word;ππ Beginπ ConvDate(DateStr, Month, Day, Year);π If Month < 3 thenπ Beginπ Month := Month + 10;π Year := Year - 1π Endπ elseπ Month := Month - 2;π Y1 := Year Div 100;π Y2 := Year Mod 100;π Dow := ((Day + Trunc(2.6 * Month - 0.1) + Y2 + Y2 Div 4 + Y1 Div 4 - 2 *π Y1 + 49) Mod 7) + 1π End;πππHere's an example of how to use it...ππBeginπ Case Dow('06/06/93') ofπ 1: Write('Sun');π 2: Write('Mon');π 3: Write('Tues');π 4: Write('Wednes');π 5: Write('Thurs');π 6: Write('Fri');π 7: Write('Satur')π End;π WriteLn('day')πEnd.πππSW>And I just know I've run across an algorithm or code to do thisπSW>before, but it was a while back, and I've looked in the places IπSW>thought it might have been. Any ideas?ππYou might want to take a look at Dr. Dobbs from a few months backπ(earlier this year), they had an whole issue related to datesππCyrusπ---π ■ SPEED 1·30 #666 ■ 2! 4! 6! 8! It's time to calculate! 2 24 720 40,32π * Midas Touch of Chicago 312-764-0591/0761 DUAL STDπ * PostLink(tm) v1.06 MIDAS (#887) : RelayNet(tm) Hubπ 22 06-22-9309:13ALL KELLY SMALL Another Day of the Week IMPORT 15 ╬NQc ===========================================================================π BBS: The Beta ConnectionπDate: 06-07-93 (18:50) Number: 823πFrom: KELLY SMALL Refer#: 744π To: STEPHEN WHITIS Recvd: NO πSubj: DATE CALCULATIONS Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------π SW│ Does anyone know where I can find an algorithm, or better yet TPπ SW│ 5.5 code, to calculate the day of the week for a give date?ππGive this a whirl:ππfunction LeapYearOffset(M,Y:Word):Integer;π Beginπ if ((Y mod 400 = 0) or ((Y mod 100 <> 0) and (Y mod 4 = 0)))π and (M > 2)π then LeapYearOffset := 1π else LeapYearOffset := 0π End;ππFunction DaysinMonth(dMonth,dYear:Word):Byte;π Beginπ case dMonth ofπ 1,3,5,7,8,10,12 : DaysInMonth := 31;π 4,6,9,11 : DaysInMonth := 30;π 2 : DaysInMonth := 28 + LeapYearOffset(3,dYear)π End;π End;ππFunction FindDayOfWeek(Day, Month, Year: Integer) : Byte;πvarπ century, yr, dw: Integer;πbeginπ if Month < 3 thenπ beginπ Inc(Month, 10);π Dec(Year);π endπ elseπ Dec(Month, 2);π century := Year div 100;π yr := year mod 100;π dw := (((26 * month - 2) div 10) + day + yr + (yr div 4) +π (century div 4) - (2 * century)) mod 7;π if dw < 0 then FindDayOfWeek := dw + 7π else FindDayOfWeek := dw;πend;ππ ⌠/ellyπ ⌡mallππ---π ■ JABBER v1.2 #18 ■ Bigamy: too many wives. Monogamy: see Bigamyπ ■ KMail 2.94 The Wish Book BBS (60π2)258-7113 (6+ nodes, ring down)π * The Wish Book 602-258-7113(6 lines)10+ GIGs/The BEST board in Arizona!π * PostLink(tm) v1.06 TWB (#1032) : RelayNet(tm)π 23 08-18-9312:19ALL JOSE ALMEIDA Get ROM Bios Date IMPORT 8 ╬Nûd { Gets the ROM BIOS date in a ASCII string.π Part of the Heartware Toolkit v2.00 (HTelse.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION ROM_Bios_Date : String8;π{ DESCRIPTION:π Gets the ROM BIOS date in a ASCII string.π SAMPLE CALL:π S := ROM_Bios_Dateπ RETURNS:π e.g., '06/10/85'.π NOTES:π Later versions of the Compaq have this release date shifted by 1 byte,π to start at F000:FFF6h }ππvarπ Tmp : String8;ππBEGIN { ROM_Bios_Date }π FillChar(Tmp,0,8);π Tmp[0] := Chr(8);π Move(Mem[$F000:$FFF5],Tmp[1],8);π ROM_Bios_Date := Tmp;πEND; { ROM_Bios_Date }π 24 08-27-9320:39ALL SWAG SUPPORT TEAM Time and Int28 IMPORT 24 ╬NÜ∙ PROGRAM TestInt28;ππ{$M 2048,0,1024}ππUSESπ DOS, CRT;ππCONSTπ StatBarColor : WORD = $74;ππVARπ DosIdleVec : PROCEDURE;ππfunction Time(Hour_12 : Boolean) : String;π{ This function will return a string that contains the time in }π{ a format as follows: HH:MM:SS am/pm or HH:MM:SS }πconstπ am = 'am';π pm = 'pm';π zero = '0';πvarπ Hour,π Minute,π Second,π Sec100 : Word;π Hr,π Min,π Sec : String[2]; { Used in time combining }πbeginπ GetTime(Hour, Minute, Second, Sec100); { Get the system time }π if Hour <= 12 thenπ beginπ Str(Hour, HR); { Convert Hour to string }π If Hour = 0 then { Fix for MIDNIGHT }π if Hour_12 thenπ HR := '12'π elseπ HR := ' 0';π endπ elseπ If Hour_12 thenπ Str(Hour - 12, HR) { Convert Hour to string }π elseπ Str(Hour, HR);π if Length(Hr) = 1 then { Fix hour for right time }π Insert(' ', HR, 1);π Str(Minute, Min); { Convert Minute to string }π if Length(Min) = 1 thenπ Min := zero + Min; { Make Min two char }π Str(Second, Sec); { Convert Second to string }π if Length(Sec) = 1 thenπ Sec := zero + Sec; { Make sec two chars }π If Hour_12 then { We want 12 hour time }π If Hour >= 12 thenπ Time := Hr + ':' + Min + ':' + Sec + ' ' + pmπ elseπ Time := Hr + ':' + Min + ':' + Sec + ' ' + amπ else { We want 24 hour time }π Time := Hr + ':' + Min + ':' + Sec;πend;ππPROCEDURE UpdateTime;πVARπ TheTime : STRING;π Row, Col : BYTE;π OldAttr : WORD;πBEGINπ ASMπ mov ah, 0Fh { get the active display page. }π int 10hπ mov ah, 03h { get the cursor position. }π int 10h { DH = ROW, DL = COL }π mov Row, dhπ mov Col, dlπ END;π GotoXY(69, 1);π TheTime := Time(True); { GET the time, write the time.. }π OldAttr := TextAttr; { SAVE text color. }π TextAttr := StatBarColor;π Write(TheTime);π TextAttr := OldAttr; { Restore TEXT color.... }π GotoXY(Col + 1, Row + 1); { add one because BIOS starts at 0 }πEND;ππ{$F+}πPROCEDURE DOSIDLE; INTERRUPT;πBEGINπ UpDateTime;π INLINE($9C); { push the flags. }π DosIdleVec; { call the old INT routine. }πEND;π{$F-}ππBEGINπ CheckBreak := False; { MAKE SURE USER CANNOT PRESS }π { CTRL+BREAK TO EXIT. THE }π { INTERRUPT WOULD NOT BE RESTORED. }π GetIntVec($1C, @DOSIdleVec); { Save old interrupt vector }π SetIntVec($1C, Addr(DOSIDLE));ππ ClrScr;π TextAttr := StatBarColor;π ClrEol;π Write('TEST PROGRAM FOR hooking timer interrupt, written by Mark Klaamas ▓');π GotoXY(1, 15);π TextAttr := $07;π Write('INPUT HERE PLEASE!!! ');π ReadLN;ππ SetIntVec($1C, Addr(DOSIdleVec)); { restore old interrupt vector. }πEND.π 25 10-28-9311:32ALL BRYAN VALENCIA IFDAY.PAS IMPORT 15 ╬N■ê {$R-,S+,I+,D+,T-,F-,V+,B-,N-,L+ }π{$M 16384,0,1024 }πprogram ifday;π{π***********************************************************************ππIFDAY.PASπ8/18/93πby Bryan Valencia.ππShows use of the EXEC Command to run Command.com with a command lineπtaken from user entered parameters.ππInclude IFDAY in Batch Files to Run lines only on certain days.πππ***********************************************************************π}πuses DOS, CRT;πvarπ y,m,d,dow:word;ππprocedure help;πbeginπ textattr:=yellow;π gotoxy(1,wherey); ClrEOL;π Writeln('IFDAY by Bryan Valencia [71553,3102]');π Writeln('SYNTAX');π textattr:=lightgreen;π Writeln('IFDAY [DAYOFWEEK,DAYNO] COMMAND');π WRiteln('IFDAY 4 MIRROR c: (if today is the 4th, mirror the C: drive).');π WRiteln('IFDAY MON SD C: /Unfrag (if today is Monday, run speed disk).');π Halt;πend;ππProcedure PerformCommand;πvarπ s:string;π t:byte;πBeginπ s:='';π for t:=2 to paramcount do s:=s+paramstr(t)+' ';π Writeln(s);π Exec('c:\Command.Com','/c '+s);π Halt;πend;ππFunction Checknum(i:integer):boolean;πvarπ y,m,d,dow:word;πbeginπ Getdate(y,m,d,dow);π if i=d then Checknum:=true else Checknum:=False;πend;πFunction CheckDay(S:String):boolean;πvarπ y,m,d,dow:word;π ss:string[3];πbeginπ Getdate(y,m,d,dow);π Case dow ofπ 0:SS:='SU';π 1:SS:='MO';π 2:SS:='TU';π 3:SS:='WE';π 4:SS:='TH';π 5:SS:='FR';π 6:SS:='SA';π end;π if S=SS then CheckDay:=true else CheckDay:=False;πend;πππProcedure GO;πvarπ s:string[2];π v,t:byte;π e:integer;ππBeginπ s:=paramstr(1);π for t:=1 to 2 do s[t]:=upcase(s[t]);π Val(s,v,e);π if e=0 then if Checknum(v) then PerformCommand;π if e<>0 then if CheckDay(S) then PerformCommand;πend;ππBeginπ if paramcount<2 then help else GO;πEnd. 26 10-28-9311:34ALL ANDREW KEY What is NEXT day ?? IMPORT 14 ╬Nªé {===========================================================================πDate: 10-04-93 (12:39)πFrom: ANDREW KEYπSubj: What is NEXT day ??π---------------------------------------------------------------------------π AC> My assignment is to write a program, given three integers whose valuesπ AC> represent a day between January 1, 1900 and December 30, 1999, willπ AC> output the value representing the day following.ππ AC> I am running into problems with three things. The end of a month, theπ AC> end of a year, and leap years.ππHere's a procedure you might get some ideas from... }ππprocedure NextDay(var MM,DD,YYYY: integer);π constπ DaysInMonth: array[0..1,1..12] of integer =π ((31,28,31,30,31,30,31,31,30,31,30,31), {regular year}π (31,29,31,30,31,30,31,31,30,31,30,31)); {leap year}π varπ Leap: integer;π beginπ Inc(DD); {increment day}π if (YYYY mod 4) = 0 then {is it a leap year?}π Leap:=1 {Leap year}π elseπ Leap:=0; {non-leap year}π if DD>DaysInMonth[Leap,MM] then {is DD > the end of the month?}π beginπ DD:=1; {set to 1st of month}π Inc(MM); {increment month by one}π if MM>12 then {is MM > December?}π beginπ MM:=1; {set MM to January}π Inc(YYYY); {and increment YYYY}π end; {if MM>12}π end; {if DD>Days}π end; {proc NextDay}ππ 27 11-02-9305:33ALL EARL DUNOVANT Calculate Day Of Week IMPORT 24 ╬N√¿ {πEARL DUNOVANTππ> Which date is what day For a particular month.ππZeller's Congruence is an algorithm that calculates a day of the week givenπa year, month and day. Created in 1887(!). Jeff Duntemann of PC Techniquesπfame implemented it in TP in the 11/90 issue of Dr Dobbs Journal, With aπ(115 min left), (H)elp, More? major kludge because TP's MOD operator returns a remainder instead of aπTrue mathematical modulus. I added the Kludge Alert banner that I use in myπown code.π}ππFunction CalcDayOfWeek(Year, Month, Day : Integer) : Integer;πVarπ Century,π Holder : Integer;πbeginπ { First test For error conditions on input values: }π if (Year < 0) or (Month < 1) or (Month > 12) or (Day < 1) or (Day > 31) thenπ CalcDayOfWeek := -1 { Return -1 to indicate an error }π elseπ { Do the Zeller's Congruence calculation as Zeller himself }π { described it in "Acta Mathematica" #7, Stockhold, 1887. }π beginπ { First we separate out the year and the century figures: }π Century := Year div 100;π Year := Year MOD 100;π { Next we adjust the month such that March remains month #3, }π { but that January and February are months #13 and #14, }π { *but of the previous year*: }π if Month < 3 thenπ beginπ Inc(Month, 12);π if Year > 0 thenπ Dec(Year, 1) { The year before 2000 is }π else { 1999, not 20-1... }π beginπ Year := 99;π Dec(Century);π end;π end;ππ { Here's Zeller's seminal black magic: }π Holder := Day; { Start With the day of month }π Holder := Holder + (((Month + 1) * 26) div 10); { Calc the increment }π Holder := Holder + Year; { Add in the year }π Holder := Holder + (Year div 4); { Correct For leap years }π Holder := Holder + (Century div 4); { Correct For century years }π Holder := Holder - Century - Century; { DON'T KNOW WHY HE DID THIS! }π {***********************KLUDGE ALERT!***************************}π While Holder < 0 do { Get negative values up into }π Inc(Holder, 7); { positive territory before }π { taking the MOD... }π Holder := Holder MOD 7; { Divide by 7 but keep the }π { remainder rather than the }π { quotient }π {***********************KLUDGE ALERT!***************************}π { Here we "wrap" Saturday around to be the last day: }π if Holder = 0 thenπ Holder := 7;ππ { Zeller kept the Sunday = 1 origin; computer weenies prefer to }π { start everything With 0, so here's a 20th century kludge: }π Dec(Holder);ππ CalcDayOfWeek := Holder; { Return the end product! }π end;πend;π 28 11-02-9305:57ALL VINCE LAURENT Julian Dates IMPORT 66 ╬N╟ª {πVINCE LAURENTππ> Does anyone have a fast function for sorting two dates?π> Something like function SortDate(Date1, Date2 : string): integer;π> Strings would be in the format of '1/1/94' etc.ππConvert the dates to Julian Dates first...then you can do with themπwhat you want. Here is a unit I got a long time ago...π}ππUNIT Julian;π{π////////////////////////////////////////// DEMO Routinesπ/Beginπ/ ClrScr;π/ GetDate(Year,Month,Day,Dow);ππ/ WriteLn('Year : ',Year);π/ WriteLn('Month : ',Month);π/ WriteLn('Day : ',Day);π/ WriteLn('DOW : ',Dow);π/ WriteLn(MachineDate);π/ JulianDate := DateToJulian(MachineDate);π/ WriteLn('Julian Date = ',JulianDate);π/ WriteLn('Jul To Date = ',JulianToDate(JulianDate));π/ WriteLn('Day Of Week = ',DayOfWeek(JulianDate));π/ WriteLn('Time = ',MachineTime(4));π/End.π///////////////////////////////////////////////////////////////π}πINTERFACEππUsesπ Crt, Dos;ππTypeπ Str3 = String[3];π Str8 = String[8];π Str9 = String[9];π Str11 = String[11];ππVarπ Hour,π Minute,π Second,π S100,π Year,π Month,π Day,π Dow : Word;π Syear,π Smonth,π Sday,π Sdow : String;π JulianDate : Integer;ππFunction MachineTime(Len : Byte) : Str11;πFunction MachineDate : Str8;πFunction DateFactor(MonthNum, DayNum, YearNum : Real) : Real;πFunction DateToJulian(DateLine : Str8) : Integer;πFunction JulianToDate(DateInt : Integer): Str11;πFunction JulianToStr8(DateInt : Integer): Str8;πFunction DayofWeek(Jdate : Integer) : Str3;πProcedure DateDiff(Date1,Date2 : Integer; VAR Date_Difference : Str9);ππIMPLEMENTATIONππFunction MachineTime(Len : Byte) : Str11;πVarπ I : Byte;π TempStr : String;π TimeStr : Array[1..4] Of String;ππBeginπ TempStr := '';π FillChar(TimeStr, SizeOf(TimeStr),0);π GetTime(Hour, Minute, Second, S100);π Str(Hour, TimeStr[1]);π Str(Minute, TimeStr[2]);π Str(Second, TimeStr[3]);π Str(S100, TimeStr[4]);π TempStr := TimeStr[1];π For I := 2 To Len Doπ TempStr := TempStr + ':' + TimeStr[I];π MachineTime := TempStr;πEnd;ππFunction MachineDate : Str8;πBeginπ GetDate(Year, Month, Day, Dow);π Str(Year, Syear);π Str(Month, Smonth);π If Month < 10 Thenπ Smonth := '0' + Smonth;π Str(Day,Sday);π If Day < 10 Thenπ Sday := '0' + Sday;π MachineDate := smonth + sday + syear;πEnd;ππFunction DateFactor(MonthNum, DayNum, YearNum : Real) : Real;πVarπ Factor : Real;πBeginπ Factor := (365 * YearNum) + DayNum + (31 * (MonthNum - 1));π If MonthNum < 3 Thenπ Factor := Factor + Int((YearNum-1) / 4) -π Int(0.75 * (Int((YearNum-1) / 100) + 1))π Elseπ Factor := Factor - Int(0.4 * MonthNum + 2.3) + Int(YearNum / 4) -π Int(0.75 * (Int(YearNum / 100) + 1));π DateFactor := Factor;πEnd;ππFunction DateToJulian(DateLine : Str8) : Integer;πVarπ Factor,π MonthNum,π DayNum,π YearNum : Real;π Ti : Integer;πBeginπ If Length(DateLine) = 7 Thenπ DateLine := '0' + DateLine;π MonthNum := 0.0;π For Ti := 1 to 2 Doπ MonthNum := (10 * MonthNum) + (Ord(DateLine[Ti])-Ord('0'));π DayNum := 0.0;π For Ti := 3 to 4 Doπ DayNum := (10 * DayNum) + (Ord(DateLine[Ti])-Ord('0'));π YearNum := 0.0;π For Ti := 5 to 8 Doπ YearNum := (10 * YearNum) + (Ord(DateLine[Ti])-Ord('0'));π Factor := DateFactor(MonthNum, DayNum, YearNum);π DateToJulian := Trunc((Factor - 679351.0) - 32767.0);πEnd;ππFunction JulianToDate(DateInt : Integer): Str11;πVarπ holdstr,π strDay : string[2];π anystr : string[11];π StrMonth : string[3];π stryear : string[4];π test,π error,π Year,π Dummy, I : Integer;π Save,π Temp : Real;π JulianToanystring : Str11;πBeginπ holdstr := '';π JulianToanystring := '00000000000';π Temp := Int(DateInt) + 32767 + 679351.0;π Save := Temp;π Dummy := Trunc(Temp/365.5);ππ While Save >= DateFactor(1.0,1.0,Dummy+0.0) Doπ Dummy := Succ(Dummy);π Dummy := Pred(Dummy);π Year := Dummy;π (* Determine number Of Days into current year *)π Temp := 1.0 + Save - DateFactor(1.0,1.0,Year+0.0);π (* Put the Year into the output string *)π For I := 8 downto 5 Doπ Beginπ JulianToanystring[I] := Char((Dummy mod 10) + Ord('0'));π Dummy := Dummy div 10;π End;π Dummy := 1 + Trunc(Temp/31.5);π While Save >= DateFactor(Dummy+0.0,1.0,Year+0.0) Doπ Dummy := Succ(Dummy);π Dummy := Pred(Dummy);π Temp := 1.0 + Save - DateFactor(Dummy+0.0,1.0,Year+0.0);π For I := 2 Downto 1 Doπ Beginπ JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));π Dummy := Dummy div 10;π End;π Dummy := Trunc(Temp);ππ For I := 4 Downto 3 Doπ Beginπ JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));π Dummy := Dummy div 10;π End;π holdstr := copy(juliantoanystring,1,2);π val(holdstr, test, error);π Case test Ofπ 1 : StrMonth := 'Jan';π 2 : StrMonth := 'Feb';π 3 : StrMonth := 'Mar';π 4 : StrMonth := 'Apr';π 5 : StrMonth := 'May';π 6 : StrMonth := 'Jun';π 7 : StrMonth := 'Jul';π 8 : StrMonth := 'Aug';π 9 : StrMonth := 'Sep';π 10 : StrMonth := 'Oct';π 11 : StrMonth := 'Nov';π 12 : StrMonth := 'Dec';π End;π stryear := copy(juliantoanystring, 5, 4);π strDay := copy(juliantoanystring, 3, 2);π anystr := StrDay + '-' + StrMonth + '-' +stryear;π JulianToDate := anystr;πEnd;ππFunction JulianToStr8(DateInt : Integer): Str8;πVarπ holdstr,π StrMonth,π strDay : string[2];π anystr : string[8];π stryear : string[4];π test,π error,π Year,π Dummy,π I : Integer;π Save,π Temp : Real;π JulianToanystring : Str8;πBeginπ holdstr := '';π JulianToanystring := '00000000';π Temp := Int(DateInt) + 32767 + 679351.0;π Save := Temp;π Dummy := Trunc(Temp/365.5);π While Save >= DateFactor(1.0,1.0,Dummy+0.0) Doπ Dummy := Succ(Dummy);π Dummy := Pred(Dummy);π Year := Dummy;π (* Determine number Of Days into current year *)π Temp := 1.0 + Save - DateFactor(1.0,1.0,Year+0.0);π (* Put the Year into the output string *)π For I := 8 downto 5 Doπ Beginπ JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));π Dummy := Dummy div 10;π End;π Dummy := 1 + Trunc(Temp/31.5);π While Save >= DateFactor(Dummy+0.0,1.0,Year+0.0) Doπ Dummy := Succ(Dummy);π Dummy := Pred(Dummy);π Temp := 1.0 + Save - DateFactor(Dummy+0.0,1.0,Year+0.0);π For I := 2 Downto 1 Doπ Beginπ JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));π Dummy := Dummy div 10;π End;π Dummy := Trunc(Temp);ππ For I := 4 Downto 3 Doπ Beginπ JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));π Dummy := Dummy div 10;π End;ππ holdstr := copy(juliantoanystring,1,2);π val(holdstr, test, error);π Case test Ofπ 1 : StrMonth := '01';π 2 : StrMonth := '02';π 3 : StrMonth := '03';π 4 : StrMonth := '04';π 5 : StrMonth := '05';π 6 : StrMonth := '06';π 7 : StrMonth := '07';π 8 : StrMonth := '08';π 9 : StrMonth := '09';π 10 : StrMonth := '10';π 11 : StrMonth := '11';π 12 : StrMonth := '12';π End;π StrYear := copy(juliantoanystring, 5, 4);π StrDay := copy(juliantoanystring, 3, 2);π AnyStr := StrMonth + StrDay + StrYear;π JulianToStr8 := AnyStr;πEnd;ππFunction DayofWeek(Jdate : Integer) : Str3;πBeginπ Case jdate MOD 7 Ofπ 0 : DayofWeek := 'Sun';π 1 : DayofWeek := 'Mon';π 2 : DayofWeek := 'Tue';π 3 : DayofWeek := 'Wed';π 4 : DayofWeek := 'Thu';π 5 : DayofWeek := 'Fri';π 6 : DayofWeek := 'Sat';π End;πEnd;ππProcedure DateDiff(Date1, Date2 : Integer; Var Date_Difference : Str9);πVARπ Temp,π Rdate1,π Rdate2,π Diff1 : Real;π Diff : Integer;π Return : String[9];π Hold : String[3];πBeginπ Rdate2 := Date2 + 32767.5;π Rdate1 := Date1 + 32767.5;π Diff1 := Rdate1 - Rdate2;π Temp := Diff1;π If Diff1 < 32 Then (* determine number of Days *)π Beginπ Diff := Round(Diff1);π Str(Diff,Hold);π Return := Hold + ' ' + 'Day';π If Diff > 1 Thenπ Return := Return + 's ';π End;π If ((Diff1 > 31) And (Diff1 < 366)) Thenπ Beginπ Diff1 := Diff1 / 30;π Diff := Round(Diff1);π Str(Diff,Hold);π Return := Hold + ' ' + 'Month';π If Diff > 1 Thenπ Return := Return + 's';π End;π If Diff1 > 365 Thenπ Beginπ Diff1 := Diff1 / 365;π Diff := Round(Diff1);ππ Str(Diff,Hold);π Return := Hold;π End;π Date_Difference := Return;π Diff := Round(Diff1);πEnd;ππEND.πππ 29 11-02-9316:49ALL ERIK HJELME TOMORROW in BASM IMPORT 10 ╬N {πFrom: ERIK HJELMEπSubj: date of tomorrowππI know you've got answers about how to calculate the date ofπtomorrow, but as DOS take care of almost anything in life itπwill offer to do this for you too : }ππvarπ yy : word;π mm,dd,ww : byte;ππbegin asmπ mov ah,$2Aπ int $21 { request todays date }π push dx { store todays date }π push cx { store todays year }ππ mov ax,$40 { pretend midnight has been passed }π mov es,axπ inc byte ptr es:[$0070]ππ mov ah,$2Aπ int $21 { request todays date, DOS will calculateπ the next available date ie tomorrow }ππ mov yy,cx { year }π mov mm,dh { month }π mov dd,dl { date }π mov ww,al { day_of_week }ππ mov ah,$2bπ pop cx { retrieve year }π pop dx { retrieve date }π int $21 { restore date }π end;πend;ππ 30 11-21-9309:48ALL ROBERT ROTHENBURG UNIXDATE Routines IMPORT 31 ╬N π(* A public domain Turbo Pascal unit to convert between the date formats *)π(* of DOS and Unix; by Robert Walking-Owl October 1993 *)ππunit UnixDate;ππinterfaceππfunction DosToUnixDate(DOSTime: LongInt): LongInt;πfunction UnixToDosDate(UnixDate: LongInt): LongInt;ππimplementationπ uses DOS;ππfunction DosToUnixDate(DOSTime: LongInt): LongInt;πconst DaysInMonth: array[1..12] of word =π (30, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);πvar i, j : Word;π UnixDate: LongInt;π DTR: DateTime;πbeginπ UnPackTime(DOSTime,DTR);π UnixDate := 0;π UnixDate:=(DTR.year-1970)*365+((DTR.year-1971) div 4);π j:=pred(DTR.day);π if DTR.month<>1π then for i:=1 to pred(DTR.month) do j:=j+DaysInMonth[i];π if ((DTR.year mod 4)=0) and (DTR.month>2)π then inc(j);π UnixDate:=UnixDate+j; (* Add number of days this year *)π UnixDate:=(UnixDate*24)+DTR.hour;π UnixDate:=(UnixDate*60)+DTR.min;π UnixDate:=(UnixDate*60)+DTR.sec;π DosToUnixDate:=UnixDate;πend;ππfunction UnixToDosDate(UnixDate: LongInt): LongInt;πconst DaysInMonth: array[1..12] of word =π (30, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);πvar i, j : Word;π DTR: DateTime;π DosTime: LongInt;πbeginπ DaysInMonth[2]:=28;π DTR.sec := UnixDate mod 60; UnixDate := UnixDate div 60;π DTR.min := UnixDate mod 60; UnixDate := UnixDate div 60;π DTR.hour := UnixDate mod 24; UnixDate := UnixDate div 24;π DTR.day := UnixDate mod 365; UnixDate := UnixDate div 365;π DTR.year := UnixDate+1970;π DTR.day := 1+DTR.day-((DTR.year-1972) div 4);π if (DTR.day > (31+29)) and ((DTR.year mod 4)=0)π then inc(DaysInMonth[2]);π DTR.month:=1;π while DTR.day>DaysInMonth[DTR.Month]π do beginπ DTR.day := DTR.day - DaysInMonth[DTR.Month];π inc(DTR.month)π end;π PackTime(DTR,DosTime);π UnixToDosDate:=DosTime;πend;ππend.πππThis archive includes the Turbo Pascal source for a unit that willπconvert between Unix-file timestamps and DOS-file timestamps.ππThe advantage is that you can write software, such as archiversπor archiver-utilities which can handle Unix-style dates and times.π(Note many systems will store the data in BigEndian format, soπyou'll have to do a further bit of conversion.)ππIf the value is bigendian: Turbo Pascal includes the function Swap πfor words. To swap a long integer you'll have to reverse the bytes.ππBoth systems store a packed record of the date and time in a fourπbyte long-integer (also called a double-word).πππDOS stores the date and time (of a file) actually as two packed words:π π Date: Time:ππBit: FEDCBA98 76543210 FEDCBA98 76543210π xxxxxxx. ........ ........ ........ Year - 1980π .......x xxx..... ........ ........ Month (1-12)π ........ ...xxxxx ........ ........ Day (1-31)ππ ........ ........ xxxxx... ........ Hours (0-23)π ........ ........ .....xxx xxx..... Minutes (0-59)π ........ ........ ........ ...xxxxx Seconds/2 (0-29)π ππUnix stores the date as the number of seconds since January 1, 1970 UTCπ(Universal Coordinated Time = Grenwich Mean Time). The is an _exact_πnumber (not including leap seconds)--it accounts for months of 28 (orπ29, for leap years), 30 and 31 days.ππNote that some (Unix) software assumes your time is set for UTC and storesπthe date/time stamp blindly, while others attempt to figure out whichπtime zone you're in and convert the time appropriately. (This can beπdone if the TZ variable is set properly.) So don't fret if you find theπconversions a few hours off...ππππ 31 11-26-9317:01ALL LIAM STITT BASM Get Date Routine IMPORT 4 ╬Nτ {πFrom: LIAM STITTπSubj: BASM Get Dateπ}ππ typeπ DateInfo = recordπ Year: Word;π Month: Byte;π Day: Byte;π DOW: Byte;π end;ππ varπ DI: DateInfo;ππ procedure GetDate; assembler;π asmπ mov ah,2Ahπ int 21hπ mov DI.Year,cxπ mov DI.Month,dhπ mov DI.Day,dlπ mov DI.DOW,alπ end;ππ 32 01-27-9411:53ALL MARK LAI Day of the Week IMPORT 10 ╬NH π> I am currently trying to create a calendar that will ask theπ> user to input a year and month. The program should print out thatπ> particular month. I believe I have a design I would like to follow,π> but I cant figure out the formula to figure out the first day of theπ> month for any year between 1900-2000.ππI have something more general from my class. Here it is:ππ A. Take the last two digits of the yearπ B. Add a quarter of this number (neglect the remainder)π C. Add the day of the monthπ D. Add according to the month:π Jan 1 Feb 4 March 4 April 0 May 2 June 5π July 0 Aug 3 Sept 6 Oct 1 Nov 4 Dec 6π E. Add for centuryπ 18th 4 20th 0π 19th 2 21st 6π F. Divide total by 7π G. The remainder gives day of week:π Sunday 1π Monday 2π Tuesday 3π Wednesday 4π Thursday 5π Friday 6π Saturday 0ππThis should work for any day between the years 1700-2099. Maybe youπcould figure out the exact formula you needed from this.ππ 33 01-27-9411:55ALL BRIAN GRAINGER Clocks IMPORT 14 ╬Nåª {π▒> Does anyone know how to make a clock (ie....working second to second)ππYou can use the clock from the Gadgets unit included with BP7.π}ππtypeπ PClockView = ^TClockView;π TClockView = object(TView)π Refresh: Byte;π LastTime: DateTime;π TimeStr: string[13];π constructor Init(var Bounds: TRect);π procedure Draw; virtual;π function FormatTimeStr(M, S: Word): String; virtual;π procedure Update; virtual;π end;ππfunction LeadingZero(w: Word): String;πvar s: String;πbeginπ Str(w:0, s);π LeadingZero := Copy('00', 1, 2 - Length(s)) + s;πend;ππconstructor TClockView.Init(var Bounds: TRect);πbeginπ inherited Init(Bounds);π FillChar(LastTime, SizeOf(LastTime), #$FF);π TimeStr := '';π Refresh := 1;πend;ππprocedure TClockView.Draw;πvarπ B: TDrawBuffer;π C: Byte;πbeginπ C := GetColor(2);π MoveChar(B, ' ', C, Size.X);π MoveStr(B, TimeStr, C);π WriteLine(0, 0, Size.X, 1, B);πend;ππprocedure TClockView.Update;πvarπ h,m,s,hund: word;π AmPmStr : STRING;π vTmpStr : STRING;πbeginπ GetTime(h,m,s,hund);π if Abs(s - LastTime.sec) >= Refresh thenπ beginπ with LastTime doπ beginπ IF ((H >= 12) AND (H < 24)) THENπ AmPmStr := ' p.m.'π ELSEπ AmPmStr := ' a.m.';π IF H > 12 THENπ H := H - 12;π IF H = 0 THENπ H := 12;π end;π Str(H : 2, vTmpStr);π TimeStr := vTmpStr + FormatTimeStr(m, s) + AmPmStr;π DrawView;π end;πend;ππfunction TClockView.FormatTimeStr(M, S: Word): String;πbeginπ FormatTimeStr := ':'+ LeadingZero(m) +π ':' + LeadingZero(s);πend;ππ 34 02-03-9409:24ALL EARL F. GLYNN Clock & Timer Unit IMPORT 150 ╬N|║ UNIT Clocks;ππ {This UNIT provides a CLOCK OBJECT for use in Turbo Pascal 5.5.ππ (C) Copyright 1989, Earl F. Glynn, Overland Park, KS. Compuserve 73257,3527.π All Rights Reserved. This Turbo Pascal 5.5 UNIT may be freely distributedπ for non-commerical use.ππ Clock objects can be used as individual timers, using either the CMOSπ real-time clock, or the DOS real-time clock. As shown in the ClkDemoπ PROGRAM, the DOS clock can be shut off when interrupts are disabled.π The resolution of the CMOS clock is only 1 second, while the DOS clockπ has 0.0549 second resolution (18.203 ticks per second). In additionπ to real-time clocks, static time stamps can be manipulated andπ formatted. The range for all clocks and time stamps is Jan 1, 1900π through Jun 5, 2079. (Sep 18, 1989 is the midpoint of this range).ππ Several REXX-like FUNCTIONs provide Date/Time formatting. [REXX,π the Restructured Extended Executor, or sometimes called the System Productπ Interpreter, is IBM's SAA command language (now primarily for VM/CMS).π That is, REXX EXECs are CMS's equivalent of PC .BAT files but REXXπ provides much more functionality than the PC 'BAT' language.]ππ REXX-like FUNCTIONS in Pascal could be considered an oxymoron sinceπ REXX doesn't have any concept of TYPEd variables and obviously Pascal does.π The Pascal functions in most cases were written to return STRINGs,π which is similar to REXX. In some cases, where a number was returnedπ that could be used in calculations, a separate function was used. Forπ example, the REXX TIME('Elapsed') function was implemented as an objectπ 'Elapsed' method that returns a REAL value to be used in calculations.π A function 'hhmmss' can be used to format elapsed seconds in aπ character string, if desired.ππ See the CLKDEMO.PAS, FLOPS.PAS and TIMER.PAS programs for sample usageπ of clock objects and this UNIT.}ππINTERFACEππ TYPEπ ClockValue =π RECORDπ year : 1900..2079;π month : 1..12;π day : 1..31;π hour : 0..23;π minute : 0..59;π second : 0..59;π hundredth : 0..99;π END;π ClockType = (CMOSClock,DOSClock);π Clock =π OBJECTπ mode : ClockType;π StartValue: ClockValue;π FUNCTION Date(s: STRING): STRING;π FUNCTION Elapsed: REAL; {elapsed timer (seconds)}π PROCEDURE Start (ct: ClockType);π FUNCTION Time(s: STRING): STRING;π END;ππ FUNCTION DateFormat(s: STRING; clk: ClockValue): STRING;π FUNCTION DaysThisCentury(y, m, d: WORD): WORD;π FUNCTION hhmmss(seconds: REAL): STRING;π FUNCTION JulianDate(y{1900..}, m{1..12}, d{1..31}: WORD): WORD;π PROCEDURE SetClock (yr,mo,d,h,m,s,hth: WORD; VAR t: ClockValue);π FUNCTION TimeDiff(t2,t1: ClockValue): REAL; {t2 - t1 seconds}π FUNCTION TimeFormat(s: STRING; clk: ClockValue): STRING;π PROCEDURE UnPackTime (TurboTime: LongInt; VAR Clk: ClockValue);ππIMPLEMENTATIONππ USESπ DOS; {INTR}ππ VARπ c : CHAR;ππ FUNCTION L2C(L: LONGINT): STRING; {LONGINT-to-character}π {L2C and W2C are intended to be similar to the standard D2Cπ (decimal-to-character) REXX function.}π VAR t: STRING[11];π BEGINπ STR (L,t);π L2C := tπ END {L2C};ππ FUNCTION W2C(w: WORD): STRING; {word-to-character}π VAR t: STRING[5];π BEGINπ STR (w,t);π W2C := tπ END {W2C};ππ FUNCTION TwoDigits (w: WORD): STRING;π CONST Digit: ARRAY[0..9] OF CHAR = '0123456789';π BEGINπ w := w MOD 100; {just to be safe}π TwoDigits := Digit[w DIV 10] + Digit[w MOD 10]π END {TwoDigits};ππ FUNCTION DateFormat(s: STRING; clk: ClockValue): STRING;π CONSTπ days : ARRAY[0..6] OF STRING[9]π =('Sunday','Monday','Tuesday','Wednesday',π 'Thursday','Friday','Saturday');π months: ARRAY[1..12] OF STRING[9]π =('January','February','March',π 'April', 'May', 'June',π 'July', 'August', 'September',π 'October','November','December');π BEGINπ IF LENGTH(s) = 0π THEN c := 'N' {NORMAL}π ELSE c := UpCase(s[1]);π CASE c OFπ {Normal (default): dd Mmm yyyy -- no leading zero or blank}π 'N': DateFormat := W2C(clk.day) + ' ' + COPY(months[clk.month],1,3)π + ' ' + W2C(clk.year);ππ {Century: ddddd -- no leading zeros or blanks}π 'C': DateFormat := W2C( DaysThisCentury(clk.year,clk.month,clk.day) );ππ {Julian date: ddd -- no leading 0s or blanks}π 'D': DateFormat := W2C(JulianDate(clk.year,clk.month,clk.day));ππ {European: dd/mm/yy}π 'E': DateFormat := TwoDigits(clk.day ) + '/' +π TwoDigits(clk.month) + '/' + TwoDigits(clk.year MOD 100);ππ {Month: current month name in mixed case}π 'M': DateFormat := months[clk.month];ππ {Ordered: yy/mm/dd suitable for sorting}π 'O': DateFormat := TwoDigits(clk.year MOD 100) + '/' +π TwoDigits(clk.month) + '/' + TwoDigits(clk.day);ππ {Standard: yyyymmdd -- suitable for sorting (ISO/R 2014-1971)}π 'S': DateFormat := W2C(clk.year) + TwoDigits(clk.month) +π TwoDigits(clk.day);ππ {USA: mm/dd/yy}π 'U': DateFormat := TwoDigits(clk.month) + '/' +π TwoDigits(clk.day ) + '/' + TwoDigits(clk.year MOD 100);ππ {Weekday: returns day of the week in mixed case}π 'W': DateFormat := {January 1, 1900 was a Monday}π days[DaysThisCentury(clk.year,clk.month,clk.day) MOD 7 ]ππ ELSE DateFormat := ''π ENDπ END {DateFormat};ππ FUNCTION DaysThisCentury(y, m, d: WORD): WORD;ππ {This function was written to be equivalent to the REXX languageπ DATE('Century') function. See DateFormat FUNCTION in this UNIT.ππ Jan 1, 1900 = 1, Jan 2, 1900 = 2, ..., Jun 5, 2079 = 65535 (largest word).π Jan 1, 1989 = 32508, Jan 1, 1990 = 32873, Sep 18, 1989 = 32768.ππ "The Astronomical Almanac" defines the astronomical julian dateπ to be the numbers of mean solar days since 4713 BC. In this systemπ Jan 1, 1900 = 2415020.5, Jan 1, 2000 = 2451544.5,π Jan 1, 1989 = 2447527.5, Jan 1, 1990 = 2447892.5,π Jun 5, 2079 = 2480554.5. This data was used to validate the function.ππ (Note: DaysThisCentry(y,m,d) MOD 7 returns day-of-week index, i.e.,π 0=Sunday, 1=Monday, etc. since January 1, 1900 was a Monday.)}π BEGINπ DaysThisCentury := 365*(y-1900) + INTEGER(y-1901) DIV 4 + JulianDate(y,m,d)π END {DaysThisCentury};ππ FUNCTION hhmmss(seconds: REAL): STRING;π {Convert elapsed times/time differences to [hh:]mm:ss format}π VARπ h,h1,h2: LONGINT;π s : STRING;π t : LONGINT;π BEGINπ IF seconds < 0.0π THEN BEGINπ seconds := ABS(seconds);π s := '-'π ENDπ ELSE s:= '';π h1 := 0;π WHILE seconds > 2147483647.0 DO BEGIN {fixup real-to-LONGINT problem}π seconds := seconds - 1576800000.0; {subtract about 50 years}π h1 := h1 + 438000 {hours} {add about 50 years}π END;π t := TRUNC(seconds);π h2 := t DIV 3600; {hours}π h := h1 + h2;π IF h > 0π THEN s := s + L2C(h) + ':';π t := t - h2*3600; {minutes and seconds left}π hhmmss := s + TwoDigits(t DIV 60) + ':' + TwoDigits(t MOD 60)π END {hhmmss};ππ FUNCTION JulianDate(y{1900..}, m{1..12}, d{1..31}: WORD): WORD;π CONSTπ julian: ARRAY[0..12] OF WORD =π (0,31,59,90,120,151,181,212,243,273,304,334,365);π VARπ jd: WORD;π BEGINπ jd := julian[m-1] + d;π IF (m > 2) AND (y MOD 4 = 0) ANDπ (y <> 1900) {AND (y <> 2100)}π THEN INC (jd); {1900 and 2100 are not leap years; 2000 is}π JulianDate := jdπ END {JulianDate};ππ PROCEDURE SetClock (yr,mo,d,h,m,s,hth: WORD; VAR t: ClockValue);π BEGINπ t.year := yr;π t.month := mo;π t.day := d;π t.hour := h;π t.minute := m;π t.second := s;π t.hundredth := hthπ END {SetClock};ππ FUNCTION TimeDiff(t2,t1: ClockValue): REAL;π BEGIN {REAL arithmetic is used to avoid INTEGER/LONGINT overflows}π TimeDiff := 0.01*INTEGER(t2.hundredth - t1.hundredth) +π INTEGER(t2.second - t1.second ) +π 60.0*INTEGER(t2.minute - t1.minute ) +π 3600.0*INTEGER(t2.hour - t1.hour ) +π 86400.0*LONGINT(DaysThisCentury(t2.year,t2.month,t2.day) -π LONGINT(DaysThisCentury(t1.year,t1.month,t1.day)))π END {TimeDiff};ππ FUNCTION TimeFormat(s: STRING; clk: ClockValue): STRING;π VARπ meridian: STRING[2];π BEGINπ IF LENGTH(s) = 0π THEN c := 'N' {NORMAL}π ELSE c := UpCase(s[1]);π CASE c OFππ {Normal (default): hh:mm:ss}π 'N': TimeFormat := TwoDigits(clk.hour ) + ':' +π TwoDigits(clk.minute) + ':' + TwoDigits(clk.second);ππ {Civil: hh:mxx, for example: 11:59pm}π 'C': BEGINπ IF clk.hour < 12π THEN BEGINπ meridian := 'am'; {anti meridiem}π IF clk.hour = 0π THEN clk.hour := 12; {12:00am is midnight}π END {12:00pm is noon}π ELSE BEGINπ meridian := 'pm'; {post meridiem}π IF clk.hour > 12π THEN clk.hour := clk.hour - 12π END;π TimeFormat := W2C(clk.hour) + ':' +π TwoDigits(clk.minute) + meridianπ END;ππ {Hours: hh -- number of hours since midnight}π 'H': TimeFormat := W2C(clk.hour);ππ {Long: hh.mm:ss.xx (real REXX requires microseconds here)}π 'L': TimeFormat := TwoDigits(clk.hour ) + ':' +π TwoDigits(clk.minute) + ':' + TwoDigits(clk.second) + '.' +π TwoDigits(clk.hundredth);ππ {Minutes: mmmm -- number of minutes since midnight}π 'M': TimeFormat := W2C(60*clk.hour + clk.minute);ππ {Seconds: sssss -- number of seconds since midnight}π 'S': TimeFormat := L2C( 3600*LONGINT(clk.hour)π + 60*LONGINT(clk.minute) + LONGINT(clk.second) )ππ ELSE TimeFormat := ''π ENDπ END {TimeFormat};ππ PROCEDURE UnPackTime (TurboTime: LongInt; VAR Clk: ClockValue);π {The DOS.DateTime TYPE does not have hundredths of a second in itsπ definition. Clocks.UnPackTime allows the use of Clocks.DateFormatπ and Clocks.TimeFormat with time stamps, especially with SearchRecπ TYPEed variables defined by FindFirst/FindNext.}π VARπ DT: DateTime;π BEGINπ DOS.UnPackTime (TurboTime, DT);π SetClock (DT.year,DT.month,DT.day,DT.hour,DT.min,DT.sec,0, Clk)π END {UnPackTime};ππ PROCEDURE GetDateTime (VAR c: ClockValue; ct: ClockType);π VAR r1,r2: Registers;ππ FUNCTION BCD (k: BYTE): WORD; {convert binary-coded decimal}π BEGINπ BCD := 10*(k DIV 16) + (k MOD 16)π END {BCD};ππ BEGINπ CASE ct OFπ CMOSClock:π BEGINπ r1.AH := $04;π INTR ($1A,r1); {BIOS call: read date from real-time clock}π r2.AH := $02;π Intr ($1A,r2); {BIOS call: read real-time clock}π SetClock (100*BCD(r1.CH) + BCD(r1.CL) {yr},π BCD(r1.DH) {mo}, BCD(r1.DL) {day},π BCD(r2.CH) {h}, BCD(r2.CL) {m}, BCD(r2.DH) {s},π 0 {.00}, c)π END;π DOSClock:π BEGINπ r1.AH := $2A; {could use GetDate and GetTime from DOS UNIT}π INTR ($21,r1); {DOS call: get system date}π r2.AH := $2C;π Intr ($21,r2); {DOS call: get system time}π SetClock (r1.CX,r1.DH,r1.DL, r2.CH,r2.CL,r2.DH,r2.DL, c)π ENDπ ENDπ END {GetDateTime};ππ FUNCTION Clock.Date(s: STRING): STRING;π BEGINπ Date := DateFormat(s,StartValue)π END {Date};ππ FUNCTION Clock.Elapsed: REAL;π VAR now: ClockValue;π BEGINπ GetDateTime (now,mode);π Elapsed := TimeDiff(now,StartValue)π END {Clock.Elapsed};ππ PROCEDURE Clock.Start (ct: ClockType);π BEGINπ mode := ct;π GetDateTime (StartValue, ct)π END {Clock.Start};ππ FUNCTION Clock.Time(s: STRING): STRING;π BEGINπ Time := TimeFormat(s,StartValue)π END {Time};ππEND {Clocks}.ππ{--------------------------- DEMO --------------------------}ππPROGRAM ClkDemo;ππ {This PROGRAM demonstates how to use the CLOCKS UNIT, including aπ clock object, its methods, and related FUNCTIONs and PROCEDUREs.π Differences between CMOS and DOS clocks are shown.ππ (C) Copyright 1989, Earl F. Glynn, Overland Park, KS. Compuserve 73257,3527.π All Rights Reserved. This Turbo Pascal 5.5 PROGRAM may be freely distributedπ for non-commerical use.ππ Several of the examples were derived from "The REXX Language" byπ M.F. Cowlishaw, Prentice Hall, 1985.}ππ USESπ CRT,π Clocks,π DOS; {FindFirst,FindNext,SearchRec,AnyFile,DOSError}ππ VARπ Clk1,Clk2,Clk3: Clock; {clock objects -- real time clocks}π stamp1,stamp2 : ClockValue; {static clocks -- time stamps}π stamp3,stamp4 : ClockValue;π stamp5 : ClockValue;π DirInfo : SearchRec;ππ PROCEDURE ShowClocks;π BEGINπ Clk2.Start (CMOSClock);π Clk3.Start (DOSClock);π WRITELN (' CMOS Clock: ',Clk2.date('u'),' ',Clk2.time('N') );π WRITELN (' DOS Clock: ',Clk3.date('u'),' ',Clk3.time('L') );π WRITELN (' Difference: ',TimeDiff(Clk2.StartValue,Clk3.StartValue):8:2,π ' second(s)');π END {ShowClocks};ππ PROCEDURE DisableInterrupts;π INLINE ($FA);ππ PROCEDURE EnableInterrupts;π INLINE ($FB);ππ PROCEDURE KillTime;π {The following could be used for a 5-second delay, but it re-enablesπ interrupts when they are disabled:ππ WHILE clk1.elapsed < 5.0 DO (* nothing *);ππ So,time will be wasted with a few calculations.}ππ VARπ i: WORD;π x: REAL;π BEGINπ WRITELN ('''Kill'' some time ...');π FOR i := 1 TO 10000 DOπ x := SQRT(i)π END;ππBEGINπ Clk1.Start (CMOSClock);π WRITELN ('CMOS/DOS Clock Differences');π WRITELN ('--------------------------');π WRITELN ('Start Clocks');π ShowClocks;π KillTime;π ShowClocks;π WRITELN ('Disable Interrupts (DOS clock will stop):');π DisableInterrupts;π KillTime;π ShowClocks;π WRITELN ('Enable Interrupts');π EnableInterrupts;ππ SetClock (1985,8,27, 16,54,22, 12, stamp1); {These are not real-time clocks.}π SetClock (1900,1, 1, 0, 0, 0, 0, stamp2);π SetClock (2079,6, 5, 23,59,59, 99, stamp3);ππ WRITELN ('Cowlishaw''s':52);π WRITELN ('now':39,'REXX Book':13,'First':13,'Last':13);π WRITELN ('Date/DateFormat Examples');π WRITELN ('------------------------');π WRITELN ('day this century - C':26,Clk2.Date('Century'):13,π DateFormat('C',stamp1):13, DateFormat('C',stamp2):13,π DateFormat('C',stamp3):13);π WRITELN ('day this year - D':26, Clk2.Date('Days'):13,π DateFormat('D',stamp1):13, DateFormat('D',stamp2):13,π DateFormat('D',stamp3):13);π WRITELN ('dd/mm/yy - E':26, Clk2.Date('European'):13,π DateFormat('E',stamp1):13, DateFormat('E',stamp2):13,π DateFormat('E',stamp3):13);π WRITELN ('month name - M':26, Clk2.Date('MONTH'):13,π DateFormat('M',stamp1):13, DateFormat('M',stamp2):13,π DateFormat('M',stamp3):13);π WRITELN ('dd Mmm yyyy - N':26, Clk2.Date('normal'):13,π DateFormat('N',stamp1):13, DateFormat('N',stamp2):13,π DateFormat('N',stamp3):13);π WRITELN ('yy/mm/dd - O':26, Clk2.Date('Ordered'):13,π DateFormat('O',stamp1):13,DateFormat('O',stamp2):13,π DateFormat('O',stamp3):13);π WRITELN ('yyyymmdd - S':26, Clk2.Date('standard'):13,π DateFormat('S',stamp1):13, DateFormat('S',stamp2):13,π DateFormat('S',stamp3):13);π WRITELN ('mm/dd/yy - U':26, Clk2.Date('USA'):13,π DateFormat('U',stamp1):13, DateFormat('U',stamp2):13,π DateFormat('U',stamp3):13);π WRITELN ('day of week - W':26, Clk2.Date('weekday'):13,π DateFormat('W',stamp1):13, DateFormat('W',stamp2):13,π DateFormat('W',stamp3):13);ππ WRITELN;π WRITELN ('Time/TimeFormat Examples');π WRITELN ('------------------------');π WRITELN ('hh:mmxm - C':26, Clk2.Time('Civil'):13,π TimeFormat('C',stamp1):13, TimeFormat('C',stamp2):13,π TimeFormat('C',stamp3):13);π WRITELN ('hours since midnight - H':26,Clk2.Time('Hours'):13,π TimeFormat('h',stamp1):13, TimeFormat('h',stamp2):13,π TimeFormat('h',stamp3):13);π WRITELN ('hh:mm:ss.xx - L':26, Clk2.Time('long'):13,π TimeFormat('L',stamp1):13, TimeFormat('L',stamp2):13,π TimeFormat('L',stamp3):13);π WRITELN ('minutes since midnight - M', Clk2.Time('minutes'):13,π TimeFormat('m',stamp1):13, TimeFormat('m',stamp2):13,π TimeFormat('m',stamp3):13);π WRITELN ('hh:mm:ss - N':26, Clk2.Time('normal'):13,π TimeFormat('n',stamp1):13, TimeFormat('n',stamp2):13,π TimeFormat('n',stamp3):13);π WRITELN ('seconds since midnight - S', Clk2.Time('seconds'):13,π TimeFormat('s',stamp1):13, TimeFormat('s',stamp2):13,π TimeFormat('s',stamp3):13);ππ WRITELN;π WRITELN ('Time Differences/Elapsed Time');π WRITELN ('-----------------------------');π WRITELN (' ':20,'seconds':12,'hh:mm:ss':16);π WRITELN ('CMOS - DOS Clock:':20,π TimeDiff(Clk2.StartValue,Clk3.StartValue):12:2,π hhmmss(TimeDiff(Clk2.StartValue,Clk3.StartValue)):16);π SetClock (1989,1, 1, 0, 0, 0, 0, stamp4);π SetClock (1990,1, 1, 0, 0, 0, 0, stamp5);π WRITELN ('Jan 1-Dec 31 1989:':20,TimeDiff(stamp5,stamp4):12:0,π hhmmss(TimeDiff(stamp5,stamp4)):16);π WRITELN ('Dec 31-Jan 1 1989:':20,TimeDiff(stamp4,stamp5):12:0,π hhmmss(TimeDiff(stamp4,stamp5)):16);π SetClock (1992,1, 1, 0, 0, 0, 0, stamp4);π SetClock (1993,1, 1, 0, 0, 0, 0, stamp5);π WRITELN ('1992 (leap year):':20,TimeDiff(stamp5,stamp4):12:0,π hhmmss(TimeDiff(stamp5,stamp4)):16);π SetClock (2000,1, 1, 0, 0, 0, 0, stamp5);π WRITELN ('20th century:':20,TimeDiff(stamp5,stamp2):12:0,π hhmmss(TimeDiff(stamp5,stamp2)):16,' (100*365 days + 24 leap days)');π WRITELN ('Maximum Clock Range:':20,TimeDiff(stamp3,stamp2):12:0,π hhmmss(TimeDiff(stamp3,stamp2)):16,' (January 1, 1900 midnight -');π WRITELN ('June 5, 2079 23:59:59.99)':78);π WRITELN ('Elapsed time:':20,Clk1.Elapsed:12:0,π hhmmss(Clk1.Elapsed):16);ππ Readkey;π WRITELN;π WRITELN ('Clocks.UnPackTime');π WRITELN ('-----------------');π FindFirst ('*.*',AnyFile,DirInfo);π WHILE DOSError = 0 DO BEGIN {Note: seconds on files are even numbers}π Clocks.UnPackTime (DirInfo.Time, stamp5);π WRITELN (DirInfo.Name:12,' ',DirInfo.size:7,' ',π COPY(DateFormat('Weekday',stamp5),1,3),' ',π DateFormat('USA',stamp5),' ',TimeFormat('Normal',stamp5));π FindNext (DirInfo)π END;π Readkey;πEND {ClkDemo}.π 35 02-03-9416:07ALL ROBERT WOOSTER Julian Date Algorithms IMPORT 25 ╬Niâ (* JULIAN.PAS - test Julian algorithmsππ test values: 1/1/79 = 2443875π 1/1/1900 = 2415021π 1/1/70 = 2440588π 8/28/40 = 2429870ππ Robert B. Wooster [72415,1602]π March 1985ππ Note: because of the magnitude of the numbers involvedπ here this probably requires an 8x87 and hence is limitedπ to MS or PC/DOS machines. However, it may work with theπ forthcoming BCD routines.π*)ππprogram JULIAN;ππvarπ JNUM : real;π month,π day,π year : integer;ππ{----------------------------------------------}πfunction Jul( mo, da, yr: integer): real;π{ this is an implementation of the FORTRAN one-liner:π JD(I, J, K) = K - 32075 + 1461 * (I + 4800 + (J-14) / 12) / 4π + 367 * (j - 2 - ((J - 14) / 12) * 12) / 12π - 3 * (( I + 4900 + (J - 14) / 12) / 100 / 4; where I,J,K areπ year, month, and day. The original version takes advantage ofπ FORTRAN's automatic truncation of integers but requires supportπ of integers somewhat larger than Turbo's Maxint, hence all of theπ Int()'s . The variable returned is an integer day count usingπ 1 January 1980 as 0. }ππ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; { Jul }πππ{----------------------------------------------}πprocedure JtoD(pj: real; var mo, da, yr: integer);π{ this reverses the calculation in Jul, returning theπ result in a Date_Rec }πvar ju, i, j, k, l, n: real;πbeginπ ju := pj;π l := ju + 68569.0;π n := int( 4 * l / 146097.0);π l := l - int( (146097.0 * n + 3)/ 4 );π i := int( 4000.0 * (l+1)/1461001.0);π l := l - int(1461.0*i/4.0) + 31.0;π j := int( 80 * l/2447.0);π k := l - int( 2447.0 * j / 80.0);π l := int(j/11);π j := j+2-12*l;π i := 100*(n - 49) + i + l;π yr := trunc(i);π mo := trunc(j);π da := trunc(k);πend; { JtoD }ππππ{-----------------MAIN-----------------------------}πbeginπ writeln('This program tests the Julian date algorithms.');π writeln('Enter a calendar date in the form MM DD YYYY <return>');π writeln('Enter a date of 00 00 00 to end the program.');ππ day := 1;π while day<>0 do beginππ writeln;π write('Enter MM DD YY '); readln( month, day, year);π if day<>0 then beginπ JNUM := Jul( month, day, year);π writeln('The Julian # of ',month,'/',day,'/',year,π ' is ', JNUM:10:0);π JtoD( JNUM, month, day, year);π Writeln('The date corresponding to ', JNUM:10:0, ' is ',π month,'/',day,'/',year);π end;π end;π writeln('That''s all folks.....');πend.ππ(* end of file JULIAN.PAS *)π 36 02-09-9411:49ALL ALAN GRAFF Handy Date/Time Unit IMPORT 125 ╬Nmò π (* * * * * * * * * * * * * * * * * * * * * * *)π (* UNIT: DTIME - By Alan Graff, Nov. 92 *)π (* Compiled from routines found in: *)π (* DATEPAK4: W.G.Madison, Nov. 87 *)π (* UNIXDATE: Brian Stark, Jan. 92 *)π (* Plus various things of my own creation *)π (* and extracted from Fidonet PASCAL echo *)π (* messages and other sources. *)π (* Contributed to the Public Domain *)π (* Version 1.1 - Nov. 1992 *)π (* * * * * * * * * * * * * * * * * * * * * * *)ππUNIT DTime;π{**************************************************************}πINTERFACEπuses crt,dos;ππTYPE DATETYPE = recordπ day:WORD;π MONTH:WORD;π YEAR:WORD;π dow:word;π end;ππ (* Sundry determinations of current date/time variables *)πFunction DayOfYear:word; (* Returns 1 to 365 *)πFunction DayOfMonth:word; (* Returns 1 to 31 *)πFunction DayOfWeek:word; (* Returns 1 to 7 *)πFunction MonthOfYear:word; (* Returns 1 to 12 *)πFunction ThisYear:word; (* Returns current year *)πFunction ThisHour:word; (* Returns 1 to 24 *)πFunction ThisMinute:word; (* Returns 0 to 59 *)π (* Calculate what day of the week a particular date falls on *)πProcedure WkDay(Year,Month,Day:Integer; var WeekDay:Integer);π (* Full Julian conversions *)πProcedure GregorianToJulianDN(Year,Month,Day:Integer;var JulianDN:LongInt);πProcedure JulianDNToGregorian(JulianDN:LongInt;var Year,Month,Day:Integer);π (* 365 day Julian conversions *)πProcedure GregorianToJulianDate(Year,Month,Day:Integer;var JulianDate:Integer);πProcedure JulianToGregorianDate(JulianDate,Year:Integer;var Month,Day:Integer);π (* Sundry string things *)πFunction DateString:String; (* Returns system date as "mm-dd-yy" string *)πFunction TimeString:String; (* Returns system time as "00:00:00" string *)π (* Create current YYMMDD string to use as a file name *)πFunction DateAFile(dy,dm,dd:word):string;π (* Return YY-MM-DD string from filename created by DateAFile func *)πFunction Parsefile(s:string):string;π (* Return values of 1 day ago *)πProcedure Yesterday(Var y,m,d:integer);π (* Return values of 1 day ahead *)πProcedure Tomorrow(Var y,m,d:integer);π (* Adjust time based on "TZ" environment *)πFunction GetTimeZone : ShortInt;πFunction IsLeapYear(Source : Word) : Boolean; (* What it says :-) *)π (* Unix date conversions *)πFunction Norm2Unix(Y,M,D,H,Min,S:Word):LongInt;πProcedure Unix2Norm(Date:LongInt;Var Y,M,D,H,Min,S:Word);π (* Determines what day of year Easter falls on *)πProcedure Easter(Year:Word;Var Date:DateType);π (* Determines what day of year Thanksgiving falls on *)πProcedure Thanksgiving(Year:Word;Var Date:DateType);π (* Determine what percentage of moon is lit on a particular night *)πFunction MoonPhase(Date:Datetype):Real;ππIMPLEMENTATIONππconstπ D0 = 1461;π D1 = 146097;π D2 = 1721119;π DaysPerMonth : Array[1..12] of ShortInt =π(031,028,031,030,031,030,031,031,030,031,030,031);π DaysPerYear : Array[1..12] of Integer =π(031,059,090,120,151,181,212,243,273,304,334,365);π DaysPerLeapYear : Array[1..12] of Integer =π(031,060,091,121,152,182,213,244,274,305,335,366);π SecsPerYear : LongInt = 31536000;π SecsPerLeapYear : LongInt = 31622400;π SecsPerDay : LongInt = 86400;π SecsPerHour : Integer = 3600;π SecsPerMinute : ShortInt = 60;ππProcedure GregorianToJulianDN;πvarπ Century,π XYear : LongInt;πbegin {GregorianToJulianDN}π If Month <= 2 then beginπ Year := pred(Year);π Month := Month + 12;π end;π Month := Month - 3;π Century := Year div 100;π XYear := Year mod 100;π Century := (Century * D1) shr 2;π XYear := (XYear * D0) shr 2;π JulianDN := ((((Month * 153) + 2) div 5) + Day) + D2 + XYear + Century;π end; {GregorianToJulianDN}π{**************************************************************}πProcedure JulianDNToGregorian;πvarπ Temp,π XYear : LongInt;π YYear,π YMonth,π YDay : Integer;πbegin {JulianDNToGregorian}π Temp := (((JulianDN - D2) shl 2) - 1);π XYear := (Temp mod D1) or 3;π JulianDN := Temp div D1;π YYear := (XYear div D0);π Temp := ((((XYear mod D0) + 4) shr 2) * 5) - 3;π YMonth := Temp div 153;π If YMonth >= 10 then beginπ YYear := YYear + 1;π YMonth := YMonth - 12;π end;π YMonth := YMonth + 3;π YDay := Temp mod 153;π YDay := (YDay + 5) div 5;π Year := YYear + (JulianDN * 100);π Month := YMonth;π Day := YDay;π end; {JulianDNToGregorian}π{**************************************************************}πProcedure GregorianToJulianDate;πvarπ Jan1,π Today : LongInt;πbegin {GregorianToJulianDate}π GregorianToJulianDN(Year, 1, 1, Jan1);π GregorianToJulianDN(Year, Month, Day, Today);π JulianDate := (Today - Jan1 + 1);π end; {GregorianToJulianDate}π{**************************************************************}πProcedure JulianToGregorianDate;πvarπ Jan1 : LongInt;πbeginπ GregorianToJulianDN(Year, 1, 1, Jan1);π JulianDNToGregorian((Jan1 + JulianDate - 1), Year, Month, Day);π end; {JulianToGregorianDate}π{**************************************************************}πProcedure WkDay;πvarπ DayNum : LongInt;πbeginπ GregorianToJulianDN(Year, Month, Day, DayNum);π DayNum := ((DayNum + 1) mod 7);π WeekDay := (DayNum) + 1;π end; {DayOfWeek}π{**************************************************************}πProcedure Yesterday(Var Y,M,D:integer);πvar jdn:longint;πbeginπGregorianToJulianDN(Y,M,D,JDN);πJDN:=JDN-1;πJulianDNToGregorian(JDN,Y,M,D);πend;π{**************************************************************}πProcedure Tomorrow(Var Y,M,D:integer);πvar JDN:longint;πbeginπGregorianToJulianDN(Y,M,D,JDN);πJDN:=JDN+1;πJulianDNToGregorian(JDN,Y,M,D);πend;π{**************************************************************}πFunction TimeString:string;πvar hr,mn,sec,hun:word;πs,q:string;πbeginπ q:='';π gettime(hr,mn,sec,hun);π if hr<10 then q:=q+'0';π str(hr:1,s);π q:=q+s+':';π if mn<10 then q:=q+'0';π str(mn:1,s);π q:=q+s;π TimeString:=q;πend;π{**************************************************************}πFunction ThisHour:Word;πvar hr,mn,sec,hun:word;πbeginπ gettime(hr,mn,sec,hun);π ThisHour:=hr;πend;π{**************************************************************}πFunction ThisMinute:Word;πvar hr,mn,sec,hun:word;πbeginπ gettime(hr,mn,sec,hun);π ThisMinute:=mn;πend;π{**************************************************************}πFunction DateString:string;πvar yr,mo,dy,dow:word;π s,q:string;πbeginπ q:='';π getdate(yr,mo,dy,dow);π if mo<10 then q:=q+'0';π str(mo:1,s);π q:=q+s+'-';π if dy<10 then q:=q+'0';π str(dy:1,s);π q:=q+s+'-';π while yr>100 do yr:=yr-100;π if yr<10 then q:=q+'0';π str(yr:1,s);π q:=q+s;π Datestring:=q;πend;π{**************************************************************}πFunction parsefile(s:string):string; { Return date string from a file name }πvar mo,errcode:word; { in either YYMMDD.EXT or MMDDYY.EXT }π st:string; { format. }πbeginπst:=copy(s,1,2)+'-'+copy(s,3,2)+'-'+copy(s,5,2);πparsefile:=st;πend;π{**************************************************************}πfunction dateafile(dy,dm,dd:word):string;πvar s1,s2:string;πbeginπwhile dy>100 do dy:=dy-100;πstr(dy,s1);πwhile length(s1)<2 do s1:='0'+s1;πs2:=s1;πstr(dm,s1);πwhile length(s1)<2 do s1:='0'+s1;πs2:=s2+s1;πstr(dd,s1);πwhile length(s1)<2 do s1:='0'+s1;πs2:=s2+s1;πdateafile:=s2;πend;π{**************************************************************}πFunction DayOfMonth:Word;πvar yr,mo,dy,dow:word;πbeginπ getdate(yr,mo,dy,dow);π DayOfMonth:=dy;πend;π{**************************************************************}πFunction ThisYear:Word;πvar yr,mo,dy,dow:word;πbeginπ getdate(yr,mo,dy,dow);π ThisYear:=yr;πend;ππ{**************************************************************}πFunction DayOfWeek:word;πvar yr,mo,dy,dow:word;πbeginπ getdate(yr,mo,dy,dow); (* Turbo Pascal authors never saw a *)π dow:=dow+1; (* calendar. Their first day of *)π if dow=8 then dow:=1; (* week is Monday.... *)π DayOfWeek:=dow;πend;π{**************************************************************}πFunction MonthOfYear:Word;πvar yr,mo,dy,dow:word;πbeginπ getdate(yr,mo,dy,dow);π monthofyear:=mo;πend;π{**************************************************************}πFunction GetTimeZone : ShortInt;πVarπ Environment : String;π Index : Integer;πBeginπ GetTimeZone := 0; {Assume UTC}π Environment := GetEnv('TZ'); {Grab TZ string}π For Index := 1 To Length(Environment) Doπ Environment[Index] := Upcase(Environment[Index]);π If Environment = 'EST05' Then GetTimeZone := -05; {USA EASTERN}π If Environment = 'EST05EDT' Then GetTimeZone := -06;π If Environment = 'CST06' Then GetTimeZone := -06; {USA CENTRAL}π If Environment = 'CST06CDT' Then GetTimeZone := -07;π If Environment = 'MST07' Then GetTimeZone := -07; {USA MOUNTAIN}π If Environment = 'MST07MDT' Then GetTimeZone := -08;π If Environment = 'PST08' Then GetTimeZone := -08;π If Environment = 'PST08PDT' Then GetTimeZone := -09;π If Environment = 'YST09' Then GetTimeZone := -09;π If Environment = 'AST10' Then GetTimeZone := -10;π If Environment = 'BST11' Then GetTimeZone := -11;π If Environment = 'CET-1' Then GetTimeZone := 01;π If Environment = 'CET-01' Then GetTimeZone := 01;π If Environment = 'EST-10' Then GetTimeZone := 10;π If Environment = 'WST-8' Then GetTimeZone := 08; {Perth,W.Austrailia}π If Environment = 'WST-08' Then GetTimeZone := 08;πEnd;π{**************************************************************}πFunction IsLeapYear(Source : Word) : Boolean;πBeginπ If (Source Mod 4 = 0) Thenπ IsLeapYear := Trueπ Elseπ IsLeapYear := False;πEnd;π{**************************************************************}πFunction Norm2Unix(Y,M,D,H,Min,S : Word) : LongInt;πVarπ UnixDate : LongInt;π Index : Word;πBeginπ UnixDate := 0; {initialize}π Inc(UnixDate,S); {add seconds}π Inc(UnixDate,(SecsPerMinute * Min)); {add minutes}π Inc(UnixDate,(SecsPerHour * H)); {add hours}π UnixDate := UnixDate - (GetTimeZone * SecsPerHour); {UTC offset}π If D > 1 Then {has one day already passed?}π Inc(UnixDate,(SecsPerDay * (D-1)));π If IsLeapYear(Y) Thenπ DaysPerMonth[02] := 29π Elseπ DaysPerMonth[02] := 28; {Check for Feb. 29th}π Index := 1;π If M > 1 Then For Index := 1 To (M-1) Do {has one month already passed?}π Inc(UnixDate,(DaysPerMonth[Index] * SecsPerDay));π While Y > 1970 Doπ Beginπ If IsLeapYear((Y-1)) Thenπ Inc(UnixDate,SecsPerLeapYear)π Elseπ Inc(UnixDate,SecsPerYear);π Dec(Y,1);π End;π Norm2Unix := UnixDate;πEnd; Procedure Unix2Norm(Date : LongInt; Var Y, M, D, H, Min, S : Word);π{}πVarπ LocalDate : LongInt; Done : Boolean; X : ShortInt; TotDays : Integer;πBeginπ Y := 1970; M := 1; D := 1; H := 0; Min := 0; S := 0;π LocalDate := Date + (GetTimeZone * SecsPerHour); {Local time date}π Done := False;π While Not Done Doπ Beginπ If LocalDate >= SecsPerYear Thenπ Beginπ Inc(Y,1);π Dec(LocalDate,SecsPerYear);π Endπ Elseπ Done := True;π If (IsLeapYear(Y+1)) And (LocalDate >= SecsPerLeapYear) Andπ (Not Done) Thenπ Beginπ Inc(Y,1);π Dec(LocalDate,SecsPerLeapYear);π End;π End;π M := 1; D := 1;π Done := False;π TotDays := LocalDate Div SecsPerDay;π If IsLeapYear(Y) Thenπ Beginπ DaysPerMonth[02] := 29;π X := 1;π Repeatπ If (TotDays <= DaysPerLeapYear[x]) Thenπ Beginπ M := X;π Done := True;π Dec(LocalDate,(TotDays * SecsPerDay));π D := DaysPerMonth[M]-(DaysPerLeapYear[M]-TotDays) + 1;π Endπ Elseπ Done := False;π Inc(X);π Until (Done) or (X > 12);π Endπ Elseπ Beginπ DaysPerMonth[02] := 28;π X := 1;π Repeatπ If (TotDays <= DaysPerYear[x]) Thenπ Beginπ M := X;π Done := True;π Dec(LocalDate,(TotDays * SecsPerDay));π D := DaysPerMonth[M]-(DaysPerYear[M]-TotDays) + 1;π Endπ Elseπ Done := False;π Inc(X);π Until Done = True or (X > 12);π End;π H := LocalDate Div SecsPerHour;π Dec(LocalDate,(H * SecsPerHour));π Min := LocalDate Div SecsPerMinute;π Dec(LocalDate,(Min * SecsPerMinute));π S := LocalDate;πEnd;π{**************************************************************}πFunction DayOfYear;πvarπ HCentury,Century,Xyear,π Ripoff,HXYear : LongInt;π Holdyear,Holdmonth,Holdday:Integer;π year,month,day,dofwk:word;πbegin {DayofYear}π getdate(year,month,day,dofwk);π Holdyear:=year-1;π Holdmonth:=9;π Holdday:=31;π HCentury := HoldYear div 100;π HXYear := HoldYear mod 100;π HCentury := (HCentury * D1) shr 2;π HXYear := (HXYear * D0) shr 2;π Ripoff := ((((HoldMonth * 153) + 2) div 5) + HoldDay) + D2 + HXYear +πHCentury;π If Month <= 2 then beginπ Year := pred(Year);π Month := Month + 12;π end;π Month := Month - 3;π Century := Year div 100;π XYear := Year mod 100;π Century := (Century * D1) shr 2;π XYear := (XYear * D0) shr 2;π DayofYear := (((((Month * 153) + 2) div 5) + Day) + D2 + XYear + Century)-πripoff;π end; {DayOfYear}πProcedure Easter(Year : Word; Var Date : DateType);π (* Calculates what day Easter falls on in a given year *)π (* Set desired Year and result is returned in Date variable *)πVarπ GoldenNo,π Sun,π Century,π LeapCent,π LunarCorr,π Epact,π FullMoon : Integer;πBeginπ Date.Year := Year;π GoldenNo := (Year Mod 19) + 1;π Century := (Year Div 100) + 1;π LeapCent := (3 * Century Div 4) - 12;π LunarCorr := ((8 * Century + 5) Div 25) - 5;π Sun := (5 * Year Div 4) - LeapCent - 10;π Epact := Abs(11 * GoldenNo + 20 + LunarCorr - LeapCent) Mod 30;π If ((Epact = 25) And (GoldenNo > 11)) Or (Epact = 24) thenπ Inc(Epact);π FullMoon := 44 - Epact;π If FullMoon < 21 thenπ Inc(FullMoon, 30);π Date.Day := FullMoon + 7 - ((Sun + FullMoon) Mod 7);π If Date.Day > 31 thenπ Beginπ Dec(Date.Day, 31);π Date.Month := 4;π Endπ Elseπ Date.Month := 3;π Date.DOW := 0;πEnd;π{**************************************************************}πProcedure Thanksgiving(Year : Word; Var Date : DateType);π (* Calculates what day Thanksgiving falls on in a given year *)π (* Set desired Year and result is returned in Date variable *)πVarπ Counter,WeekDay:Word;π Daynum:longint;πBeginπ Date.Year := Year;π Date.Month := 11;π counter:=29;π repeatπ dec(counter);π GregorianToJulianDN(Date.Year, Date.Month, Counter, DayNum);π DayNum := ((DayNum + 1) mod 7);π WeekDay := (DayNum) + 1;π Until Weekday = 5;π Date.Day:=Counter;πEnd;π{*************************************************************}πFunction MoonPhase(Date:Datetype):Real;π (* Determines APPROXIMATE phase of the moon (percentage lit) *)π (* 0.00 = New moon, 1.00 = Full moon *)π (* Due to rounding, full values may possibly never be reached *)π (* Valid from Oct. 15, 1582 to Feb. 28, 4000 *)π (* Calculations adapted to Turbo Pascal from routines found in *)π (* "119 Practical Programs For The TRS-80 Pocket Computer" *)π (* John Clark Craig, TAB Books, 1982 (Ag) *)πVAR j:longint; m:real;πBeginπ GregorianToJulianDN(Date.Year,Date.Month,Date.Day,J);π M:=(J+4.867)/ 29.53058;π M:=2*(M-Int(m))-1;π MoonPhase:=Abs(M);πend;ππEND.π 37 02-09-9411:49ALL BRIAN STARK UNIX Date IMPORT 68 ╬N
· π(***************************************************************************)π(* UNIX DATE Version 1.01 *)π(* This unit provides access to UNIX date related functions and procedures *)π(* A UNIX date is the number of seconds from January 1, 1970. This unit *)π(* may be freely used. If you modify the source code, please do not *)π(* distribute your enhancements. *)π(* (C) 1991-1993 by Brian Stark. *)π(* This is a programming release from Digital Illusions *)π(* FidoNet 1:289/27.2 + Columbia, MO - USA *)π(* Revision History *)π(* ----------------------------------------------------------------------- *)π(* 06-13-1993 1.02 | Minor code cleanup *)π(* 05-23-1993 1.01 | Added a few more routines for use with ViSiON BBS *)π(* ??-??-1991 1.00 | First release *)π(* ----------------------------------------------------------------------- *)π(***************************************************************************)ππINTERFACEππUsesπ DOS;ππFunction GetTimeZone : ShortInt;π {Returns the value from the enviroment variable "TZ". If not found, UTC isπ assumed, and a value of zero is returned}πFunction IsLeapYear(Source : Word) : Boolean;π {Determines if the year is a leap year or not}πFunction Norm2Unix(Y, M, D, H, Min, S : Word) : LongInt;π {Convert a normal date to its UNIX date. If environment variable "TZ" isπ defined, then the input parameters are assumed to be in **LOCAL TIME**}πProcedure Unix2Norm(Date : LongInt; Var Y, M, D, H, Min, S : Word);π {Convert a UNIX date to its normal date counterpart. If the environmentπ variable "TZ" is defined, then the output will be in **LOCAL TIME**}ππFunction TodayInUnix : LongInt;π {Gets today's date, and calls Norm2Unix}π{π Following returns a string and requires the TechnoJock totSTR unit.πFunction Unix2Str(N : LongInt) : String;π}πConstπ DaysPerMonth :π Array[1..12] of ShortInt = (031,028,031,030,031,030,031,031,030,031,030,031);π DaysPerYear :π Array[1..12] of Integer = (031,059,090,120,151,181,212,243,273,304,334,365);π DaysPerLeapYear :π Array[1..12] of Integer = (031,060,091,121,152,182,213,244,274,305,335,366);π SecsPerYear : LongInt = 31536000;π SecsPerLeapYear : LongInt = 31622400;π SecsPerDay : LongInt = 86400;π SecsPerHour : Integer = 3600;π SecsPerMinute : ShortInt = 60;ππIMPLEMENTATIONππFunction GetTimeZone : ShortInt;πVarπ Environment : String;π Index : Integer;πBeginπ GetTimeZone := 0; {Assume UTC}π Environment := GetEnv('TZ'); {Grab TZ string}π For Index := 1 To Length(Environment) Doπ Environment[Index] := Upcase(Environment[Index]);π(*π NOTE: I have yet to find a complete list of the ISO table of time zoneπ abbreviations. The following is excerpted from the Opus-Cbcsπ documentation files.π*)π If Environment = 'EST05' Then GetTimeZone := -05; {USA EASTERN}π If Environment = 'EST05EDT' Then GetTimeZone := -06;π If Environment = 'CST06' Then GetTimeZone := -06; {USA CENTRAL}π If Environment = 'CST06CDT' Then GetTimeZone := -07;π If Environment = 'MST07' Then GetTimeZone := -07; {USA MOUNTAIN}π If Environment = 'MST07MDT' Then GetTimeZone := -08;π If Environment = 'PST08' Then GetTimeZone := -08;π If Environment = 'PST08PDT' Then GetTimeZone := -09;π If Environment = 'YST09' Then GetTimeZone := -09;π If Environment = 'AST10' Then GetTimeZone := -10;π If Environment = 'BST11' Then GetTimeZone := -11;π If Environment = 'CET-1' Then GetTimeZone := 01;π If Environment = 'CET-01' Then GetTimeZone := 01;π If Environment = 'EST-10' Then GetTimeZone := 10;π If Environment = 'WST-8' Then GetTimeZone := 08; {Perth, Western Austrailia}π If Environment = 'WST-08' Then GetTimeZone := 08;πEnd;ππFunction IsLeapYear(Source : Word) : Boolean;πBeginπ(*π NOTE: This is wrong!π*)π If (Source Mod 4 = 0) Thenπ IsLeapYear := Trueπ Elseπ IsLeapYear := False;πEnd;ππFunction Norm2Unix(Y,M,D,H,Min,S : Word) : LongInt;πVarπ UnixDate : LongInt;π Index : Word;πBeginπ UnixDate := 0; {initialize}π Inc(UnixDate,S); {add seconds}π Inc(UnixDate,(SecsPerMinute * Min)); {add minutes}π Inc(UnixDate,(SecsPerHour * H)); {add hours}π (*************************************************************************)π (* If UTC = 0, and local time is -06 hours of UTC, then *)π (* UTC := UTC - (-06 * SecsPerHour) *)π (* Remember that a negative # minus a negative # yields a positive value *)π (*************************************************************************)π UnixDate := UnixDate - (GetTimeZone * SecsPerHour); {UTC offset}ππ If D > 1 Then {has one day already passed?}π Inc(UnixDate,(SecsPerDay * (D-1)));ππ If IsLeapYear(Y) Thenπ DaysPerMonth[02] := 29π Elseπ DaysPerMonth[02] := 28; {Check for Feb. 29th}ππ Index := 1;π If M > 1 Then For Index := 1 To (M-1) Do {has one month already passed?}π Inc(UnixDate,(DaysPerMonth[Index] * SecsPerDay));ππ While Y > 1970 Doπ Beginπ If IsLeapYear((Y-1)) Thenπ Inc(UnixDate,SecsPerLeapYear)π Elseπ Inc(UnixDate,SecsPerYear);π Dec(Y,1);π End;ππ Norm2Unix := UnixDate;πEnd;ππProcedure Unix2Norm(Date : LongInt; Var Y, M, D, H, Min, S : Word);π{}πVarπ LocalDate : LongInt;π Done : Boolean;π X : ShortInt;π TotDays : Integer;πBeginπ Y := 1970;π M := 1;π D := 1;π H := 0;π Min := 0;π S := 0;π LocalDate := Date + (GetTimeZone * SecsPerHour); {Local time date}π (*************************************************************************)π (* Sweep out the years... *)π (*************************************************************************)π Done := False;π While Not Done Doπ Beginπ If LocalDate >= SecsPerYear Thenπ Beginπ Inc(Y,1);π Dec(LocalDate,SecsPerYear);π Endπ Elseπ Done := True;ππ If (IsLeapYear(Y+1)) And (LocalDate >= SecsPerLeapYear) Andπ (Not Done) Thenπ Beginπ Inc(Y,1);π Dec(LocalDate,SecsPerLeapYear);π End;π End;π (*************************************************************************)π M := 1;π D := 1;π Done := False;π TotDays := LocalDate Div SecsPerDay;π If IsLeapYear(Y) Thenπ Beginπ DaysPerMonth[02] := 29;π X := 1;π Repeatπ If (TotDays <= DaysPerLeapYear[x]) Thenπ Beginπ M := X;π Done := True;π Dec(LocalDate,(TotDays * SecsPerDay));π D := DaysPerMonth[M]-(DaysPerLeapYear[M]-TotDays) + 1;π Endπ Elseπ Done := False;π Inc(X);π Until (Done) or (X > 12);π Endπ Elseπ Beginπ DaysPerMonth[02] := 28;π X := 1;π Repeatπ If (TotDays <= DaysPerYear[x]) Thenπ Beginπ M := X;π Done := True;π Dec(LocalDate,(TotDays * SecsPerDay));π D := DaysPerMonth[M]-(DaysPerYear[M]-TotDays) + 1;π Endπ Elseπ Done := False;π Inc(X);π Until Done = True or (X > 12);π End;π H := LocalDate Div SecsPerHour;π Dec(LocalDate,(H * SecsPerHour));π Min := LocalDate Div SecsPerMinute;π Dec(LocalDate,(Min * SecsPerMinute));π S := LocalDate;πEnd;ππFunction TodayInUnix : LongInt;πVarπ Year, Month, Day, DayOfWeek: Word;π Hour, Minute, Second, Sec100: Word;πBeginπ GetDate(Year, Month, Day, DayOfWeek);π GetTime(Hour, Minute, Second, Sec100);π TodayInUnix := Norm2Unix(Year,Month,Day,Hour,Minute,Second);πEnd;ππFunction Unix2Str(N : LongInt) : String;πVarπ Year, Month, Day, DayOfWeek : Word;π Hour, Minute, Second, Sec100 : Word;π T : String;πBeginπ Unix2Norm(N, Year, Month, Day, Hour, Minute, Second);π T := PadRight(IntToStr(Month),2,'0')+'-'+PadRight(IntToStr(Day),2,'0')+'-'+π PadRight(IntToStr(Year),2,'0')+' '+ PadRight(IntToStr(Hour),2,'0')+':'+π PadRight(IntToStr(Minute),2,'0')+':'+PadRight(IntToStr(Second),2,'0');π If Hour > 12 Thenπ T := T + ' PM'π Elseπ T := T + ' AM';π Unix2Str := T;πEnd;πππEND.π 38 02-09-9411:49ALL CARLOS BEGUIGNE Set Date/Time Routine IMPORT 31 ╬N s π{Created by Carlos Beguinge, Sept 12, 1993}π{Program to get the systems date using [GetDate] and allowing you toπ change the date using [SetDate]. Feel free to incorporated into anyπ other code, and change it as you wish... Enjoy.}π{P.S. Any changes made to make this code better please post it back to meπ outlining the changes, Thank you.}π πuses Dos, Crt;π πconstπ days : array [0..6] of String[9] = {Array of Weekdays set here}π ('Sunday','Monday','Tuesday',π 'Wednesday','Thursday','Friday',π 'Saturday');πvarπ y, m, d, dow, I, Code : Word; {Setting the variables here}π changedt, cch : Char;π flagd, flagm, flagy : boolean;π ch : String;π πprocedure start(Code: Word); Forward; {To allow to go forward in a }π {procedure. Used for Error } π {Checking. }π πprocedure compute; {Called from procedure Start }πbegin {Moves the numeric string to }π Val(ch, I, Code); {numeric value. then checks }π if code <> 0 then {for errors. if error true }π begin {then Call procedure Start }π clrscr;π Writeln('Error in Date Statement', 'Press any key to Start Again ');π readln;π start(Code);π end; {Else Process Month, Day, and}π if (flagm = false) then {Year. }π beginπ m := I;π flagm := true;π write(cch);π cch :=#0;π end;π if (flagd = false) and (cch > #0) thenπ beginπ d := I;π flagd := true;π write(cch);π cch :=#0;π end;π if (flagy = false) and ( cch > #0) thenπ beginπ y := I;π flagy := true;π cch :=#13;π end;π ch := '';πend;π πprocedure ResetVars; {Called from procedure Start }πbegin {Resets all variable. }π clrscr;π Code :=0;π d :=0;π m :=0;π y :=0;π flagd := false;π flagm := false;π flagy := false;π ch :='';π cch := #0;πend;π πprocedure start; {Called from Main Program }πbegin π ResetVars; {Calls procedure ResetFields }π while (cch <> #13) do {Gets input from the keyboard}π begin {until a "/" or "Enter is }π cch := readkey; {pressed. }π while (cch <> #47) and (cch <> #13) doπ beginπ ch := ch + cch; {Adds the each numeric charac}π write(cch); {ter to the string variable }π cch := readkey;π end;π compute; {Calls procedure Compute }π end;πend;ππbegin {Main Program which calls }π clrscr; {procedure Start }π GetDate(y,m,d,dow);π Writeln('Today is ', days[dow],', ',π m:0, '/', d:0, '/', y:0);π Writeln;π Write('Would you like to change this Date? ');π readln(changedt);π if upcase(changedt) ='Y' thenπ beginπ start(Code);π clrscr;π SetDate(y,m,d); {Sets the Date if Changed }π Writeln('Today is ', days[dow],', ',π m:0, '/', d:0, '/', y:0);π readln;π endπ elseπ begin {Date remains unchanged }π Writeln('Today'#39's date Was NOT changed ');π Writeln('Today is ', days[dow],', ',π m:0, '/', d:0, '/', y:0);π readln;π end;πend.ππ 39 02-15-9407:44ALL WILBERT VAN LEIJEN Get Native DOS Date/Time IMPORT 66 ╬NEd { COUNTRY.PAS -- Going native with Dos. Do not use under DOS 2.xx.π Written by Wilbert van Leijen and released into the Public Domain }ππUnit Country;ππInterfaceπuses Dos;ππTypeπ DelimType = Recordπ thousands,π decimal,π date,π time : Array[0..1] of Char;π end;π CurrType = (leads, { symbol precedes value }π trails, { value precedes symbol }π leads_, { symbol, space, value }π _trails, { value, space, symbol }π replace); { replaced }π CountryType = Recordπ DateFormat : Word; { 0: USA, 1: Europe, 2: Japan }π CurrSymbol : Array[0..4] of Char;π Delimiter : DelimType; { Separators }π CurrFormat : CurrType; { Way currency is formatted }π CurrDigits : Byte; { Digits in currency }π Clock24hrs : Boolean; { True if 24-hour clock }π CaseMapCall : Procedure; { Lookup table for ASCII ≥ $80 }π DataListSep : Array[0..1] of Char;π CountryCode : Word;π end;π UpCaseType = Function(c : Char) : Char;π UpCaseStrType = Procedure(Var s : String);ππVarπ UpCase : UpCaseType; { To be determined at runtime }π UpCaseStr : UpCaseStrType;π CountryOk : Boolean; { Could determine country code flag }π CountryRec : CountryType;ππProcedure GetSysTime(Var Today : DateTime);πProcedure SetSysTime(Today : DateTime);ππFunction DateString(FileStamp : DateTime) : String;πFunction TimeString(FileStamp : DateTime) : String;ππImplementationππ{$R-,S-,V- }ππ{ Country dependent character capitalisation for DOS 3 }ππFunction UpCase3(c : Char) : Char; Far; Assembler;ππASMπ MOV AL, cπ CMP AL, 'a'π JB @2π CMP AL, 'z'π JA @1π AND AL, 11011111bπ JMP @2π@1: CMP AL, 80hπ JB @2π CALL [CountryRec.CaseMapCall]π@2:πend; { UpCase3 }ππ{ Country dependent string capitalisation for DOS 3 }ππProcedure UpCaseStr3(Var s : String); Far; Assembler;ππASMπ CLDπ LES DI, sπ XOR AX, AXπ MOV AL, ES:[DI]π STOSBπ XCHG AX, CXπ JCXZ @4ππ@1: MOV AL, ES:[DI]π CMP AL, 'a'π JB @3π CMP AL, 'z'π JA @2π AND AL, 11011111bπ JMP @3π@2: CMP AL, 80hπ JB @3π CALL [CountryRec.CaseMapCall]π@3: STOSBπ LOOP @1π@4:πend; { UpCaseStr3 }ππ{ Country dependent character capitalisation for DOS 4+ }ππFunction UpCase4(c : Char) : Char; Far; Assembler;ππASMπ MOV DL, cπ MOV AX, 6520hπ INT 21hπ MOV AL, DLπend; { UpCase4 }ππ{ Country dependent string capitalisation for DOS 4+ }ππProcedure UpCaseStr4(Var s : String); Far; Assembler;ππASMπ PUSH DSπ CLDπ XOR AX, AXπ LDS SI, sπ LODSBπ XCHG AX, CXπ JCXZ @1ππ MOV DX, SIπ MOV AX, 6521hπ INT 21hπ@1: POP DSπend; { UpCaseStr4 }ππ{ Return system time in Today }ππProcedure GetSysTime(Var Today : DateTime); Assembler;ππASMπ LES DI, Todayπ CLDππ MOV AH, 2Ahπ INT 21hπ XCHG AX, CX { year }π STOSWπ XOR AH, AHπ MOV AL, DH { month }π STOSWπ MOV AL, DL { day }π STOSWππ MOV AH, 2Chπ INT 21hπ XOR AH, AHπ MOV AL, CH { hours }π STOSWπ MOV AL, CL { min }π STOSWπ MOV AL, DH { seconds }π STOSWπend; { GetSysTime }ππ{ Set system time }ππProcedure SetSysTime(Today : DateTime); Assembler;ππASMπ PUSH DSπ CLDπ LDS SI, Todayπ LODSWπ MOV CX, AX { year }π LODSWπ MOV DH, AL { month }π LODSWπ MOV DL, AL { day }π MOV AH, 2Bhπ INT 21hππ LODSW π MOV CH, AL { hour }π LODSWπ MOV CL, AL { minutes }π LODSWπ MOV DH, AL { seconds }π XOR DL, DLπ MOV AH, 2Dhπ INT 21hπ POP DSπend; { SetSysTime }ππ{ Convert a binary number to an unpacked decimalπ On entry: AL <-- number ≤ 99π On exit: AX --> ASCII representation }ππProcedure UnpackNumber; Assembler;ππASMπ AAMπ XCHG AH, ALπ ADD AX, '00'πend; { UnpackNumber }ππFunction DateString(FileStamp : DateTime) : String; Assembler;ππASMπ PUSH DSπ CLDππ { Set string length }ππ LES DI, @Resultπ MOV AL, 8π STOSBππ { Store year, month and day in registers }ππ LDS SI, FileStampπ LODSWπ SUB AX, 1900π CALL UnpackNumberπ XCHG AX, BX { yy -> BX }π LODSWπ CALL UnpackNumberπ XCHG AX, CX { mm -> CX }π LODSWπ CALL UnpackNumberπ XCHG AX, DX { dd -> DX }ππ { Case date format ofπ 0 : USA standard mm:dd:yyπ 1 : Europe standard dd:mm:yyπ 2 : Japan standard yy:mm:dd }ππ POP DSπ MOV AL, Byte Ptr [CountryRec.DateFormat]π OR AL, ALπ JZ @1π DEC ALπ JZ @2ππ { Japan }ππ PUSH DXπ PUSH CXπ PUSH BXπ JMP @3ππ { USA }ππ@1: PUSH BXπ PUSH DXπ PUSH CXπ JMP @3ππ { Europe }ππ@2: PUSH BXπ PUSH CXπ PUSH DXππ { Remove leading zero }ππ@3: POP AXπ CMP AL, '0'π JNE @4π MOV AL, ' 'ππ@4: MOV CL, Byte Ptr [CountryRec.Delimiter.date]π STOSWπ MOV AL, CLπ STOSBπ POP AXπ STOSWπ MOV AL, CLπ STOSBπ POP AXπ STOSWπend; { DateString }ππFunction TimeString(FileStamp : DateTime) : String; Assembler;ππASMπ PUSH DSπ CLDππ MOV BL, [CountryRec.Clock24Hrs]π MOV DX, [CountryRec.Delimiter.time]π LDS SI, FileStampπ LES DI, @Resultππ { Set string length }ππ MOV AL, 5π STOSBππ { Advance string index of FileStamp to hour field }ππ ADD SI, 6π LODSWππ { Query time format }ππ OR BL, BLπ JNZ @2ππ { a.m. / p.m. clock format, set string length to 6 }ππ INC Byte Ptr ES:[DI-1]π MOV BL, 'a'π CMP AL, 12π JBE @1π SUB AL, 12π MOV BL, 'p'π@1: MOV Byte Ptr ES:[DI+5], BLππ { Convert to ASCII and remove leading zero }ππ@2: CALL UnpackNumberπ CMP AL, '0'π JNE @3π MOV AL, ' 'π@3: STOSWππ { Write time separator }ππ XCHG AX, DXπ STOSBππ { Store minutes in string }ππ LODSWπ CALL UnpackNumberπ STOSWππ POP DSπend; { TimeString }ππBegin { Country }πASMππ { Exit if Dos version < 3.0 }ππ MOV AH, 30hπ INT 21hπ CMP AL, 3π JB @3π JA @1ππ { Initialise pointers to DOS 3 capitalisation routines }ππ MOV Word Ptr [UpCase], Offset UpCase3π MOV Word Ptr [UpCaseStr], Offset UpCaseStr3π JMP @2ππ { Initialise pointers to DOS 4 (or later) capitalisation routines }ππ@1: MOV Word Ptr [UpCase], Offset UpCase4π MOV Word Ptr [UpCaseStr], Offset UpCaseStr4ππ@2: MOV Word Ptr [UpCase+2], CSπ MOV Word Ptr [UpCaseStr+2], CSππ { Call Dos 'Get country dependent information' function }ππ MOV AX, 3800hπ MOV DX, Offset [CountryRec]π INT 21hπ JC @3ππ { Add country code to the structure }ππ MOV [CountryRec.CountryCode], BXπ MOV [CountryOk], Trueπ JMP @4π@3: MOV [CountryOk], Falseπ@4:πend;πend. { Country } 40 05-25-9408:19ALL ALAN GRAFF Moonphase Algorithm? SWAG9405 17 ╬N⌠â {πAs Robert Forbes said to All on 25 Apr 94...ππ RF> Anyone have any idea how to make an algorithm toπ RF> calculate the moonphase given the date?ππHere ya go:ππTYPE DATETYPE = recordπ day:WORD;π MONTH:WORD;π YEAR:WORD;π dow:word;π end;ππ{=================================================================}ππProcedure GregorianToJulianDN(Year, Month, Day:Integer;π var JulianDN :LongInt);πvarπ Century,π XYear : LongInt;ππbegin {GregorianToJulianDN}π If Month <= 2 then beginπ Year := pred(Year);π Month := Month + 12;π end;π Month := Month - 3;π Century := Year div 100;π XYear := Year mod 100;π Century := (Century * D1) shr 2;π XYear := (XYear * D0) shr 2;π JulianDN := ((((Month * 153) + 2) div 5) + Day) + D2π + XYear + Century;π end; {GregorianToJulianDN}ππ{=================================================================}ππFunction MoonPhase(Date:Datetype):Real;ππ (***************************************************************)π (* *)π (* Determines APPROXIMATE phase of the moon (percentage lit) *)π (* 0.00 = New moon, 1.00 = Full moon *)π (* Due to rounding, full values may possibly never be reached *)π (* Valid from Oct. 15, 1582 to Feb. 28, 4000 *)π (* Calculations and BASIC program found in *)π (* "119 Practical Programs For The TRS-80 Pocket Computer" by *)π (* John Clark Craig, TAB Books, 1982 *)π (* Conversion to Turbo Pascal by Alan Graff, Wheelersburg, OH *)π (* *)π (***************************************************************)ππvarπj:longint; m:real;ππBeginπ GregorianToJulianDN(Date.Year,Date.Month,Date.Day,J);π M:=(J+4.867)/ 29.53058;π M:=2*(M-Int(m))-1;π MoonPhase:=Abs(M);πend;ππ 41 05-26-9406:19ALL FRED JOHNSON Day Of Week IMPORT 9 ╬N≡╔ {Returns a string or an integer, what ever you want}π{You fix for leap year}ππunit dow;πinterfaceππconstπ saDayOfWeek : array [0..6] of string =π ('Monday','Tuesday','Wednesday','Thursday',π 'Friday','Saturday','Sunday');ππtypeπ spString = ^string;ππfunction IntDow(yyyy,mm,dd : integer) : integer;πfunction StrDow(yyyy,mm,dd : integer) : spString;ππimplementationπ πfunction IntDow(yyyy,mm,dd : integer) : integer;π varπ iAddVal : shortint;π beginπ if mm < 3 then iAddVal := 1 else iAddVal := 0;π IntDow := (((3*(yyyy)-(7*((yyyy)+((mm)+9) div 12)) π div 4+(23*(mm)) div 9+(dd)+2 π +(((yyyy)-iAddVal) div 100+1)*3 div 4-16) mod 7));π end;ππfunction StrDow(yyyy,mm,dd : integer): spString;π var π sReturnString : string;π beginπ sReturnString := saDayOfWeek[IntDow(yyyy, mm, dd)];π StrDow := @sReturnString;π end; πend.π{test file}ππuses dow;πbeginπ write(StrDow(1995, 10,08)^);πend.π 42 05-26-9410:57ALL CHARLES CHAPMAN General Date Routines IMPORT 195 ╬N├ {$F+,O+,N+}πUNIT Dates;ππ { Version 1R0 - 1991 03 25 }π { 1R1 - 1991 04 09 - corrected several bugs, and }π { - deleted <JulianDa2>, <Da2OfWeek> and }π { <JulianDa2ToDate> - all found to be not }π { completely reliable. }ππINTERFACEππ { These routines all assume that the year (y, y1) value is supplied in a }π { form that includes the century (i.e., in YYYY form). No checking is }π { performed to ensure that a month (m, m1) value is in the range 1..12 }π { or that a day (d, d1) value is in the range 1..28,29,30,31. The }π { FUNCTION ValidDate may be used to check for valid month and day }π { parameters. FUNCTION DayOfYearToDate returns month and day (m, d) both }π { = 0 if the day-of-the-year (nd) is > 366 for a leap-year or > 365 for }π { other years. }ππ { NOTE: As written, FUNCTION Secs100 requires the presence of a 80x87 }π { co-processor. Its declaration and implementation may be altered to }π { REAL to make use of the floating-point emulation. }ππ { Because the Gregorian calendar was not implemented in all countries at }π { the same time, these routines are not guaranteed to be valid for all }π { dates. The real utility of these routines is that they will not fail }π { on December 31, 1999 - as will many algorithms used in MIS programs }π { implemented on mainframes. } ππ { The routines are NOT highly optimized - I have tried to maintain the }π { style of the algorithms presented in the sources I indicate. Any }π { suggestions for algorithmic or code improvements will be gratefully }π { accepted. This implementation is in the public domain - no copyright }π { is claimed. No warranty either express or implied is given as to the }π { correctness of the algorithms or their implementation. }ππ { Author: Charles B. Chapman, London, Ontario, Canada [74370,516] }π { Thanks to Leonard Erickson who supplied a test suite of values. }ππ FUNCTION IsLeap (y : WORD) : BOOLEAN;ππ FUNCTION ValidDate (y, m, d : WORD) : BOOLEAN;π FUNCTION ValidDate_Str (Str : string; {DWH}π VAR Y, M, D : word;π VAR Err_Str : string) : boolean;π FUNCTION ValidTime_Str (Str : string; {DWH}π VAR H, M, S : word;π VAR Err_Str : string) : boolean;ππ FUNCTION DayOfYear (y, m, d : WORD) : WORD;π FUNCTION JulianDay (y, m, d : WORD) : LONGINT;π FUNCTION JJ_JulianDay (y, m, d : word) : LONGINT; {DWH}ππ FUNCTION DayOfWeek (y, m, d : WORD) : WORD;π FUNCTION DayOfWeek_Str (y, m, d : WORD) : String; {DWH}ππ FUNCTION TimeStr (h, m, s, c : WORD) : STRING;π FUNCTION TimeStr2 (h, m, s : WORD) : STRING;π FUNCTION SIDateStr (y, m, d : WORD; SLen : BYTE; FillCh : CHAR) : STRING;π FUNCTION MDYR_Str (y, m, d : WORD): STRING; {DWH}ππ FUNCTION Secs100 (h, m, s, c : WORD) : DOUBLE;π PROCEDURE DayOfYearToDate (nd, y : WORD; VAR m, d : WORD);ππ PROCEDURE JulianDayToDate (nd : LONGINT; VAR y, m, d : WORD);π PROCEDURE JJ_JulianDayToDate (nd : LONGINT; VAR y, m, d : WORD); {DWH}ππ PROCEDURE DateOfEaster (Yr : WORD; VAR Mo, Da : WORD);π PROCEDURE AddDays (y, m, d : WORD; plus : LONGINT; VAR y1, m1, d1 : WORD);ππ FUNCTION Lotus_Date_Str (nd : LONGINT) : string; {DWH}π FUNCTION Str_Date_to_Lotus_Date_Formatπ (Date : String;π VAR Err_Msg : String): LongInt; {OLC}π{==========================================================================}ππIMPLEMENTATIONπ USESπ Dos;ππ{==========================================================================}ππ FUNCTION IsLeap (y : WORD) : BOOLEAN;ππ { Returns TRUE if <y> is a leap-year }ππ BEGINπ IF y MOD 4 <> 0 THENπ IsLeap := FALSEπ ELSEπ IF y MOD 100 = 0 THENπ IF y MOD 400 = 0 THENπ IsLeap := TRUEπ ELSEπ IsLeap := FALSEπ ELSEπ IsLeap := TRUEπ END; { IsLeap }ππ{==========================================================================}ππ FUNCTION DayOfYear (y, m, d : WORD) : WORD;ππ { function IDAY from remark on CACM Algorithm 398 }π { Computes day of the year for a given calendar date }π { GIVEN: y - year }π { m - month }π { d - day }π { RETURNS: day-of-the-year (1..366, given valid input) }ππ VARπ yy, mm, dd, Tmp1 : LONGINT;π BEGINπ yy := y;π mm := m;π dd := d;π Tmp1 := (mm + 10) DIV 13;π DayOfYear := 3055 * (mm + 2) DIV 100 - Tmp1 * 2 - 91 +π (1 - (yy - yy DIV 4 * 4 + 3) DIV 4 +π (yy - yy DIV 100 * 100 + 99) DIV 100 -π (yy - yy DIV 400 * 400 + 399) DIV 400) * Tmp1 + ddπ END; { DayOfYear }ππ{==========================================================================}ππ FUNCTION JulianDay (y, m, d : WORD) : LONGINT;ππ { procedure JDAY from CACM Alorithm 199 }π { Computes Julian day number for any Gregorian Calendar date }π { GIVEN: y - year }π { m - month }π { d - day }π { RETURNS: Julian day number (astronomically, for the day }π { beginning at noon) on the given date. }ππ VARπ Tmp1, Tmp2, Tmp3, Tmp4, Tmp5 : LONGINT;π BEGINπ IF m > 2 THENπ BEGINπ Tmp1 := m - 3;π Tmp2 := yπ ENDπ ELSEπ BEGINπ Tmp1 := m + 9;π Tmp2 := y - 1π END;π Tmp3 := Tmp2 DIV 100;π Tmp4 := Tmp2 MOD 100;π Tmp5 := d;π JulianDay := (146097 * Tmp3) DIV 4 + (1461 * Tmp4) DIV 4 +π (153 * Tmp1 + 2) DIV 5 + Tmp5 + 1721119π END; { JulianDay }ππ{==========================================================================}π π PROCEDURE DayOfYearToDate (nd, y : WORD; VAR m, d : WORD);π π { procedure CALENDAR from CACM Algorithm 398 }π { Computes month and day from given year and day of the year }π { GIVEN: nd - day-of-the-year (1..366) }π { y - year }π { RETURNS: m - month }π { d - day }ππ VARπ Tmp1, Tmp2, Tmp3, Tmp4, DaYr : LONGINT; π BEGINπ DaYr := nd;π IF (DaYr = 366) AND (DayOfYear (y, 12, 31) <> 366) THENπ DaYr := 999;π IF DaYr <= 366 THENπ BEGINπ IF y MOD 4 = 0 THENπ Tmp1 := 1π ELSEπ Tmp1 := 0;π IF (y MOD 400 = 0) OR (y MOD 100 <> 0) THENπ Tmp2 := Tmp1π ELSEπ Tmp2 := 0;π Tmp1 := 0;π IF DaYr > Tmp2 + 59 THENπ Tmp1 := 2 - Tmp2;π Tmp3 := DaYr + Tmp1;π Tmp4 := ((Tmp3 + 91) * 100) DIV 3055;π d := ((Tmp3 + 91) - (Tmp4 * 3055) DIV 100);π m := (Tmp4 - 2)π ENDπ ELSEπ BEGINπ d := 0;π m := 0π ENDπ END; { DayOfYearToDate }ππ{==========================================================================}ππ PROCEDURE JulianDayToDate (nd : LONGINT; VAR y, m, d : WORD);ππ { procedure JDATE from CACM Algorithm 199 }π { Computes calendar date from a given Julian day number for any }π { valid Gregorian calendar date }π { GIVEN: nd - Julian day number (2440000 --> 1968 5 23) }π { RETURNS: y - year }π { m - month }π { d - day }ππ VARπ Tmp1, Tmp2, Tmp3 : LONGINT;π BEGINπ Tmp1 := nd - 1721119;π Tmp3 := (4 * Tmp1 - 1) DIV 146097;π Tmp1 := (4 * Tmp1 - 1) MOD 146097;π Tmp2 := Tmp1 DIV 4;π Tmp1 := (4 * Tmp2 + 3) DIV 1461;π Tmp2 := (4 * Tmp2 + 3) MOD 1461;π Tmp2 := (Tmp2 + 4) DIV 4;π m := ((5 * Tmp2 - 3) DIV 153);π Tmp2 := (5 * Tmp2 - 3) MOD 153;π d := ((Tmp2 + 5) DIV 5);π y := (100 * Tmp3 + Tmp1);π IF m < 10 THENπ m := m + 3π ELSEπ BEGINπ m := m - 9;π y := y + 1π ENDπ END; { JulianDayToDate }ππ{==========================================================================}ππ PROCEDURE DateOfEaster (Yr : WORD; VAR Mo, Da : WORD);ππ { Algorithm "E" from Knuth's "Art of Computer Programming", vol. 1 }π { Computes date of Easter for any year in the Gregorian calendar }π { The local variables are the variable names used by Knuth. }π { GIVEN: Yr - year }π { RETURNS: Mo - month of Easter (3 or 4) }π { Da - day of Easter }ππ VARπ G, C, X, Z, D, E, N : LONGINT;π BEGINπ { Golden number of the year in Metonic cycle }π G := Yr MOD 19 + 1;π { Century }π C := Yr DIV 100 + 1;π { Corrections: }π { <X> is the no. of years in which leap-year was dropped in }π { order to keep step with the sun }π { <Z> is a special correction to synchronize Easter with the }π { moon's orbit . }π X := (3 * C) DIV 4 - 12;π Z := (8 * C + 5) DIV 25 - 5;π { <D> Find Sunday }π D := (5 * Yr) DIV 4 - X - 10;π { Set Epact }π E := (11 * G + 20 + Z - X) MOD 30;π IF E < 0 THENπ E := E + 30;π IF ((E = 25) AND (G > 11)) OR (E = 24) THENπ E := E + 1;π { Find full moon - the Nth of MARCH is a "calendar" full moon }π N := 44 - E;π IF N < 21 THENπ N := N + 30;π { Advance to Sunday }π N := N + 7 - ((D + N) MOD 7);π { Get Month and Day }π IF N > 31 THENπ BEGINπ Mo := 4;π Da := N - 31π ENDπ ELSEπ BEGINπ Mo := 3;π Da := Nπ ENDπ END; { DateOfEaster }ππ{==========================================================================}ππ FUNCTION SIDateStr (y, m, d : WORD; SLen : BYTE; FillCh : CHAR) : STRING;ππ { Returns date <y>, <m>, <d> converted to a string in SI format. If }π { <Slen> = 10, the string is in form YYYY_MM_DD; If <SLen> = 8, in form }π { YY_MM_DD; otherwise a NULL string is returned. The character between }π { values is <FillCh>. }π { For correct Systeme-Internationale date format, the call should be: }π { SIDateStr (Year, Month, Day, 10, ' '); }π { IF <y>, <m> & <d> are all = 0, Runtime library PROCEDURE GetDate is }π { called to obtain the current date. }ππ VARπ s2 : STRING[2];π s4 : STRING[4];π DStr : STRING[10];π Index : BYTE;π dw : WORD;π BEGINπ IF (SLen <> 10) AND (SLen <> 8) THENπ DStr[0] := Chr (0)π ELSEπ BEGINπ IF (y = 0) AND (m = 0) AND (d = 0) THENπ GetDate (y, m, d, dw);π IF SLen = 10 THENπ BEGINπ Str (y:4, s4);π DStr[1] := s4[1];π DStr[2] := s4[2];π DStr[3] := s4[3];π DStr[4] := s4[4];π Index := 5π ENDπ ELSEπ IF SLen = 8 THENπ BEGINπ Str (y MOD 100:2, s2);π DStr[1] := s2[1];π DStr[2] := s2[2];π Index := 3π END;π DStr[Index] := FillCh;π Inc (Index);π Str (m:2, s2);π IF s2[1] = ' ' THENπ DStr[Index] := '0'π ELSEπ DStr[Index] := s2[1];π DStr[Index+1] := s2[2];π Index := Index + 2;π DStr[Index] := FillCh;π Inc (Index);π Str (d:2, s2);π IF s2[1] = ' ' THENπ DStr[Index] := '0'π ELSEπ DStr[Index] := s2[1];π DStr[Index+1] := s2[2];π DStr[0] := Chr (SLen)π END;π SIDateStr := DStrπ END; { SIDateStr }π π{==========================================================================}ππ FUNCTION TimeStr (h, m, s, c : WORD) : STRING;ππ { Returns the time <h>, <m>, <s> and <c> formatted in a string: }π { "HH:MM:SS.CC" }π { This function does NOT check for valid string length. }π { }π { IF <h>, <m>, <s> & <c> all = 0, the Runtime PROCEDURE GetTime is }π { called to get the current time. }ππ VARπ sh, sm, ss, sc : STRING[2];π BEGINπ IF h + m + s + c = 0 THENπ GetTime (h, m, s, c);π Str (h:2, sh);π IF sh[1] = ' ' THENπ sh[1] := '0';π Str (m:2, sm);π IF sm[1] = ' ' THENπ sm[1] := '0';π Str (s:2, ss);π IF ss[1] = ' ' THENπ ss[1] := '0';π Str (c:2, sc);π IF sc[1] = ' ' THENπ sc[1] := '0';π TimeStr := Concat (sh, ':', sm, ':', ss, '.', sc)π END; { TimeStr }ππ{==========================================================================}π FUNCTION TimeStr2 (h, m, s : WORD) : STRING;ππ { Returns the time <h>, <m>, and <s> formatted in a string: }π { "HH:MM:SS" }π { This function does NOT check for valid string length. }π { }π { IF <h>, <m>, & <c> all = 0, the Runtime PROCEDURE GetTime is }π { called to get the current time. }ππ VARπ c : word;π sh, sm, ss : STRING[2];π BEGINπ IF h + m + s = 0 THENπ GetTime (h, m, s, c);π Str (h:2, sh);π IF sh[1] = ' ' THENπ sh[1] := '0';π Str (m:2, sm);π IF sm[1] = ' ' THENπ sm[1] := '0';π Str (s:2, ss);π IF ss[1] = ' ' THENπ ss[1] := '0';π TimeStr2 := Concat (sh, ':', sm, ':', ss)π END; { TimeStr2 }ππ{==========================================================================}π FUNCTION MDYR_Str (y, m, d : WORD): STRING; {dwh}ππ { Returns the date <y>, <m>, <d> formatted in a string: }π { "MM/DD/YYYY" }π { This function does NOT check for valid string length. }π { }π { IF <m>, <d>, & <y> all = 0, the Runtime PROCEDURE GetDate is }π { called to get the current date. }ππ VARπ sm, sd : STRING[2];π sy : STRING[4];π dont_care : word;π BEGINπ IF y + m + d = 0 THENπ GetDate (y, m, d, dont_care);π Str (m:2, sm);π IF sm[1] = ' ' THENπ sm[1] := '0';π Str (d:2, sd);π IF sd[1] = ' ' THENπ sd[1] := '0';π Str (y:4, sy);π MDYR_Str := Concat (sm, '/', sd, '/', sy)π END; { MDYR_Str }πππ{==========================================================================}ππ FUNCTION Secs100 (h, m, s, c : WORD) : DOUBLE;ππ { Returns the given time <h>, <m>, <s> and <c> as a floating-point }π { value in seconds (presumably valid to .01 of a second). }π { }π { IF <h>, <m>, <s> & <c> all = 0, the Runtime PROCEDURE GetTime is }π { called to get the current time. }ππ BEGINπ IF h + m + s + c = 0 THENπ GetTime (h, m, s, c);π Secs100 := (h * 60.0 + m) * 60.0 + s + (c * 0.01)π END; { Secs100 }πππ{==========================================================================}ππ PROCEDURE AddDays (y, m, d : WORD; plus : LONGINT; VAR y1, m1, d1 : WORD);ππ { Computes the date <y1>, <m1>, <d1> resulting from the addition of }π { <plus> days to the calendar date <y>, <m>, <d>. }ππ VARπ JulDay : LONGINT;π BEGINπ JulDay := JulianDay (y, m, d) + plus;π JulianDayToDate (JulDay, y1, m1, d1)π END; { AddDays }ππ{==========================================================================}ππ FUNCTION ValidDate (y, m, d : WORD) : BOOLEAN;ππ { Returns TRUE if the date <y> <m> <d> is valid. }ππ VARπ JulDay : LONGINT;π ycal, mcal, dcal : WORD;π BEGINπ JulDay := JulianDay (y, m, d);π JulianDayToDate (JulDay, ycal, mcal, dcal);π ValidDate := (y = ycal) AND (m = mcal) AND (d = dcal)π END; { ValidDate }ππ{==========================================================================}ππ FUNCTION DayOfWeek (y, m, d : WORD) : WORD;ππ { Returns the Day-of-the-week (0 = Sunday) (Zeller's congruence) from an }π { algorithm IZLR given in a remark on CACM Algorithm 398. }ππ VARπ Tmp1, Tmp2, yy, mm, dd : LONGINT;π BEGINπ yy := y;π mm := m;π dd := d;π Tmp1 := mm + 10;π Tmp2 := yy + (mm - 14) DIV 12;π DayOfWeek := ((13 * (Tmp1 - Tmp1 DIV 13 * 12) - 1) DIV 5 +π dd + 77 + 5 * (Tmp2 - Tmp2 DIV 100 * 100) DIV 4 +π Tmp2 DIV 400 - Tmp2 DIV 100 * 2) MOD 7;π END; { DayOfWeek }ππ{==========================================================================}πFUNCTION DayOfWeek_Str (y, m, d : WORD) : String;πbeginπ CASE DayOfWeek (y, m, d) ofπ 0: DayOfWeek_Str := 'SUNDAY';π 1: DayOfWeek_Str := 'MONDAY';π 2: DayOfWeek_Str := 'TUESDAY';π 3: DayOfWeek_Str := 'WEDNESDAY';π 4: DayOfWeek_Str := 'THURSDAY';π 5: DayOfWeek_Str := 'FRIDAY';π 6: DayOfWeek_Str := 'SATURDAY';π end; {case}πend; {dayofweek_str}πππ{==========================================================================}πFUNCTION JJ_JulianDay (y, m, d : word) : LONGINT;π {* format 5 position = last 2 digits of year+DayOfYear *}πvarπ dw : word;πbeginπ IF (y+m+d = 0)π THEN GetDate (Y,M,D, dw);π JJ_JulianDay:= ((LongInt(y) Mod 100)*1000+ DayOfYear(y,m,d));πend; {jj_julianday}πππ{==========================================================================}πPROCEDURE JJ_JulianDayToDate (nd : LONGINT; VAR y, m, d : WORD);π {* format nd=5 positions last 2 digits of year+DayOfYear *}πBEGINπ y := (nd DIV 1000); {year}π IF (y < 60) {will error when 2060}π THEN y := 2000+yπ ELSE y := 1900+y;π {dayofyear}π DayOfYearToDate ( (nd MOD 1000), y, m, d);πEND; { JulianDayToDate }ππ{==========================================================================}πFUNCTION Lotus_Date_Str (nd : LONGINT) : string;π {* lotus is strange the ND is the number of days SINCE 12/31/1899 *}π {* which is the JULIAN day 2415020 *}π {* Return format is MM/DD/YYYY *}πvarπ y,m,d : word;πbeginπ JulianDayToDate (nd+2415020-1, y,m,d);π Lotus_Date_Str := MDYr_Str (y,m,d);πend; {lotus_date_str}ππ{==========================================================================}πFUNCTION Str_Date_to_Lotus_Date_Format( Date : String;π VAR Err_Msg : String): LongInt;{OLC}πVARπ Y, M, D : word;π Julian : LongInt;πBEGINπ Err_Msg := '';π IF ValidDate_Str(Date, Y, M, D, Err_Msg ) THENπ BEGINπ Julian := JulianDay( Y, M, D );π Julian := Julian - 2415020 + 1;π Str_Date_to_Lotus_Date_Format := Julianπ ENDπ ELSEπ Str_Date_to_Lotus_Date_Format := -1;πEND;{Str_Date_to_Lotus_Date_Format}πππ{==========================================================================}πFUNCTION ValidDate_Str (Str : string;π VAR Y, M, D : word;π VAR Err_Str : string) : boolean;π {* returns TRUE when Str is valid MM/DD/YYYY or MM-DD-YYYY *}π {* the values are ranged checked and the date is also *}π {* checked for existance *}π {* Y, M, D are filled in with the values. *}πvarπ Err_Code : integer;π Long_Int : LongInt;π Slash1, Slash2 : byte;πbeginπ Err_Str := '';π Err_Code := 0;ππ IF (Length (Str) < 8)π THEN Err_Str := 'Date must be 12/31/1999 format'π ELSEπ BEGINπ Slash1 := POS ('/', Str);π IF (Slash1 > 0)π THEN Slash2 := POS ('/', COPY (Str, Slash1+1, LENGTH(Str))) + Slash1π ELSEπ BEGINπ Slash2 := 0;π Slash1 := POS ('-', Str);π IF (Slash1 > 0)π THEN Slash2 := POS ('-', COPY (Str, Slash1+1,π LENGTH(Str))) + Slash1;π END;ππ IF ((Slash1 = Slash2) or (Slash2 = 0))π THEN Err_Str := 'Date String must have either "-" or "/"'+π ' such as (12/01/1999)'π ELSEπ BEGINπ VAL (COPY(Str, 1,(Slash1-1)), Long_Int, Err_Code);π IF ((Err_Code <> 0) or (Long_Int < 1) or (Long_Int > 12))π THEN Err_Str := 'Month must be a number 1..12!'ππ ELSEπ BEGINπ M := Long_Int;π VAL (COPY(Str, (Slash1+1),(Slash2-Slash1-1)),π Long_Int, Err_Code);π IF ((Err_Code <> 0) or (Long_Int < 1) or (Long_Int > 31))π THEN Err_Str := 'Day must be a number 1..31!'ππ ELSEπ BEGINπ D := Long_Int;π VAL (COPY(Str, (Slash2+1),LENGTH(Str)), Long_Int, Err_Code);π IF ((Err_Code <> 0) or (Long_Int < 1900))π THEN Err_Str := 'Year must be a number greater than 1900!'π ELSE Y := Long_Int;π END;π END;π END;π END; {if long enough}ππ IF ((LENGTH(Err_Str) = 0) and (NOT DATES.ValidDate (Y, M, D)))π THEN Err_Str := 'Date does not exist!!!!';ππ IF (LENGTH(Err_Str) = 0)π THEN ValidDate_Str := TRUEπ ELSE ValidDate_Str := FALSE;ππEND; {validdate_str}ππ{==========================================================================}πFUNCTION ValidTime_Str (Str : string;π VAR H, M, S : word;π VAR Err_Str : string) : boolean;π {* returns TRUE when Str is valid HH:MM or HH:MM:SS *}π {* also H, M, S are filled in with the values. *}πvarπ Err_Code : integer;π Long_Int : LongInt;{use longint with VAL to prevent overflow}π Sep1, Sep2 : byte;π Count : byte;πbeginπ Err_Str := '';π Err_Code := 0;ππ IF (Length (Str) < 4)π THEN Err_Str := 'Time must be HH:MM or HH:MM:SS format'π ELSEπ BEGINπ Sep1 := POS (':', Str);π IF (Sep1 = 0)π THEN Err_Str := 'Time String must have either ":" '+π ' such as HH:MM or HH:MM:SS'ππ ELSEπ BEGINπ VAL (COPY(Str, 1,(Sep1-1)), Long_Int, Err_Code);π IF ((Err_Code <> 0) or (Long_Int < 1) or (Long_Int > 24))π THEN Err_Str := 'Hour must be a number 1..24!'ππ ELSEπ BEGINπ H := Long_Int;π Sep2 := POS (':', COPY (Str, Sep1+1, LENGTH(Str))) + Sep1;π IF (Sep2 = Sep1)π THEN Count := LENGTH(Str)π ELSE Count := Sep2-Sep1-1;π VAL (COPY(Str,(Sep1+1),Count), Long_Int, Err_Code);π IF ((Err_Code <> 0) or (Long_Int < 0) or (Long_Int > 59))π THEN Err_Str := 'Minute must be a number 0..59!'ππ ELSEπ BEGINπ M := Long_Int;π IF (Sep2 <> Sep1) THENπ BEGINπ VAL (COPY(Str, (Sep2+1),LENGTH(Str)), Long_Int, Err_Code);π IF ((Err_Code <> 0) or (Long_Int < 0) or (Long_Int > 59))π THEN Err_Str := 'Second must be a number 0..59!'π ELSE S := Long_Int;π ENDπ ELSE S := 0;π END;π END;π END;π END; {if long enough}ππ IF (LENGTH(Err_Str) = 0)π THEN ValidTime_Str := TRUEπ ELSE ValidTime_Str := FALSE;ππEND; {validtime_str}ππEND. {unit dates}ππ
