SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00025 DATE & TIME ROUTINES 1 05-28-9313:37ALL SWAG SUPPORT TEAM ASMTIME.PAS 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 SWAG SUPPORT TEAM 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 SWAG SUPPORT TEAM 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 SWAG SUPPORT TEAM 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 SWAG SUPPORT TEAM 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 SWAG SUPPORT TEAM 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 SWAG SUPPORT TEAM 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 SWAG SUPPORT TEAM 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 SWAG SUPPORT TEAM 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 05-28-9313:37ALL SWAG SUPPORT TEAM UNIXTIME.PAS IMPORT 32 ╬Nbl {πINBAR RAZππ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.ππ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 seconds 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;π 21 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.ππ 22 06-22-9309:13ALL SWAG SUPPORT TEAM 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π 23 06-22-9309:13ALL SWAG SUPPORT TEAM 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)π 24 08-18-9312:19ALL JOSE ALMEIDA Get ROM Bios Date IMPORT 8 ╬N { 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 }π 25 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.π
