Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/NUTUG11.ZIP/DATETIME.PAS

Pascal/Delphi Source File | 1987-11-21 | 13.4 KB | 432 lines

Unit DateTime;
             {NORTHWESTERN UNIVERSITY TURBO USERS GROUP UTILITIES}

                            (** FILE DATETIME.PAS **)


          {This is a set of routines for (1) Getting and Setting the
          DOS system time and date. (2) Event timing.               }

          {/These routines provide a good illustration of the use of
          DOS function calls.                                      /}

Interface

Uses      Dos,
          Crt,
          BASECON;
                 {The InBCD function in this file is required by
                 three of the following routines.               }



PROCEDURE GetDosDate (VAR M, DofM, Y, DofW : integer);
         {Gets date with MS-DOS call.                                       }

PROCEDURE GetDosTime (VAR Hour, Min, Sec, CSec : integer);
         {Gets the time with MS-DOS interrupt call.}

FUNCTION SetDosDate (Month, Day, Year : integer) : Boolean;
         {Sets the DOS date according to the input: Year (1980 - 2099)
         Month (1 - 12) and Day (1 - 31). Returns false if any of the
         inputs are out of range.                                    }

FUNCTION SetDosTime (Hour24, Min, Sec : integer) : Boolean;
         {Uses DOS interrupt to set time according to input: Hour24
         (0 - 23), Min (0 - 59) and Sec (0 - 59). }

PROCEDURE ASTDateTime (VAR H, M, S, mS, Y, Mo, D : Integer);
         (***************************************************************)
         (* This procedure will read the time off of an AST Memory board*)
         (* (and probably all of its clones) equipped with a National   *)
         (* Semiconductor MM58167A Real time clock.                     *)
         (***************************************************************)

FUNCTION DOSTimer : real;
         {Returns time since midnight in milliseconds. The average
         resolution is 54 milliseconds.                          }

FUNCTION JTimer : real;
         {This function returns the time in milliseconds since midnight
         for systems having TallTree J-RAM 2 board. The resolution is
         1 millisecond.}

FUNCTION ASTTimer : real;
         {For systems having AST clock/calendar board or compatable.
         Returns the time since midnight in milliseconds with a
         resolution of one millisecond.}

PROCEDURE DateTimeDemo;

Implementation

TYPE

  RegType  = Registers;

PROCEDURE GetDosDate (VAR M, DofM, Y, DofW : integer);

         {Gets date with MS-DOS call.                                       }

VAR

  Reg : RegType;

Begin

  Reg.AH := $2A;                       {Function call $2A returns the date. }
  MsDos (Reg);

  with Reg do
    begin
      Y    := CX;
      M    := DH;
      DofM := DL;
      DofW := AL;                      {Undocumented. See GetDosTime.       }
    end {with}                         {Sun = 0, Sat = 6.                   }

