Power-Programmierung/CD1.mdf/pascal/library/dos/tug__002/timer.pas

Pascal/Delphi Source File | 1988-08-08 | 22.7 KB | 669 lines

{TUG PDS CERT 1.01 (Pascal)

==========================================================================

                  TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION

The Turbo User Group (TUG) is recognized by Borland International as the
official support organization for Turbo languages.  This file has been
compiled and verified by the TUG library staff.  We are reasonably certain
that the information contained in this file is public domain material, but
it is also subject to any restrictions applied by its author.

This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
DOMAIN, provided as a service of TUG for the use of its members.  The
Turbo User Group will not be liable for any damages, including any lost
profits, lost savings or other incidental or consequential damages arising
out of the use of or inability to use the contents, even if TUG has been
advised of the possibility of such damages, or for any claim by any
other party.

To the best of our knowledge, the routines in this file compile and function
properly in accordance with the information described below.

If you discover an error in this file, we would appreciate it if you would
report it to us.  To report bugs, or to request information on membership
in TUG, please contact us at:

             Turbo User Group
             PO Box 1510
             Poulsbo, Washington USA  98370

--------------------------------------------------------------------------
                       F i l e    I n f o r m a t i o n

* DESCRIPTION
Version 1.01. Author Rob Rosenberger. Turbo Pascal 4.0 unit source code
provides 256 independent stop-watch timers. Great for timing the execution
of a routine or an I/O access. Timer #0 specifically times the overall
program, the rest are at your disposal. Fully compatible with other
programs and units since it dosen't use clock ticks.

* ASSOCIATED FILES


* CHECKED BY
DRM - 08/08/88

* KEYWORDS
TURBO PASCAL V4.0 TIME TIMER CLOCK

==========================================================================
}
{$R-,S+,I+,D+,T-,F-,V+,B-,N-,L+ }

UNIT Timer;  {Version 1.01, released to the public domain on 20 June 1988 }

{
Created by:          Rob Rosenberger             CompuServe
                      P.O. Box #643              74017,1344
                   O'Fallon, IL  62269


   This unit takes the hassles off the programmer when it comes to timing
programming routines, disk accesses, etc.  Just place the appropriate routine
calls where you want to start/start the timer, or catch a lap-time.  This
unit does the rest!
   You can use up to 255 different timers at once!  Just supply the number of
the timer you want to use.  Clock #zero is a special timer that starts when
the program begins.  You can tell how long your program has been running just
by using GetLapTime(0)!
   The unit does NOT count clock ticks or anything like that.  It asks DOS for
the current date & time and calculates the elapsed time from that.  It should
be compatible with any program or unit.
   Please send a letter or CompuServe EasyPlex message if you have any ideas
that will make this unit even better.  I'll give you credit for your ideas!

Version 1.00: released to the public domain on 24 Feb 88.

Version 1.01: released to the public domain on 20 Jun 88
   Altered the returned strings for GetLapTime and RestartTimer so they would
only show the time-lapse portion.  The programmer must attach a description to
the time, i.e. WRITE(OUTPUT,Timer0msg + GetLapTime(0)).
   Added logic to the program to account for a DOS 3.20 bug which doesn't roll
the date when the DOS clock ticks past midnight.  The TIMER unit now accounts
for just such a possibility and, if it comes across it, it will add one day to
the current time.  Note: This means a time-lapse is limited to 24 hours.  Any
multiple-day lapses will be lost because of the DOS 3.20 bug.
}

INTERFACE {section}

USES DOS;


PROCEDURE StartTimer (WhichClock : BYTE);
  {Starts the internal clock.  Resets the clock if it was previously set.}

FUNCTION  GetLapTime (WhichClock : BYTE) : STRING;
  {Returns a string showing the elapsed time.  The returned string is...
    "xx:xx:xx.xx".  The clock continues to run.}

PROCEDURE RestartTimer (WhichClock : BYTE);
  {Restarts the clock if the StopTimer procedure stopped the clock.  It does
    nothing if the clock is still running.}

