home *** CD-ROM | disk | FTP | other *** search
/ Phoenix CD 2.0 / Phoenix_CD.cdr / 15a / murutil.zip / DATTIM.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-26  |  3KB  |  133 lines
  1. {$P512,D-}
  2. PROGRAM DATTIM;
  3.  
  4. {  This program displays the current date and time.
  5.  
  6.    Program by Harry M. Murphy,  22 February 1986.  }
  7.  
  8. TYPE
  9.   DATESTRING = STRING[28];
  10.   TIMESTRING = STRING[6];
  11.  
  12. VAR
  13.   CLOCK: TIMESTRING;
  14.   TODAY: DATESTRING;
  15.  
  16.  
  17. FUNCTION DATE: DATESTRING;
  18.  
  19. {  This function returns today's date as a DateString of up
  20.    to 28 bytes, such as:  "Tuesday, 18 February 1986".
  21.  
  22.    Note:  TYPE DATESTRING = STRING[28];
  23.  
  24.    Procedure adapted from the Turbo Pascal date example by
  25.    Harry M. Murphy,  18 February 1986.  }
  26.  
  27.   TYPE
  28.     REGPAK = RECORD
  29.                AX,BX,CX,DX,BP,SI,DI,DS,ES,FL: INTEGER
  30.              END;
  31.  
  32.   VAR
  33.     ID,IM,IW,IY,JC,JD,JM,JY: INTEGER;
  34.     REG:  REGPAK;
  35.     DAY:  STRING[2];
  36.     DTE:  DATESTRING;
  37.     YEAR: STRING[4];
  38.  
  39.   BEGIN
  40.     WITH REG DO
  41.       BEGIN
  42.         AX:=$2A00;
  43.         MSDOS(REG);
  44.         IY:=CX;
  45.         IM:=HI(DX);
  46.         ID:=LO(DX)
  47.       END;
  48.     JY:=IY; JM:=IM-2;
  49.     IF JM < 1 THEN BEGIN JM:=JM+12; JY:=JY-1 END;
  50.     JC:=JY DIV 100; JD:=JY-100*JC;
  51.     IW:=((ID+42+(13*JM-1) DIV 5 +JD+JD DIV 4+JC DIV 4-2*JC) MOD 7);
  52.     CASE IW OF
  53.       0: DTE:='Sunday, ';
  54.       1: DTE:='Monday, ';
  55.       2: DTE:='Tuesday, ';
  56.       3: DTE:='Wednesday, ';
  57.       4: DTE:='Thursday, ';
  58.       5: DTE:='Friday, ';
  59.       6: DTE:='Saturday, '
  60.     END { CASE };
  61.     STR(ID:2,DAY); STR(IY:4,YEAR);
  62.     CASE IM OF
  63.       1: DTE:=DTE+DAY+' January '+YEAR;
  64.       2: DTE:=DTE+DAY+' February '+YEAR;
  65.       3: DTE:=DTE+DAY+' March '+YEAR;
  66.       4: DTE:=DTE+DAY+' April '+YEAR;
  67.       5: DTE:=DTE+DAY+' May '+YEAR;
  68.       6: DTE:=DTE+DAY+' June '+YEAR;
  69.       7: DTE:=DTE+DAY+' July '+YEAR;
  70.       8: DTE:=DTE+DAY+' August '+YEAR;
  71.       9: DTE:=DTE+DAY+' September '+YEAR;
  72.      10: DTE:=DTE+DAY+' October '+YEAR;
  73.      11: DTE:=DTE+DAY+' November '+YEAR;
  74.      12: DTE:=DTE+DAY+' December '+YEAR
  75.     END { CASE };
  76.     DATE:=DTE
  77.   END {Function DATE};
  78.  
  79.  
  80. FUNCTION TIME: TIMESTRING;
  81.  
  82. {  This function returns the current clock time as a TimeString
  83.    of 6 bytes, such as:  "19:05h".
  84.  
  85.    Note:  TYPE TIMESTRING = STRING[6];
  86.  
  87.    Procedure adapted from the Turbo Pascal date example by
  88.    Harry M. Murphy,  19 February 1986.  }
  89.  
  90.   TYPE
  91.     REGPAK = RECORD
  92.                AX,BX,CX,DX,BP,SI,DI,DS,ES,FL: INTEGER
  93.              END;
  94.  
  95.   VAR
  96.     H,M,S,T: INTEGER;
  97.     HR:      STRING[2];
  98.     MN:      STRING[2];
  99.     REG:     REGPAK;
  100.  
  101.   BEGIN
  102.     WITH REG DO
  103.       BEGIN
  104.         AX:=$2C00;
  105.         MSDOS(REG);
  106.         H:=HI(CX);
  107.         M:=LO(CX);
  108.         S:=HI(DX);
  109.         T:=LO(DX)
  110.       END;
  111.     IF T > 50 THEN S:=S+1;
  112.     IF S > 30 THEN M:=M+1;
  113.     IF M = 60
  114.       THEN
  115.         BEGIN
  116.           H:=H+1;
  117.           M:=0;
  118.           IF H = 24 THEN H:=0
  119.         END;
  120.     STR(H:2,HR);
  121.     STR(M:2,MN);
  122.     IF MN[1]=' ' THEN MN[1]:='0'; 
  123.     TIME:=HR+':'+MN+'h'
  124.   END {Function TIME};
  125.  
  126.  
  127. BEGIN  { Program DATTIME}
  128.   CLOCK:=TIME;
  129.   TODAY:=DATE;
  130.   LOWVIDEO;
  131.   WRITELN(CLOCK,',  ',TODAY)
  132. END.
  133.