home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mod201j.zip / modula2.exe / os2src / timedate.mod < prev    next >
Text File  |  1995-06-16  |  8KB  |  418 lines
  1. IMPLEMENTATION MODULE TimeDate;
  2. (*
  3.     Title       : A group of time and date utilities
  4.     Limitations : Limited to dates 31 December 1899 to 4 June 2079
  5.     Author      : I.R. Matters (Ian.Matters@anu.edu.au)
  6.     System      : Juergen Neuhoff's Modula-2 compiler on OS/2 v3.0
  7.     Version     : 1.00
  8.     Last Edit   : 16 June 1995
  9. *)
  10.  
  11.  
  12. FROM Conversions IMPORT CardToStr, StrToCard;
  13. FROM Strings     IMPORT Append, Assign, Concat, Copy, Length;
  14. FROM OS2DEF      IMPORT APIRET;
  15. FROM DOSDATETIME IMPORT DATETIME, DosGetDateTime;
  16.  
  17.  
  18. CONST Leap         =     4;  (* Leap years every 4 years *)
  19.       Century      =   100;  (* Years in a century       *)
  20.       QuadCentury  =   400;  (* Years in four centuries  *)
  21.       NormalYear   =   365;  (* Days in a non-leap year  *)
  22.       FirstYear    =  1900;  (* Our first year           *)
  23.       DaysIn4Years =  1461;  (* Including leap day       *)
  24.       Minute       =    60;  (* Seconds on one minute    *)
  25.       Hour         =  3600;  (* Seconds in one hour      *)
  26.       Day          = 86400;  (* Seconds in one day       *)
  27.  
  28.  
  29. (* Local declarations *)
  30.  
  31. PROCEDURE Str (C, W : CARDINAL; VAR S: ARRAY OF CHAR);
  32. (*
  33.    Convert a CARDINAL to a string with a designated field width
  34. *)
  35. VAR result : BOOLEAN;
  36. BEGIN
  37.   result := CardToStr (C, S);
  38.   WHILE (Length (S) < W) DO
  39.     Concat (" ", S, S);
  40.   END; 
  41. END Str;
  42.  
  43.  
  44. (* Procedure implementations *)
  45.  
  46. PROCEDURE DateNow(): CARDINAL;
  47. (*
  48.    Returns the current date as a CARDINAL
  49.    containing the date serial number - 1 January 1900 = 1.
  50. *)
  51. VAR DateTime : DATETIME;
  52.     rc       : APIRET;
  53. BEGIN
  54.   rc := DosGetDateTime (DateTime);
  55.   RETURN (DateToSerialNumber (DateTime.year, DateTime.month, DateTime.day));
  56. END  DateNow;
  57.  
  58.  
  59. PROCEDURE DateToStr (N: CARDINAL; F: DateFormats; VAR S: ARRAY OF CHAR);
  60. (*
  61.    Convert a date serial number to a "DD/MM/YYYY" or
  62.    "MM-DD-YYYY" date string - day 1 = 1 January 1900
  63. *)
  64. VAR Y, M, D : CARDINAL;
  65.     S1, S2  : ARRAY [0..10] OF CHAR;
  66. BEGIN
  67.   S2 [0] := 0C;
  68.   Append ("00/00/0000", S2);
  69.   IF (F = US) THEN
  70.     S2 [2] := '-';
  71.     S2 [5] := '-';
  72.   END;
  73.   SerialNumberToDate (N, Y, M, D);
  74.  
  75.   (* Now do the days *)
  76.  
  77.   Str (D, 2, S1);
  78.   IF (F = US) THEN
  79.     IF (S1 [0] > '0') THEN
  80.       S2 [3] := S1 [0];
  81.     END;
  82.     S2 [4] := S1 [1];
  83.   ELSE
  84.     IF (S1 [0] > '0') THEN
  85.       S2 [0] := S1 [0];
  86.     END;
  87.     S2 [1] := S1 [1];
  88.   END;
  89.  
  90.   (* Now do the months *)
  91.  
  92.   Str (M, 2, S1);
  93.   IF (F = US) THEN
  94.     IF (S1 [0] > '0') THEN
  95.       S2 [0] := S1 [0];
  96.     END;
  97.     S2 [1] := S1 [1];
  98.   ELSE
  99.     IF (S1 [0] > '0') THEN
  100.       S2 [3] := S1 [0];
  101.     END;
  102.     S2 [4] := S1 [1];
  103.   END;
  104.  
  105.   (* Now do the year *)
  106.  
  107.   Str (Y, 4, S1);
  108.   IF (S1 [0] > '0') THEN
  109.     S2 [6] := S1 [0];
  110.   END;
  111.   IF (S1 [1] > '0') THEN
  112.     S2 [7] := S1 [1];
  113.   END;
  114.   IF (S1 [2] > '0') THEN
  115.     S2 [8] := S1 [2];
  116.   END;
  117.   S2 [9] := S1 [3];
  118.  
  119.   Assign (S2, S);
  120. END DateToStr;
  121.  
  122.  
  123. PROCEDURE SerialNumberToDate (N: CARDINAL; VAR Y, M, D: CARDINAL);
  124. (*
  125.    Convert a date serial number to a date - 1 January 1900 = 1
  126. *)
  127. VAR Feb : CARDINAL;
  128. BEGIN
  129.   IF (N = 0) THEN
  130.     Y := FirstYear - 1;
  131.     M := 12;
  132.     D := DaysInMonth (Y, M);
  133.   ELSE
  134.     Y := CARDINAL (((Leap * (LONGINT (N) - 1)) DIV DaysIn4Years) + FirstYear);
  135.     M := 1;
  136.     D := CARDINAL (LONGINT (N) - LONGINT (DateToSerialNumber (Y, M, 1)) + 1);
  137.   END;
  138.  
  139.   IF (D > 31) THEN
  140.     INC (M);
  141.     DEC (D, 31);
  142.   ELSE
  143.     RETURN;
  144.   END;
  145.  
  146.   IF LeapYear (Y) THEN
  147.     Feb := 29
  148.   ELSE
  149.     Feb := 28;
  150.   END;
  151.  
  152.   IF (D > Feb) THEN
  153.     INC (M);
  154.     DEC (D, Feb);
  155.   ELSE
  156.     RETURN;
  157.   END;
  158.  
  159.   IF (D > 31) THEN
  160.     INC (M);
  161.     DEC (D, 31);
  162.   ELSE 
  163.     RETURN;
  164.   END;
  165.  
  166.   IF (D > 30) THEN
  167.     INC (M);
  168.     DEC (D, 30);
  169.   ELSE
  170.     RETURN;
  171.   END;
  172.  
  173.   IF (D > 31) THEN
  174.     INC (M);
  175.     DEC (D, 31);
  176.   ELSE
  177.     RETURN;
  178.   END;
  179.  
  180.   IF (D > 30) THEN
  181.     INC (M);
  182.     DEC (D, 30);
  183.   ELSE
  184.     RETURN;
  185.   END;
  186.  
  187.   IF (D > 31) THEN
  188.     INC (M);
  189.     DEC (D, 31);
  190.   ELSE
  191.     RETURN;
  192.   END;
  193.  
  194.   IF (D > 31) THEN
  195.     INC (M);
  196.     DEC (D, 31);
  197.   ELSE
  198.     RETURN;
  199.   END;
  200.  
  201.   IF (D > 30) THEN
  202.     INC (M);
  203.     DEC (D, 30);
  204.   ELSE
  205.     RETURN;
  206.   END;
  207.  
  208.   IF (D > 31) THEN
  209.     INC (M);
  210.     DEC (D, 31);
  211.   ELSE
  212.     RETURN;
  213.   END;
  214.  
  215.   IF (D > 30) THEN
  216.     INC (M);
  217.     DEC (D, 30);
  218.   ELSE
  219.     RETURN;
  220.   END;
  221.  
  222. END SerialNumberToDate;
  223.  
  224.  
  225. PROCEDURE DateToSerialNumber (Y, M, D: CARDINAL): CARDINAL;
  226. (*
  227.    Convert a date to a date serial number - 1 January 1900 = 1
  228. *)
  229. VAR Feb : CARDINAL;
  230.     N   : LONGINT;
  231. BEGIN
  232.   N := (NormalYear * (LONGINT (Y) - FirstYear)) +
  233.        ((LONGINT (Y) - FirstYear - 1) DIV Leap) + LONGINT (D) + 1;
  234.  
  235.   IF LeapYear (Y) THEN
  236.     Feb := 29
  237.   ELSE
  238.     Feb := 28;
  239.   END;
  240.  
  241.   IF (M >  1) THEN
  242.     INC (N, 31);
  243.   END;
  244.  
  245.   IF (M >  2) THEN
  246.     INC (N, Feb);
  247.   END;
  248.  
  249.   IF (M >  3) THEN
  250.     INC (N, 31);
  251.   END;
  252.  
  253.   IF (M >  4) THEN
  254.     INC (N, 30);
  255.   END;
  256.  
  257.   IF (M >  5) THEN INC
  258.     (N, 31);
  259.   END;
  260.  
  261.   IF (M >  6) THEN INC
  262.     (N, 30);
  263.   END;
  264.  
  265.   IF (M >  7) THEN INC
  266.     (N, 31);
  267.   END;
  268.  
  269.   IF (M >  8) THEN
  270.     INC (N, 31);
  271.   END;
  272.  
  273.   IF (M >  9) THEN INC
  274.     (N, 30);
  275.   END;
  276.  
  277.   IF (M > 10) THEN INC
  278.     (N, 31);
  279.   END;
  280.  
  281.   IF (M > 11) THEN INC
  282.     (N, 30);
  283.   END;
  284.  
  285.   RETURN (CARDINAL (N));
  286. END DateToSerialNumber;
  287.  
  288.  
  289. PROCEDURE TimeNow(): LONGCARD;
  290. (*
  291.    Returns the current time of day as a LONGCARD
  292.    containing the number of seconds since midnight.
  293. *)
  294. VAR DateTime : DATETIME;
  295.     rc       : APIRET;
  296. BEGIN
  297.   rc := DosGetDateTime (DateTime);
  298.   RETURN (Hour * LONGCARD (DateTime.hours)) +
  299.           (Minute * LONGCARD (DateTime.minutes)) +
  300.           LONGCARD (DateTime.seconds);
  301. END TimeNow;
  302.  
  303.  
  304. PROCEDURE TimeToStr (N: LONGCARD; VAR S: ARRAY OF CHAR);
  305. (*
  306.    Convert a time serial number to a "HH:MM:SS" time string
  307. *)
  308. VAR H, M, Sec : CARDINAL;
  309.     S1, S2    : ARRAY [1..9] OF CHAR;
  310. BEGIN
  311.   S2 [1] := 0C;
  312.   Append ("00:00:00", S2);
  313.   SerialNumberToTime (N, H, M, Sec);
  314.  
  315.   Str (H, 2, S1);
  316.   IF (S1 [1] > '0') THEN
  317.     S2 [1] := S1 [1];
  318.   END;
  319.   S2 [2] := S1 [2];
  320.  
  321.   Str (M, 2, S1);
  322.   IF (S1 [1] > '0') THEN
  323.     S2 [4] := S1 [1];
  324.   END;
  325.   S2 [5] := S1 [2];
  326.  
  327.   Str (Sec, 2, S1);
  328.   IF (S1 [1] > '0') THEN
  329.     S2 [7] := S1 [1];
  330.   END;
  331.   S2 [8] := S1 [2];
  332.  
  333.   S2 [9] := 0C;
  334.   Assign (S2, S);
  335. END TimeToStr;
  336.  
  337.  
  338. PROCEDURE SerialNumberToTime (N: LONGCARD; VAR H, M, S: CARDINAL);
  339. (*
  340.    Convert a "HH:MM:SS" time serial number to hours, minutes and seconds
  341. *)
  342. BEGIN
  343.   H := CARDINAL (N DIV Hour);
  344.   M := CARDINAL ((N - (H * Hour)) DIV Minute);
  345.   S := CARDINAL (N - (H * Hour) - (M * Minute));
  346. END SerialNumberToTime;
  347.  
  348.  
  349. PROCEDURE TimeToSerialNumber (H, M, S: CARDINAL): LONGCARD;
  350. (*
  351.    Convert a time to a time serial number - seconds since midnight
  352. *)
  353. BEGIN
  354.   RETURN (Hour * LONGCARD (H)) + (Minute * LONGCARD (M)) + LONGCARD (S);
  355. END TimeToSerialNumber;
  356.  
  357.  
  358. PROCEDURE TimeStrToTime (TS: ARRAY OF CHAR; VAR H, M, S: CARDINAL);
  359. (*
  360.    Convert a time string to hours, minutes and seconds
  361. *)
  362. VAR ok   : BOOLEAN;
  363.     Temp : ARRAY [1..9] OF CHAR;
  364. BEGIN
  365.   Copy (TS, 0, 2, Temp);
  366.   ok := StrToCard (Temp, H);
  367.   Copy (TS, 3, 2, Temp);
  368.   ok := StrToCard (Temp, M);
  369.   Copy (TS, 6, 2, Temp);
  370.   ok := StrToCard (Temp, S);
  371. END TimeStrToTime;
  372.  
  373.  
  374. PROCEDURE LeapYear (Y: CARDINAL): BOOLEAN;
  375. (*
  376.    Is the year a leap year?
  377. *)
  378. VAR Result: BOOLEAN;
  379. BEGIN
  380.   Result := FALSE;
  381.   IF (Y = (Y DIV Leap) * Leap) THEN
  382.     Result := TRUE;
  383.     IF (Y = (Y DIV Century) * Century) THEN
  384.       Result := FALSE;
  385.       IF (Y = (Y DIV QuadCentury) * QuadCentury) THEN
  386.         Result := TRUE;
  387.       END;
  388.     END;
  389.   END;
  390.   RETURN (Result);
  391. END LeapYear;
  392.  
  393.  
  394. PROCEDURE DaysInMonth (Y, M: CARDINAL): CARDINAL;
  395. (*
  396.    How many days are in a given month?
  397. *)
  398. VAR Result: CARDINAL;
  399. BEGIN
  400.   IF (M = 2) THEN
  401.     IF LeapYear (Y) THEN
  402.       Result := 29;
  403.     ELSE
  404.       Result := 28;
  405.     END;
  406.   ELSIF (M IN {4, 6, 9, 11}) THEN
  407.     Result := 30;
  408.   ELSE
  409.     Result := 31;
  410.   END;
  411.  
  412.   RETURN (Result);
  413. END DaysInMonth;
  414.  
  415.  
  416. BEGIN  (* Initialization *)
  417. END TimeDate.
  418.