FUNCTION  StopTimer (WhichClock : BYTE) : STRING;
  {Stops the timer without clearing the elapsed time.  Returned string will be
    one of the following...  "xx:xx:xx.xx", or "Can't stop clock #0!".}

{----------------------------------------------------------------------------}



IMPLEMENTATION {section}

CONST
   NullChar = $00;
   Colon    = ':';
   Period   = '.';
   Space    = ' ';
   Zero     = '0';

TYPE
   DateRecord = RECORD
                Year      : WORD;
                Month     : WORD;
                Date      : WORD;
                DayOfWeek : WORD
                END;

   TimeRecord = RECORD
                Hour      : WORD;
                Minute    : WORD;
                Second    : WORD;
                Hundredth : WORD
                END;

   ClockRecord = RECORD
                 ClockStartDate : DateRecord;
                 ClockStartTime : TimeRecord;
                 ElapsedTime    : TimeRecord;
                 ClockIsRunning : BOOLEAN;
                 END;

VAR
   ClockArray : ARRAY [BYTE] OF ClockRecord;


{============================================================================}
PROCEDURE AddTogetherTwoTimeRecords(TimeRecordOne : TimeRecord;
                                    TimeRecordTwo : TimeRecord;
                                VAR ResultRecord  : TimeRecord);
   {This is an internal procedure.}

   {This procedure adds two time records and stores the result in the third
record.  It is up to the calling routine to deal with times that go beyond the
24-hour mark.}

BEGIN {AdditionOfTwoTimes}
ResultRecord.Hundredth := (TimeRecordOne.Hundredth + TimeRecordTwo.Hundredth);
ResultRecord.Second    := (TimeRecordOne.Second    + TimeRecordTwo.Second);
ResultRecord.Minute    := (TimeRecordOne.Minute    + TimeRecordTwo.Minute);
ResultRecord.Hour      := (TimeRecordOne.Hour      + TimeRecordTwo.Hour);

WHILE (ResultRecord.Hundredth >= 100)
 DO BEGIN
    DEC(ResultRecord.Hundredth,100);
    INC(ResultRecord.Second)
    END;
WHILE (ResultRecord.Second >= 60)
 DO BEGIN
    DEC(ResultRecord.Second,60);
    INC(ResultRecord.Minute)
    END;
WHILE (ResultRecord.Minute >= 60)
 DO BEGIN
    DEC(ResultRecord.Minute,60);
    INC(ResultRecord.Hour)
    END
END; {AdditionOfTwoTimes}
{============================================================================}

{============================================================================}
PROCEDURE AddOneDayToDate(VAR TheDateRecord : DateRecord);
   {This is an internal procedure.}

   {This procedure adds one day to TheDateRecord.  Results are unpredictable
with an invalid date.}

BEGIN {AddOneDayToDate}
WITH TheDateRecord
 DO BEGIN
    INC(Date);
    CASE Month OF
      1, 3, 5, 7, 8, 10, 12 :
        IF (Date > 31)
         THEN
            BEGIN
            DEC(Date,31);
            INC(Month)
            END;
      4, 6, 9, 11 :
        IF (Date > 30)
         THEN
            BEGIN
            DEC(Date,30);
            INC(Month)
            END;
      2 :
        IF (Date > 29)
         THEN
            BEGIN
            DEC(Date,29);
            Month := 3
            END
         ELSE
            IF ((Date > 28) AND NOT (((Year MOD 4) = 0)
             AND (((Year MOD 100) <> 0) OR ((Year MOD 400) = 0))))
             THEN
                BEGIN
                DEC(Date,28);
                Month := 3
                END
     END; {CASE Month}
    WHILE (Month > 12)
     DO BEGIN
        DEC(Month,12);
        INC(Year)
        END;
    INC(DayOfWeek);
    DayOfWeek := (DayOfWeek MOD 7)
    END {WITH TheDateRec}
END; {AddOneDayToDate}
{============================================================================}

