freepascal.compiler/fvision/time.pas

{ $Id$ }
{*********************[ TIME UNIT ]************************}
{                                                          }
{             System independent TIME unit                 }
{                                                          }
{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
{   [email protected]  - primary e-mail address        }
{   [email protected] - backup e-mail address         }
{                                                          }
{****************[ THIS CODE IS FREEWARE ]*****************}
{                                                          }
{     This sourcecode is released for the purpose to       }
{   promote the pascal language on all platforms. You may  }
{   redistribute it and/or modify with the following       }
{   DISCLAIMER.                                            }
{                                                          }
{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
{                                                          }
{*****************[ SUPPORTED PLATFORMS ]******************}
{     16 and 32 Bit compilers                              }
{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
{                 - Delphi 1.0+             (16 Bit)       }
{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
{                 - Virtual Pascal 2.0+     (32 Bit)       }
{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
{                 - FPC 0.9912+             (32 Bit)       }
{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
{                 - Speed Pascal 1.0+       (32 Bit)       }
{                 - C'T patch to BP         (16 Bit)       }
{                                                          }
{******************[ REVISION HISTORY ]********************}
{  Version  Date        Fix                                }
{  -------  ---------   ---------------------------------  }
{  1.00     06 Dec 96   First multi platform release.      }
{  1.10     06 Jul 97   New functiions added.              }
{  1.20     22 Jul 97   FPC pascal compiler added.         }
{  1.30     29 Aug 97   Platform.inc sort added.           }
{  1.40     13 Oct 97   Delphi 2/3 32 bit code added.      }
{  1.50     06 Nov 97   Speed pascal code added.           }
{  1.60     05 May 98   Virtual pascal 2.0 compiler added. }
{  1.61     07 Jul 99   Speedsoft SYBIL 2.0 code added.    }
{**********************************************************}

UNIT Time;

{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                  INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

{====Include file to sort compiler platform out =====================}
{$I Platform.inc}
{====================================================================}

{==== Compiler directives ===========================================}

{$IFNDEF PPC_FPC} { FPC doesn't support these switches }
   {$F-} { Short calls are okay }
   {$A+} { Word Align Data }
   {$B-} { Allow short circuit boolean evaluations }
   {$O+} { This unit may be overlaid }
   {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
   {$E+} {  Emulation is on }
   {$N-} {  No 80x87 code generation }
{$ENDIF}

{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
{$I-} { Disable IO Checking }
{$Q-} { Disable Overflow Checking }
{$V-} { Turn off strict VAR strings }
{====================================================================}

{***************************************************************************}
{                            INTERFACE ROUTINES                             }
{***************************************************************************}

{-CurrentMinuteOfDay-------------------------------------------------
Returns the number of minutes since midnight of a current system time.
19Jun97 LdB               (Range: 0 - 1439)
---------------------------------------------------------------------}
FUNCTION CurrentMinuteOfDay: Word;

{-CurrentSecondOfDay-------------------------------------------------
Returns the number of seconds since midnight of current system time.
24Jun97 LdB               (Range: 0 - 86399)
---------------------------------------------------------------------}
FUNCTION CurrentSecondOfDay: LongInt;

{-CurrentSec100OfDay-------------------------------------------------
Returns the 1/100ths of a second since midnight of current system time.
24Jun97 LdB               (Range: 0 - 8639999)
---------------------------------------------------------------------}
FUNCTION CurrentSec100OfDay: LongInt;

{-MinuteOfDay--------------------------------------------------------
Returns the number of minutes since midnight of a valid given time.
19Jun97 LdB               (Range: 0 - 1439)
---------------------------------------------------------------------}
FUNCTION MinuteOfDay (Hour24, Minute: Word): Word;

{-SecondOfDay--------------------------------------------------------
Returns the number of seconds since midnight of a valid given time.
19Jun97 LdB               (Range: 0 - 86399)
---------------------------------------------------------------------}
FUNCTION SecondOfDay (Hour24, Minute, Second: Word): LongInt;

{-SetTime------------------------------------------------------------
Set the operating systems time clock to the given values. If values
are invalid this function will fail without notification.
06Nov97 LdB
---------------------------------------------------------------------}
PROCEDURE SetTime (Hour, Minute, Second, Sec100: Word);

{-GetTime------------------------------------------------------------
Returns the current time settings of the operating system.
06Nov97 LdB
---------------------------------------------------------------------}
PROCEDURE GetTime (Var Hour, Minute, Second, Sec100: Word);

{-MinutesToTime------------------------------------------------------
Returns the time in hours and minutes of a given number of minutes.
19Jun97 LdB
---------------------------------------------------------------------}
PROCEDURE MinutesToTime (Md: LongInt; Var Hour24, Minute: Word);

{-SecondsToTime------------------------------------------------------
Returns the time in hours, mins and secs of a given number of seconds.
19Jun97 LdB
---------------------------------------------------------------------}
PROCEDURE SecondsToTime (Sd: LongInt; Var Hour24, Minute, Second: Word);

{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{$IFDEF OS_WINDOWS}                                   { WIN/NT CODE }

  {$IFNDEF PPC_SPEED}                                 { NON SPEED COMPILER }
    {$IFDEF PPC_FPC}                                  { FPC WINDOWS COMPILER }
    USEs Windows;                                     { Standard unit }
    {$ELSE}                                           { OTHER COMPILERS }
    USES WinTypes, WinProcs;                          { Standard units }
    {$ENDIF}
  {$ELSE}                                             { SPEEDSOFT COMPILER }
  USES WinBase;                                       { Standard unit }
  TYPE TSystemTime = SystemTime;                      { Type fix up }
  {$ENDIF}

{$ENDIF}

{$IFDEF OS_OS2}                                       { OS2 COMPILERS }

  {$IFDEF PPC_VIRTUAL}                                { VIRTUAL PASCAL }
  USES OS2Base;                                       { Standard unit }
  {$ENDIF}

  {$IFDEF PPC_SPEED}                                  { SPEED PASCAL }
  USES BseDos, Os2Def;                                { Standard unit }
  {$ENDIF}

  {$IFDEF PPC_BPOS2}                                  { C'T PATCH TO BP CODE }
  USES DosTypes, DosProcs;                            { Standard unit }

  TYPE DateTime = TDateTime;                          { Type correction }
  {$ENDIF}

{$ENDIF}

{$ifdef OS_UNIX}
  USES Dos;
{$endif OS_UNIX}

{$ifdef OS_GO32}
  USES Dos;
{$endif OS_GO32}

{***************************************************************************}
{                            INTERFACE ROUTINES                             }
{***************************************************************************}

{---------------------------------------------------------------------------}
{  CurrentMinuteOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Jun97 LdB}
{---------------------------------------------------------------------------}
FUNCTION CurrentMinuteOfDay: Word;
VAR Hour, Minute, Second, Sec100: Word;
BEGIN
   GetTime(Hour, Minute, Second, Sec100);             { Get current time }
   CurrentMinuteOfDay := (Hour * 60) + Minute;        { Minute from midnight }
END;

{---------------------------------------------------------------------------}
{  CurrentSecondOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Jun97 LdB}
{---------------------------------------------------------------------------}
FUNCTION CurrentSecondOfDay: LongInt;
VAR Hour, Minute, Second, Sec100: Word;
BEGIN
   GetTime(Hour, Minute, Second, Sec100);             { Get current time }
   CurrentSecondOfDay := (LongInt(Hour) * 3600) +
     (Minute * 60) + Second;                          { Second from midnight }
END;

{---------------------------------------------------------------------------}
{  CurrentSec100OfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Jun97 LdB}
{---------------------------------------------------------------------------}
FUNCTION CurrentSec100OfDay: LongInt;
VAR Hour, Minute, Second, Sec100: Word;
BEGIN
   GetTime(Hour, Minute, Second, Sec100);             { Get current time }
   CurrentSec100OfDay := (LongInt(Hour) * 360000) +
     (LongInt(Minute) * 6000) + (Second*100)+ Sec100; { Sec100 from midnight }
END;

{---------------------------------------------------------------------------}
{  MinuteOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB       }
{---------------------------------------------------------------------------}
FUNCTION MinuteOfDay (Hour24, Minute: Word): Word;
BEGIN
   MinuteOfDay := (Hour24 * 60) + Minute;             { Minute from midnight }
END;

{---------------------------------------------------------------------------}
{  SecondOfDay -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB       }
{---------------------------------------------------------------------------}
FUNCTION SecondOfDay (Hour24, Minute, Second: Word): LongInt;
BEGIN
   SecondOfDay := (LongInt(Hour24) * 3600) +
     (Minute * 60) + Second;                          { Second from midnight }
END;

{---------------------------------------------------------------------------}
{  SetTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Nov97 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE SetTime (Hour, Minute, Second, Sec100: Word);
{$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
   {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
   ASSEMBLER;
   ASM
     MOV CH, BYTE PTR Hour;                           { Fetch hour }
     MOV CL, BYTE PTR Minute;                         { Fetch minute }
     MOV DH, BYTE PTR Second;                         { Fetch second }
     MOV DL, BYTE PTR Sec100;                         { Fetch hundredths }
     MOV AX, $2D00;                                   { Set function id }
     PUSH BP;                                         { Safety save register }
     INT $21;                                         { Set the time }
     POP BP;                                          { Restore register }
   END;
   {$ENDIF}
   {$IFDEF ASM_FPC}                                   { FPC COMPATABLE ASM }
   BEGIN
   ASM
     MOVB Hour, %CH;                                  { Fetch hour }
     MOVB Minute, %CL;                                { Fetch minute }
     MOVB Second, %DH;                                { Fetch second }
     MOVB Sec100, %DL;                                { Fetch hundredths }
     MOVW $0x2D00, %AX;                               { Set function id }
     PUSHL %EBP;                                      { Save register }
     INT $0x21;                                       { BIOS set time }
     POPL %EBP;                                       { Restore register }
   END;
   END;
   {$ENDIF}
{$ENDIF}
{$IFDEF OS_WINDOWS}                                   { WIN/NT CODE }
   {$IFDEF BIT_16}                                    { 16 BIT WINDOWS CODE }
   ASSEMBLER;
   ASM
     MOV CH, BYTE PTR Hour;                           { Fetch hour }
     MOV CL, BYTE PTR Minute;                         { Fetch minute }
     MOV DH, BYTE PTR Second;                         { Fetch second }
     MOV DL, BYTE PTR Sec100;                         { Fetch hundredths }
     MOV AX, $2D00;                                   { Set function id }
     PUSH BP;                                         { Safety save register }
     INT $21;                                         { Set the time }
     POP BP;                                          { Restore register }
   END;
   {$ENDIF}
   {$IFDEF BIT_32}                                    { 32 BIT WINDOWS CODE }
   VAR DT: TSystemTime;
   BEGIN
     {$IFDEF PPC_FPC}                                 { FPC WINDOWS COMPILER }
     GetLocalTime(@DT);                              { Get the date/time }
     {$ELSE}                                          { OTHER COMPILERS }
     GetLocalTime(DT);                               { Get the date/time }
     {$ENDIF}
     DT.wHour := Hour;                                { Transfer hour }
     DT.wMinute := Minute;                            { Transfer minute }
     DT.wSecond := Second;                            { Transfer seconds }
     DT.wMilliseconds := Sec100 * 10;                 { Transfer millisecs }
     SetLocalTime(DT);                               { Set the date/time }
   END;
   {$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2}                                       { OS2 CODE }
VAR DT: DateTime;
BEGIN
   DosGetDateTime(DT);                                { Get the date/time }
   DT.Hours := Hour;                                  { Transfer hour }
   DT.Minutes := Minute;                              { Transfer minute }
   DT.Seconds := Second;                              { Transfer seconds }
   DT.Hundredths := Sec100;                           { Transfer hundredths }
   DosSetDateTime(DT);                                { Set the time }
END;
{$ENDIF}
{$ifdef OS_UNIX}
BEGIN
 {settime is dummy in Linux}
END;
{$endif OS_UNIX}

{---------------------------------------------------------------------------}
{  GetTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Nov97 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE GetTime (Var Hour, Minute, Second, Sec100: Word);
{$IFDEF OS_DOS}                                       { DOS/DPMI CODE }
   {$IFDEF ASM_BP}                                    { BP COMPATABLE ASM }
   ASSEMBLER;
   ASM
     MOV AX, $2C00;                                   { Set function id }
     PUSH BP;                                         { Safety save register }
     INT $21;                                         { System get time }
     POP BP;                                          { Restore register }
     XOR AH, AH;                                      { Clear register }
     CLD;                                             { Strings go forward }
     MOV AL, DL;                                      { Transfer register }
     LES DI, Sec100;                                  { ES:DI -> hundredths }
     STOSW;                                           { Return hundredths }
     MOV AL, DH;                                      { Transfer register }
     LES DI, Second;                                  { ES:DI -> seconds }
     STOSW;                                           { Return seconds }
     MOV AL, CL;                                      { Transfer register }
     LES DI, Minute;                                  { ES:DI -> minutes }
     STOSW;                                           { Return minutes }
     MOV AL, CH;                                      { Transfer register }
     LES DI, Hour;                                    { ES:DI -> hours }
     STOSW;                                           { Return hours }
   END;
   {$ENDIF}
   {$IFDEF OS_GO32}                                   { FPC COMPATABLE ASM }
   BEGIN
   (* ASM
     MOVW $0x2C00, %AX;                               { Set function id }
     PUSHL %EBP;                                      { Save register }
     INT $0x21;                                       { System get time }
     POPL %EBP;                                       { Restore register }
     XORB %AH, %AH;                                   { Clear register }
     MOVB %DL, %AL;                                   { Transfer register }
     MOVL Sec100, %EDI;                               { EDI -> Sec100 }
     MOVW %AX, (%EDI);                                { Return Sec100 }
     MOVB %DH, %AL;                                   { Transfer register }
     MOVL Second, %EDI;                               { EDI -> Second }
     MOVW %AX, (%EDI);                                { Return Second }
     MOVB %CL, %AL;                                   { Transfer register }
     MOVL Minute, %EDI;                               { EDI -> Minute }
     MOVW %AX, (%EDI);                                { Return minute }
     MOVB %CH, %AL;                                   { Transfer register }
     MOVL Hour, %EDI;                                 { EDI -> Hour }
     MOVW %AX, (%EDI);                                { Return hour }
   END; *)
   { direct call of real interrupt seems to render the system
     unstable on Win2000 because some registers are not properly
     restored if a mouse interrupt is generated while the Dos
     interrupt is called... PM }
     Dos.GetTime(Hour,Minute,Second,Sec100);
   END;
   {$ENDIF}
{$ENDIF}
{$IFDEF OS_WINDOWS}                                   { WIN/NT CODE }
   {$IFDEF BIT_16}                                    { 16 BIT WINDOWS CODE }
   ASSEMBLER;
   ASM
     MOV AX, $2C00;                                   { Set function id }
     PUSH BP;                                         { Safety save register }
     INT $21;                                         { System get time }
     POP BP;                                          { Restore register }
     XOR AH, AH;                                      { Clear register }
     CLD;                                             { Strings go forward }
     MOV AL, DL;                                      { Transfer register }
     LES DI, Sec100;                                  { ES:DI -> hundredths }
     STOSW;                                           { Return hundredths }
     MOV AL, DH;                                      { Transfer register }
     LES DI, Second;                                  { ES:DI -> seconds }
     STOSW;                                           { Return seconds }
     MOV AL, CL;                                      { Transfer register }
     LES DI, Minute;                                  { ES:DI -> minutes }
     STOSW;                                           { Return minutes }
     MOV AL, CH;                                      { Transfer register }
     LES DI, Hour;                                    { ES:DI -> hours }
     STOSW;                                           { Return hours }
   END;
   {$ENDIF}
   {$IFDEF BIT_32}                                    { 32 BIT WINDOWS CODE }
   VAR DT: TSystemTime;
   BEGIN
     {$IFDEF PPC_FPC}                                 { FPC WINDOWS COMPILER }
     GetLocalTime(@DT);                              { Get the date/time }
     {$ELSE}                                          { OTHER COMPILERS }
     GetLocalTime(DT);                               { Get the date/time }
     {$ENDIF}
     Hour := DT.wHour;                                { Transfer hour }
     Minute := DT.wMinute;                            { Transfer minute }
     Second := DT.wSecond;                            { Transfer seconds }
     Sec100 := DT.wMilliseconds DIV 10;               { Transfer hundredths }
   END;
   {$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2}                                       { OS2 CODE }
VAR DT: DateTime;
BEGIN
   DosGetDateTime(DT);                                { Get the date/time }
   Hour   := DT.Hours;                                { Transfer hour }
   Minute := DT.Minutes;                              { Transfer minute }
   Second := DT.Seconds;                              { Transfer seconds }
   Sec100 := DT.Hundredths;                           { Transfer hundredths }
END;
{$ENDIF}
{$ifdef OS_UNIX}
BEGIN
  Dos.GetTime(Hour,Minute,Second,Sec100);
END;
{$endif OS_UNIX}

{---------------------------------------------------------------------------}
{  MinutesToTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB     }
{---------------------------------------------------------------------------}
PROCEDURE MinutesToTime (Md: LongInt; Var Hour24, Minute: Word);
BEGIN
   Hour24 := Md DIV 60;                               { Hours of time }
   Minute := Md MOD 60;                               { Minutes of time }
END;

{---------------------------------------------------------------------------}
{  SecondsToTime -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Jun97 LdB     }
{---------------------------------------------------------------------------}
PROCEDURE SecondsToTime (Sd: LongInt; Var Hour24, Minute, Second: Word);
BEGIN
   Hour24 := Sd DIV 3600;                             { Hours of time }
   Minute := Sd MOD 3600 DIV 60;                      { Minutes of time }
   Second := Sd MOD 60;                               { Seconds of time }
END;

END.

{
 $Log$
 Revision 1.8  2002-09-09 08:02:49  pierre
  * avoid instabilities on win2000

 Revision 1.7  2002/09/07 15:06:38  peter
   * old logs removed and tabs fixed

 Revision 1.6  2002/06/04 11:12:41  marco
  * Renamefest

 Revision 1.5  2002/06/03 20:26:16  pierre
  * use local time for windows

}