home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
PROGRAM
/
MISCPAS.ZIP
/
SHOWDATE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-06-23
|
3KB
|
120 lines
PROGRAM showdate; {For Turbo Pascal}
TYPE
Datetimestr = STRING[26];
VAR
datetimestamp : datetimestr;
{$V-}
{Library Function to get current date and time from clock}
FUNCTION DateTime: DateTimeStr;
TYPE
regpack = RECORD
ax,bx,cx,dx,bp,si,ds,es,flags: integer;
END;
dayname = STRING[3];
TYPE monthname = ARRAY[1..12] OF STRING[3];
CONST mon: monthname = ('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
VAR
recpack: regpack; {record for MsDos call}
day,hours,minutes,seconds,ampm: STRING[2];
year: STRING[4];
month,dx,cx,daynumber,yearnumber,time: integer;
dayoftheweek : dayname;
FUNCTION DayofWeek(juliandate:real): dayname;
{finds day of week for 10 feb 1985 or later}
TYPE daynames = ARRAY[1..7] OF STRING[3];
CONST day: daynames = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
VAR daynumber : real;
BEGIN
daynumber := (juliandate + 1.5)/7;
daynumber := daynumber -349444.0; {sun 10 feb 1985}
WHILE daynumber > 32000 DO
daynumber := daynumber - 32000;
daynumber := (daynumber - trunc(daynumber))*7;
dayofweek := day[round(daynumber)+1];
END;
FUNCTION juliandate(daynumber, monthnumber, yearnumber:integer): real;
VAR a,b,c,d : real;
BEGIN
IF monthnumber < 3
THEN
BEGIN
yearnumber := yearnumber -1;
monthnumber := monthnumber + 12;
END;
a := trunc(yearnumber/100)*1.0;
b := 2-a+trunc(a/4)*1.0;
c := 365.0 * yearnumber+trunc(yearnumber/4);
d := trunc(30.6001*(monthnumber+1));
juliandate := b+c+d+1720994.5+daynumber;
{ writeln('julian date ',b+c+d+1720994.5+daynumber:10:1);}
END;
BEGIN
WITH recpack DO
BEGIN
ax := $2a shl 8;
END;
MsDos(recpack); { call function }
WITH recpack DO
BEGIN
str(cx,year); {convert to string}
yearnumber := cx;
daynumber := dx MOD 256;
str(daynumber,day); { " }
month := dx shr 8;
END;
WITH recpack DO
BEGIN
ax := $2c shl 8;
END;
MsDos(recpack);
WITH recpack DO
BEGIN
time := cx shr 8;
IF time = 0
THEN time := 12;
IF time>12
THEN BEGIN
ampm := 'PM';
time := time -12;
END
ELSE ampm := 'AM';
str(time,hours);
str(cx MOD 256,minutes);
IF (cx MOD 256)<10
THEN minutes := '0'+minutes;
str(dx shr 8,seconds);
IF (dx shr 8)<10
THEN seconds := '0'+seconds;
END;
dayoftheweek := (dayofweek(juliandate(daynumber,month,yearnumber)));
IF daynumber > 9
THEN
datetime := dayoftheweek+' '+day+' '+mon[month]+' '+year
+' '+hours+':'+minutes+' '+ampm
ELSE
datetime := dayoftheweek+' '+' '+day+' '+mon[month]+' '+year+' '
+hours+':'+minutes+' '+ampm;
END;
BEGIN
datetimestamp := datetime;
writeln(datetimestamp);
END.