{============================================================================}
FUNCTION JulianDate(TheDate : DateRecord) : LONGINT;
   {This is an internal function.}

   {This function returns TheDate as a long integer which is the value of the
date as a julian date.  It assumes the date is valid or at least zeroed-out.
The syntax of the julian date is Year*1000 + the day of the year.  Be sure the
year is in the format 19xx, not just xx!
   Julian dates are nice in that you can compare them to see which date comes
first in history.}

VAR
   TempLongInt : LONGINT;

BEGIN {JulianDate}
TempLongInt := TheDate.Year;
TempLongInt := (TempLongInt * 1000);
   {We do this portion of the logic in two steps because we would get overflow
   if we said "TempLongInt := (DateRecord.Year * 1000)".  See the TP4 manual,
   p. 210 for an in-depth explanation.}

CASE TheDate.Month OF
  02 : INC(TempLongInt,31);
  03 : INC(TempLongInt,59);
  04 : INC(TempLongInt,90);
  05 : INC(TempLongInt,120);
  06 : INC(TempLongInt,151);
  07 : INC(TempLongInt,181);
  08 : INC(TempLongInt,212);
  09 : INC(TempLongInt,243);
  10 : INC(TempLongInt,273);
  11 : INC(TempLongInt,304);
  12 : INC(TempLongInt,334)
 END; {CASE DateRecord.Month}
IF (((TheDate.Year MOD 4) = 0) AND (TheDate.Month > 2))
 THEN
    IF (((TheDate.Year MOD 100) <> 0) OR ((TheDate.Year MOD 400) = 0))
     THEN INC(TempLongInt); {add a day for leapyears}

TempLongInt := (TempLongInt + TheDate.Date);

JulianDate := TempLongInt
END; {JulianDate}
{============================================================================}

{============================================================================}
PROCEDURE SubtractOneDayFromDate(VAR TheDateRecord : DateRecord);
   {This is an internal procedure.}

   {This procedure subtracts one day to TheDateRecord.  Results are unpredict-
able with an invalid date.}

BEGIN {SubtractOneDayFromDate}
WITH TheDateRecord
 DO BEGIN
    IF Date = 1
     THEN
        BEGIN
        IF Month = 1
         THEN
            BEGIN
            DEC(Year);
            Month := 12;
            Date := 31
            END
         ELSE
            BEGIN
            DEC(Month);
            CASE Month OF
              1, 3, 5, 7, 8, 10, 12 :
                Date := 31;
              4, 6, 9, 11 :
                Date := 30;
              2 :
                IF (((Year MOD 4) = 0)
                 AND (((Year MOD 100) <> 0) OR ((Year MOD 400) = 0)))
                 THEN Date := 29
                 ELSE Date := 28
             END {CASE Month}
            END
        END
     ELSE
        DEC(Date);
    IF (DayOfWeek = 0)
     THEN
        DayOfWeek := 6
     ELSE
        DEC(DayOfWeek)
    END {WITH TheDateRec}
END; {SubtractOneDayFromDate}
{============================================================================}

{============================================================================}
FUNCTION  ConvertTimeToString(TheTimeRec : TimeRecord) : STRING;
   {This is an internal function.}

   {This function creates a time string from TheTimeRec.  It doesn't check to
see if the time is valid.}

VAR
   TempString1 : STRING;
   TempString2 : STRING;
   Index       : BYTE;

BEGIN {ConvertTimeToString}
STR(TheTimeRec.Hour:2,{VAR} TempString1);
STR(TheTimeRec.Minute:2,{VAR} TempString2);
TempString1 := (TempString1 + Colon + TempString2);
STR(TheTimeRec.Second:2,{VAR} TempString2);
TempString1 := (TempString1 + Colon + TempString2);
STR(TheTimeRec.Hundredth:2,{VAR} TempString2);
TempString1 := (TempString1 + Period + TempString2);

FOR Index := 1 TO LENGTH(TempString1)
 DO IF (TempString1[Index] = Space)
     THEN TempString1[Index] := Zero;
