home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / date / showdate / showdate.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-04-30  |  3.0 KB  |  104 lines
  1. PROGRAM ShowDate;  {For Turbo Pascal}
  2. { converted to TP 4++ jb/'94 }
  3. USES Dos;
  4.  
  5. TYPE
  6.   Datetimestr = STRING[26];
  7.  
  8. VAR
  9.   datetimestamp : datetimestr;
  10. {$V-}
  11.  
  12. {Library Function to get current date and time from clock}
  13.  
  14.   FUNCTION DateTime: DateTimeStr;
  15.  
  16.   TYPE
  17.     dayname   = STRING[3];
  18.     monthname = ARRAY[1..12] OF STRING[3];
  19.  
  20.   CONST
  21.     mon: monthname = ('Jan','Feb','Mar','Apr','May','Jun',
  22.                       'Jul','Aug','Sep','Oct','Nov','Dec');
  23.  
  24.   VAR
  25.     recpack:       Registers;              {record for MsDos call}
  26.     day,hours,minutes,seconds,ampm:     STRING[2];
  27.     year:          STRING[4];
  28.     month,dx,cx,daynumber,yearnumber,time:         integer;
  29.     dayoftheweek : dayname;
  30.  
  31.     FUNCTION DayofWeek(juliandate:real): dayname;
  32.     { finds day of week for 10 feb 1985 or later }
  33.     TYPE
  34.       daynames = ARRAY[1..7] OF STRING[3];
  35.     CONST
  36.       day: daynames = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  37.     VAR
  38.       daynumber : real;
  39.     BEGIN
  40.       daynumber := (juliandate + 1.5)/7;
  41.       daynumber := daynumber -349444.0;   {sun 10 feb 1985}
  42.       WHILE daynumber > 32000 DO
  43.         daynumber := daynumber - 32000;
  44.       daynumber := (daynumber - trunc(daynumber))*7;
  45.       dayofweek := day[round(daynumber)+1];
  46.     END;
  47.  
  48.     FUNCTION juliandate(daynumber, monthnumber, yearnumber:integer): real;
  49.     VAR
  50.       a,b,c,d : real;
  51.     BEGIN
  52.       IF monthnumber < 3 THEN BEGIN
  53.         yearnumber := yearnumber -1;
  54.         monthnumber := monthnumber + 12;
  55.       END;
  56.       a := trunc(yearnumber/100)*1.0;
  57.       b := 2-a+trunc(a/4)*1.0;
  58.       c := 365.0 * yearnumber+trunc(yearnumber/4);
  59.       d := trunc(30.6001*(monthnumber+1));
  60.       juliandate := b+c+d+1720994.5+daynumber;
  61.     {  writeln('julian date ',b+c+d+1720994.5+daynumber:10:1);}
  62.     END;
  63.  
  64.   BEGIN
  65.     WITH recpack DO ax := $2a shl 8;
  66.     MsDos(recpack);                        { call function }
  67.     WITH recpack DO BEGIN
  68.       str(cx,year);                        {convert to string}
  69.       yearnumber := cx;
  70.       daynumber := dx MOD 256;
  71.       str(daynumber,day);                     { " }
  72.       month := dx shr 8;
  73.     END;
  74.     WITH recpack DO ax := $2c shl 8;
  75.     MsDos(recpack);
  76.     WITH recpack DO BEGIN
  77.       time := cx shr 8;
  78.       IF time = 0 THEN time := 12;
  79.       IF time > 12 THEN BEGIN
  80.         ampm := 'PM';
  81.         time := time -12;
  82.       END
  83.       ELSE ampm := 'AM';
  84.       str(time,hours);
  85.       str(cx MOD 256,minutes);
  86.       IF (cx MOD 256)<10 THEN minutes := '0'+minutes;
  87.       str(dx shr 8,seconds);
  88.       IF (dx shr 8)<10 THEN seconds := '0'+seconds;
  89.     END;
  90.     dayoftheweek := (dayofweek(juliandate(daynumber,month,yearnumber)));
  91.  
  92.     IF daynumber > 9 THEN
  93.       datetime := dayoftheweek+' '+day+' '+mon[month]+' '+year
  94.                 + '   '+hours+':'+minutes+' '+ampm
  95.     ELSE
  96.       datetime := dayoftheweek+' '+' '+day+' '+mon[month]+' '+year+'   '
  97.                 + hours+':'+minutes+' '+ampm;
  98.   END;
  99.  
  100. BEGIN
  101.   datetimestamp := datetime;
  102.   writeln(datetimestamp);
  103. END.
  104.