End; {GetDosDate (VAR M, DofM, Y, DofW : integer}


PROCEDURE GetDosTime (VAR Hour, Min, Sec, CSec : integer);

         {Gets the time with MS-DOS interrupt call. NOTE: The DOS V2
         Technical Manual incorrectly states that the Day of Week is
         returned by function $2C. In fact, it is returned by the date
         function $2A (as is logical).

         The clock is only updated 18.2 times per second so there is
         uncertainty of +/- 2.5/100 sec in the value returned in CSec.}

VAR

  Reg : RegType;

Begin

  Reg.AH := $2C;                       {Function call $2C returns time.     }
  MsDos (Reg);

  with Reg do
    begin
      Hour   := CH;
      Min    := CL;
      Sec    := DH;
      CSec   := DL;                     {Sec/100.                           }
    end {with}

End; {GetDosTime (VAR Hour, Min, Sec, CSec : integer)}


FUNCTION SetDosDate (Month, Day, Year : integer) : Boolean;

         {Sets the DOS date according to the input: Year (1980 - 2099)
         Month (1 - 12) and Day (1 - 31). Returns false if any of the
         inputs are out of range.                                    }

VAR

  Reg : RegType;

Begin

  with Reg do
    begin
      AH := $2B;                       {Set Date function.                  }
      CX := Year;
      DH := Month;
      DL := Day;
    end; {with}

  MsDos (Reg);

  SetDosDate := Reg.Al = 0;            {AL is the error return.             }

         {/Note: This is more economical than an: if . . then . . else
          construction.                                                    /}

End; {SetDosDate (Month, Day, Year : integer) : Boolean}


FUNCTION SetDosTime (Hour24, Min, Sec : integer) : Boolean;

         {Uses DOS interrupt to set time according to input: Hour24
         (0 - 23), Min (0 - 59) and Sec (0 - 59). See comment for set-
         ting 1/100 sec if this is required.

         Function returns false if any of the inputs are out range.   }

VAR

  Reg : RegType;

Begin

  with Reg do
    begin
      AH := $2D;                       {Set Time function.                  }
      CH := Hour24;
      CL := Min;
      DH := Sec mod 60;                {*}
      DL := 0;                         {Use for setting 1/100 sec.          }
    end; {with}

         {*Sec mod 60 to avoid error in case 'Sec' undefined.}

  MsDos (Reg);
  SetDosTime := Reg.AL = 0;             {AL is the error return.             }

End; {SetDosTime (Hour24, Min, Sec : integer) : Boolean}




PROCEDURE ASTDateTime (VAR H, M, S, mS, Y, Mo, D : Integer);

         (***************************************************************
         This procedure will read the time off of an AST Memory board
         (and probably all of its clones) equipped with a National
         Semiconductor MM58167A Real time clock. Although the National
         Semiconductor clock uses the I/O adresses $2C0 to $2DF, AST
         has put a "latch" in front of the clock so that all of the
         functions can be used while only using 8 bytes of I/O space.
         Thus, the procedure for extracting the time is different than
         that for the J-Ram timer (see JTimer in these utilities).
         Execution speed is sacrificed for I/O space. The function takes
         3 ms to execute (using a Zenith 151 with a V-20 running at 4.77
         MHz. See the clock-board's manual for more details.
                                                   6-13-86 SEL
          ************************************************************)

Var ccs:integer;

Function ReadPortAST (PortNum:integer):integer;
begin
  port[$2C0]:=PortNum;
  ReadPortAST:=Port[$2C1];
end;


Begin                     (*ASTTime*)
                          (*First read the ports as quickly as possible*)
  ms :=ReadPortAST(0);    (*actually, this is 1/10000 of a second*)
  ccs :=ReadPortAST(1);
  s  :=ReadPortAST(2);
  m  :=ReadPortAST(3);
  h  :=ReadPortAST(4);
  D  :=ReadPortAST(6);
  Mo :=ReadPortAST(7);
  Y  :=(ReadPortAST(10));
                           (*Now convert from BCD*)
  ms:=InBCD(ccs)*10 + InBCD(ms shr 4);
  s :=InBCD(s);
  m :=InBCD(m);
  h :=InBCD(h);
  D :=InBCD(D);
  Mo:=InBCD(Mo);
  Y :=InBCD(Y);

End; {ASTDateTime}



           {/The following three functions return the time since
           midnight in milliseconds and are intended for timing
           purposes. DOSTimer will work on any IBM PC compatable
           system but has a resolution of only 54 milliseconds. The
           remaining two use clock/calendar boards and have a reso-
           lution of one millisecond. For critical applications
           the time should be determined for executing the function
           and this should be subtracted from the observed time.

           By using the calendar functions the timing range can be
           extended. But watch out for the following: (1) Overflow
           of the mantissa. (2) It has been reported that a correction
           of several seconds is made to the DOS clock at midnight.
           (3) The DOS clock on most sytems drift by a minute or
           more a day.                                           /}


FUNCTION DOSTimer : real;

         {Returns time since midnight in milliseconds. The average
         resolution is 54 milliseconds.                          }


VAR

  Reg : RegType;

Begin

  Reg.AH := $2C;                       {Function call $2C returns time.     }
  MsDos (Reg);

  with Reg do
    begin
      DOSTimer :=
        3.6E6 * CH +                   {Hours.                              }
        6.0E4 * CL +                   {Mins.                               }
        1.0E3 * DH +                   {Secs.                               }
        1.0E1 * Dl;                    {Secs / 100.                         }
    end {with}

End; {DOSTimer : real}


FUNCTION JTimer : real;


         {This function returns the time in milliseconds since midnight
         for systems having TallTree J-RAM 2 board. The resolution is
         1 millisecond.

         The ports for the clock on the J-RAM board are assigned as follows;

           $2C0*  : (Integer)  millisec X 10;
           $2C2*  : (Byte)     sec;
           $2C3*  : (Byte)     min;
           $2C4*  : (Byte)     hr;
           $2C6*  : (Byte)     day;
           $2C9   : (Byte)     month;
           $2CA   : (Byte)     year - 1980;

         *NOTE: Values returned by these ports are in BCD.           }

         {/Data transfer between external devices and the 8088 is by
         the use of 'Ports'. Turbo has two pre-defined arrays, Port
         and PortW, for passing byte and integer data respectively.
         The index of the array defines the port number.            /}

VAR

  Ms, S, M, H : integer;

Begin

  Ms := PortW[$2C0];                   {Poll the ports as rapidly as        }
  S  := Port[$2C2];                    {possible in order to minimize the   }
  M  := Port[$2C3];                    {probability that a port will be     }
  H  := Port[$2C4];                    {incremented during polling.         }

  Ms := Ms shr 4;                      {A BCD divide by ten.                }

  JTimer := 3.6E6 * InBCD (H) +        {Hours.                              }
            6.0E4 * InBCD (M) +        {Minutes.                            }
            1.0E3 * InBCD (S) +        {Seconds.                            }
            InBCD (Ms);

End; {JTimer : real}


FUNCTION ASTTimer : real;

         {For systems having AST clock/calendar board or compatable.
         Returns the time since midnight in milliseconds with a
         resolution of one millisecond.

         The coding is based on Scott Lindsey's ASTDateTime routine. }

VAR

  MSec, CSec, Sec, Min, Hr : integer;


Begin

  Port [$2C0] := 0;
  MSec        := Port [$2C1];          {Actually 1/10000 sec.               }
  Port [$2C0] := 1;
  CSec        := Port [$2C1];
  Port [$2C0] := 2;
  Sec         := Port [$2C1];
  Port [$2C0] := 3;
  Min         := Port [$2C1];
  Port [$2C0] := 4;
  Hr          := Port [$2C1];

  MSec := MSec shr 4;                  {BCD convert to millisec.            }

  ASTTimer := 3.6E6 * InBCD (Hr)   +   {Hours.                              }
              6.0E4 * InBCD (Min)  +   {Minutes.                            }
              1.0E3 * InBCD (Sec)  +   {Seconds.                            }
              1.0E1 * InBCD (CSec) +   {Centisec.                           }
                      InBCD (MSec);

End; {ASTTimer : real}


PROCEDURE DateTimeDemo;

TYPE

  String10 = string[10];

Procedure ErrorMsg (Word : String10);

begin

  GoToXY (5, 22); ClrEol;
  if Word <> '' then
    write (Word + ' not in allowed range. Please re-enter.');

end; {ErrorMsg (Word : String10}

VAR

 Y, M, D, K, Hr, Min, Sec : integer;
 OK                    : Boolean;
 ch                    : char;

Begin

  repeat
    ClrScr;
    ch := ' ';                         {Initialize.                         }
    GoToXY (31, 5); write ('DOS Date-Time Demo');
    GoToXY (31, 6); write ('------------------');
    repeat
      GoToXY (1, 9); ClrEol;
      write ('Enter date to set - Month (1 - 12): ':50);
      read (M); writeln; ClrEol;
      write ('Day (1 - 31): ':50);
      read (D); writeln; ClrEol;
      write ('Year (4 digits): ':50);
      read (Y);
      OK := SetDosDate (M, D, Y);
      if not OK then
        ErrorMsg ('Date');
    until OK;
    ErrorMsg ('');                     {Clear.                              }
    writeln; writeln;
    repeat
      GoToXY (1, 14); ClrEol;
      write ('Enter time to set - Hr (0 - 23): ':50);
      read (Hr); writeln; ClrEol;
      write ('Min (0 - 59): ':50);
      read (Min); writeln; ClrEol;
      write ('Sec (0 - 59): ':50);
      read (Sec);
      OK := SetDosTime (Hr, Min, Sec);
      if not OK then
        ErrorMsg ('Time');
    until OK;

    ErrorMsg ('');                     {Clear.                              }
    GoToXY (1, 19);
    GetDosDate (M, D, Y, K);
    GetDosTime (Hr, Min, Sec, K);
    writeln ('     The date has been entered as: ', M, '-', D, '-', Y - 1900);
    writeln;
    writeln ('     The time has been entered as: ', Hr, ':', Min, ':', Sec);

    GoToXY (6, 24); write ('Press any key to repeat or Q to quit. ');
    Ch := readkey;
  until UpCase (ch) = 'Q';

End; {DateTimeDemo}

BEGIN (* Unit DateTime *)

END.