ConvertTimeToString := TempString1
END; {ConvertTimeToString}
{============================================================================}

{============================================================================}
FUNCTION  DatesAreEqual(DateRecord1 : DateRecord;
                        DateRecord2 : DateRecord) : BOOLEAN;

   {This function determines if two date records are identical.  It does not
compare the day of the week.}

BEGIN {DatesAreEqual}
IF ((DateRecord1.Date = DateRecord2.Date)
 AND (DateRecord1.Month = DateRecord2.Month)
 AND (DateRecord1.Year = DateRecord2.Year))
 THEN DatesAreEqual := TRUE
 ELSE DatesAreEqual := FALSE
END; {DatesAreEqual}
{============================================================================}

{============================================================================}
FUNCTION  JulianTime(TimeRecord : TimeRecord) : LONGINT;

   {This function returns the given TimeRecord as a long integer which is the
value of the time as a julian time.  Julian times are nice in that you can
compare them to see which time is earlier in the day.}

VAR
   TempLongInt  : LONGINT;
   TempVariable : LONGINT;

BEGIN {JulianTime}
TempLongInt  := TimeRecord.Hour;
TempLongInt  := (TempLongInt * 1000000);
TempVariable := TimeRecord.Minute;
TempLongInt  := (TempLongInt
                   + (TempVariable * 10000)
                   + (TimeRecord.Second * 100)
                   + TimeRecord.Hundredth);
  {We do some portions of the logic in two steps because we would get overflow
    if we said "TempLongInt := (TimeRecord.Hour * 1000000)", etc.  See the TP4
    manual, p. 210 for an in-depth explanation.}

JulianTime := TempLongInt
END; {JulianTime}
{============================================================================}

{============================================================================}
PROCEDURE DetermineLengthBetweenTwoDateTimes(StartDateRecord   : DateRecord;
                                             StartTimeRecord   : TimeRecord;
                                             EndDateRecord     : DateRecord;
                                             EndTimeRecord     : TimeRecord;
                                         VAR ElapsedTimeRecord : TimeRecord);
   {This is an internal procedure.}

   {This procedure determines the length of time between two dates/times.  It
assumes the starting date/time comes after the ending date/time.
   This procedure quickly calculates the elapsed time, then begins adding one
day at a time until it determines the date separation.  Lengthy separations
will require quite a few add-one-day repetitions!
   Should the starting date be GREATER THAN the ending date, this procedure
will assume DOS 3.20 is in use and it's date-rollover bug has popped up.  It
will add one day to the ending date as a compromise.}

VAR
   JulianEndDate : LONGINT;

BEGIN {DetermineLengthBetweenTwoDateTimes}
{Initialize.}
WITH ElapsedTimeRecord
 DO BEGIN
    Hour      := 0;
    Minute    := 0;
    Second    := 0;
    Hundredth := 0
    END;

IF ((JulianDate(StartDateRecord) > JulianDate(EndDateRecord))
 OR (DatesAreEqual(StartDateRecord,EndDateRecord)
 AND (JulianTime(StartTimeRecord) > JulianTime(EndTimeRecord))))
 THEN {StartDateRecord comes chronologically after EndDateRecord!}
    AddOneDayToDate({VAR} EndDateRecord);

WHILE (EndTimeRecord.Hundredth < StartTimeRecord.Hundredth)
 DO BEGIN
    INC(EndTimeRecord.Hundredth,100);
    IF (EndTimeRecord.Second = 0)
     THEN
        BEGIN
        EndTimeRecord.Second := 59;
        IF (EndTimeRecord.Minute = 0)
         THEN
            BEGIN
            EndTimeRecord.Minute := 59;
            IF (EndTimeRecord.Hour = 0)
             THEN
                BEGIN
                EndTimeRecord.Hour := 23;
                SubtractOneDayFromDate(EndDateRecord)
                END
             ELSE
                DEC(EndTimeRecord.Hour)
            END
         ELSE
            DEC(EndTimeRecord.Minute)
        END
     ELSE
        DEC(EndTimeRecord.Second)
    END; {WHILE (EndTimeRecord.Hundreth < StartTimeRecord.Hundredth)}
ElapsedTimeRecord.Hundredth := (EndTimeRecord.Hundredth
                                        - StartTimeRecord.Hundredth);

WHILE (EndTimeRecord.Second < StartTimeRecord.Second)
 DO BEGIN
    INC(EndTimeRecord.Second,60);
    IF (EndTimeRecord.Minute = 0)
     THEN
        BEGIN
        EndTimeRecord.Minute := 59;
        IF (EndTimeRecord.Hour = 0)
         THEN
            BEGIN
            EndTimeRecord.Hour := 23;
            SubtractOneDayFromDate(EndDateRecord)
            END
         ELSE
            DEC(EndTimeRecord.Hour)
        END
     ELSE
        DEC(EndTimeRecord.Minute)
    END; {WHILE (EndTimeRecord.Second < StartTimeRecord.Second)}
ElapsedTimeRecord.Second := (EndTimeRecord.Second - StartTimeRecord.Second);

WHILE (EndTimeRecord.Minute < StartTimeRecord.Minute)
 DO BEGIN
    INC(EndTimeRecord.Minute,60);
    IF (EndTimeRecord.Hour = 0)
     THEN
        BEGIN
        EndTimeRecord.Hour := 23;
        SubtractOneDayFromDate(EndDateRecord)
        END
     ELSE
        DEC(EndTimeRecord.Hour)
    END; {WHILE (EndTimeRecord.Minute < StartTimeRecord.Minute)}
ElapsedTimeRecord.Minute := (EndTimeRecord.Minute - StartTimeRecord.Minute);

WHILE (EndTimeRecord.Hour < StartTimeRecord.Hour)
 DO BEGIN
    INC(EndTimeRecord.Hour,24);
    SubtractOneDayFromDate(EndDateRecord)
    END; {WHILE (EndTimeRecord.Hour < StartTimeRecord.Hour)}
ElapsedTimeRecord.Hour := (EndTimeRecord.Hour - StartTimeRecord.Hour);

JulianEndDate := JulianDate(EndDateRecord);
WHILE (JulianDate(StartDateRecord) <> JulianEndDate)
 DO BEGIN
    INC(ElapsedTimeRecord.Hour,24);
    AddOneDayToDate({VAR} StartDateRecord)
    END {WHILE}
END; {DetermineLengthBetweenTwoDateTimes}
{============================================================================}

{============================================================================}
PROCEDURE StartTimer (WhichClock : BYTE);

  {Starts the internal clock.  Resets the clock if it was previously set.}

BEGIN {StartTimer}
IF (WhichClock = 0)
 THEN {can't reset the program-timer clock!}
    EXIT
 ELSE
    WITH ClockArray[WhichClock]
     DO BEGIN
        WITH ClockStartDate
         DO GETDATE({VAR} Year,Month,Date,DayOfWeek);
        WITH ClockStartTime
         DO GETTIME({VAR} Hour,Minute,Second,Hundredth);
        WITH ElapsedTime
         DO BEGIN
            Hour      := 0;
            Minute    := 0;
            Second    := 0;
            Hundredth := 0
            END;
        ClockIsRunning := TRUE
        END
END; {StartTimer}
{============================================================================}

{============================================================================}
FUNCTION  GetLapTime (WhichClock : BYTE) : STRING;

  {Returns a string showing the elapsed time.  The returned string is...
    "xx:xx:xx.xx".  The clock continues to run.}

VAR
   CurrentDate : DateRecord;
   CurrentTime : TimeRecord;
   ElapsedTime : TimeRecord;
   TempString  : STRING[3];

BEGIN {GetLapTime}
{Initialize.}
WITH CurrentDate
 DO GETDATE({VAR} Year,Month,Date,DayOfWeek);
WITH CurrentTime
 DO GETTIME({VAR} Hour,Minute,Second,Hundredth);
FILLCHAR(ElapsedTime,SIZEOF(ElapsedTime),NullChar);
STR(WhichClock,{VAR} TempString);

{Determine how long it's been since timer was started.}
DetermineLengthBetweenTwoDateTimes(ClockArray[WhichClock].ClockStartDate,
                                   ClockArray[WhichClock].ClockStartTime,
                                   CurrentDate,
                                   CurrentTime,
                             {VAR} ElapsedTime);
{Add that to any lap time that was stored when StopTimer routine was called.}
AddTogetherTwoTimeRecords(ElapsedTime,
                          ClockArray[WhichClock].ElapsedTime,
                    {VAR} ElapsedTime);

{Feed information back to the calling routine.}
GetLapTime := ConvertTimeToString(ElapsedTime)
END; {GetLapTime}
{============================================================================}

{============================================================================}
PROCEDURE RestartTimer (WhichClock : BYTE);

  {Restarts the clock if the StopTimer procedure stopped the clock.  It does
    nothing if the clock is still running.}

BEGIN {RestartTimer}
WITH ClockArray[WhichClock]
 DO BEGIN
    WITH ClockStartDate
     DO GETDATE({VAR} Year,Month,Date,DayOfWeek);
    WITH ClockStartTime
     DO GETTIME({VAR} Hour,Minute,Second,Hundredth);
    {Leave the elapsed time alone.}
    ClockIsRunning := TRUE
    END
END; {RestartTimer}

{============================================================================}


{============================================================================}
FUNCTION  StopTimer (WhichClock : BYTE) : STRING;

  {Stops the timer without clearing the elapsed time.  Returned string will be
    one of the following...  "xx:xx:xx.xx", or "Can't stop clock #0!".}

CONST
   CantStopClockZeroText = 'Can''t stop clock #0!';

VAR
   CurrentDate : DateRecord;
   CurrentTime : TimeRecord;
   ElapsedTime : TimeRecord;
   TempString  : STRING[3];

BEGIN {StopTimer}
IF ((WhichClock = 0)
 OR (NOT ClockArray[WhichClock].ClockIsRunning))
 THEN {tell programmer we can't stop the overall program timer}
    StopTimer := (CantStopClockZeroText)
 ELSE
    BEGIN
    {Initialize.}
    WITH CurrentDate
     DO GETDATE({VAR} Year,Month,Date,DayOfWeek);
    WITH CurrentTime
     DO GETTIME({VAR} Hour,Minute,Second,Hundredth);
    FILLCHAR(ElapsedTime,SIZEOF(ElapsedTime),NullChar);
    STR(WhichClock,{VAR} TempString);

    {Determine how long it's been since timer was started.}
    DetermineLengthBetweenTwoDateTimes(ClockArray[WhichClock].ClockStartDate,
                                       ClockArray[WhichClock].ClockStartTime,
                                       CurrentDate,
                                       CurrentTime,
                                 {VAR} ElapsedTime);
    {Add that to any lap time currently stored.}
    AddTogetherTwoTimeRecords(ElapsedTime,
                              ClockArray[WhichClock].ElapsedTime,
                        {VAR} ClockArray[WhichClock].ElapsedTime);

    ClockArray[WhichClock].ClockIsRunning := FALSE;

    {Feed information back to the calling routine.}
    StopTimer := ConvertTimeToString(ElapsedTime)
    END
END; {StopTimer}
{============================================================================}





BEGIN {Timer UNIT}

{Zero-out the ClockArray.}
FILLCHAR(ClockArray,SIZEOF(ClockArray),NullChar);

{Start the program timer, AKA ClockArray(0).}
WITH ClockArray[0]
 DO BEGIN
    WITH ClockStartDate
     DO GETDATE({VAR} Year,Month,Date,DayOfWeek);
    WITH ClockStartTime
     DO GETTIME({VAR} Hour,Minute,Second,Hundredth);
    ClockIsRunning := TRUE
    END

END. {Timer UNIT}